aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/kernel
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/kernel')
-rw-r--r--lib/kernel/AUTHORS42
-rw-r--r--lib/kernel/Makefile35
-rw-r--r--lib/kernel/doc/html/.gitignore0
-rw-r--r--lib/kernel/doc/man3/.gitignore0
-rw-r--r--lib/kernel/doc/man4/.gitignore0
-rw-r--r--lib/kernel/doc/man6/.gitignore0
-rw-r--r--lib/kernel/doc/pdf/.gitignore0
-rw-r--r--lib/kernel/doc/src/Makefile150
-rw-r--r--lib/kernel/doc/src/app.xml199
-rw-r--r--lib/kernel/doc/src/application.xml622
-rw-r--r--lib/kernel/doc/src/auth.xml109
-rw-r--r--lib/kernel/doc/src/book.xml45
-rw-r--r--lib/kernel/doc/src/code.xml829
-rw-r--r--lib/kernel/doc/src/config.xml125
-rw-r--r--lib/kernel/doc/src/disk_log.xml1162
-rw-r--r--lib/kernel/doc/src/erl_boot_server.xml126
-rw-r--r--lib/kernel/doc/src/erl_ddll.xml1165
-rw-r--r--lib/kernel/doc/src/erl_prim_loader_stub.xml42
-rw-r--r--lib/kernel/doc/src/erlang_stub.xml42
-rw-r--r--lib/kernel/doc/src/error_handler.xml98
-rw-r--r--lib/kernel/doc/src/error_logger.xml450
-rw-r--r--lib/kernel/doc/src/fascicules.xml15
-rw-r--r--lib/kernel/doc/src/file.xml2002
-rw-r--r--lib/kernel/doc/src/gen_sctp.xml1075
-rw-r--r--lib/kernel/doc/src/gen_tcp.xml464
-rw-r--r--lib/kernel/doc/src/gen_udp.xml179
-rw-r--r--lib/kernel/doc/src/global.xml399
-rw-r--r--lib/kernel/doc/src/global_group.xml284
-rw-r--r--lib/kernel/doc/src/heart.xml116
-rw-r--r--lib/kernel/doc/src/inet.xml827
-rw-r--r--lib/kernel/doc/src/inet_res.xml482
-rw-r--r--lib/kernel/doc/src/init_stub.xml42
-rw-r--r--lib/kernel/doc/src/kernel_app.xml348
-rw-r--r--lib/kernel/doc/src/make.dep28
-rw-r--r--lib/kernel/doc/src/net_adm.xml166
-rw-r--r--lib/kernel/doc/src/net_kernel.xml331
-rw-r--r--lib/kernel/doc/src/notes.xml2273
-rw-r--r--lib/kernel/doc/src/notes_history.xml415
-rw-r--r--lib/kernel/doc/src/os.xml212
-rw-r--r--lib/kernel/doc/src/packages.xml214
-rw-r--r--lib/kernel/doc/src/part_notes.xml39
-rw-r--r--lib/kernel/doc/src/part_notes_history.xml39
-rw-r--r--lib/kernel/doc/src/pg2.xml199
-rw-r--r--lib/kernel/doc/src/ref_man.xml69
-rw-r--r--lib/kernel/doc/src/rpc.xml499
-rw-r--r--lib/kernel/doc/src/seq_trace.xml506
-rw-r--r--lib/kernel/doc/src/user.xml40
-rw-r--r--lib/kernel/doc/src/user_guide.gifbin0 -> 1581 bytes
-rw-r--r--lib/kernel/doc/src/wrap_log_reader.xml157
-rw-r--r--lib/kernel/doc/src/zlib_stub.xml42
-rw-r--r--lib/kernel/ebin/.gitignore0
-rw-r--r--lib/kernel/examples/Makefile54
-rw-r--r--lib/kernel/examples/uds_dist/c_src/Makefile32
-rw-r--r--lib/kernel/examples/uds_dist/c_src/uds_drv.c1065
-rw-r--r--lib/kernel/examples/uds_dist/ebin/.gitignore0
-rw-r--r--lib/kernel/examples/uds_dist/priv/.gitignore0
-rw-r--r--lib/kernel/examples/uds_dist/src/Makefile27
-rw-r--r--lib/kernel/examples/uds_dist/src/uds.erl166
-rw-r--r--lib/kernel/examples/uds_dist/src/uds_dist.app7
-rw-r--r--lib/kernel/examples/uds_dist/src/uds_dist.erl304
-rw-r--r--lib/kernel/examples/uds_dist/src/uds_server.erl156
-rw-r--r--lib/kernel/include/file.hrl70
-rw-r--r--lib/kernel/include/inet.hrl36
-rw-r--r--lib/kernel/include/inet_sctp.hrl247
-rw-r--r--lib/kernel/info2
-rw-r--r--lib/kernel/internal_doc/distribution_handshake.txt215
-rw-r--r--lib/kernel/priv/.gitignore0
-rw-r--r--lib/kernel/src/Makefile243
-rw-r--r--lib/kernel/src/application.erl263
-rw-r--r--lib/kernel/src/application_controller.erl1946
-rw-r--r--lib/kernel/src/application_master.erl426
-rw-r--r--lib/kernel/src/application_master.hrl20
-rw-r--r--lib/kernel/src/application_starter.erl111
-rw-r--r--lib/kernel/src/auth.erl391
-rw-r--r--lib/kernel/src/code.erl491
-rw-r--r--lib/kernel/src/code_server.erl1539
-rw-r--r--lib/kernel/src/disk_log.erl1899
-rw-r--r--lib/kernel/src/disk_log.hrl161
-rw-r--r--lib/kernel/src/disk_log_1.erl1551
-rw-r--r--lib/kernel/src/disk_log_server.erl368
-rw-r--r--lib/kernel/src/disk_log_sup.erl32
-rw-r--r--lib/kernel/src/dist.hrl38
-rw-r--r--lib/kernel/src/dist_ac.erl1534
-rw-r--r--lib/kernel/src/dist_util.erl762
-rw-r--r--lib/kernel/src/dist_util.hrl87
-rw-r--r--lib/kernel/src/erl_boot_server.erl325
-rw-r--r--lib/kernel/src/erl_ddll.erl150
-rw-r--r--lib/kernel/src/erl_distribution.erl106
-rw-r--r--lib/kernel/src/erl_epmd.erl553
-rw-r--r--lib/kernel/src/erl_epmd.hrl32
-rw-r--r--lib/kernel/src/erl_reply.erl49
-rw-r--r--lib/kernel/src/error_handler.erl141
-rw-r--r--lib/kernel/src/error_logger.erl387
-rw-r--r--lib/kernel/src/erts_debug.erl155
-rw-r--r--lib/kernel/src/file.erl1077
-rw-r--r--lib/kernel/src/file_io_server.erl882
-rw-r--r--lib/kernel/src/file_server.erl325
-rw-r--r--lib/kernel/src/gen_sctp.erl230
-rw-r--r--lib/kernel/src/gen_tcp.erl192
-rw-r--r--lib/kernel/src/gen_udp.erl117
-rw-r--r--lib/kernel/src/global.erl2244
-rw-r--r--lib/kernel/src/global_group.erl1347
-rw-r--r--lib/kernel/src/global_search.erl279
-rw-r--r--lib/kernel/src/group.erl689
-rw-r--r--lib/kernel/src/heart.erl271
-rw-r--r--lib/kernel/src/hipe_ext_format.hrl41
-rw-r--r--lib/kernel/src/hipe_unified_loader.erl894
-rw-r--r--lib/kernel/src/inet.erl1342
-rw-r--r--lib/kernel/src/inet6_sctp.erl75
-rw-r--r--lib/kernel/src/inet6_tcp.erl153
-rw-r--r--lib/kernel/src/inet6_tcp_dist.erl417
-rw-r--r--lib/kernel/src/inet6_udp.erl87
-rw-r--r--lib/kernel/src/inet_boot.hrl32
-rw-r--r--lib/kernel/src/inet_config.erl638
-rw-r--r--lib/kernel/src/inet_config.hrl34
-rw-r--r--lib/kernel/src/inet_db.erl1525
-rw-r--r--lib/kernel/src/inet_dns.erl701
-rw-r--r--lib/kernel/src/inet_dns.hrl208
-rw-r--r--lib/kernel/src/inet_dns_record_adts.pl180
-rw-r--r--lib/kernel/src/inet_gethost_native.erl626
-rw-r--r--lib/kernel/src/inet_hosts.erl123
-rw-r--r--lib/kernel/src/inet_int.hrl414
-rw-r--r--lib/kernel/src/inet_parse.erl755
-rw-r--r--lib/kernel/src/inet_res.erl846
-rw-r--r--lib/kernel/src/inet_res.hrl42
-rw-r--r--lib/kernel/src/inet_sctp.erl139
-rw-r--r--lib/kernel/src/inet_tcp.erl153
-rw-r--r--lib/kernel/src/inet_tcp_dist.erl448
-rw-r--r--lib/kernel/src/inet_udp.erl132
-rw-r--r--lib/kernel/src/kernel.app.src120
-rw-r--r--lib/kernel/src/kernel.appup.src1
-rw-r--r--lib/kernel/src/kernel.erl292
-rw-r--r--lib/kernel/src/kernel_config.erl173
-rw-r--r--lib/kernel/src/net.erl39
-rw-r--r--lib/kernel/src/net_address.hrl28
-rw-r--r--lib/kernel/src/net_adm.erl239
-rw-r--r--lib/kernel/src/net_kernel.erl1513
-rw-r--r--lib/kernel/src/os.erl291
-rw-r--r--lib/kernel/src/packages.erl158
-rw-r--r--lib/kernel/src/pg2.erl376
-rw-r--r--lib/kernel/src/ram_file.erl492
-rw-r--r--lib/kernel/src/rpc.erl609
-rw-r--r--lib/kernel/src/seq_trace.erl126
-rw-r--r--lib/kernel/src/standard_error.erl253
-rw-r--r--lib/kernel/src/user.erl786
-rw-r--r--lib/kernel/src/user_drv.erl614
-rw-r--r--lib/kernel/src/user_sup.erl129
-rw-r--r--lib/kernel/src/wrap_log_reader.erl288
-rw-r--r--lib/kernel/test/Makefile149
-rw-r--r--lib/kernel/test/appinc.app10
-rw-r--r--lib/kernel/test/appinc1.app9
-rw-r--r--lib/kernel/test/appinc1.erl49
-rw-r--r--lib/kernel/test/appinc1x.app9
-rw-r--r--lib/kernel/test/appinc1x.erl49
-rw-r--r--lib/kernel/test/appinc2.app9
-rw-r--r--lib/kernel/test/appinc2.erl49
-rw-r--r--lib/kernel/test/appinc2A.app9
-rw-r--r--lib/kernel/test/appinc2A.erl49
-rw-r--r--lib/kernel/test/appinc2B.app9
-rw-r--r--lib/kernel/test/appinc2B.erl49
-rw-r--r--lib/kernel/test/appinc2top.app10
-rw-r--r--lib/kernel/test/appinc2top.erl49
-rw-r--r--lib/kernel/test/application_SUITE.erl2734
-rw-r--r--lib/kernel/test/application_SUITE_data/Makefile.src24
-rw-r--r--lib/kernel/test/application_SUITE_data/app_start_error.erl35
-rw-r--r--lib/kernel/test/application_SUITE_data/group_leader.erl61
-rw-r--r--lib/kernel/test/application_SUITE_data/group_leader_sup.erl37
-rw-r--r--lib/kernel/test/application_SUITE_data/subdir/t3.config1
-rw-r--r--lib/kernel/test/application_SUITE_data/t1.config2
-rw-r--r--lib/kernel/test/application_SUITE_data/t2.config2
-rw-r--r--lib/kernel/test/application_SUITE_data/trans_abnormal_sup.erl39
-rw-r--r--lib/kernel/test/application_SUITE_data/trans_normal_sup.erl38
-rw-r--r--lib/kernel/test/application_SUITE_data/transient.erl52
-rw-r--r--lib/kernel/test/bif_SUITE.erl649
-rw-r--r--lib/kernel/test/ch.erl84
-rw-r--r--lib/kernel/test/ch_sup.erl51
-rw-r--r--lib/kernel/test/cleanup.erl38
-rw-r--r--lib/kernel/test/code_SUITE.erl1236
-rw-r--r--lib/kernel/test/code_SUITE_data/calendar.erl23
-rw-r--r--lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/ebin/code_archive_dict.app12
-rw-r--r--lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/priv/code_archive.txt1
-rw-r--r--lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict.erl125
-rw-r--r--lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_app.erl29
-rw-r--r--lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_sup.erl39
-rw-r--r--lib/kernel/test/code_SUITE_data/dummy_app-1.0/ebin/dummy_file1
-rw-r--r--lib/kernel/test/code_SUITE_data/dummy_app-1.0/priv/dummy_file1
-rw-r--r--lib/kernel/test/code_SUITE_data/dummy_app-2.0/ebin/dummy_file1
-rw-r--r--lib/kernel/test/code_SUITE_data/dummy_app-2.0/priv/dummy_file1
-rw-r--r--lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-a/ebin/.gitignore0
-rw-r--r--lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-b/ebin/lists.erl24
-rw-r--r--lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module.erl24
-rw-r--r--lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-d/ebin/.gitignore0
-rw-r--r--lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-e/ebin/.gitignore0
-rw-r--r--lib/kernel/test/code_SUITE_data/on_load/on_load_a.erl28
-rw-r--r--lib/kernel/test/code_SUITE_data/on_load/on_load_b.erl12
-rw-r--r--lib/kernel/test/code_SUITE_data/on_load/on_load_c.erl14
-rw-r--r--lib/kernel/test/code_SUITE_data/on_load_app-1.0/ebin/on_load_app.app10
-rw-r--r--lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl18
-rw-r--r--lib/kernel/test/code_SUITE_data/pa/dummy1
-rw-r--r--lib/kernel/test/code_SUITE_data/pz/dummy1
-rw-r--r--lib/kernel/test/code_a_test.erl28
-rw-r--r--lib/kernel/test/code_b_test.erl47
-rw-r--r--lib/kernel/test/disk_log_SUITE.erl5162
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/Makefile.src15
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt.LOG.1bin0 -> 53 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt.LOG.2bin0 -> 53 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt.LOG.3bin0 -> 53 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt.LOG.4bin0 -> 53 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt.LOG.idxbin0 -> 17 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.1bin0 -> 53 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.2bin0 -> 53 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.3bin0 -> 53 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.4bin0 -> 53 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.idxbin0 -> 21 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.sizbin0 -> 8 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/nfs_check.c46
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/old_terms.LOGbin0 -> 131536 bytes
-rw-r--r--lib/kernel/test/disk_log_SUITE_data/wrap_log_test.erl184
-rw-r--r--lib/kernel/test/erl_boot_server_SUITE.erl338
-rw-r--r--lib/kernel/test/erl_distribution_SUITE.erl1235
-rw-r--r--lib/kernel/test/erl_distribution_wb_SUITE.erl705
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE.erl517
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/ebin/primary_archive_dict.app12
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/priv/primary_archive.txt1
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict.erl125
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_app.erl29
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_sup.erl39
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/ebin/primary_archive_dummy.app11
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy.erl29
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_app.erl29
-rw-r--r--lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_sup.erl33
-rw-r--r--lib/kernel/test/error_logger_SUITE.erl300
-rw-r--r--lib/kernel/test/error_logger_warn_SUITE.erl503
-rw-r--r--lib/kernel/test/file_SUITE.erl3716
-rw-r--r--lib/kernel/test/file_SUITE_data/cooked_tar_problem.tar.gzbin0 -> 4285 bytes
-rw-r--r--lib/kernel/test/file_SUITE_data/corrupted.gz5
-rw-r--r--lib/kernel/test/file_SUITE_data/realmen.html520
-rw-r--r--lib/kernel/test/file_SUITE_data/realmen.html.gzbin0 -> 10303 bytes
-rw-r--r--lib/kernel/test/gen_sctp_SUITE.erl338
-rw-r--r--lib/kernel/test/gen_tcp_api_SUITE.erl219
-rw-r--r--lib/kernel/test/gen_tcp_echo_SUITE.erl585
-rw-r--r--lib/kernel/test/gen_tcp_misc_SUITE.erl2362
-rw-r--r--lib/kernel/test/gen_udp_SUITE.erl410
-rw-r--r--lib/kernel/test/global_SUITE.erl4395
-rw-r--r--lib/kernel/test/global_SUITE_data/global_trace.erl1023
-rw-r--r--lib/kernel/test/global_group_SUITE.erl1415
-rw-r--r--lib/kernel/test/global_group_SUITE_data/.gitignore0
-rw-r--r--lib/kernel/test/heart_SUITE.erl460
-rw-r--r--lib/kernel/test/heart_SUITE_data/Makefile.src14
-rw-r--r--lib/kernel/test/heart_SUITE_data/simple_echo.c17
-rw-r--r--lib/kernel/test/inet_SUITE.erl735
-rw-r--r--lib/kernel/test/inet_SUITE_data/hosts22
-rw-r--r--lib/kernel/test/inet_SUITE_data/hosts_err1170
-rw-r--r--lib/kernel/test/inet_SUITE_data/resolv.conf7
-rw-r--r--lib/kernel/test/inet_SUITE_data/resolv.conf.err17
-rw-r--r--lib/kernel/test/inet_res_SUITE.erl418
-rw-r--r--lib/kernel/test/inet_res_SUITE_data/otptest/0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone12
-rw-r--r--lib/kernel/test/inet_res_SUITE_data/otptest/0.0.127.in-addr.arpa.zone27
-rw-r--r--lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf12
-rw-r--r--lib/kernel/test/inet_res_SUITE_data/otptest/root.zone50
-rwxr-xr-xlib/kernel/test/inet_res_SUITE_data/run-named163
-rw-r--r--lib/kernel/test/inet_sockopt_SUITE.erl681
-rw-r--r--lib/kernel/test/inet_sockopt_SUITE_data/Makefile.src14
-rw-r--r--lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c219
-rw-r--r--lib/kernel/test/init_SUITE.erl582
-rw-r--r--lib/kernel/test/interactive_shell_SUITE.erl616
-rw-r--r--lib/kernel/test/kernel.cover4
-rw-r--r--lib/kernel/test/kernel.dynspec57
-rw-r--r--lib/kernel/test/kernel_SUITE.erl61
-rw-r--r--lib/kernel/test/kernel_config_SUITE.erl107
-rw-r--r--lib/kernel/test/loose_node.erl193
-rw-r--r--lib/kernel/test/myApp.app7
-rw-r--r--lib/kernel/test/myApp.erl48
-rw-r--r--lib/kernel/test/os_SUITE.erl212
-rw-r--r--lib/kernel/test/os_SUITE_data/Makefile.src14
-rw-r--r--lib/kernel/test/os_SUITE_data/my_echo.c19
-rw-r--r--lib/kernel/test/os_SUITE_data/unix/.gitignore0
-rwxr-xr-xlib/kernel/test/os_SUITE_data/win32/abin/hello.exebin0 -> 27648 bytes
-rw-r--r--lib/kernel/test/os_SUITE_data/win32/abin/my_adb.bat2
-rw-r--r--lib/kernel/test/os_SUITE_data/win32/abin/my_ar.exe1
-rw-r--r--lib/kernel/test/os_SUITE_data/win32/abin/my_ascii.combin0 -> 5175 bytes
-rw-r--r--lib/kernel/test/os_SUITE_data/win32/bin/.gitignore0
-rw-r--r--lib/kernel/test/os_SUITE_data/win32/current/my_batch.bat2
-rw-r--r--lib/kernel/test/os_SUITE_data/win32/current/my_command.com1
-rw-r--r--lib/kernel/test/os_SUITE_data/win32/current/my_program.exe1
-rw-r--r--lib/kernel/test/os_SUITE_data/win32/usr/bin/.gitignore0
-rw-r--r--lib/kernel/test/pdict_SUITE.erl323
-rw-r--r--lib/kernel/test/pg2_SUITE.erl718
-rw-r--r--lib/kernel/test/prim_file_SUITE.erl1810
-rw-r--r--lib/kernel/test/prim_file_SUITE_data/corrupted.gz5
-rw-r--r--lib/kernel/test/prim_file_SUITE_data/realmen.html520
-rw-r--r--lib/kernel/test/prim_file_SUITE_data/realmen.html.gzbin0 -> 10303 bytes
-rw-r--r--lib/kernel/test/ram_file_SUITE.erl651
-rw-r--r--lib/kernel/test/ram_file_SUITE_data/corrupted.gz5
-rw-r--r--lib/kernel/test/ram_file_SUITE_data/corrupted.uu528
-rw-r--r--lib/kernel/test/ram_file_SUITE_data/realmen.html520
-rw-r--r--lib/kernel/test/ram_file_SUITE_data/realmen.html.gzbin0 -> 10284 bytes
-rw-r--r--lib/kernel/test/ram_file_SUITE_data/realmen.html.uu529
-rw-r--r--lib/kernel/test/rpc_SUITE.erl518
-rw-r--r--lib/kernel/test/seq_trace_SUITE.erl760
-rw-r--r--lib/kernel/test/seq_trace_SUITE_data/Makefile.src3
-rw-r--r--lib/kernel/test/seq_trace_SUITE_data/echo_drv.c43
-rw-r--r--lib/kernel/test/topApp.app11
-rw-r--r--lib/kernel/test/topApp.erl48
-rw-r--r--lib/kernel/test/topApp2.app11
-rw-r--r--lib/kernel/test/topApp2.erl48
-rw-r--r--lib/kernel/test/topApp3.app12
-rw-r--r--lib/kernel/test/topApp3.erl48
-rw-r--r--lib/kernel/test/wrap_log_reader_SUITE.erl550
-rw-r--r--lib/kernel/test/wrap_log_reader_SUITE_data/Makefile.src7
-rw-r--r--lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl184
-rw-r--r--lib/kernel/test/zlib_SUITE.erl1004
-rw-r--r--lib/kernel/test/zlib_SUITE_data/png-compressed.zlibbin0 -> 2205 bytes
-rw-r--r--lib/kernel/test/zlib_SUITE_data/zipdoc1924
-rw-r--r--lib/kernel/test/zlib_SUITE_data/zipdoc.1.gzbin0 -> 24620 bytes
-rw-r--r--lib/kernel/test/zlib_SUITE_data/zipdoc.txt.gzbin0 -> 20510 bytes
-rw-r--r--lib/kernel/test/zlib_SUITE_data/zipdoc.zipbin0 -> 20459 bytes
-rw-r--r--lib/kernel/vsn.mk1
318 files changed, 103097 insertions, 0 deletions
diff --git a/lib/kernel/AUTHORS b/lib/kernel/AUTHORS
new file mode 100644
index 0000000000..77636132dd
--- /dev/null
+++ b/lib/kernel/AUTHORS
@@ -0,0 +1,42 @@
+Original Authors and Contributors:
+
+Joe Armstrong
+Robert Virding
+Claes Wikstr�m
+Mike Williams
+Tony Rogvall
+Magnus Fr�berg
+Martin Bj�rklund
+Bj�rn Gustavsson
+Patrik Nyblom
+Arndt Jonasson
+Kenneth Lundin
+Esko Vierum�ki
+Peter Olin
+Micael Karlberg
+Raimo Niskanen
+Rickard Green
+Gunilla Arendt
+Hans Bolinder
+Dan Gudmundsson
+Jan-Erik Dahlin
+Jakob Cederlund
+The HiPE project (mainly loading of native code)
+Rickard Carlsson
+
+and probably others...
+
+Open source contributors:
+
+Tony Rogvall (now at Bluetail)
+ Rewrote inet_{tcp,udp}.erl and gen_{tcp,udp}.erl among others,
+ added prim_{file,inet}.erl. When adding a new and faster
+ inet_drv.
+Leonid Timochouk <l (dot) timochouk (at) gmail (dot) com> and
+Serge Aleynikov <saleyn (at) gmail (dot) com>
+ then (2006) at IDT Corp.
+ Wrote the original SCTP implementation, adapted by the OTP team;
+ in {gen,inet,inet6}_sctp.erl, inet_sctp.hrl, as well as the parts
+ in e.g prim_inet.erl and also inet_drv.c in the emulator. Their
+ included edoc documentation was manually extracted and reworked
+ into gen_sctp.xml. They continue to provide patches.
diff --git a/lib/kernel/Makefile b/lib/kernel/Makefile
new file mode 100644
index 0000000000..b90373db8b
--- /dev/null
+++ b/lib/kernel/Makefile
@@ -0,0 +1,35 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1996-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+include vsn.mk
+VSN = $(KERNEL_VSN)
+
+SUB_DIRECTORIES = src doc/src examples
+
+SPECIAL_TARGETS =
+
+# ----------------------------------------------------
+# Default Subdir Targets
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_subdir.mk
diff --git a/lib/kernel/doc/html/.gitignore b/lib/kernel/doc/html/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/doc/html/.gitignore
diff --git a/lib/kernel/doc/man3/.gitignore b/lib/kernel/doc/man3/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/doc/man3/.gitignore
diff --git a/lib/kernel/doc/man4/.gitignore b/lib/kernel/doc/man4/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/doc/man4/.gitignore
diff --git a/lib/kernel/doc/man6/.gitignore b/lib/kernel/doc/man6/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/doc/man6/.gitignore
diff --git a/lib/kernel/doc/pdf/.gitignore b/lib/kernel/doc/pdf/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/doc/pdf/.gitignore
diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile
new file mode 100644
index 0000000000..f8c1cac8b3
--- /dev/null
+++ b/lib/kernel/doc/src/Makefile
@@ -0,0 +1,150 @@
+# ``The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved via the world wide web at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+# AB. All Rights Reserved.''
+#
+# $Id$
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+include ../../vsn.mk
+VSN=$(KERNEL_VSN)
+APPLICATION=kernel
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+XML_APPLICATION_FILES = ref_man.xml
+XML_REF3_FILES = application.xml \
+ auth.xml \
+ code.xml \
+ disk_log.xml \
+ erl_boot_server.xml \
+ erl_ddll.xml \
+ erl_prim_loader_stub.xml \
+ erlang_stub.xml \
+ error_handler.xml \
+ error_logger.xml \
+ file.xml \
+ gen_tcp.xml \
+ gen_udp.xml \
+ gen_sctp.xml \
+ global.xml \
+ global_group.xml \
+ heart.xml \
+ inet.xml \
+ inet_res.xml \
+ init_stub.xml \
+ net_adm.xml \
+ net_kernel.xml \
+ os.xml \
+ packages.xml \
+ pg2.xml \
+ rpc.xml \
+ seq_trace.xml \
+ wrap_log_reader.xml \
+ user.xml \
+ zlib_stub.xml
+
+XML_REF4_FILES = app.xml config.xml
+
+XML_REF6_FILES = kernel_app.xml
+
+XML_PART_FILES = part_notes.xml part_notes_history.xml
+XML_CHAPTER_FILES = notes.xml notes_history.xml
+
+BOOK_FILES = book.xml
+
+XML_FILES = \
+ $(BOOK_FILES) $(XML_CHAPTER_FILES) \
+ $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF4_FILES) \
+ $(XML_REF6_FILES) $(XML_APPLICATION_FILES)
+
+# ----------------------------------------------------
+
+HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \
+ $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html)
+
+INFO_FILE = ../../info
+
+MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3)
+MAN4_FILES = $(XML_REF4_FILES:%.xml=$(MAN4DIR)/%.4)
+MAN6_FILES = $(XML_REF6_FILES:%_app.xml=$(MAN6DIR)/%.6)
+
+HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
+
+TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
+
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+XML_FLAGS +=
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+$(HTMLDIR)/%.gif: %.gif
+ $(INSTALL_DATA) $< $@
+
+docs: pdf html man
+
+$(TOP_PDF_FILE): $(XML_FILES)
+
+pdf: $(TOP_PDF_FILE)
+
+html: gifs $(HTML_REF_MAN_FILE)
+
+man: $(MAN3_FILES) $(MAN4_FILES) $(MAN6_FILES)
+
+gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
+debug opt:
+
+clean clean_docs:
+ rm -rf $(HTMLDIR)/*
+ rm -f $(MAN3DIR)/*
+ rm -f $(MAN4DIR)/*
+ rm -f $(MAN6DIR)/*
+ 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) $(RELSYSDIR)/doc/pdf
+ $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf
+ $(INSTALL_DIR) $(RELSYSDIR)/doc/html
+ $(INSTALL_DATA) $(HTMLDIR)/* \
+ $(RELSYSDIR)/doc/html
+ $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR)
+ $(INSTALL_DIR) $(RELEASE_PATH)/man/man3
+ $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3
+ $(INSTALL_DIR) $(RELEASE_PATH)/man/man4
+ $(INSTALL_DATA) $(MAN4_FILES) $(RELEASE_PATH)/man/man4
+ $(INSTALL_DIR) $(RELEASE_PATH)/man/man6
+ $(INSTALL_DATA) $(MAN6_FILES) $(RELEASE_PATH)/man/man6
+
+release_spec:
+
diff --git a/lib/kernel/doc/src/app.xml b/lib/kernel/doc/src/app.xml
new file mode 100644
index 0000000000..ef1f5985f4
--- /dev/null
+++ b/lib/kernel/doc/src/app.xml
@@ -0,0 +1,199 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE fileref SYSTEM "fileref.dtd">
+
+<fileref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>app</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <file>app</file>
+ <filesummary>Application resource file.</filesummary>
+ <description>
+ <p>The <em>application resource file</em> specifies the resources an
+ application uses, and how the application is started. There must
+ always be one application resource file called
+ <c>Application.app</c> for each application <c>Application</c> in
+ the system.</p>
+ <p>The file is read by the application controller when an
+ application is loaded/started. It is also used by the functions in
+ <c>systools</c>, for example when generating start scripts.</p>
+ </description>
+
+ <section>
+ <title>FILE SYNTAX</title>
+ <p>The application resource file should be called
+ <c>Application.app</c> where <c>Application</c> is the name of
+ the application. The file should be located in the <c>ebin</c>
+ directory for the application.</p>
+ <p>It must contain one single Erlang term, which is called an
+ <em>application specification</em>:</p>
+ <code type="none">
+{application, Application,
+ [{description, Description},
+ {id, Id},
+ {vsn, Vsn},
+ {modules, Modules},
+ {maxP, MaxP},
+ {maxT, MaxT},
+ {registered, Names},
+ {included_applications, Apps},
+ {applications, Apps},
+ {env, Env},
+ {mod, Start},
+ {start_phases, Phases}]}.
+
+ Value Default
+ ----- -------
+Application atom() -
+Description string() ""
+Id string() ""
+Vsn string() ""
+Modules [Module] []
+MaxP int() infinity
+MaxT int() infinity
+Names [Name] []
+Apps [App] []
+Env [{Par,Val}] []
+Start {Module,StartArgs} undefined
+Phases [{Phase,PhaseArgs}] undefined
+ Module = Name = App = Par = Phase = atom()
+ Val = StartArgs = PhaseArgs = term()</code>
+ <p><c>Application</c> is the name of the application.</p>
+ <p>For the application controller, all keys are optional.
+ The respective default values are used for any omitted keys.</p>
+ <p>The functions in <c>systools</c> require more information. If
+ they are used, the following keys are mandatory:
+ <c>description</c>, <c>vsn</c>, <c>modules</c>, <c>registered</c>
+ and <c>applications</c>. The other keys are ignored by
+ <c>systools</c>.</p>
+ <taglist>
+ <tag><c>description</c></tag>
+ <item>
+ <p>A one-line description of the application.</p>
+ </item>
+ <tag><c>id</c></tag>
+ <item>
+ <p>Product identification, or similar.</p>
+ </item>
+ <tag><c>vsn</c></tag>
+ <item>
+ <p>The version of the application.</p>
+ </item>
+ <tag><c>modules</c></tag>
+ <item>
+ <p>All modules introduced by this application. <c>systools</c>
+ uses this list when generating start scripts and tar files. A
+ module can only be defined in one application.</p>
+ </item>
+ <tag><c>maxP</c></tag>
+ <item>
+ <p><em>Deprecated - will be ignored</em> <br></br>
+
+ The maximum number of processes allowed in the application.</p>
+ </item>
+ <tag><c>maxT</c></tag>
+ <item>
+ <p>The maximum time in milliseconds that the application is
+ allowed to run. After the specified time the application will
+ automatically terminate.</p>
+ </item>
+ <tag><c>registered</c></tag>
+ <item>
+ <p>All names of registered processes started in this
+ application. <c>systools</c> uses this list to detect name
+ clashes between different applications.</p>
+ </item>
+ <tag><c>included_applications</c></tag>
+ <item>
+ <p>All applications which are included by this application.
+ When this application is started, all included application
+ will automatically be loaded, but not started, by
+ the application controller. It is assumed that the topmost
+ supervisor of the included application is started by a
+ supervisor of this application.</p>
+ </item>
+ <tag><c>applications</c></tag>
+ <item>
+ <p>All applications which must be started before this
+ application is allowed to be started. <c>systools</c> uses
+ this list to generate correct start scripts. Defaults to
+ the empty list, but note that all applications have
+ dependencies to (at least) <c>kernel</c> and <c>stdlib</c>.</p>
+ </item>
+ <tag><c>env</c></tag>
+ <item>
+ <p>Configuration parameters used by the application. The value
+ of a configuration parameter is retrieved by calling
+ <c>application:get_env/1,2</c>. The values in the application
+ resource file can be overridden by values in a configuration
+ file (see <c>config(4)</c>) or by command line flags (see
+ <c>erl(1)</c>).</p>
+ </item>
+ <tag><c>mod</c></tag>
+ <item>
+ <p>Specifies the application callback module and a start
+ argument, see <c>application(3)</c>.</p>
+ <p>The <c>mod</c> key is necessary for an application
+ implemented as a supervision tree, or the application
+ controller will not know how to start it. The <c>mod</c> key
+ can be omitted for applications without processes, typically
+ code libraries such as the application STDLIB.</p>
+ </item>
+ <tag><c>start_phases</c></tag>
+ <item>
+ <p>A list of start phases and corresponding start arguments for
+ the application. If this key is present, the application
+ master will - in addition to the usual call to
+ <c>Module:start/2</c> - also call
+ <c>Module:start_phase(Phase,Type,PhaseArgs)</c> for each
+ start phase defined by the <c>start_phases</c> key, and only
+ after this extended start procedure will
+ <c>application:start(Application)</c> return.</p>
+ <p></p>
+ <p>Start phases may be used to synchronize startup of an
+ application and its included applications. In this case,
+ the <c>mod</c> key must be specified as:</p>
+ <code type="none">
+{mod, {application_starter,[Module,StartArgs]}}</code>
+ <p>The application master will then call <c>Module:start/2</c>
+ for the primary application, followed by calls to
+ <c>Module:start_phase/3</c> for each start phase (as defined
+ for the primary application) both for the primary application
+ and for each of its included application, for which the start
+ phase is defined.</p>
+ <p></p>
+ <p>This implies that for an included application, the set of
+ start phases must be a subset of the set of phases defined
+ for the primary application. Refer to <em>OTP Design Principles</em> for more information.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><seealso marker="application">application(3)</seealso>,
+ systools(3)</p>
+ </section>
+</fileref>
+
diff --git a/lib/kernel/doc/src/application.xml b/lib/kernel/doc/src/application.xml
new file mode 100644
index 0000000000..08ef0b1e52
--- /dev/null
+++ b/lib/kernel/doc/src/application.xml
@@ -0,0 +1,622 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>application</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>application</module>
+ <modulesummary>Generic OTP application functions</modulesummary>
+ <description>
+ <p>In OTP, <em>application</em> denotes a component implementing
+ some specific functionality, that can be started and stopped as a
+ unit, and which can be re-used in other systems as well. This
+ module interfaces the <em>application controller</em>, a process
+ started at every Erlang runtime system, and contains functions
+ for controlling applications (for example starting and stopping
+ applications), and functions to access information about
+ applications (for example configuration parameters).</p>
+ <p>An application is defined by an <em>application specification</em>. The specification is normally located in an
+ <em>application resource file</em> called <c>Application.app</c>,
+ where <c>Application</c> is the name of the application. Refer to
+ <seealso marker="app">app(4)</seealso> for more information about
+ the application specification.</p>
+ <p>This module can also be viewed as a behaviour for an application
+ implemented according to the OTP design principles as a
+ supervision tree. The definition of how to start and stop
+ the tree should be located in an <em>application callback module</em> exporting a pre-defined set of functions.</p>
+ <p>Refer to <seealso marker="doc/design_principles:des_princ">OTP Design Principles</seealso> for more information about
+ applications and behaviours.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>get_all_env() -> Env</name>
+ <name>get_all_env(Application) -> Env</name>
+ <fsummary>Get the configuration parameters for an application</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Env = [{Par,Val}]</v>
+ <v>&nbsp;Par = atom()</v>
+ <v>&nbsp;Val = term()</v>
+ </type>
+ <desc>
+ <p>Returns the configuration parameters and their values for
+ <c>Application</c>. If the argument is omitted, it defaults to
+ the application of the calling process.</p>
+ <p>If the specified application is not loaded, or if the process
+ executing the call does not belong to any application,
+ the function returns <c>[]</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_all_key() -> {ok, Keys} | []</name>
+ <name>get_all_key(Application) -> {ok, Keys} | undefined </name>
+ <fsummary>Get the application specification keys</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Keys = [{Key,Val}]</v>
+ <v>&nbsp;Key = atom()</v>
+ <v>&nbsp;Val = term()</v>
+ </type>
+ <desc>
+ <p>Returns the application specification keys and their values
+ for <c>Application</c>. If the argument is omitted, it
+ defaults to the application of the calling process.</p>
+ <p>If the specified application is not loaded, the function
+ returns <c>undefined</c>. If the process executing the call
+ does not belong to any application, the function returns
+ <c>[]</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_application() -> {ok, Application} | undefined</name>
+ <name>get_application(Pid | Module) -> {ok, Application} | undefined</name>
+ <fsummary>Get the name of an application containing a certain process or module</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Module = atom()</v>
+ <v>Application = atom()</v>
+ </type>
+ <desc>
+ <p>Returns the name of the application to which the process
+ <c>Pid</c> or the module <c>Module</c> belongs. Providing no
+ argument is the same as calling
+ <c>get_application(self())</c>.</p>
+ <p>If the specified process does not belong to any application,
+ or if the specified process or module does not exist,
+ the function returns <c>undefined</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_env(Par) -> {ok, Val} | undefined</name>
+ <name>get_env(Application, Par) -> {ok, Val} | undefined</name>
+ <fsummary>Get the value of a configuration parameter</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Par = atom()</v>
+ <v>Val = term()</v>
+ </type>
+ <desc>
+ <p>Returns the value of the configuration parameter <c>Par</c>
+ for <c>Application</c>. If the application argument is
+ omitted, it defaults to the application of the calling
+ process.</p>
+ <p>If the specified application is not loaded, or
+ the configuration parameter does not exist, or if the process
+ executing the call does not belong to any application,
+ the function returns <c>undefined</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_key(Key) -> {ok, Val} | undefined</name>
+ <name>get_key(Application, Key) -> {ok, Val} | undefined</name>
+ <fsummary>Get the value of an application specification key</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Key = atom()</v>
+ <v>Val = term()</v>
+ </type>
+ <desc>
+ <p>Returns the value of the application specification key
+ <c>Key</c> for <c>Application</c>. If the application
+ argument is omitted, it defaults to the application of
+ the calling process.</p>
+ <p>If the specified application is not loaded, or
+ the specification key does not exist, or if the process
+ executing the call does not belong to any application,
+ the function returns <c>undefined</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>load(AppDescr) -> ok | {error, Reason}</name>
+ <name>load(AppDescr, Distributed) -> ok | {error, Reason}</name>
+ <fsummary>Load an application</fsummary>
+ <type>
+ <v>AppDescr = Application | AppSpec</v>
+ <v>&nbsp;Application = atom()</v>
+ <v>&nbsp;AppSpec = {application,Application,AppSpecKeys}</v>
+ <v>&nbsp;&nbsp;AppSpec = [{Key,Val}]</v>
+ <v>&nbsp;&nbsp;&nbsp;Key = atom()</v>
+ <v>&nbsp;&nbsp;&nbsp;Val = term()</v>
+ <v>Distributed = {Application,Nodes} | {Application,Time,Nodes} | default</v>
+ <v>&nbsp;Nodes = [node() | {node(),..,node()}]</v>
+ <v>&nbsp;Time = integer() > 0</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Loads the application specification for an application into
+ the application controller. It will also load the application
+ specifications for any included applications. Note that
+ the function does not load the actual Erlang object code.</p>
+ <p>The application can be given by its name <c>Application</c>.
+ In this case the application controller will search the code
+ path for the application resource file <c>Application.app</c>
+ and load the specification it contains.</p>
+ <p>The application specification can also be given directly as a
+ tuple <c>AppSpec</c>. This tuple should have the format and
+ contents as described in <c>app(4)</c>.</p>
+ <p>If <c>Distributed == {Application,[Time,]Nodes}</c>,
+ the application will be distributed. The argument overrides
+ the value for the application in the Kernel configuration
+ parameter <c>distributed</c>. <c>Application</c> must be
+ the name of the application (same as in the first argument).
+ If a node crashes and <c>Time</c> has been specified, then
+ the application controller will wait for <c>Time</c>
+ milliseconds before attempting to restart the application on
+ another node. If <c>Time</c> is not specified, it will
+ default to 0 and the application will be restarted
+ immediately.</p>
+ <p><c>Nodes</c> is a list of node names where the application
+ may run, in priority from left to right. Node names can be
+ grouped using tuples to indicate that they have the same
+ priority. Example:</p>
+ <code type="none">
+Nodes = [cp1@cave, {cp2@cave, cp3@cave}]</code>
+ <p>This means that the application should preferably be started
+ at <c>cp1@cave</c>. If <c>cp1@cave</c> is down,
+ the application should be started at either <c>cp2@cave</c>
+ or <c>cp3@cave</c>.</p>
+ <p>If <c>Distributed == default</c>, the value for
+ the application in the Kernel configuration parameter
+ <c>distributed</c> will be used.</p>
+ </desc>
+ </func>
+ <func>
+ <name>loaded_applications() -> [{Application, Description, Vsn}]</name>
+ <fsummary>Get the currently loaded applications</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Description = string()</v>
+ <v>Vsn = string()</v>
+ </type>
+ <desc>
+ <p>Returns a list with information about the applications which
+ have been loaded using <c>load/1,2</c>, also included
+ applications. <c>Application</c> is the application name.
+ <c>Description</c> and <c>Vsn</c> are the values of its
+ <c>description</c> and <c>vsn</c> application specification
+ keys, respectively.</p>
+ </desc>
+ </func>
+ <func>
+ <name>permit(Application, Bool) -> ok | {error, Reason}</name>
+ <fsummary>Change an application's permission to run on a node.</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Bool = bool()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Changes the permission for <c>Application</c> to run at
+ the current node. The application must have been loaded using
+ <c>load/1,2</c> for the function to have effect.</p>
+ <p>If the permission of a loaded, but not started, application
+ is set to <c>false</c>, <c>start</c> will return <c>ok</c> but
+ the application will not be started until the permission is
+ set to <c>true</c>.</p>
+ <p>If the permission of a running application is set to
+ <c>false</c>, the application will be stopped. If
+ the permission later is set to <c>true</c>, it will be
+ restarted.</p>
+ <p>If the application is distributed, setting the permission to
+ <c>false</c> means that the application will be started at, or
+ moved to, another node according to how its distribution is
+ configured (see <c>load/2</c> above).</p>
+ <p>The function does not return until the application is
+ started, stopped or successfully moved to another node.
+ However, in some cases where permission is set to <c>true</c>
+ the function may return <c>ok</c> even though the application
+ itself has not started. This is true when an application
+ cannot start because it has dependencies to other
+ applications which have not yet been started. When they have
+ been started, <c>Application</c> will be started as well.</p>
+ <p>By default, all applications are loaded with permission
+ <c>true</c> on all nodes. The permission is configurable by
+ using the Kernel configuration parameter <c>permissions</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>set_env(Application, Par, Val) -> ok</name>
+ <name>set_env(Application, Par, Val, Timeout) -> ok</name>
+ <fsummary>Set the value of a configuration parameter</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Par = atom()</v>
+ <v>Val = term()</v>
+ <v>Timeout = int() | infinity</v>
+ </type>
+ <desc>
+ <p>Sets the value of the configuration parameter <c>Par</c> for
+ <c>Application</c>.</p>
+ <p><c>set_env/3</c> uses the standard <c>gen_server</c> timeout
+ value (5000 ms). A <c>Timeout</c> argument can be provided
+ if another timeout value is useful, for example, in situations
+ where the application controller is heavily loaded.</p>
+ <warning>
+ <p>Use this function only if you know what you are doing,
+ that is, on your own applications. It is very application
+ and configuration parameter dependent when and how often
+ the value is read by the application, and careless use
+ of this function may put the application in a
+ weird, inconsistent, and malfunctioning state. </p>
+ </warning>
+ </desc>
+ </func>
+ <func>
+ <name>start(Application) -> ok | {error, Reason}</name>
+ <name>start(Application, Type) -> ok | {error, Reason}</name>
+ <fsummary>Load and start an application</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Type = permanent | transient | temporary</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Starts <c>Application</c>. If it is not loaded,
+ the application controller will first load it using
+ <c>load/1</c>. It will make sure any included applications
+ are loaded, but will not start them. That is assumed to be
+ taken care of in the code for <c>Application</c>.</p>
+ <p>The application controller checks the value of
+ the application specification key <c>applications</c>, to
+ ensure that all applications that should be started before
+ this application are running. If not,
+ <c>{error,{not_started,App}}</c> is returned, where <c>App</c>
+ is the name of the missing application.</p>
+ <p>The application controller then creates an <em>application master</em> for the application. The application master is
+ the group leader of all the processes in the application.
+ The application master starts the application by calling
+ the application callback function <c>Module:start/2</c> as
+ defined by the application specification key <c>mod</c>.</p>
+ <p>The <c>Type</c> argument specifies the type of
+ the application. If omitted, it defaults to <c>temporary</c>.</p>
+ <list type="bulleted">
+ <item>If a permanent application terminates, all other
+ applications and the entire Erlang node are also terminated.</item>
+ <item>If a transient application terminates with <c>Reason == normal</c>, this is reported but no other applications are
+ terminated. If a transient application terminates
+ abnormally, all other applications and the entire Erlang
+ node are also terminated.</item>
+ <item>If a temporary application terminates, this is reported
+ but no other applications are terminated.</item>
+ </list>
+ <p>Note that it is always possible to stop an application
+ explicitly by calling <c>stop/1</c>. Regardless of the type of
+ the application, no other applications will be affected.</p>
+ <p>Note also that the transient type is of little practical use,
+ since when a supervision tree terminates, the reason is set to
+ <c>shutdown</c>, not <c>normal</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>start_type() -> StartType | local | undefined</name>
+ <fsummary>Get the start type of an ongoing application startup.</fsummary>
+ <type>
+ <v>StartType = normal | {takeover,Node} | {failover,Node}</v>
+ <v>&nbsp;Node = node()</v>
+ </type>
+ <desc>
+ <p>This function is intended to be called by a process belonging
+ to an application, when the application is being started, to
+ determine the start type which is either <c>StartType</c> or
+ <c>local</c>.</p>
+ <p>See <c>Module:start/2</c> for a description of
+ <c>StartType</c>.</p>
+ <p><c>local</c> is returned if only parts of the application is
+ being restarted (by a supervisor), or if the function is
+ called outside a startup.</p>
+ <p>If the process executing the call does not belong to any
+ application, the function returns <c>undefined</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>stop(Application) -> ok | {error, Reason}</name>
+ <fsummary>Stop an application</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Stops <c>Application</c>. The application master calls
+ <c>Module:prep_stop/1</c>, if such a function is defined, and
+ then tells the top supervisor of the application to shutdown
+ (see <c>supervisor(3)</c>). This means that the entire
+ supervision tree, including included applications, is
+ terminated in reversed start order. After the shutdown,
+ the application master calls <c>Module:stop/1</c>.
+ <c>Module</c> is the callback module as defined by
+ the application specification key <c>mod</c>.</p>
+ <p>Last, the application master itself terminates. Note that all
+ processes with the application master as group leader, i.e.
+ processes spawned from a process belonging to the application,
+ thus are terminated as well.</p>
+ <p>When stopped, the application is still loaded.</p>
+ <p>In order to stop a distributed application, <c>stop/1</c>
+ has to be called on all nodes where it can execute (that is,
+ on all nodes where it has been started). The call to
+ <c>stop/1</c> on the node where the application currently
+ executes will stop its execution. The application will not be
+ moved between nodes due to <c>stop/1</c> being called on
+ the node where the application currently executes before
+ <c>stop/1</c> is called on the other nodes.</p>
+ </desc>
+ </func>
+ <func>
+ <name>takeover(Application, Type) -> ok | {error, Reason}</name>
+ <fsummary>Take over a distributed application</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Type = permanent | transient | temporary</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Performs a takeover of the distributed application
+ <c>Application</c>, which executes at another node
+ <c>Node</c>. At the current node, the application is
+ restarted by calling
+ <c>Module:start({takeover,Node},StartArgs)</c>. <c>Module</c>
+ and <c>StartArgs</c> are retrieved from the loaded application
+ specification. The application at the other node is not
+ stopped until the startup is completed, i.e. when
+ <c>Module:start/2</c> and any calls to
+ <c>Module:start_phase/3</c> have returned.</p>
+ <p>Thus two instances of the application will run simultaneously
+ during the takeover, which makes it possible to transfer data
+ from the old to the new instance. If this is not acceptable
+ behavior, parts of the old instance may be shut down when
+ the new instance is started. Note that the application may
+ not be stopped entirely however, at least the top supervisor
+ must remain alive.</p>
+ <p>See <c>start/1,2</c> for a description of <c>Type</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>unload(Application) -> ok | {error, Reason}</name>
+ <fsummary>Unload an application</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Unloads the application specification for <c>Application</c>
+ from the application controller. It will also unload
+ the application specifications for any included applications.
+ Note that the function does not purge the actual Erlang
+ object code.</p>
+ </desc>
+ </func>
+ <func>
+ <name>unset_env(Application, Par) -> ok</name>
+ <name>unset_env(Application, Par, Timeout) -> ok</name>
+ <fsummary>Unset the value of a configuration parameter</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Par = atom()</v>
+ <v>Timeout = int() | infinity</v>
+ </type>
+ <desc>
+ <p>Removes the configuration parameter <c>Par</c> and its value
+ for <c>Application</c>.</p>
+ <p><c>unset_env/2</c> uses the standard <c>gen_server</c>
+ timeout value (5000 ms). A <c>Timeout</c> argument can be
+ provided if another timeout value is useful, for example, in
+ situations where the application controller is heavily loaded.</p>
+ <warning>
+ <p>Use this function only if you know what you are doing,
+ that is, on your own applications. It is very application
+ and configuration parameter dependent when and how often
+ the value is read by the application, and careless use
+ of this function may put the application in a
+ weird, inconsistent, and malfunctioning state. </p>
+ </warning>
+ </desc>
+ </func>
+ <func>
+ <name>which_applications() -> [{Application, Description, Vsn}]</name>
+ <name>which_applications(Timeout) -> [{Application, Description, Vsn}]</name>
+ <fsummary>Get the currently running applications</fsummary>
+ <type>
+ <v>Application = atom()</v>
+ <v>Description = string()</v>
+ <v>Vsn = string()</v>
+ <v>Timeout = int() | infinity</v>
+ </type>
+ <desc>
+ <p>Returns a list with information about the applications which
+ are currently running. <c>Application</c> is the application
+ name. <c>Description</c> and <c>Vsn</c> are the values of its
+ <c>description</c> and <c>vsn</c> application specification
+ keys, respectively.</p>
+ <p><c>which_applications/0</c> uses the standard
+ <c>gen_server</c> timeout value (5000 ms). A <c>Timeout</c>
+ argument can be provided if another timeout value is useful,
+ for example, in situations where the application controller
+ is heavily loaded.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>CALLBACK MODULE</title>
+ <p>The following functions should be exported from an
+ <c>application</c> callback module.</p>
+ </section>
+ <funcs>
+ <func>
+ <name>Module:start(StartType, StartArgs) -> {ok, Pid} | {ok, Pid, State} | {error, Reason}</name>
+ <fsummary>Start an application</fsummary>
+ <type>
+ <v>StartType = normal | {takeover,Node} | {failover,Node}</v>
+ <v>&nbsp;Node = node()</v>
+ <v>StartArgs = term()</v>
+ <v>Pid = pid()</v>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>This function is called whenever an application is started
+ using <c>application:start/1,2</c>, and should start
+ the processes of the application. If the application is
+ structured according to the OTP design principles as a
+ supervision tree, this means starting the top supervisor of
+ the tree.</p>
+ <p><c>StartType</c> defines the type of start:</p>
+ <list type="bulleted">
+ <item><c>normal</c> if its a normal startup.</item>
+ <item><c>normal</c> also if the application is distributed and
+ started at the current node due to a failover from another
+ node, and the application specification key <c>start_phases == undefined</c>.</item>
+ <item><c>{takeover,Node}</c> if the application is
+ distributed and started at the current node due to a
+ takeover from <c>Node</c>, either because
+ <c>application:takeover/2</c> has been called or because
+ the current node has higher priority than <c>Node</c>.</item>
+ <item><c>{failover,Node}</c> if the application is
+ distributed and started at the current node due to a
+ failover from <c>Node</c>, and the application
+ specification key <c>start_phases /= undefined</c>.</item>
+ </list>
+ <p><c>StartArgs</c> is the <c>StartArgs</c> argument defined by
+ the application specification key <c>mod</c>.</p>
+ <p>The function should return <c>{ok,Pid}</c> or
+ <c>{ok,Pid,State}</c> where <c>Pid</c> is the pid of the top
+ supervisor and <c>State</c> is any term. If omitted,
+ <c>State</c> defaults to <c>[]</c>. If later the application
+ is stopped, <c>State</c> is passed to
+ <c>Module:prep_stop/1</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>Module:start_phase(Phase, StartType, PhaseArgs) -> ok | {error, Reason}</name>
+ <fsummary>Extended start of an application</fsummary>
+ <type>
+ <v>Phase = atom()</v>
+ <v>StartType = normal | {takeover,Node} | {failover,Node}</v>
+ <v>&nbsp;Node = node()</v>
+ <v>PhaseArgs = term()</v>
+ <v>Pid = pid()</v>
+ <v>State = state()</v>
+ </type>
+ <desc>
+ <p>This function is used to start an application with included
+ applications, when there is a need for synchronization between
+ processes in the different applications during startup.</p>
+ <p>The start phases is defined by the application specification
+ key <c>start_phases == [{Phase,PhaseArgs}]</c>. For included
+ applications, the set of phases must be a subset of the set of
+ phases defined for the including application.</p>
+ <p>The function is called for each start phase (as defined for
+ the primary application) for the primary application and all
+ included applications, for which the start phase is defined.</p>
+ <p>See <c>Module:start/2</c> for a description of
+ <c>StartType</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>Module:prep_stop(State) -> NewState</name>
+ <fsummary>Prepare an application for termination</fsummary>
+ <type>
+ <v>State = NewState = term()</v>
+ </type>
+ <desc>
+ <p>This function is called when an application is about to be
+ stopped, before shutting down the processes of
+ the application.</p>
+ <p><c>State</c> is the state returned from
+ <c>Module:start/2</c>, or <c>[]</c> if no state was returned.
+ <c>NewState</c> is any term and will be passed to
+ <c>Module:stop/1</c>.</p>
+ <p>The function is optional. If it is not defined, the processes
+ will be terminated and then <c>Module:stop(State)</c> is
+ called.</p>
+ </desc>
+ </func>
+ <func>
+ <name>Module:stop(State)</name>
+ <fsummary>Clean up after termination of an application</fsummary>
+ <type>
+ <v>State = term()</v>
+ </type>
+ <desc>
+ <p>This function is called whenever an application has stopped.
+ It is intended to be the opposite of <c>Module:start/2</c>
+ and should do any necessary cleaning up. The return value is
+ ignored.</p>
+ <p><c>State</c> is the return value of
+ <c>Module:prep_stop/1</c>, if such a function exists.
+ Otherwise <c>State</c> is taken from the return value of
+ <c>Module:start/2</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>Module:config_change(Changed, New, Removed) -> ok</name>
+ <fsummary>Update the configuration parameters for an application.</fsummary>
+ <type>
+ <v>Changed = [{Par,Val}]</v>
+ <v>New = [{Par,Val}]</v>
+ <v>Removed = [Par]</v>
+ <v>&nbsp;Par = atom()</v>
+ <v>&nbsp;Val = term()</v>
+ </type>
+ <desc>
+ <p>This function is called by an application after a code
+ replacement, if there are any changes to the configuration
+ parameters.</p>
+ <p><c>Changed</c> is a list of parameter-value tuples with all
+ configuration parameters with changed values, <c>New</c> is
+ a list of parameter-value tuples with all configuration
+ parameters that have been added, and <c>Removed</c> is a list
+ of all parameters that have been removed.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><seealso marker="doc/design_principles:des_princ">OTP Design Principles</seealso>,
+ <seealso marker="kernel_app">kernel(6)</seealso>,
+ <seealso marker="app">app(4)</seealso></p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/auth.xml b/lib/kernel/doc/src/auth.xml
new file mode 100644
index 0000000000..f53fc8b29a
--- /dev/null
+++ b/lib/kernel/doc/src/auth.xml
@@ -0,0 +1,109 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>auth</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>auth</module>
+ <modulesummary>Erlang Network Authentication Server</modulesummary>
+ <description>
+ <p>This module is deprecated. For a description of the Magic
+ Cookie system, refer to
+ <seealso marker="doc/reference_manual:distributed">Distributed Erlang</seealso> in the Erlang Reference Manual.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>is_auth(Node) -> yes | no</name>
+ <fsummary>Status of communication authorization (deprecated)</fsummary>
+ <type>
+ <v>Node = node()</v>
+ </type>
+ <desc>
+ <p>Returns <c>yes</c> if communication with <c>Node</c> is
+ authorized. Note that a connection to <c>Node</c> will
+ be established in this case. Returns <c>no</c> if <c>Node</c>
+ does not exist or communication is not authorized (it has
+ another cookie than <c>auth</c> thinks it has).</p>
+ <p>Use <seealso marker="net_adm#ping/1">net_adm:ping(Node)</seealso>
+ instead.</p>
+ </desc>
+ </func>
+ <func>
+ <name>cookie() -> Cookie</name>
+ <fsummary>Magic cookie for local node (deprecated)</fsummary>
+ <type>
+ <v>Cookie = atom()</v>
+ </type>
+ <desc>
+ <p>Use
+ <seealso marker="erts:erlang#erlang:get_cookie/0">erlang:get_cookie()</seealso>
+ instead.</p>
+ </desc>
+ </func>
+ <func>
+ <name>cookie(TheCookie) -> true</name>
+ <fsummary>Set the magic for the local node (deprecated)</fsummary>
+ <type>
+ <v>TheCookie = Cookie | [Cookie]</v>
+ <d>The cookie may also be given as a list with a single atom element</d>
+ <v>&nbsp;Cookie = atom()</v>
+ </type>
+ <desc>
+ <p>Use
+ <seealso marker="erts:erlang#erlang:set_cookie/2">erlang:set_cookie(node(), Cookie)</seealso>
+ instead.</p>
+ </desc>
+ </func>
+ <func>
+ <name>node_cookie([Node, Cookie]) -> yes | no</name>
+ <fsummary>Set the magic cookie for a node and verify authorization (deprecated)</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Cookie = atom()</v>
+ </type>
+ <desc>
+ <p>Equivalent to
+ <seealso marker="#node_cookie/2">node_cookie(Node, Cookie)</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>node_cookie(Node, Cookie) -> yes | no</name>
+ <fsummary>Set the magic cookie for a node and verify authorization (deprecated)</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Cookie = atom()</v>
+ </type>
+ <desc>
+ <p>Sets the magic cookie of <c>Node</c> to <c>Cookie</c>, and
+ verifies the status of the authorization.
+ Equivalent to calling
+ <seealso marker="erts:erlang#erlang:set_cookie/2">erlang:set_cookie(Node, Cookie)</seealso>, followed by
+ <seealso marker="#is_auth/1">auth:is_auth(Node)</seealso>.</p>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
diff --git a/lib/kernel/doc/src/book.xml b/lib/kernel/doc/src/book.xml
new file mode 100644
index 0000000000..caf13fd001
--- /dev/null
+++ b/lib/kernel/doc/src/book.xml
@@ -0,0 +1,45 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE book SYSTEM "book.dtd">
+
+<book xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header titlestyle="normal">
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>Kernel</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <insidecover>
+ </insidecover>
+ <pagetext>Kernel</pagetext>
+ <preamble>
+ <contents level="2"></contents>
+ </preamble>
+ <applications>
+ <xi:include href="ref_man.xml"/>
+ </applications>
+ <releasenotes>
+ <xi:include href="notes.xml"/>
+ </releasenotes>
+ <listofterms></listofterms>
+ <index></index>
+</book>
+
diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
new file mode 100644
index 0000000000..19e1d3221c
--- /dev/null
+++ b/lib/kernel/doc/src/code.xml
@@ -0,0 +1,829 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>code</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>code</module>
+ <modulesummary>Erlang Code Server</modulesummary>
+ <description>
+ <p>This module contains the interface to the Erlang
+ <em>code server</em>, which deals with the loading of compiled
+ code into a running Erlang runtime system.</p>
+ <p>The runtime system can be started in either <em>embedded</em> or
+ <em>interactive</em> mode. Which one is decided by the command
+ line flag <c>-mode</c>.</p>
+ <pre>
+% <input>erl -mode interactive</input></pre>
+ <p>Default mode is <c>interactive</c>.</p>
+ <list type="bulleted">
+ <item>
+ <p>In embedded mode, all code is loaded during system start-up
+ according to the boot script. (Code can also be loaded later
+ by explicitly ordering the code server to do so).</p>
+ </item>
+ <item>
+ <p>In interactive mode, only some code is loaded during system
+ startup-up, basically the modules needed by the runtime
+ system itself. Other code is dynamically loaded when first
+ referenced. When a call to a function in a certain module is
+ made, and the module is not loaded, the code server searches
+ for and tries to load the module.</p>
+ </item>
+ </list>
+ <p>To prevent accidentaly reloading modules affecting the Erlang
+ runtime system itself, the <c>kernel</c>, <c>stdlib</c> and
+ <c>compiler</c> directories are considered <em>sticky</em>. This
+ means that the system issues a warning and rejects the request if
+ a user tries to reload a module residing in any of them.
+ The feature can be disabled by using the command line flag
+ <c>-nostick</c>.</p>
+ </description>
+
+ <section>
+ <title>Code Path</title>
+ <p>In interactive mode, the code server maintains a search path --
+ usually called the <em>code path</em> -- consisting of a list of
+ directories, which it searches sequentially when trying to load a
+ module.</p>
+ <p>Initially, the code path consists of the current working
+ directory and all Erlang object code directories under the library
+ directory <c>$OTPROOT/lib</c>, where <c>$OTPROOT</c> is
+ the installation directory of Erlang/OTP, <c>code:root_dir()</c>.
+ Directories can be named <c>Name[-Vsn]</c> and the code server,
+ by default, chooses the directory with the highest version number
+ among those which have the same <c>Name</c>. The <c>-Vsn</c>
+ suffix is optional. If an <c>ebin</c> directory exists under
+ <c>Name[-Vsn]</c>, it is this directory which is added to
+ the code path.</p>
+ <p>The environment variable <c>ERL_LIBS</c> (defined in the operating
+ system) can be used to define additional library directories that
+ will be handled in the same way as the standard OTP library
+ directory described above, except that directories that do not
+ have an <c>ebin</c> directory will be ignored.</p>
+ <p>All application directories found in the additional directories
+ will appear before the standard OTP applications, except for the
+ Kernel and STDLIB applications, which will be placed before any
+ additional applications. In other words, modules found in any
+ of the additional library directories will override modules with
+ the same name in OTP, except for modules in Kernel and
+ STDLIB.</p>
+ <p>The environment variable <c>ERL_LIBS</c> (if defined) shold contain
+ a colon-separated (for Unix-like systems) or semicolon-separated
+ (for Windows) list of additional libraries.</p>
+ <p>Example: On an Unix-like system, <c>ERL_LIBS</c> could be set to
+ <c>/usr/local/jungerl:/home/some_user/my_erlang_lib</c>. (On Windows,
+ use semi-colon as separator.)</p>
+ </section>
+
+ <section>
+ <title>Code Path Cache</title>
+ <p>The code server incorporates a code path cache. The cache
+ functionality is disabled by default. To activate it, start
+ the emulator with the command line flag <c>-code_path_cache</c>
+ or call <c>code:rehash()</c>. When the cache is created (or
+ updated), the code server searches for modules in the code path
+ directories. This may take some time if the the code path is long.
+ After the cache creation, the time for loading modules in a large
+ system (one with a large directory structure) is significantly
+ reduced compared to having the cache disabled. The code server
+ is able to look up the location of a module from the cache in
+ constant time instead of having to search through the code path
+ directories.</p>
+ <p>Application resource files (<c>.app</c> files) are also stored
+ in the code path cache. This feature is used by the application
+ controller (see
+ <seealso marker="application">application(3)</seealso>) to load
+ applications efficiently in large systems.</p>
+ <p>Note that when the code path cache is created (or updated), any
+ relative directory names in the code path are converted to
+ absolute.</p>
+ </section>
+
+ <section>
+ <title>Loading of Code From Archive Files</title>
+
+ <warning><p>The support for loading of code from archive files is
+ experimental. The sole purpose of releasing it before it is ready
+ is to obtain early feedback. The file format, semantics,
+ interfaces etc. may be changed in a future release. The function
+ <c>lib_dir/2</c> and the flag <c>-code_path_choice</c> are also
+ experimental.</p></warning>
+
+ <p>In the current implementation, Erlang archives are <c>ZIP</c>
+ files with <c>.ez</c> extension. Erlang archives may also be
+ enclosed in <c>escript</c> files whose file extension is arbitrary.</p>
+
+ <p>Erlang archive files may contain entire Erlang applications or
+ parts of applications. The structure in an archive file is the
+ same as the directory structure for an application. If you for
+ example would create an archive of <c>mnesia-4.4.7</c>, the
+ archive file must be named <c>mnesia-4.4.7.ez</c> and it must
+ contain a top directory with the name <c>mnesia-4.4.7</c>. If the
+ version part of the name is omitted, it must also be omitted in
+ the archive. That is, a <c>mnesia.ez</c> archive must contain a
+ <c>mnesia</c> top directory.</p>
+
+ <p>An archive file for an application may for example be
+ created like this:</p>
+
+<pre>
+ zip:create("mnesia-4.4.7.ez",
+ ["mnesia-4.4.7"],
+ [{cwd, code:lib_dir()},
+ {compress, all},
+ {uncompress,[".beam",".app"]}]).</pre>
+
+ <p>Any file in the archive may be compressed, but in order to
+ speed up the access of frequently read files, it may be a good
+ idea to store <c>beam</c> and <c>app</c> files uncompressed in
+ the archive.</p>
+
+ <p>Normally the top directory of an application is located either
+ in the library directory <c>$OTPROOT/lib</c> or in a directory
+ referred to by the environment variable <c>ERL_LIBS</c>. At
+ startup when the initial code path is computed, the code server
+ will also look for archive files in these directories and
+ possibly add <c>ebin</c> directories in archives to the code path. The
+ code path will then contain paths to directories that looks like
+ <c>$OTPROOT/lib/mnesia.ez/mnesia/ebin</c> or
+ <c>$OTPROOT/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin</c>.</p>
+
+ <p>The code server uses the module <c>erl_prim_loader</c>
+ (possibly via the <c>erl_boot_server</c>) to read code files from
+ archives. But the functions in <c>erl_prim_loader</c> may also be
+ used by other applications to read files from archives. For
+ example, the call
+ <c>erl_prim_loader:list_dir("/otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/examples/bench)"</c>
+ would list the contents of a directory inside an archive.
+ See <seealso marker="erts:erl_prim_loader">erl_prim_loader(3)</seealso></p>
+
+ <p>An application archive file and a regular application directory
+ may coexist. This may be useful when there is a need of having
+ parts of the application as regular files. A typical case is the
+ <c>priv</c> directory which must reside as a regular directory in
+ order to be able to dynamically link in drivers and start port
+ programs. For other applications that do not have this need, the
+ <c>priv</c> directory may reside in the archive and the files
+ under the <c>priv</c> directory may be read via the
+ <c>erl_prim_loader</c>.</p>
+
+ <p>At the time point when a directory is added to the code path as
+ well as when the entire code path is (re)set, the code server
+ will decide which subdirectories in an application that shall be
+ read from the archive and which that shall be read as regular
+ files. If directories are added or removed afterwards, the file
+ access may fail if the code path is not updated (possibly to the
+ same path as before in order to trigger the directory resolution
+ update). For each directory on the second level (ebin, priv, src
+ etc.) in the application archive, the code server will firstly
+ choose the regular directory if it exists and secondly from the
+ archive. The function
+ <c>code:lib_dir/2</c> returns the path to the subdirectory. For
+ example <c>code:lib_dir(megaco,ebin)</c> may return
+ <c>/otp/root/lib/megaco-3.9.1.1.ez/megaco-3.9.1.1/ebin</c> while
+ <c>code:lib_dir(megaco,priv)</c> may return
+ <c>/otp/root/lib/megaco-3.9.1.1/priv</c>.</p>
+
+ <p>When an <c>escript</c> file contains an archive, there are
+ neither restrictions on the name of the <c>escript</c> nor on how
+ many applications that may be stored in the embedded
+ archive. Single <c>beam</c> files may also reside on the top
+ level in the archive. At startup, both the top directory in the
+ embedded archive as well as all (second level) <c>ebin</c>
+ directories in the embedded archive are added to the code path.
+ See <seealso marker="erts:escript">escript(1)</seealso></p>
+
+ <p>When the choice of directories in the code path is
+ <c>strict</c>, the directory that ends up in the code path will
+ be exactly the stated one. This means that if for example the
+ directory <c>$OTPROOT/lib/mnesia-4.4.7/ebin</c> is explicitly
+ added to the code path, the code server will not load files from
+ <c>$OTPROOT/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin</c> and vice
+ versa. </p>
+
+ <p>This behavior can be controlled via the command line flag
+ <c>-code_path_choice Choice</c>. If the flag is set to <c>relaxed</c>,
+ the code server will instead choose a suitable directory
+ depending on the actual file structure. If there exists a regular
+ application ebin directory,situation it will be choosen. But if it does
+ not exist, the ebin directory in the archive is choosen if it
+ exists. If neither of them exists the original directory will be
+ choosen.</p>
+
+ <p>The command line flag <c>-code_path_choice Choice</c> does also
+ affect how <c>init</c> interprets the <c>boot script</c>. The
+ interpretation of the explicit code paths in the <c>boot
+ script</c> may be <c>strict</c> or <c>relaxed</c>. It is
+ particular useful to set the flag to <c>relaxed</c> when you want
+ to elaborate with code loading from archives without editing the
+ <c>boot script</c>. The default is <c>relaxed</c>. See <seealso
+ marker="erts:init">init(3)</seealso></p> </section>
+
+ <section>
+
+ <title>Current and Old Code</title>
+ <p>The code of a module can exists in two variants in a system:
+ <em>current code</em> and <em>old code</em>. When a module is
+ loaded into the system for the first time, the code of the module
+ becomes 'current' and the global <em>export table</em> is updated
+ with references to all functions exported from the module.</p>
+ <p>If then a new instance of the module is loaded (perhaps because
+ of the correction of an error), then the code of the previous
+ instance becomes 'old', and all export entries referring to
+ the previous instance are removed. After that the new instance is
+ loaded as if it was loaded for the first time, as described above,
+ and becomes 'current'.</p>
+ <p>Both old and current code for a module are valid, and may even be
+ evaluated concurrently. The difference is that exported functions
+ in old code are unavailable. Hence there is no way to make a
+ global call to an exported function in old code, but old code may
+ still be evaluated because of processes lingering in it.</p>
+ <p>If a third instance of the module is loaded, the code server will
+ remove (purge) the old code and any processes lingering in it will
+ be terminated. Then the third instance becomes 'current' and
+ the previously current code becomes 'old'.</p>
+ <p>For more information about old and current code, and how to
+ make a process switch from old to current code, refer to
+ <seealso marker="doc/reference_manual:code_loading">Erlang Reference Manual</seealso>.</p>
+ </section>
+
+ <section>
+ <title>Argument Types and Invalid Arguments</title>
+
+ <p>Generally, module and application names are atoms, while file and directory
+ names are strings. For backward compatibility reasons, some functions accept
+ both strings and atoms, but a future release will probably only allow
+ the arguments that are documented.</p>
+
+ <p>From the R12B release, functions in this module will generally fail with an
+ exception if they are passed an incorrect type (for instance, an integer or a tuple
+ where an atom was expected). An error tuple will be returned if type of argument
+ was correct, but there was some other error (for instance, a non-existing directory
+ given to <c>set_path/1</c>.</p>
+ </section>
+
+ <funcs>
+ <func>
+ <name>set_path(Path) -> true | {error, What}</name>
+ <fsummary>Set the code server search path</fsummary>
+ <type>
+ <v>Path = [Dir]</v>
+ <v>Dir = string()</v>
+ <v>What = bad_directory | bad_path</v>
+ </type>
+ <desc>
+ <p>Sets the code path to the list of directories <c>Path</c>.</p>
+ <p>Returns <c>true</c> if successful, or
+ <c>{error, bad_directory}</c> if any <c>Dir</c> is not
+ the name of a directory, or <c>{error, bad_path}</c> if
+ the argument is invalid.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_path() -> Path</name>
+ <fsummary>Return the code server search path</fsummary>
+ <type>
+ <v>Path = [Dir]</v>
+ <v>Dir = string()</v>
+ </type>
+ <desc>
+ <p>Returns the code path</p>
+ </desc>
+ </func>
+ <func>
+ <name>add_path(Dir) -> true | {error, What}</name>
+ <name>add_pathz(Dir) -> true | {error, What}</name>
+ <fsummary>Add a directory to the end of the code path</fsummary>
+ <type>
+ <v>Dir = string()</v>
+ <v>What = bad_directory</v>
+ </type>
+ <desc>
+ <p>Adds <c>Dir</c> to the code path. The directory is added as
+ the last directory in the new path. If <c>Dir</c> already
+ exists in the path, it is not added.</p>
+ <p>Returns <c>true</c> if successful, or
+ <c>{error, bad_directory}</c> if <c>Dir</c> is not the name
+ of a directory.</p>
+ </desc>
+ </func>
+ <func>
+ <name>add_patha(Dir) -> true | {error, What}</name>
+ <fsummary>Add a directory to the beginning of the code path</fsummary>
+ <type>
+ <v>Dir = string()</v>
+ <v>What = bad_directory</v>
+ </type>
+ <desc>
+ <p>Adds <c>Dir</c> to the beginning of the code path. If
+ <c>Dir</c> already exists, it is removed from the old
+ position in the code path.</p>
+ <p>Returns <c>true</c> if successful, or
+ <c>{error, bad_directory}</c> if <c>Dir</c> is not the name
+ of a directory.</p>
+ </desc>
+ </func>
+ <func>
+ <name>add_paths(Dirs) -> ok</name>
+ <name>add_pathsz(Dirs) -> ok</name>
+ <fsummary>Add directories to the end of the code path</fsummary>
+ <type>
+ <v>Dirs = [Dir]</v>
+ <v>Dir = string()</v>
+ </type>
+ <desc>
+ <p>Adds the directories in <c>Dirs</c> to the end of the code
+ path. If a <c>Dir</c> already exists, it is not added. This
+ function always returns <c>ok</c>, regardless of the validity
+ of each individual <c>Dir</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>add_pathsa(Dirs) -> ok</name>
+ <fsummary>Add directories to the beginning of the code path</fsummary>
+ <type>
+ <v>Dirs = [Dir]</v>
+ <v>Dir = string()</v>
+ </type>
+ <desc>
+ <p>Adds the directories in <c>Dirs</c> to the beginning of
+ the code path. If a <c>Dir</c> already exists, it is removed
+ from the old position in the code path. This function always
+ returns <c>ok</c>, regardless of the validity of each
+ individual <c>Dir</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>del_path(Name | Dir) -> true | false | {error, What}</name>
+ <fsummary>Delete a directory from the code path</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>Dir = string()</v>
+ <v>What = bad_name</v>
+ </type>
+ <desc>
+ <p>Deletes a directory from the code path. The argument can be
+ an atom <c>Name</c>, in which case the directory with
+ the name <c>.../Name[-Vsn][/ebin]</c> is deleted from the code
+ path. It is also possible to give the complete directory name
+ <c>Dir</c> as argument.</p>
+ <p>Returns <c>true</c> if successful, or <c>false</c> if
+ the directory is not found, or <c>{error, bad_name}</c> if
+ the argument is invalid.</p>
+ </desc>
+ </func>
+ <func>
+ <name>replace_path(Name, Dir) -> true | {error, What}</name>
+ <fsummary>Replace a directory with another in the code path</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>Dir = string()</v>
+ <v>What = bad_name | bad_directory | {badarg, term()}</v>
+ </type>
+ <desc>
+ <p>This function replaces an old occurrence of a directory
+ named <c>.../Name[-Vsn][/ebin]</c>, in the code path, with
+ <c>Dir</c>. If <c>Name</c> does not exist, it adds the new
+ directory <c>Dir</c> last in the code path. The new directory
+ must also be named <c>.../Name[-Vsn][/ebin]</c>. This function
+ should be used if a new version of the directory (library) is
+ added to a running system.</p>
+ <p>Returns <c>true</c> if successful, or
+ <c>{error, bad_name}</c> if <c>Name</c> is not found, or
+ <c>{error, bad_directory}</c> if <c>Dir</c> does not exist, or
+ <c>{error, {badarg, [Name, Dir]}}</c> if <c>Name</c> or
+ <c>Dir</c> is invalid.</p>
+ </desc>
+ </func>
+ <func>
+ <name>load_file(Module) -> {module, Module} | {error, What}</name>
+ <fsummary>Load a module</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ <v>What = nofile | sticky_directory | badarg | term()</v>
+ </type>
+ <desc>
+ <p>Tries to load the Erlang module <c>Module</c>, using
+ the code path. It looks for the object code file with an
+ extension that corresponds to the Erlang machine used, for
+ example <c>Module.beam</c>. The loading fails if the module
+ name found in the object code differs from the name
+ <c>Module</c>.
+ <seealso marker="#load_binary/3">load_binary/3</seealso> must
+ be used to load object code with a module name that is
+ different from the file name.</p>
+ <p>Returns <c>{module, Module}</c> if successful, or
+ <c>{error, nofile}</c> if no object code is found, or
+ <c>{error, sticky_directory}</c> if the object code resides in
+ a sticky directory, or <c>{error, badarg}</c> if the argument
+ is invalid. Also if the loading fails, an error tuple is
+ returned. See
+ <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso>
+ for possible values of <c>What</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>load_abs(Filename) -> {module, Module} | {error, What}</name>
+ <fsummary>Load a module, residing in a given file</fsummary>
+ <type>
+ <v>Filename = string()</v>
+ <v>Module = atom()</v>
+ <v>What = nofile | sticky_directory | badarg | term()</v>
+ </type>
+ <desc>
+ <p>Does the same as <c>load_file(Module)</c>, but
+ <c>Filename</c> is either an absolute file name, or a
+ relative file name. The code path is not searched. It returns
+ a value in the same way as
+ <seealso marker="#load_file/1">load_file/1</seealso>. Note
+ that <c>Filename</c> should not contain the extension (for
+ example <c>".beam"</c>); <c>load_abs/1</c> adds the correct
+ extension itself.</p>
+ </desc>
+ </func>
+ <func>
+ <name>ensure_loaded(Module) -> {module, Module} | {error, What}</name>
+ <fsummary>Ensure that a module is loaded</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ <v>What = nofile | sticky_directory | embedded | badarg | term()</v>
+ </type>
+ <desc>
+ <p>Tries to to load a module in the same way as
+ <seealso marker="#load_file/1">load_file/1</seealso>,
+ unless the module is already loaded.
+ In embedded mode, however, it does not load a module which is not
+ already loaded, but returns <c>{error, embedded}</c> instead.</p>
+ </desc>
+ </func>
+ <func>
+ <name>load_binary(Module, Filename, Binary) -> {module, Module} | {error, What}</name>
+ <fsummary>Load object code for a module</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ <v>Filename = string()</v>
+ <v>What = sticky_directory | badarg | term()</v>
+ </type>
+ <desc>
+ <p>This function can be used to load object code on remote
+ Erlang nodes. The argument <c>Binary</c> must contain
+ object code for <c>Module</c>.
+ <c>Filename</c> is only used by the code server to keep a
+ record of from which file the object code for <c>Module</c>
+ comes. Accordingly, <c>Filename</c> is not opened and read by
+ the code server.</p>
+ <p>Returns <c>{module, Module}</c> if successful, or
+ <c>{error, sticky_directory}</c> if the object code resides in
+ a sticky directory, or <c>{error, badarg}</c> if any argument
+ is invalid. Also if the loading fails, an error tuple is
+ returned. See
+ <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso>
+ for possible values of <c>What</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>delete(Module) -> true | false</name>
+ <fsummary>Removes current code for a module</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ </type>
+ <desc>
+ <p>Removes the current code for <c>Module</c>, that is,
+ the current code for <c>Module</c> is made old. This means
+ that processes can continue to execute the code in the module,
+ but that no external function calls can be made to it.</p>
+ <p>Returns <c>true</c> if successful, or <c>false</c> if there
+ is old code for <c>Module</c> which must be purged first, or
+ if <c>Module</c> is not a (loaded) module.</p>
+ </desc>
+ </func>
+ <func>
+ <name>purge(Module) -> true | false</name>
+ <fsummary>Removes old code for a module</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ </type>
+ <desc>
+ <p>Purges the code for <c>Module</c>, that is, removes code
+ marked as old. If some processes still linger in the old code,
+ these processes are killed before the code is removed.</p>
+ <p>Returns <c>true</c> if successful and any process needed to
+ be killed, otherwise <c>false</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>soft_purge(Module) -> true | false</name>
+ <fsummary>Removes old code for a module, unless no process uses it</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ </type>
+ <desc>
+ <p>Purges the code for <c>Module</c>, that is, removes code
+ marked as old, but only if no processes linger in it.</p>
+ <p>Returns <c>false</c> if the module could not be purged due
+ to processes lingering in old code, otherwise <c>true</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>is_loaded(Module) -> {file, Loaded} | false</name>
+ <fsummary>Check if a module is loaded</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ <v>Loaded = Absname | preloaded | cover_compiled</v>
+ <v>Absname = string()</v>
+ </type>
+ <desc>
+ <p>Checks if <c>Module</c> is loaded. If it is,
+ <c>{file, Loaded}</c> is returned, otherwise <c>false</c>.</p>
+ <p>Normally, <c>Loaded</c> is the absolute file name
+ <c>Absname</c> from which the code was obtained. If the module
+ is preloaded (see
+ <seealso marker="sasl:script">script(4)</seealso>),
+ <c>Loaded==preloaded</c>. If the module is Cover compiled (see
+ <seealso marker="tools:cover">cover(3)</seealso>),
+ <c>Loaded==cover_compiled</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>all_loaded() -> [{Module, Loaded}]</name>
+ <fsummary>Get all loaded modules</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ <v>Loaded = Absname | preloaded | cover_compiled</v>
+ <v>Absname = string()</v>
+ </type>
+ <desc>
+ <p>Returns a list of tuples <c>{Module, Loaded}</c> for all
+ loaded modules. <c>Loaded</c> is normally the absolute file
+ name, as described for
+ <seealso marker="#is_loaded/1">is_loaded/1</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>which(Module) -> Which</name>
+ <fsummary>The object code file of a module</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ <v>Which = Filename | non_existing | preloaded | cover_compiled</v>
+ <v>Filename = string()</v>
+ </type>
+ <desc>
+ <p>If the module is not loaded, this function searches the code
+ path for the first file which contains object code for
+ <c>Module</c> and returns the absolute file name. If
+ the module is loaded, it returns the name of the file which
+ contained the loaded object code. If the module is pre-loaded,
+ <c>preloaded</c> is returned. If the module is Cover compiled,
+ <c>cover_compiled</c> is returned. <c>non_existing</c> is
+ returned if the module cannot be found.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_object_code(Module) -> {Module, Binary, Filename} | error</name>
+ <fsummary>Get the object code for a module</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ <v>Binary = binary()</v>
+ <v>Filename = string()</v>
+ </type>
+ <desc>
+ <p>Searches the code path for the object code of the module
+ <c>Module</c>. It returns <c>{Module, Binary, Filename}</c>
+ if successful, and <c>error</c> if not. <c>Binary</c> is a
+ binary data object which contains the object code for
+ the module. This can be useful if code is to be loaded on a
+ remote node in a distributed system. For example, loading
+ module <c>Module</c> on a node <c>Node</c> is done as
+ follows:</p>
+ <code type="none">
+...
+{_Module, Binary, Filename} = code:get_object_code(Module),
+rpc:call(Node, code, load_binary, [Module, Filename, Binary]),
+...</code>
+ </desc>
+ </func>
+ <func>
+ <name>root_dir() -> string()</name>
+ <fsummary>Root directory of Erlang/OTP</fsummary>
+ <desc>
+ <p>Returns the root directory of Erlang/OTP, which is
+ the directory where it is installed.</p>
+ <pre>
+> <input>code:root_dir().</input>
+"/usr/local/otp"</pre>
+ </desc>
+ </func>
+ <func>
+ <name>lib_dir() -> string()</name>
+ <fsummary>Library directory of Erlang/OTP</fsummary>
+ <desc>
+ <p>Returns the library directory, <c>$OTPROOT/lib</c>, where
+ <c>$OTPROOT</c> is the root directory of Erlang/OTP.</p>
+ <pre>
+> <input>code:lib_dir().</input>
+"/usr/local/otp/lib"</pre>
+ </desc>
+ </func>
+ <func>
+ <name>lib_dir(Name) -> string() | {error, bad_name}</name>
+ <fsummary>Library directory for an application</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ </type>
+ <desc>
+ <p>This function is mainly intended for finding out the path
+ for the "library directory", the top directory, for an
+ application <c>Name</c> located under <c>$OTPROOT/lib</c> or
+ on a directory referred to via the <c>ERL_LIBS</c>
+ environment variable.</p>
+ <p>If there is a regular directory called <c>Name</c> or
+ <c>Name-Vsn</c> in the code path with an <c>ebin</c>
+ subdirectory, the path to this directory is returned (not
+ the <c>ebin</c> directory). If the directory refers to a
+ directory in an archive, the archive name is stripped away
+ before the path is returned. For example, if the directory
+ <c>/usr/local/otp/lib/mnesia-4.2.2.ez/mnesia-4.2.2/ebin</c>
+ is in the path, <c>/usr/local/otp/lib/mnesia-4.2.2/ebin</c>
+ will be returned. This means that the library directory for
+ an application is the same, regardless of whether the
+ application resides in an archive or not.</p>
+
+ <pre>
+> <input>code:lib_dir(mnesia).</input>
+"/usr/local/otp/lib/mnesia-4.2.2"</pre>
+ <p>Returns <c>{error, bad_name}</c> if <c>Name</c>
+ is not the name of an application under <c>$OTPROOT/lib</c> or
+ on a directory referred to via the <c>ERL_LIBS</c>
+ environment variable. Fails with an exception if <c>Name</c>
+ has the wrong type.</p>
+
+ <warning><p>For backward compatibility, <c>Name</c> is also allowed to
+ be a string. That will probably change in a future release.</p></warning>
+ </desc>
+ </func>
+ <func>
+ <name>lib_dir(Name, SubDir) -> string() | {error, bad_name}</name>
+ <fsummary>subdirectory for an application</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>SubDir = atom()</v>
+ </type>
+ <desc>
+ <p>Returns the path to a subdirectory directly under the top
+ directory of an application. Normally the subdirectories
+ resides under the top directory for the application, but when
+ applications at least partly resides in an archive the
+ situation is different. Some of the subdirectories may reside
+ as regular directories while other resides in an archive
+ file. It is not checked if this directory really exists.</p>
+
+ <pre>
+> <input>code:lib_dir(megaco, priv).</input>
+"/usr/local/otp/lib/megaco-3.9.1.1/priv"</pre>
+
+ <p>Fails with an exception if <c>Name</c> or <c>SubDir</c> has
+ the wrong type.</p>
+ </desc>
+ </func>
+ <func>
+ <name>compiler_dir() -> string()</name>
+ <fsummary>Library directory for the compiler</fsummary>
+ <desc>
+ <p>Returns the compiler library directory. Equivalent to
+ <c>code:lib_dir(compiler)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>priv_dir(Name) -> string() | {error, bad_name}</name>
+ <fsummary>Priv directory for an application</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ </type>
+ <desc>
+ <p>Returns the path to the <c>priv</c> directory in an
+ application. Equivalent to <c>code:lib_dir(Name,priv).</c>.</p>
+
+ <warning><p>For backward compatibility, <c>Name</c> is also allowed to
+ be a string. That will probably change in a future release.</p></warning>
+ </desc>
+ </func>
+ <func>
+ <name>objfile_extension() -> ".beam"</name>
+ <fsummary>Object code file extension</fsummary>
+ <desc>
+ <p>Returns the object code file extension that corresponds to
+ the Erlang machine used, namely <c>".beam"</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>stick_dir(Dir) -> ok | error</name>
+ <fsummary>Mark a directory as sticky</fsummary>
+ <type>
+ <v>Dir = string()</v>
+ <v>What = term()</v>
+ </type>
+ <desc>
+ <p>This function marks <c>Dir</c> as sticky.</p>
+ <p>Returns <c>ok</c> if successful or <c>error</c> if not.</p>
+ </desc>
+ </func>
+ <func>
+ <name>unstick_dir(Dir) -> ok | error</name>
+ <fsummary>Remove a sticky directory mark</fsummary>
+ <type>
+ <v>Dir = string()</v>
+ <v>What = term()</v>
+ </type>
+ <desc>
+ <p>This function unsticks a directory which has been marked as
+ sticky.</p>
+ <p>Returns <c>ok</c> if successful or <c>error</c> if not.</p>
+ </desc>
+ </func>
+ <func>
+ <name>is_sticky(Module) -> true | false</name>
+ <fsummary>Test whether a module is sticky</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ </type>
+ <desc>
+ <p>This function returns <c>true</c> if <c>Module</c> is the
+ name of a module that has been loaded from a sticky directory
+ (or in other words: an attempt to reload the module will fail),
+ or <c>false</c> if <c>Module</c> is not a loaded module or is
+ not sticky.</p>
+ </desc>
+ </func>
+ <func>
+ <name>rehash() -> ok</name>
+ <fsummary>Rehash or create code path cache</fsummary>
+ <desc>
+ <p>This function creates or rehashes the code path cache.</p>
+ </desc>
+ </func>
+ <func>
+ <name>where_is_file(Filename) -> Absname | non_existing</name>
+ <fsummary>Full name of a file located in the code path</fsummary>
+ <type>
+ <v>Filename = Absname = string()</v>
+ </type>
+ <desc>
+ <p>Searches the code path for <c>Filename</c>, a file of
+ arbitrary type. If found, the full name is returned.
+ <c>non_existing</c> is returned if the file cannot be found.
+ The function can be useful, for example, to locate
+ application resource files. If the code path cache is used,
+ the code server will efficiently read the full name from
+ the cache, provided that <c>Filename</c> is an object code
+ file or an <c>.app</c> file.</p>
+ </desc>
+ </func>
+ <func>
+ <name>clash() -> ok</name>
+ <fsummary>Search for modules with identical names.</fsummary>
+ <desc>
+ <p>Searches the entire code space for module names with
+ identical names and writes a report to <c>stdout</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>is_module_native(Module) -> true | false | undefined</name>
+ <fsummary>Test whether a module has native code</fsummary>
+ <type>
+ <v>Module = atom()</v>
+ </type>
+ <desc>
+ <p>This function returns <c>true</c> if <c>Module</c> is
+ name of a loaded module that has native code loaded, and
+ <c>false</c> if <c>Module</c> is loaded but does not have
+ native. If <c>Module</c> is not loaded, this function returns
+ <c>undefined</c>.</p>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
diff --git a/lib/kernel/doc/src/config.xml b/lib/kernel/doc/src/config.xml
new file mode 100644
index 0000000000..34398e90ac
--- /dev/null
+++ b/lib/kernel/doc/src/config.xml
@@ -0,0 +1,125 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE fileref SYSTEM "fileref.dtd">
+
+<fileref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>config</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <file>config</file>
+ <filesummary>Configuration file.</filesummary>
+ <description>
+ <p>A <em>configuration file</em> contains values for configuration
+ parameters for the applications in the system. The <c>erl</c>
+ command line argument <c>-config Name</c> tells the system to use
+ data in the system configuration file <c>Name.config</c>.</p>
+ <p>Configuration parameter values in the configuration file will
+ override the values in the application resource files (see
+ <c>app(4)</c>). The values in the configuration file can be
+ overridden by command line flags (see <c>erl(1)</c>).</p>
+ <p>The value of a configuration parameter is retrieved by calling
+ <c>application:get_env/1,2</c>.</p>
+ </description>
+
+ <section>
+ <title>FILE SYNTAX</title>
+ <p>The configuration file should be called <c>Name.config</c> where
+ <c>Name</c> is an arbitrary name.</p>
+ <p>The <c>.config</c> file contains one single Erlang term.
+ The file has the following syntax:</p>
+ <code type="none">
+[{Application1, [{Par11, Val11}, ..]},
+ ..
+ {ApplicationN, [{ParN1, ValN1}, ..]}].</code>
+ <list type="bulleted">
+ <item>
+ <p><c>Application = atom()</c> is the name of the application.</p>
+ </item>
+ <item>
+ <p><c>Par = atom()</c> is the name of a configuration parameter.</p>
+ </item>
+ <item>
+ <p><c>Val = term()</c> is the value of a configuration
+ parameter.</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>sys.config</title>
+ <p>When starting Erlang in embedded mode, it is assumed that
+ exactly one system configuration file is used, named
+ <c>sys.config</c>. This file should be located in
+ <c>$ROOT/releases/Vsn</c>, where <c>$ROOT</c> is the Erlang/OTP
+ root installation directory and <c>Vsn</c> is the release version.</p>
+ <p>Release handling relies on this assumption. When installing a
+ new release version, the new <c>sys.config</c> is read and used
+ to update the application configurations.</p>
+ <p>This means that specifying another, or additional, <c>.config</c>
+ files would lead to inconsistent update of application
+ configurations. Therefore, in Erlang 5.4/OTP R10B, the syntax of
+ <c>sys.config</c> was extended to allow pointing out other
+ <c>.config</c> files:</p>
+ <code type="none">
+[{Application, [{Par, Val}]} | File].</code>
+ <list type="bulleted">
+ <item>
+ <p><c>File = string()</c> is the name of another <c>.config</c>
+ file. The extension <c>.config</c> may be omitted. It is
+ recommended to use absolute paths. A relative path is
+ relative the current working directory of the emulator.</p>
+ </item>
+ </list>
+ <p>When traversing the contents of <c>sys.config</c> and a filename
+ is encountered, its contents are read and merged with the result
+ so far. When an application configuration tuple
+ <c>{Application, Env}</c> is found, it is merged with the result
+ so far. Merging means that new parameters are added and existing
+ parameter values overwritten. Example:</p>
+ <code type="none">
+sys.config:
+
+[{myapp,[{par1,val1},{par2,val2}]},
+ "/home/user/myconfig"].
+
+
+myconfig.config:
+
+[{myapp,[{par2,val3},{par3,val4}]}].</code>
+ <p>This will yield the following environment for <c>myapp</c>:</p>
+ <code type="none">
+[{par1,val1},{par2,val3},{par3,val4}]</code>
+ <p>The behaviour if a file specified in <c>sys.config</c> does not
+ exist or is erroneous in some other way, is backwards compatible.
+ Starting the runtime system will fail. Installing a new release
+ version will not fail, but an error message is given and
+ the erroneous file is ignored.</p>
+ </section>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><c>app(4)</c>, <c>erl(1)</c>, <em>OTP Design Principles</em></p>
+ </section>
+</fileref>
+
diff --git a/lib/kernel/doc/src/disk_log.xml b/lib/kernel/doc/src/disk_log.xml
new file mode 100644
index 0000000000..07c1844485
--- /dev/null
+++ b/lib/kernel/doc/src/disk_log.xml
@@ -0,0 +1,1162 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year>
+ <year>2007</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>disk_log</title>
+ <prepared>Claes Wikstr&ouml;m</prepared>
+ <responsible>Claes Wikstr&ouml;m</responsible>
+ <docno></docno>
+ <approved>nobody</approved>
+ <checked>no</checked>
+ <date>1999-10-10</date>
+ <rev>D</rev>
+ <file>disk_log.sgml</file>
+ </header>
+ <module>disk_log</module>
+ <modulesummary>A disk based term logging facility</modulesummary>
+ <description>
+ <p><c>disk_log</c> is a disk based term logger which makes
+ it possible to efficiently log items on files.
+ Two types of logs are supported,
+ <em>halt logs</em> and <em>wrap logs</em>. A halt log
+ appends items to a single file, the size of which may or may
+ not be limited by the disk log module, whereas a wrap log utilizes
+ a sequence of wrap log files of limited size. As a wrap log file
+ has been filled up, further items are logged onto to the next
+ file in the sequence, starting all over with the first file when
+ the last file has been filled up. For the sake of efficiency,
+ items are always written to files as binaries.
+ </p>
+ <p>Two formats of the log files are supported, the <em>internal format</em> and the <em>external format</em>. The internal
+ format supports automatic repair of log files that have not been
+ properly closed, and makes it possible to efficiently read
+ logged items in <em>chunks</em> using a set of functions defined
+ in this module. In fact, this is the only way to read internally
+ formatted logs. The external format leaves it up to the user to
+ read the logged deep byte lists. The disk log module cannot
+ repair externally formatted logs. An item logged to an
+ internally formatted log must not occupy more than 4 GB of disk
+ space (the size must fit in 4 bytes).
+ </p>
+ <p>For each open disk log there is one process that handles requests
+ made to the disk log; the disk log process is created when <c>open/1</c>
+ is called, provided there exists no process handling the disk log.
+ A process that opens a disk log can either be an <em>owner</em>
+ or an anonymous <em>user</em> of the disk log. Each owner is
+ linked to the disk log
+ process, and the disk log is closed by the owner should the
+ owner terminate. Owners can subscribe to <em>notifications</em>,
+ messages of the form <c>{disk_log, Node, Log, Info}</c> that are sent
+ from the disk log process when certain events occur, see
+ the commands below and in particular the <c>open/1</c> option
+ <seealso marker="#notify">notify</seealso>.
+ There can be several owners of a log, but a process cannot own a
+ log more than once. One and the same process may, however,
+ open the log
+ as a user more than once. For a disk log process to properly close
+ its file and terminate, it must be closed by its owners and once by
+ some non-owner process for each time the log was used anonymously;
+ the users are counted, and there must not be any users left when the
+ disk log process terminates.
+ </p>
+ <p>Items can be logged <em>synchronously</em> by using the functions
+ <c>log/2</c>, <c>blog/2</c>, <c>log_terms/2</c> and
+ <c>blog_terms/2</c>. For each of these functions, the caller is put
+ on hold until the items have been logged (but not necessarily
+ written, use <c>sync/1</c> to ensure that). By adding an <c>a</c>
+ to each of the mentioned function names we get functions that log
+ items <em>asynchronously</em>. Asynchronous functions do not wait for
+ the disk log process to actually write the items to the file, but
+ return the control to the caller more or less immediately.
+ </p>
+ <p>When using the internal format for logs, the functions
+ <c>log/2</c>, <c>log_terms/2</c>, <c>alog/2</c>, and
+ <c>alog_terms/2</c> should be used. These functions log one or
+ more Erlang terms. By prefixing each of the functions with
+ a <c>b</c> (for "binary") we get the corresponding <c>blog</c>
+ functions for the external format. These functions log one or
+ more deep lists of bytes or, alternatively, binaries of deep lists
+ of bytes.
+ For example, to log the string <c>"hello"</c> in ASCII format, we
+ can use <c>disk_log:blog(Log, "hello")</c>, or
+ <c>disk_log:blog(Log, list_to_binary("hello"))</c>. The two
+ alternatives are equally efficient. The <c>blog</c> functions
+ can be used for internally formatted logs as well, but in
+ this case they must be called with binaries constructed with
+ calls to <c>term_to_binary/1</c>. There is no check to ensure
+ this, it is entirely the responsibility of the caller. If these
+ functions are called with binaries that do not correspond to
+ Erlang terms, the <c>chunk/2,3</c> and automatic repair
+ functions will fail. The corresponding terms (not the binaries)
+ will be returned when <c>chunk/2,3</c> is called.
+ </p>
+ <p>A collection of open disk logs with the same name running on
+ different nodes is said to be a <em>a distributed disk log</em>
+ if requests made to any one of the logs are automatically made to
+ the other logs as well. The members of such a collection will be
+ called individual distributed disk logs, or just distributed
+ disk logs if there is no risk of confusion. There is no order
+ between the members of such a collection. For instance, logged
+ terms are not necessarily written onto the node where the
+ request was made before written onto the other nodes. One could
+ note here that there are a few functions that do not make
+ requests to all members of distributed disk logs, namely
+ <c>info</c>, <c>chunk</c>, <c>bchunk</c>, <c>chunk_step</c> and
+ <c>lclose</c>. An open disk log that is not a distributed disk
+ log is said to be a <em>local disk log</em>. A local disk log is
+ accessible only from the node where the disk log process runs,
+ whereas a distributed disk log is accessible from all nodes in
+ the Erlang system, with exception for those nodes where a local
+ disk log with the same name as the distributed disk log exists.
+ All processes on nodes that have access to a local or
+ distributed disk log can log items or otherwise change, inspect
+ or close the log.
+ </p>
+ <p>It is not guaranteed that all log files of a distributed disk log
+ contain the same log items; there is no attempt made to synchronize
+ the contents of the files. However, as long as at least one of
+ the involved nodes is alive at each time, all items will be logged.
+ When logging items to a distributed log, or otherwise trying to
+ change the log, the replies from individual logs are
+ ignored. If all nodes are down, the disk log functions
+ reply with a <c>nonode</c> error.
+ </p>
+ <note>
+ <p>In some applications it may not be acceptable that
+ replies from individual logs are ignored. An alternative in such
+ situations is to use several local disk logs instead of one
+ distributed disk log, and implement the distribution without use
+ of the disk log module.</p>
+ </note>
+ <p>Errors are reported differently for asynchronous log attempts
+ and other uses of the disk log module. When used synchronously
+ the disk log module replies with an error message, but when called
+ asynchronously, the disk log module does not know where to send
+ the error message. Instead owners subscribing to notifications will
+ receive an <c>error_status</c> message.
+ </p>
+ <p>The disk log module itself does not report errors to the
+ <c>error_logger</c> module; it is up to the caller to decide
+ whether the error logger should be employed or not. The function
+ <c>format_error/1</c> can be used to produce readable messages
+ from error replies. Information events are however sent to the
+ error logger in two situations, namely when a log is repaired,
+ or when a file is missing while reading chunks.
+ </p>
+ <p>The error message <c>no_such_log</c> means that the given
+ disk log is not currently open. Nothing is said about
+ whether the disk log files exist or not.
+ </p>
+ <note>
+ <p>If an attempt to reopen or truncate a log fails (see
+ <c>reopen</c> and <c>truncate</c>) the disk log process
+ immediately terminates. Before the process terminates links to
+ to owners and blocking processes (see <c>block</c>) are removed.
+ The effect is that the links work in one direction only; any
+ process using a disk log has to check for the error message
+ <c>no_such_log</c> if some other process might truncate or
+ reopen the log simultaneously.</p>
+ </note>
+ </description>
+ <funcs>
+ <func>
+ <name>accessible_logs() -> {[LocalLog], [DistributedLog]}</name>
+ <fsummary>Return the accessible disk logs on the current node.</fsummary>
+ <type>
+ <v>LocalLog = DistributedLog = term()</v>
+ </type>
+ <desc>
+ <p>The <c>accessible_logs/0</c> function returns
+ the names of the disk logs accessible on the current node.
+ The first list contains local disk logs, and the
+ second list contains distributed disk logs.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>alog(Log, Term)</name>
+ <name>balog(Log, Bytes) -> ok | {error, Reason}</name>
+ <fsummary>Asynchronously log an item onto a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Term = term()</v>
+ <v>Bytes = binary() | [Byte]</v>
+ <v>Byte = [Byte] | 0 =&lt; integer() =&lt; 255</v>
+ <v>Reason = no_such_log</v>
+ </type>
+ <desc>
+ <p>The <c>alog/2</c> and <c>balog/2</c> functions asynchronously
+ append an item to a disk log. The function <c>alog/2</c> is
+ used for internally formatted logs, and the function <c>balog/2</c>
+ for externally formatted logs. <c>balog/2</c> can be used
+ for internally formatted logs as well provided the binary was
+ constructed with a call to <c>term_to_binary/1</c>.
+ </p>
+ <p>The owners that subscribe to notifications will receive the
+ message <c>read_only</c>, <c>blocked_log</c>
+ or <c>format_external</c> in case the item cannot be written
+ on the log, and possibly one of the messages <c>wrap</c>,
+ <c>full</c> and <c>error_status</c> if an item was written
+ on the log. The message <c>error_status</c> is sent if there
+ is something wrong with the header function or a file error
+ occurred.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>alog_terms(Log, TermList)</name>
+ <name>balog_terms(Log, BytesList) -> ok | {error, Reason}</name>
+ <fsummary>Asynchronously log several items onto a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>TermList = [term()]</v>
+ <v>BytesList = [Bytes]</v>
+ <v>Bytes = binary() | [Byte]</v>
+ <v>Byte = [Byte] | 0 =&lt; integer() =&lt; 255</v>
+ <v>Reason = no_such_log</v>
+ </type>
+ <desc>
+ <p>The <c>alog_terms/2</c> and <c>balog_terms/2</c> functions
+ asynchronously append a list of items to a disk log.
+ The function <c>alog_terms/2</c> is used for internally
+ formatted logs, and the function <c>balog_terms/2</c>
+ for externally formatted logs. <c>balog_terms/2</c> can be used
+ for internally formatted logs as well provided the binaries were
+ constructed with calls to <c>term_to_binary/1</c>.
+ </p>
+ <p>The owners that subscribe to notifications will receive the
+ message <c>read_only</c>, <c>blocked_log</c>
+ or <c>format_external</c> in case the items cannot be written
+ on the log, and possibly one or more of the messages <c>wrap</c>,
+ <c>full</c> and <c>error_status</c> if items were written
+ on the log. The message <c>error_status</c> is sent if there
+ is something wrong with the header function or a file error
+ occurred.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>block(Log)</name>
+ <name>block(Log, QueueLogRecords) -> ok | {error, Reason}</name>
+ <fsummary>Block a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>QueueLogRecords = bool()</v>
+ <v>Reason = no_such_log | nonode | {blocked_log, Log}</v>
+ </type>
+ <desc>
+ <p>With a call to <c>block/1,2</c> a process can block a log.
+ If the blocking process is not an owner of the log, a temporary
+ link is created between the disk log process and the blocking
+ process. The link is used to ensure that the disk log is
+ unblocked should the blocking process terminate without
+ first closing or unblocking the log.
+ </p>
+ <p>Any process can probe a blocked log with <c>info/1</c> or
+ close it with <c>close/1</c>. The blocking process can also
+ use the functions <c>chunk/2,3</c>, <c>bchunk/2,3</c>,
+ <c>chunk_step/3</c>, and <c>unblock/1</c> without being
+ affected by the block. Any other attempt than those hitherto
+ mentioned to update or read a blocked log suspends the
+ calling process until the log is unblocked or returns an
+ error message <c>{blocked_log, Log}</c>, depending on
+ whether the value of <c>QueueLogRecords</c> is <c>true</c>
+ or <c>false</c>. The default value of <c>QueueLogRecords</c>
+ is <c>true</c>, which is used by <c>block/1</c>.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>change_header(Log, Header) -> ok | {error, Reason}</name>
+ <fsummary>Change the head or head_func option for an owner of a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Header = {head, Head} | {head_func, {M,F,A}}</v>
+ <v>Head = none | term() | binary() | [Byte]</v>
+ <v>Byte = [Byte] | 0 =&lt; integer() =&lt; 255</v>
+ <v>Reason = no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} | {badarg, head}</v>
+ </type>
+ <desc>
+ <p>The <c>change_header/2</c> function changes the value of
+ the <c>head</c> or <c>head_func</c> option of a disk log.</p>
+ </desc>
+ </func>
+ <func>
+ <name>change_notify(Log, Owner, Notify) -> ok | {error, Reason}</name>
+ <fsummary>Change the notify option for an owner of a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Owner = pid()</v>
+ <v>Notify = bool()</v>
+ <v>Reason = no_such_log | nonode | {blocked_log, Log} | {badarg, notify} | {not_owner, Owner}</v>
+ </type>
+ <desc>
+ <p>The <c>change_notify/3</c> function changes the value of the
+ <c>notify</c> option for an owner of a disk log. </p>
+ </desc>
+ </func>
+ <func>
+ <name>change_size(Log, Size) -> ok | {error, Reason}</name>
+ <fsummary>Change the size of an open disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Size = integer() > 0 | infinity | {MaxNoBytes, MaxNoFiles}</v>
+ <v>MaxNoBytes = integer() > 0</v>
+ <v>MaxNoFiles = integer() > 0</v>
+ <v>Reason = no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} | {new_size_too_small, CurrentSize} | {badarg, size} | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The <c>change_size/2</c> function changes the size of an open log.
+ For a halt log it is always possible to increase the size,
+ but it is not possible to decrease the size to something less than
+ the current size of the file.
+ </p>
+ <p>For a wrap log it is always possible to increase both the
+ size and number of files, as long as the number of files does not
+ exceed 65000. If the maximum number of files is decreased, the
+ change will not be valid until the current file is full and the
+ log wraps to the next file.
+ The redundant files will be removed next time the log wraps around,
+ i.e. starts to log to file number 1.
+ </p>
+ <p>As an example, assume that the old maximum number of files
+ is 10 and that the new maximum number of files is 6. If
+ the current file number is not greater than the new maximum number
+ of files, the files 7 to 10 will be removed when file number 6
+ is full and the log starts to write to file number 1 again.
+ Otherwise the files greater than the current
+ file will be removed when the current file is full (e.g. if
+ the current file is 8, the files 9 and 10); the files between
+ new maximum number of files and the current
+ file (i.e. files 7 and 8) will be removed next time file number 6
+ is full.
+ </p>
+ <p>If the size of the files is decreased the change will immediately
+ affect the current log. It will not of course change the
+ size of log files already full until next time they are used.
+ </p>
+ <p>If the log size is decreased for instance to save space,
+ the function <c>inc_wrap_file/1</c> can be used to force the log
+ to wrap.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>chunk(Log, Continuation)</name>
+ <name>chunk(Log, Continuation, N) -> {Continuation2, Terms} | {Continuation2, Terms, Badbytes} | eof | {error, Reason}</name>
+ <name>bchunk(Log, Continuation)</name>
+ <name>bchunk(Log, Continuation, N) -> {Continuation2, Binaries} | {Continuation2, Binaries, Badbytes} | eof | {error, Reason}</name>
+ <fsummary>Read a chunk of items written to a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Continuation = start | cont()</v>
+ <v>N = integer() > 0 | infinity</v>
+ <v>Continuation2 = cont()</v>
+ <v>Terms = [term()]</v>
+ <v>Badbytes = integer()</v>
+ <v>Reason = no_such_log | {format_external, Log} | {blocked_log, Log} | {badarg, continuation} | {not_internal_wrap, Log} | {corrupt_log_file, FileName} | {file_error, FileName, FileError}</v>
+ <v>Binaries = [binary()]</v>
+ </type>
+ <desc>
+ <p>The <c>chunk/2,3</c> and <c>bchunk/2,3</c> functions make
+ it possible to efficiently read the terms which have been
+ appended to an internally formatted log. It minimizes disk
+ I/O by reading 64 kilobyte chunks from the file. The
+ <c>bchunk/2,3</c> functions return the binaries read from
+ the file; they do not call <c>binary_to_term</c>. Otherwise
+ the work just like <c>chunk/2,3</c>.
+ </p>
+ <p>The first time <c>chunk</c> (or <c>bchunk</c>) is called,
+ an initial continuation, the atom <c>start</c>, must be
+ provided. If there is a disk log process running on the
+ current node, terms are read from that log, otherwise an
+ individual distributed log on some other node is chosen, if
+ such a log exists.
+ </p>
+ <p>When <c>chunk/3</c> is called, <c>N</c> controls the
+ maximum number of terms that are read from the log in each
+ chunk. Default is <c>infinity</c>, which means that all the
+ terms contained in the 64 kilobyte chunk are read. If less than
+ <c>N</c> terms are returned, this does not necessarily mean
+ that the end of the file has been reached.
+ </p>
+ <p>The <c>chunk</c> function returns a tuple
+ <c>{Continuation2, Terms}</c>, where <c>Terms</c> is a list
+ of terms found in the log. <c>Continuation2</c> is yet
+ another continuation which must be passed on to any
+ subsequent calls to <c>chunk</c>. With a series of calls to
+ <c>chunk</c> it is possible to extract all terms from a log.
+ </p>
+ <p>The <c>chunk</c> function returns a tuple
+ <c>{Continuation2, Terms, Badbytes}</c> if the log is opened
+ in read-only mode and the read chunk is corrupt. <c>Badbytes</c>
+ is the number of bytes in the file which were found not to be
+ Erlang terms in the chunk. Note also that the log is not repaired.
+ When trying to read chunks from a log opened in read-write mode,
+ the tuple <c>{corrupt_log_file, FileName}</c> is returned if the
+ read chunk is corrupt.
+ </p>
+ <p><c>chunk</c> returns <c>eof</c> when the end of the log is
+ reached, or <c>{error, Reason}</c> if an error occurs. Should
+ a wrap log file be missing, a message is output on the error log.
+ </p>
+ <p>When <c>chunk/2,3</c> is used with wrap logs, the returned
+ continuation may or may not be valid in the next call to
+ <c>chunk</c>. This is because the log may wrap and delete
+ the file into which the continuation points. To make sure
+ this does not happen, the log can be blocked during the
+ search.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>chunk_info(Continuation) -> InfoList | {error, Reason}</name>
+ <fsummary>Return information about a chunk continuation of a disk log.</fsummary>
+ <type>
+ <v>Continuation = cont()</v>
+ <v>Reason = {no_continuation, Continuation}</v>
+ </type>
+ <desc>
+ <p>The <c>chunk_info/1</c> function returns the following pair
+ describing the chunk continuation returned by
+ <c>chunk/2,3</c>, <c>bchunk/2,3</c>, or <c>chunk_step/3</c>:
+ </p>
+ <list type="bulleted">
+ <item>
+ <p><c>{node, Node}</c>. Terms are read from
+ the disk log running on <c>Node</c>.</p>
+ </item>
+ </list>
+ </desc>
+ </func>
+ <func>
+ <name>chunk_step(Log, Continuation, Step) -> {ok, Continuation2} | {error, Reason}</name>
+ <fsummary>Step forward or backward among the wrap log files of a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Continuation = start | cont()</v>
+ <v>Step = integer()</v>
+ <v>Continuation2 = cont()</v>
+ <v>Reason = no_such_log | end_of_log | {format_external, Log} | {blocked_log, Log} | {badarg, continuation} | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The function <c>chunk_step</c> can be used in conjunction
+ with <c>chunk/2,3</c> and <c>bchunk/2,3</c> to search
+ through an internally formatted wrap log. It takes as
+ argument a continuation as returned by <c>chunk/2,3</c>,
+ <c>bchunk/2,3</c>, or <c>chunk_step/3</c>, and steps forward
+ (or backward) <c>Step</c> files in the wrap log. The
+ continuation returned points to the first log item in the
+ new current file.
+ </p>
+ <p>If the atom <c>start</c> is given as continuation, a disk log
+ to read terms from is chosen. A local or distributed disk log
+ on the current node is preferred to an
+ individual distributed log on some other node.
+ </p>
+ <p>If the wrap log is not full because all files have not been
+ used yet, <c>{error, end_of_log}</c> is returned if trying to
+ step outside the log.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>close(Log) -> ok | {error, Reason}</name>
+ <fsummary>Close a disk log.</fsummary>
+ <type>
+ <v>Reason = no_such_log | nonode | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p> <marker id="close_1"></marker>
+The function <c>close/1</c> closes a
+ local or distributed disk log properly. An internally
+ formatted log must be closed before the Erlang system is
+ stopped, otherwise the log is regarded as unclosed and the
+ automatic repair procedure will be activated next time the
+ log is opened.
+ </p>
+ <p>The disk log process in not terminated as long as there are
+ owners or users of the log. It should be stressed that each
+ and every owner must close the log, possibly by terminating,
+ and that any other process - not only the processes that have
+ opened the log anonymously - can decrement the <c>users</c>
+ counter by closing the log.
+ Attempts to close a log by a process that is
+ not an owner are simply ignored if there are no users.
+ </p>
+ <p>If the log is blocked by the closing process, the log is also
+ unblocked.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>format_error(Error) -> Chars</name>
+ <fsummary>Return an English description of a disk log error reply.</fsummary>
+ <type>
+ <v>Chars = [char() | Chars]</v>
+ </type>
+ <desc>
+ <p>Given the error returned by any function in this module,
+ the function <c>format_error</c> returns a descriptive string
+ of the error in English. For file errors, the function
+ <c>format_error/1</c> in the <c>file</c> module is called.</p>
+ </desc>
+ </func>
+ <func>
+ <name>inc_wrap_file(Log) -> ok | {error, Reason}</name>
+ <fsummary>Change to the next wrap log file of a disk log.</fsummary>
+ <type>
+ <v>Reason = no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} | {halt_log, Log} | {invalid_header, InvalidHeader} | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The <c>inc_wrap_file/1</c> function forces the internally formatted
+ disk log to start logging to the
+ next log file. It can be used, for instance, in conjunction with
+ <c>change_size/2</c> to reduce the amount of disk space allocated
+ by the disk log.
+ </p>
+ <p>The owners that subscribe to notifications will normally
+ receive a <c>wrap</c> message, but in case of
+ an error with a reason tag of <c>invalid_header</c> or
+ <c>file_error</c> an <c>error_status</c> message will be sent.</p>
+ </desc>
+ </func>
+ <func>
+ <name>info(Log) -> InfoList | {error, no_such_log}</name>
+ <fsummary>Return information about a disk log.</fsummary>
+ <desc>
+ <p>The <c>info/1</c> function returns a list of <c>{Tag, Value}</c>
+ pairs describing the log. If there is a disk log process running
+ on the current node, that log is used as source of information,
+ otherwise an individual distributed log on
+ some other node is chosen, if such a log exists.
+ </p>
+ <p>The following pairs are returned for all logs:
+ </p>
+ <list type="bulleted">
+ <item>
+ <p><c>{name, Log}</c>, where <c>Log</c> is the name of
+ the log as given by the <c>open/1</c> option <c>name</c>.</p>
+ </item>
+ <item>
+ <p><c>{file, File}</c>. For halt logs <c>File</c> is the
+ filename, and for wrap logs <c>File</c> is the base name.</p>
+ </item>
+ <item>
+ <p><c>{type, Type}</c>, where <c>Type</c> is the type of
+ the log as given by the <c>open/1</c> option <c>type</c>.</p>
+ </item>
+ <item>
+ <p><c>{format, Format}</c>, where <c>Format</c> is the format
+ of the log as given by the <c>open/1</c> option <c>format</c>.</p>
+ </item>
+ <item>
+ <p><c>{size, Size}</c>, where <c>Size</c> is the size
+ of the log as given by the <c>open/1</c> option <c>size</c>,
+ or the size set by <c>change_size/2</c>. The value set by
+ <c>change_size/2</c> is reflected immediately.</p>
+ </item>
+ <item>
+ <p><c>{mode, Mode}</c>, where <c>Mode</c> is the mode
+ of the log as given by the <c>open/1</c> option <c>mode</c>.</p>
+ </item>
+ <item>
+ <p><c>{owners, [{pid(), Notify}]}</c> where <c>Notify</c>
+ is the value set by the <c>open/1</c> option <c>notify</c>
+ or the function <c>change_notify/3</c> for the owners of
+ the log.</p>
+ </item>
+ <item>
+ <p><c>{users, Users}</c> where <c>Users</c> is the number
+ of anonymous users of the log, see the <c>open/1</c> option
+ <seealso marker="#linkto">linkto</seealso>.</p>
+ </item>
+ <item>
+ <p><c>{status, Status}</c>, where <c>Status</c> is <c>ok</c>
+ or <c>{blocked, QueueLogRecords}</c> as set by the functions
+ <c>block/1,2</c> and <c>unblock/1</c>.</p>
+ </item>
+ <item>
+ <p><c>{node, Node}</c>. The information returned by the
+ current invocation of the <c>info/1</c> function has been
+ gathered from the disk log process running on <c>Node</c>.</p>
+ </item>
+ <item>
+ <p><c>{distributed, Dist}</c>. If the log is local on
+ the current node, then <c>Dist</c> has the value <c>local</c>,
+ otherwise all nodes where the log is distributed
+ are returned as a list.</p>
+ </item>
+ </list>
+ <p>The following pairs are returned for all logs opened in
+ <c>read_write</c> mode:
+ </p>
+ <list type="bulleted">
+ <item>
+ <p><c>{head, Head}</c>. Depending of the value of
+ the <c>open/1</c> options <c>head</c> and <c>head_func</c>
+ or set by the function <c>change_header/2</c>, the value
+ of <c>Head</c> is <c>none</c> (default),
+ <c>{head, H}</c> (<c>head</c> option) or <c>{M,F,A}</c>
+ (<c>head_func</c> option).</p>
+ </item>
+ <item>
+ <p><c>{no_written_items, NoWrittenItems}</c>, where
+ <c>NoWrittenItems</c> is the number of items
+ written to the log since the disk log process was created.</p>
+ </item>
+ </list>
+ <p>The following pair is returned for halt logs opened in
+ <c>read_write</c> mode:
+ </p>
+ <list type="bulleted">
+ <item>
+ <p><c>{full, Full}</c>, where <c>Full</c> is <c>true</c> or
+ <c>false</c> depending on whether the halt log is full or not.</p>
+ </item>
+ </list>
+ <p>The following pairs are returned for wrap logs opened in
+ <c>read_write</c> mode:
+ </p>
+ <list type="bulleted">
+ <item>
+ <p><c>{no_current_bytes, integer() >= 0}</c> is the number
+ of bytes written to the current wrap log file.</p>
+ </item>
+ <item>
+ <p><c>{no_current_items, integer() >= 0}</c> is the number
+ of items written to the current wrap log file, header
+ inclusive.</p>
+ </item>
+ <item>
+ <p><c>{no_items, integer() >= 0}</c> is the total number
+ of items in all wrap log files.</p>
+ </item>
+ <item>
+ <p><c>{current_file, integer()}</c> is the ordinal for
+ the current wrap log file in the range <c>1..MaxNoFiles</c>,
+ where <c>MaxNoFiles</c> is given by the <c>open/1</c> option
+ <c>size</c> or set by <c>change_size/2</c>.</p>
+ </item>
+ <item>
+ <p><c>{no_overflows, {SinceLogWasOpened, SinceLastInfo}}</c>,
+ where <c>SinceLogWasOpened</c> (<c>SinceLastInfo</c>) is
+ the number of times a wrap log file has been filled up and a
+ new one opened or <c>inc_wrap_file/1</c> has been called since
+ the disk log was last opened (<c>info/1</c>
+ was last called). The first time <c>info/2</c> is called
+ after a log was (re)opened or truncated, the two values
+ are equal.</p>
+ </item>
+ </list>
+ <p>Note that the <c>chunk/2,3</c>, <c>bchunk/2,3</c>, and
+ <c>chunk_step/3</c> functions do not affect any value
+ returned by <c>info/1</c>.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>lclose(Log)</name>
+ <name>lclose(Log, Node) -> ok | {error, Reason}</name>
+ <fsummary>Close a disk log on one node.</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Reason = no_such_log | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The function <c>lclose/1</c> closes a local log or an
+ individual distributed log on the current node.
+ The function <c>lclose/2</c> closes an individual
+ distributed log on the specified node if the node
+ is not the current one.
+ <c>lclose(Log)</c> is equivalent to
+ <c>lclose(Log,&nbsp;node())</c>.
+ See also <seealso marker="#close_1">close/1</seealso>.
+ </p>
+ <p>If there is no log with the given name
+ on the specified node, <c>no_such_log</c> is returned.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>log(Log, Term)</name>
+ <name>blog(Log, Bytes) -> ok | {error, Reason}</name>
+ <fsummary>Log an item onto a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Term = term()</v>
+ <v>Bytes = binary() | [Byte]</v>
+ <v>Byte = [Byte] | 0 =&lt; integer() =&lt; 255</v>
+ <v>Reason = no_such_log | nonode | {read_only_mode, Log} | {format_external, Log} | {blocked_log, Log} | {full, Log} | {invalid_header, InvalidHeader} | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The <c>log/2</c> and <c>blog/2</c> functions synchronously
+ append a term to a disk log. They return <c>ok</c> or
+ <c>{error, Reason}</c> when the term has been written to
+ disk. If the log is distributed, <c>ok</c> is always
+ returned, unless all nodes are down. Terms are written by
+ means of the ordinary <c>write()</c> function of the
+ operating system. Hence, there is no guarantee that the term
+ has actually been written to the disk, it might linger in
+ the operating system kernel for a while. To make sure the
+ item is actually written to disk, the <c>sync/1</c> function
+ must be called.
+ </p>
+ <p>The <c>log/2</c> function is used for internally formatted logs,
+ and <c>blog/2</c> for externally formatted logs.
+ <c>blog/2</c> can be used
+ for internally formatted logs as well provided the binary was
+ constructed with a call to <c>term_to_binary/1</c>.
+ </p>
+ <p>The owners that subscribe to notifications will be notified
+ of an error with an <c>error_status</c> message if the error
+ reason tag is <c>invalid_header</c> or <c>file_error</c>.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>log_terms(Log, TermList)</name>
+ <name>blog_terms(Log, BytesList) -> ok | {error, Reason}</name>
+ <fsummary>Log several items onto a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>TermList = [term()]</v>
+ <v>BytesList = [Bytes]</v>
+ <v>Bytes = binary() | [Byte]</v>
+ <v>Byte = [Byte] | 0 =&lt; integer() =&lt; 255</v>
+ <v>Reason = no_such_log | nonode | {read_only_mode, Log} | {format_external, Log} | {blocked_log, Log} | {full, Log} | {invalid_header, InvalidHeader} | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The <c>log_terms/2</c> and <c>blog_terms/2</c> functions
+ synchronously append a list of items to the log. The benefit
+ of using these functions rather than the <c>log/2</c> and
+ <c>blog/2</c> functions is that of efficiency: the given
+ list is split into as large sublists as possible (limited by
+ the size of wrap log files), and each sublist is logged as
+ one single item, which reduces the overhead.
+ </p>
+ <p>The <c>log_terms/2</c> function is used for internally formatted
+ logs, and <c>blog_terms/2</c> for externally formatted logs.
+ <c>blog_terms/2</c> can be used
+ for internally formatted logs as well provided the binaries were
+ constructed with calls to <c>term_to_binary/1</c>.
+ </p>
+ <p>The owners that subscribe to notifications will be notified
+ of an error with an <c>error_status</c> message if the error
+ reason tag is <c>invalid_header</c> or <c>file_error</c>.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>open(ArgL) -> OpenRet | DistOpenRet</name>
+ <fsummary>Open a disk log file.</fsummary>
+ <type>
+ <v>ArgL = [Opt]</v>
+ <v>Opt = {name, term()} | {file, FileName}, {linkto, LinkTo} | {repair, Repair} | {type, Type} | {format, Format} | {size, Size} | {distributed, [Node]} | {notify, bool()} | {head, Head} | {head_func, {M,F,A}} | {mode, Mode}</v>
+ <v>FileName = string() | atom()</v>
+ <v>LinkTo = pid() | none</v>
+ <v>Repair = true | false | truncate</v>
+ <v>Type = halt | wrap</v>
+ <v>Format = internal | external</v>
+ <v>Size = integer() > 0 | infinity | {MaxNoBytes, MaxNoFiles}</v>
+ <v>MaxNoBytes = integer() > 0</v>
+ <v>MaxNoFiles = 0 &lt; integer() &lt; 65000</v>
+ <v>Rec = integer()</v>
+ <v>Bad = integer()</v>
+ <v>Head = none | term() | binary() | [Byte]</v>
+ <v>Byte = [Byte] | 0 =&lt; integer() =&lt; 255</v>
+ <v>Mode = read_write | read_only</v>
+ <v>OpenRet = Ret | {error, Reason}</v>
+ <v>DistOpenRet = {[{Node, Ret}], [{BadNode, {error, DistReason}}]}</v>
+ <v>Node = BadNode = atom()</v>
+ <v>Ret = {ok, Log} | {repaired, Log, {recovered, Rec}, {badbytes, Bad}}</v>
+ <v>DistReason = nodedown | Reason</v>
+ <v>Reason = no_such_log | {badarg, Arg} | {size_mismatch, CurrentSize, NewSize} | {arg_mismatch, OptionName, CurrentValue, Value} | {name_already_open, Log} | {open_read_write, Log} | {open_read_only, Log} | {need_repair, Log} | {not_a_log_file, FileName} | {invalid_index_file, FileName} | {invalid_header, InvalidHeader} | {file_error, FileName, FileError} | {node_already_open, Log}</v>
+ </type>
+ <desc>
+ <p>The <c>ArgL</c> parameter is a list of options which have
+ the following meanings:</p>
+ <list type="bulleted">
+ <item>
+ <p><c>{name, Log}</c> specifies the name of the log.
+ This is the name which must be passed on as a parameter in
+ all subsequent logging operations. A name must always
+ be supplied.
+ </p>
+ </item>
+ <item>
+ <p><c>{file, FileName}</c> specifies the name of the
+ file which will be used for logged terms. If this value is
+ omitted and the name of the log is either an atom or a string,
+ the file name will default to <c>lists:concat([Log, ".LOG"])</c> for halt logs. For wrap logs, this will be
+ the base name of the files. Each file in a wrap log
+ will be called <c><![CDATA[<base_name>.N]]></c>, where <c>N</c> is an
+ integer. Each wrap log will also have two files called
+ <c><![CDATA[<base_name>.idx]]></c> and <c><![CDATA[<base_name>.siz]]></c>.
+ </p>
+ </item>
+ <item>
+ <p><c>{linkto, LinkTo}</c>. <marker id="linkto"></marker>
+If
+ <c>LinkTo</c> is a pid, that pid becomes an owner of the
+ log. If <c>LinkTo</c> is <c>none</c> the log records
+ that it is used anonymously by some process by
+ incrementing the <c>users</c> counter. By default, the
+ process which calls <c>open/1</c> owns the log.
+ </p>
+ </item>
+ <item>
+ <p><c>{repair, Repair}</c>. If <c>Repair</c> is <c>true</c>,
+ the current log file will be repaired, if needed. As the
+ restoration is initiated, a message is output on the error log.
+ If <c>false</c> is given,
+ no automatic repair will be attempted. Instead, the
+ tuple <c>{error, {need_repair, Log}}</c> is returned if an
+ attempt is made to open a corrupt log file.
+ If <c>truncate</c> is given, the log file will
+ be truncated, creating an empty log. Default is
+ <c>true</c>, which has no effect on logs opened in
+ read-only mode.
+ </p>
+ </item>
+ <item>
+ <p><c>{type, Type}</c> is the type of the log. Default
+ is <c>halt</c>.
+ </p>
+ </item>
+ <item>
+ <p><c>{format, Format}</c> specifies the format of the
+ disk log. Default is <c>internal</c>.
+ </p>
+ </item>
+ <item>
+ <p><c>{size, Size}</c> specifies the size of the log.
+ When a halt log has reached its maximum size, all attempts to
+ log more items are rejected. The default size is
+ <c>infinity</c>, which for halt implies that there is no
+ maximum size. For wrap logs, the <c>Size</c> parameter
+ may be either a pair
+ <c>{MaxNoBytes, MaxNoFiles}</c> or <c>infinity</c>. In the
+ latter case, if the files of an already existing wrap log
+ with the same name can be found, the size is read
+ from the existing wrap log, otherwise an error is returned.
+ Wrap logs write at most <c>MaxNoBytes</c> bytes on each file
+ and use <c>MaxNoFiles</c> files before starting all over with
+ the first wrap log file. Regardless of <c>MaxNoBytes</c>,
+ at least the header (if there is one) and one
+ item is written on each wrap log file before
+ wrapping to the next file.
+ When opening an existing wrap log, it is not
+ necessary to supply a value for the option <c>Size</c>, but any
+ supplied value must equal the current size of the log, otherwise
+ the tuple <c>{error, {size_mismatch, CurrentSize, NewSize}}</c>
+ is returned.
+ </p>
+ </item>
+ <item>
+ <p><c>{distributed, Nodes}</c>. This option can be used for
+ adding members to a distributed disk log. The
+ default value is <c>[]</c>, which means that
+ the log is local on the current node.
+ </p>
+ </item>
+ <item>
+ <marker id="notify"></marker>
+ <p><c>{notify, bool()}</c>. If <c>true</c>, the owners of the
+ log are notified when certain events occur in the log.
+ Default is <c>false</c>. The owners are sent one of the
+ following messages when an event occurs:
+ </p>
+ <list type="bulleted">
+ <item>
+ <p><c>{disk_log, Node, Log, {wrap, NoLostItems}}</c> is sent when a wrap log has
+ filled up one of its files and a new file is
+ opened. <c>NoLostItems</c> is the number of
+ previously logged items that have been lost when
+ truncating existing files.
+ </p>
+ </item>
+ <item>
+ <p><c>{disk_log, Node, Log, {truncated, NoLostItems}}</c> is sent when a log has been
+ truncated or reopened. For halt logs <c>NoLostItems</c>
+ is the number of items written on the log since the
+ disk log process was created. For wrap logs
+ <c>NoLostItems</c> is the number of items on all
+ wrap log files.
+ </p>
+ </item>
+ <item>
+ <p><c>{disk_log, Node, Log, {read_only, Items}}</c>
+ is sent when an asynchronous log attempt is made to
+ a log file opened in read-only mode.
+ <c>Items</c> is the items from the log attempt.
+ </p>
+ </item>
+ <item>
+ <p><c>{disk_log, Node, Log, {blocked_log, Items}}</c>
+ is sent when an asynchronous log attempt is made to
+ a blocked log that does not queue log attempts.
+ <c>Items</c> is the items from the log attempt.
+ </p>
+ </item>
+ <item>
+ <p><c>{disk_log, Node, Log, {format_external, Items}}</c>
+ is sent when <c>alog/2</c> or <c>alog_terms/2</c> is
+ used for internally formatted logs. <c>Items</c> is the
+ items from the log attempt.
+ </p>
+ </item>
+ <item>
+ <p><c>{disk_log, Node, Log, full}</c> is sent when
+ an attempt to log items to a wrap log would write more
+ bytes than the limit set by the <c>size</c> option.
+ </p>
+ </item>
+ <item>
+ <p><c>{disk_log, Node, Log, {error_status, Status}}</c>
+ is sent when the error status changes. The error status
+ is defined by the outcome of the last attempt to log
+ items to a the log or to truncate the log or the last
+ use of <c>sync/1</c>, <c>inc_wrap_file/1</c> or
+ <c>change_size/2</c>. <c>Status</c> is one of <c>ok</c> and
+ <c>{error, Error}</c>, the former being the initial value.
+ </p>
+ </item>
+ </list>
+ </item>
+ <item>
+ <p><c>{head, Head}</c> specifies a header to be
+ written first on the log file. If the log is a wrap
+ log, the item <c>Head</c> is written first in each new file.
+ <c>Head</c> should be a term if the format is
+ <c>internal</c>, and a deep list of bytes (or a binary)
+ otherwise. Default is <c>none</c>, which means that
+ no header is written first on the file.
+ </p>
+ </item>
+ <item>
+ <p><c>{head_func, {M,F,A}}</c> specifies a function
+ to be called each time a new log file is opened.
+ The call <c>M:F(A)</c> is assumed to return <c>{ok, Head}</c>.
+ The item <c>Head</c> is written first in each file.
+ <c>Head</c> should be a term if the format is
+ <c>internal</c>, and a deep list of bytes (or a binary)
+ otherwise.
+ </p>
+ </item>
+ <item>
+ <p><c>{mode, Mode}</c> specifies if the log is to be
+ opened in read-only or read-write mode. It defaults to
+ <c>read_write</c>.
+ </p>
+ </item>
+ </list>
+ <p>The <c>open/1</c> function returns <c>{ok, Log}</c> if the
+ log file was successfully opened. If the file was
+ successfully repaired, the tuple <c>{repaired, Log, {recovered, Rec}, {badbytes, Bad}}</c> is returned, where
+ <c>Rec</c> is the number of whole Erlang terms found in the
+ file and <c>Bad</c> is the number of bytes in the file which
+ were non-Erlang terms. If the <c>distributed</c> parameter
+ was given, <c>open/1</c> returns a list of
+ successful replies and a list of erroneous replies. Each
+ reply is tagged with the node name.
+ </p>
+ <p>When a disk log is opened in read-write mode, any existing
+ log file is checked for. If there is none a new empty
+ log is created, otherwise the existing file is opened at the
+ position after the last logged item, and the logging of items
+ will commence from there. If the format is <c>internal</c>
+ and the existing file is not recognized as an internally
+ formatted log, a tuple <c>{error, {not_a_log_file, FileName}}</c>
+ is returned.
+ </p>
+ <p>The <c>open/1</c> function cannot be used for changing the
+ values of options of an already open log; when there are prior
+ owners or users of a log, all option values except <c>name</c>,
+ <c>linkto</c> and <c>notify</c> are just checked against
+ the values that have been supplied before as option values
+ to <c>open/1</c>, <c>change_header/2</c>, <c>change_notify/3</c>
+ or <c>change_size/2</c>. As a consequence,
+ none of the options except <c>name</c> is mandatory. If some
+ given value differs from the current value, a tuple
+ <c>{error, {arg_mismatch, OptionName, CurrentValue, Value}}</c>
+ is returned. Caution: an owner's attempt to open a log
+ as owner once again is acknowledged with the return value
+ <c>{ok, Log}</c>, but the state of the disk log is not
+ affected in any way.
+ </p>
+ <p>If a log with a given name is local on some node,
+ and one tries to open the log distributed on the same node,
+ then the tuple <c>{error, {node_already_open, Name}}</c> is
+ returned. The same tuple is returned if the log is distributed on
+ some node, and one tries to open the log locally on the same node.
+ Opening individual distributed disk logs for the first time
+ adds those logs to a (possibly empty) distributed disk log.
+ The option values supplied are used
+ on all nodes mentioned by the <c>distributed</c> option.
+ Individual distributed logs know nothing
+ about each other's option values, so each node can be
+ given unique option values by creating a distributed
+ log with several calls to <c>open/1</c>.
+ </p>
+ <p>It is possible to open a log file more than once by giving
+ different values to the option <c>name</c> or by using the
+ same file when distributing a log on different nodes.
+ It is up to the user of the <c>disk_log</c>
+ module to ensure that no more than one
+ disk log process has write access to any file, or the
+ the file may be corrupted.
+ </p>
+ <p>If an attempt to open a log file for the first time fails,
+ the disk log process terminates with the EXIT message
+ <c>{{failed,Reason},[{disk_log,open,1}]}</c>.
+ The function returns <c>{error, Reason}</c> for all other errors.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>pid2name(Pid) -> {ok, Log} | undefined</name>
+ <fsummary>Return the name of the disk log handled by a pid.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Pid = pid()</v>
+ </type>
+ <desc>
+ <p>The <c>pid2name/1</c> function returns the name of the log
+ given the pid of a disk log process on the current node, or
+ <c>undefined</c> if the given pid is not a disk log process.
+ </p>
+ <p>This function is meant to be used for debugging only.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>reopen(Log, File)</name>
+ <name>reopen(Log, File, Head)</name>
+ <name>breopen(Log, File, BHead) -> ok | {error, Reason}</name>
+ <fsummary>Reopen a disk log and save the old log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>File = string()</v>
+ <v>Head = term()</v>
+ <v>BHead = binary() | [Byte]</v>
+ <v>Byte = [Byte] | 0 =&lt; integer() =&lt; 255</v>
+ <v>Reason = no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} | {same_file_name, Log} | {invalid_index_file, FileName} | {invalid_header, InvalidHeader} | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The <c>reopen</c> functions first rename the log file
+ to <c>File</c> and then re-create a new log file.
+ In case of a wrap log, <c>File</c> is used as the base name
+ of the renamed files.
+ By default the header given to <c>open/1</c> is written first in
+ the newly opened log file, but if the <c>Head</c> or the
+ <c>BHead</c> argument is given, this item is used instead.
+ The header argument is used once only; next time a wrap log file
+ is opened, the header given to <c>open/1</c> is used.
+ </p>
+ <p>The <c>reopen/2,3</c> functions are used for internally formatted
+ logs, and <c>breopen/3</c> for externally formatted logs.
+ </p>
+ <p>The owners that subscribe to notifications will receive
+ a <c>truncate</c> message.
+ </p>
+ <p>Upon failure to reopen the log, the disk log process terminates
+ with the EXIT message <c>{{failed,Error},[{disk_log,Fun,Arity}]}</c>,
+ and other processes that have requests queued receive the message
+ <c>{disk_log, Node, {error, disk_log_stopped}}</c>.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>sync(Log) -> ok | {error, Reason}</name>
+ <fsummary>Flush the contents of a disk log to the disk.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Reason = no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The <c>sync/1</c> function ensures that the contents of the
+ log are actually written to the disk.
+ This is usually a rather expensive operation.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>truncate(Log)</name>
+ <name>truncate(Log, Head)</name>
+ <name>btruncate(Log, BHead) -> ok | {error, Reason}</name>
+ <fsummary>Truncate a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Head = term()</v>
+ <v>BHead = binary() | [Byte]</v>
+ <v>Byte = [Byte] | 0 =&lt; integer() =&lt; 255</v>
+ <v>Reason = no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} | {invalid_header, InvalidHeader} | {file_error, FileName, FileError}</v>
+ </type>
+ <desc>
+ <p>The <c>truncate</c> functions remove all items from a disk log.
+ If the <c>Head</c> or the <c>BHead</c> argument is
+ given, this item is written first in the newly truncated
+ log, otherwise the header given to <c>open/1</c> is used.
+ The header argument is only used once; next time a wrap log file
+ is opened, the header given to <c>open/1</c> is used.
+ </p>
+ <p>The <c>truncate/1,2</c> functions are used for internally
+ formatted logs, and <c>btruncate/2</c> for externally formatted
+ logs.
+ </p>
+ <p>The owners that subscribe to notifications will receive
+ a <c>truncate</c> message.
+ </p>
+ <p>If the attempt to truncate the log fails, the disk log process
+ terminates with the EXIT message
+ <c>{{failed,Reason},[{disk_log,Fun,Arity}]}</c>, and
+ other processes that have requests queued receive the message
+ <c>{disk_log, Node, {error, disk_log_stopped}}</c>.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>unblock(Log) -> ok | {error, Reason}</name>
+ <fsummary>Unblock a disk log.</fsummary>
+ <type>
+ <v>Log = term()</v>
+ <v>Reason = no_such_log | nonode | {not_blocked, Log} | {not_blocked_by_pid, Log}</v>
+ </type>
+ <desc>
+ <p>The <c>unblock/1</c> function unblocks a log.
+ A log can only be unblocked by the blocking process.
+ </p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>See Also</title>
+ <p><seealso marker="file">file(3)</seealso>,
+ <seealso marker="pg2">pg2(3)</seealso>,
+ <seealso marker="wrap_log_reader">wrap_log_reader(3)</seealso></p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/erl_boot_server.xml b/lib/kernel/doc/src/erl_boot_server.xml
new file mode 100644
index 0000000000..4e7533810e
--- /dev/null
+++ b/lib/kernel/doc/src/erl_boot_server.xml
@@ -0,0 +1,126 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>erl_boot_server</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>erl_boot_server</module>
+ <modulesummary>Boot Server for Other Erlang Machines</modulesummary>
+ <description>
+ <p>This server is used to assist diskless Erlang nodes which fetch
+ all Erlang code from another machine.</p>
+ <p>This server is used to fetch all code, including the start
+ script, if an Erlang runtime system is started with
+ the <c>-loader inet</c> command line flag. All hosts specified
+ with the <c>-hosts Host</c> command line flag must have one
+ instance of this server running.</p>
+ <p>This server can be started with the <c>kernel</c> configuration
+ parameter <c>start_boot_server</c>.</p>
+ <p>The <c>erl_boot_server</c> can both read regular files as well as
+ files in archives. See <seealso marker="code">code(3)</seealso>
+ and <seealso marker="erts:erl_prim_loader">erl_prim_loader(3)</seealso>.</p>
+ <warning><p>The support for loading of code from archive files is
+ experimental. The sole purpose of releasing it before it is ready
+ is to obtain early feedback. The file format, semantics,
+ interfaces etc. may be changed in a future release.</p></warning>
+ </description>
+ <funcs>
+ <func>
+ <name>start(Slaves) -> {ok, Pid} | {error, What}</name>
+ <fsummary>Start the boot server</fsummary>
+ <type>
+ <v>Slaves = [Host]</v>
+ <v>Host = atom()</v>
+ <v>Pid = pid()</v>
+ <v>What = term()</v>
+ </type>
+ <desc>
+ <p>Starts the boot server. <c>Slaves</c> is a list of IP
+ addresses for hosts which are allowed to use this server as a
+ boot server.</p>
+ </desc>
+ </func>
+ <func>
+ <name>start_link(Slaves) -> {ok, Pid} | {error, What}</name>
+ <fsummary>Start the boot server and links the caller</fsummary>
+ <type>
+ <v>Slaves = [Host]</v>
+ <v>Host = atom()</v>
+ <v>Pid = pid()</v>
+ <v>What = term()()</v>
+ </type>
+ <desc>
+ <p>Starts the boot server and links to the caller. This function
+ is used to start the server if it is included in a supervision
+ tree.</p>
+ </desc>
+ </func>
+ <func>
+ <name>add_slave(Slave) -> ok | {error, What}</name>
+ <fsummary>Add a slave to the list of allowed slaves</fsummary>
+ <type>
+ <v>Slave = Host</v>
+ <v>Host = atom()</v>
+ <v>What = term()</v>
+ </type>
+ <desc>
+ <p>Adds a <c>Slave</c> node to the list of allowed slave hosts.</p>
+ </desc>
+ </func>
+ <func>
+ <name>delete_slave(Slave) -> ok | {error, What}</name>
+ <fsummary>Delete a slave from the list of allowed slaves</fsummary>
+ <type>
+ <v>Slave = Host</v>
+ <v>Host = atom()</v>
+ <v>What = void()</v>
+ </type>
+ <desc>
+ <p>Deletes a <c>Slave</c> node from the list of allowed slave
+ hosts.</p>
+ </desc>
+ </func>
+ <func>
+ <name>which_slaves() -> Slaves</name>
+ <fsummary>Return the current list of allowed slave hosts</fsummary>
+ <type>
+ <v>Slaves = [Host]</v>
+ <v>Host = atom()</v>
+ </type>
+ <desc>
+ <p>Returns the current list of allowed slave hosts.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><seealso marker="erts:init">init(3)</seealso>,
+ <seealso marker="erts:erl_prim_loader">erl_prim_loader(3)</seealso></p>
+ </section>
+</erlref>
+
+
diff --git a/lib/kernel/doc/src/erl_ddll.xml b/lib/kernel/doc/src/erl_ddll.xml
new file mode 100644
index 0000000000..75dca8a85d
--- /dev/null
+++ b/lib/kernel/doc/src/erl_ddll.xml
@@ -0,0 +1,1165 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>erl_ddll</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>erl_ddll</module>
+ <modulesummary>Dynamic Driver Loader and Linker</modulesummary>
+ <description>
+ <p>The <c>erl_ddll</c> module provides an interface for loading
+ and unloading <em>erlang linked in drivers</em> in runtime.</p>
+ <note>
+ <p>This is a large reference document. For casual use of the
+ module, as well as for most real world applications, the
+ descriptions of the functions <seealso marker="#load/2">load/2</seealso> and <seealso marker="#unload/1">unload/1</seealso> are enough to get
+ going. </p>
+ </note>
+ <p>The driver should be provided as a dynamically linked library
+ in a object code format specific for the platform in use,
+ i. e. <c>.so</c> files on most Unix systems and <c>.ddl</c>
+ files on windows. An erlang linked in driver has to provide
+ specific interfaces to the emulator, so this module is not
+ designed for loading arbitrary dynamic libraries. For further
+ information about erlang drivers, refer to the ERTS reference
+ manual section <seealso marker="erts:erl_driver">erl_driver</seealso>.</p>
+ <marker id="users"></marker>
+ <p>When describing a set of functions, (i.e. a module, a part of a
+ module or an application) executing in a process and wanting to
+ use a ddll-driver, we use the term <em>user</em>. There can be
+ several users in one process (different modules needing the same
+ driver) and several processes running the same code, making up
+ several <em>users</em> of a driver. In the basic scenario, each
+ user loads the driver before starting to use it and unloads the
+ driver when done. The reference counting keeps track of
+ processes as well as the number of loads by each process, so that
+ the driver will only be unloaded when no one wants it
+ (it has no user). The driver also keeps track of ports that are
+ opened towards it, so that one can delay unloading until all
+ ports are closed or kill all ports using the driver when it is
+ unloaded. </p>
+ <marker id="scenarios"></marker>
+ <p>The interface supports two basic scenarios of loading and
+ unloading. Each scenario can also have the option of either
+ killing ports when the driver is unloading, or waiting for the
+ ports to close themselves. The scenarios are:</p>
+ <taglist>
+ <tag><em>Load and unload on a "when needed basis"</em></tag>
+ <item>
+ <p>This (most common) scenario simply supports that each
+ <seealso marker="#users">user</seealso> of the driver loads
+ it when it is needed and unloads it when the <seealso marker="#users">user</seealso> no longer have any use for
+ it. The driver is always reference counted and as long as a
+ process keeping the driver loaded is still alive, the driver
+ is present in the system.</p>
+ <p>Each <seealso marker="#users">user</seealso> of the driver
+ use <em>literally</em> the same pathname for the driver when
+ demanding load, but the <seealso marker="#users">users</seealso> are not really concerned
+ with if the driver is already loaded from the filesystem or
+ if the object code has to be loaded from filesystem.</p>
+ <p>Two pairs of functions support this scenario:</p>
+ <taglist>
+ <tag><em>load/2 and unload/1</em></tag>
+ <item>
+ <p>When using the <c>load/unload</c> interfaces, the
+ driver will not <em>actually</em> get unloaded until the
+ <em>last port</em> using the driver is closed. The function
+ <c>unload/1</c> can return immediately, as the <seealso marker="#users">users</seealso> are not really concerned
+ with when the actual unloading occurs. The
+ driver will actually get unloaded when no one needs it any longer.</p>
+ <p>If a process having the driver loaded dies, it will have
+ the same effect as if unloading was done. </p>
+ <p>When loading, the function <c>load/2</c> returns
+ <c>ok</c> as soon as there is any instance of the driver
+ present, so that if a driver is waiting to get unloaded
+ (due to open ports), it will simply change state to no
+ longer need unloading.</p>
+ </item>
+ <tag><em>load_driver/2 and unload_driver/1</em></tag>
+ <item>
+ <p>These interfaces is intended to be used when it is considered an
+ error that ports are open towards a driver that no <seealso marker="#users">user</seealso>
+ has loaded. The ports still open when the
+ last <seealso marker="#users">user</seealso> calls
+ <c>unload_driver/1</c> or when the last process having the
+ driver loaded dies, will get killed with reason
+ <c>driver_unloaded</c>.</p>
+ <p>The function names <c>load_driver</c> and
+ <c>unload_driver</c> are kept for backward
+ compatibility.</p>
+ </item>
+ </taglist>
+ </item>
+ <tag><em>Loading and reloading for code replacement</em></tag>
+ <item>
+ <p>This scenario occurs when the driver code might need
+ replacement during operation of the Erlang
+ emulator. Implementing driver code replacement is somewhat
+ more tedious than beam code replacement, as one driver
+ cannot be loaded as both "old" and "new" code. All <seealso marker="#users">users</seealso> of a driver must have it
+ closed (no open ports) before the old code can be unloaded
+ and the new code can be loaded.</p>
+ <p>The actual unloading/loading is done as one atomic
+ operation, blocking all processes in the system from using
+ the driver concerned while in progress.</p>
+ <p>The preferred way to do driver code replacement is to let
+ <em>one single process</em> keep track of the driver. When
+ the process start, the driver is loaded. When replacement
+ is required, the driver is reloaded. Unload is probably never
+ done, or done when the process exits. If more than one <seealso marker="#users">user</seealso> has a driver loaded when code
+ replacement is demanded, the replacement cannot occur until
+ the last "other" <seealso marker="#users">user</seealso> has
+ unloaded the driver.</p>
+ <p>Demanding reload when a reload is already in progress is
+ always an error. Using the high level functions, it is also
+ an error to demand reloading when more than one <seealso marker="#users">user</seealso> has the driver loaded. To
+ simplify driver replacement, avoid designing your system so
+ that more than than one <seealso marker="#users">user</seealso> has the driver loaded.</p>
+ <p>The two functions for reloading drivers should be used
+ together with corresponding load functions, to support the two
+ different behaviors concerning open ports:</p>
+ <taglist>
+ <tag><em>load/2 and reload/2</em></tag>
+ <item>
+ <p>This pair of functions is used when reloading should be
+ done after the last open port towards the driver is
+ closed.</p>
+ <p>As <c>reload/2</c> actually waits for the reloading to
+ occur, a misbehaving process keeping open ports towards
+ the driver (or keeping the driver loaded) might cause
+ infinite waiting for reload. Timeouts has to be provided
+ outside of the process demanding the reload or by using
+ the low-level interface <seealso marker="#try_load/3">try_load/3</seealso> in combination
+ with driver monitors (see below).</p>
+ </item>
+ <tag><em>load_driver/2 and reload_driver/2</em></tag>
+ <item>
+ <p>This pair of functions are used when open ports towards
+ the driver should be killed with reason
+ <c>driver_unloaded</c> to allow for new driver code to
+ get loaded.</p>
+ <p>If, however, another process has the driver loaded,
+ calling <c>reload_driver</c> returns the error code
+ <c>pending_process</c>. As stated earlier,
+ the recommended design is to not allow other <seealso marker="#users">users</seealso> than the "driver
+ reloader" to actually demand loading of the concerned
+ driver.</p>
+ </item>
+ </taglist>
+ </item>
+ </taglist>
+ </description>
+ <funcs>
+ <func>
+ <name>demonitor(MonitorRef) -> ok</name>
+ <fsummary>Remove a monitor for a driver</fsummary>
+ <type>
+ <v>MonitorRef = ref()</v>
+ </type>
+ <desc>
+ <p>Removes a driver monitor in much the same way as
+ <seealso marker="erts:erlang#erlang:demonitor/1">erlang:demonitor/1</seealso> does with process
+ monitors. See <seealso marker="#monitor/2">monitor/2</seealso>, <seealso marker="#try_load/3">try_load/3</seealso> and <seealso marker="#try_unload/2">try_unload/2</seealso> for details
+ about how to create driver monitors.</p>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameter is not a ref(). </p>
+ </desc>
+ </func>
+ <func>
+ <name>info() -> AllInfoList</name>
+ <fsummary>Retrieve information about all drivers</fsummary>
+ <type>
+ <v>AllInfoList = [ DriverInfo ]</v>
+ <v>DriverInfo = {DriverName, InfoList}</v>
+ <v>DriverName = string()</v>
+ <v>InfoList = [ InfoItem ]</v>
+ <v>InfoItem = {Tag, Value}</v>
+ <v>Tag = atom()</v>
+ <v>Value = term()</v>
+ </type>
+ <desc>
+ <p>Returns a list of tuples <c>{DriverName, InfoList}</c>, where
+ <c>InfoList</c> is the result of calling <seealso marker="#info/1">info/1</seealso> for that
+ <c>DriverName</c>. Only dynamically linked in drivers are
+ included in the list.</p>
+ </desc>
+ </func>
+ <func>
+ <name>info(Name) -> InfoList</name>
+ <fsummary>Retrieve information about one driver</fsummary>
+ <type>
+ <v>Name = string() | atom()</v>
+ <v>InfoList = [ InfoItem ]</v>
+ <v>InfoItem = {Tag, Value}</v>
+ <v>Tag = atom()</v>
+ <v>Value = term()</v>
+ </type>
+ <desc>
+ <p>Returns a list of tuples <c>{Tag, Value}</c>, where
+ <c>Tag</c> is the information item and <c>Value</c> is the result
+ of calling <seealso marker="#info/2">info/2</seealso> with this driver name and
+ this tag. The result being a tuple list containing all
+ information available about a driver. </p>
+ <p>The different tags that will appear in the list are:</p>
+ <list type="bulleted">
+ <item>processes</item>
+ <item>driver_options</item>
+ <item>port_count</item>
+ <item>linked_in_driver</item>
+ <item>permanent</item>
+ <item>awaiting_load</item>
+ <item>awaiting_unload</item>
+ </list>
+ <p>For a detailed description of each value, please read the
+ description of <seealso marker="#info/2">info/2</seealso> below.</p>
+ <p>The function throws a <c>badarg</c> exception if the driver
+ is not present in the system.</p>
+ </desc>
+ </func>
+ <func>
+ <name>info(Name, Tag) -> Value</name>
+ <fsummary>Retrieve specific information about one driver</fsummary>
+ <type>
+ <v>Name = string() | atom()</v>
+ <v>Tag = processes | driver_options | port_count | linked_in_driver | permanent | awaiting_load | awaiting_unload</v>
+ <v>Value = term()</v>
+ </type>
+ <desc>
+ <p>This function returns specific information about one aspect
+ of a driver. The <c>Tag</c> parameter specifies which aspect
+ to get information about. The <c>Value</c> return differs
+ between different tags:</p>
+ <taglist>
+ <tag><em>processes</em></tag>
+ <item>
+ <p>Return all processes containing <seealso marker="#users">users</seealso> of the specific drivers
+ as a list of tuples <c>{pid(),int()}</c>, where the
+ <c>int()</c> denotes the number of users in the process
+ <c>pid()</c>.</p>
+ </item>
+ <tag><em>driver_options</em></tag>
+ <item>
+ <p>Return a list of the driver options provided when
+ loading, as well as any options set by the driver itself
+ during initialization. The currently only valid option
+ being <c>kill_ports</c>.</p>
+ </item>
+ <tag><em>port_count</em></tag>
+ <item>
+ <p>Return the number of ports (an <c>int()</c>) using the driver.</p>
+ </item>
+ <tag><em>linked_in_driver</em></tag>
+ <item>
+ <p>Return a <c>bool()</c>, being <c>true</c> if the driver is a
+ statically linked in one and <c>false</c> otherwise.</p>
+ </item>
+ <tag><em>permanent</em></tag>
+ <item>
+ <p>Return a <c>bool()</c>, being <c>true</c> if the driver has made
+ itself permanent (and is <em>not</em> a statically
+ linked in driver). <c>false</c> otherwise.</p>
+ </item>
+ <tag><em>awaiting_load</em></tag>
+ <item>
+ <p>Return a list of all processes having monitors for
+ <c>loading</c> active, each process returned as
+ <c>{pid(),int()}</c>, where the <c>int()</c> is the
+ number of monitors held by the process <c>pid()</c>.</p>
+ </item>
+ <tag><em>awaiting_unload</em></tag>
+ <item>
+ <p>Return a list of all processes having monitors for
+ <c>unloading</c> active, each process returned as
+ <c>{pid(),int()}</c>, where the <c>int()</c> is the
+ number of monitors held by the process <c>pid()</c>.</p>
+ </item>
+ </taglist>
+ <p>If the options <c>linked_in_driver</c> or <c>permanent</c>
+ return true, all other options will return the value
+ <c>linked_in_driver</c> or <c>permanent</c> respectively.</p>
+ <p>The function throws a <c>badarg</c> exception if the driver
+ is not present in the system or the tag is not supported.</p>
+ </desc>
+ </func>
+ <func>
+ <name>load(Path, Name) -> ok | {error, ErrorDesc}</name>
+ <fsummary>Load a driver</fsummary>
+ <type>
+ <v>Path = Name = string() | atom()</v>
+ <v>ErrorDesc = term()</v>
+ </type>
+ <desc>
+ <p>Loads and links the dynamic driver <c>Name</c>. <c>Path</c>
+ is a file path to the directory containing the driver.
+ <c>Name</c> must be a sharable object/dynamic library. Two
+ drivers with different <c>Path</c> parameters cannot be
+ loaded under the same name. The <c>Name</c> is a string or
+ atom containing at least one character.</p>
+ <p>The <c>Name</c> given should correspond to the filename
+ of the actual dynamically loadable object file residing in
+ the directory given as <c>Path</c>, but <em>without</em> the
+ extension (i.e. <c>.so</c>). The driver name provided in
+ the driver initialization routine must correspond with the
+ filename, in much the same way as erlang module names
+ correspond to the names of the <c>.beam</c> files.</p>
+ <p>If the driver has been previously unloaded, but is still
+ present due to open ports against it, a call to
+ <c>load/2</c> will stop the unloading and keep the driver
+ (as long as the <c>Path</c> is the same) and <c>ok</c> is
+ returned. If one actually wants the object code to be
+ reloaded, one uses <seealso marker="#reload/2">reload/2</seealso> or the low-level
+ interface <seealso marker="#try_load/3">try_load/3</seealso>
+ instead. Please refer to the description of <seealso marker="#scenarios">different scenarios</seealso> for
+ loading/unloading in the introduction.</p>
+ <p>If more than one process tries to load an already loaded
+ driver withe the same <c>Path</c>, or if the same process
+ tries to load it several times, the function will return
+ <c>ok</c>. The emulator will keep track of the
+ <c>load/2</c> calls, so that a corresponding number of
+ <c>unload/2</c> calls will have to be done from the same
+ process before the driver will actually get unloaded. It is
+ therefore safe for an application to load a driver that is
+ shared between processes or applications when needed. It can
+ safely be unloaded without causing trouble for other
+ parts of the system. </p>
+ <p>It is not allowed to load
+ several drivers with the same name but with different
+ <c>Path</c> parameters.</p>
+ <note>
+ <p>Note especially that the <c>Path</c> is interpreted
+ literally, so that all loaders of the same driver needs to
+ give the same <em>literal</em><c>Path</c> string, even
+ though different paths might point out the same directory
+ in the filesystem (due to use of relative paths and
+ links).</p>
+ </note>
+ <p>On success, the function returns <c>ok</c>. On
+ failure, the return value is <c>{error,ErrorDesc}</c>,
+ where <c>ErrorDesc</c> is an opaque term to be
+ translated into human readable form by the <seealso marker="#format_error/1">format_error/1</seealso>
+ function.</p>
+ <p>For more control over the error handling, again use the
+ <seealso marker="#try_load/3">try_load/3</seealso>
+ interface instead.</p>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameters are not given as described above. </p>
+ </desc>
+ </func>
+ <func>
+ <name>load_driver(Path, Name) -> ok | {error, ErrorDesc}</name>
+ <fsummary>Load a driver</fsummary>
+ <type>
+ <v>Path = Name = string() | atom()</v>
+ <v>ErrorDesc = term()</v>
+ </type>
+ <desc>
+ <p>Works essentially as <c>load/2</c>, but will load the driver
+ with options other options. All ports that are using the
+ driver will get killed with the reason
+ <c>driver_unloaded</c> when the driver is to be unloaded.</p>
+ <p>The number of loads and unloads by different <seealso marker="#users">users</seealso> influence the actual loading
+ and unloading of a driver file. The port killing will
+ therefore only happen when the <em>last</em><seealso marker="#users">user</seealso> unloads the driver, or the
+ last process having loaded the driver exits.</p>
+ <p>This interface (or at least the name of the functions) is
+ kept for backward compatibility. Using <seealso marker="#try_load/3">try_load/3</seealso> with
+ <c>{driver_options,[kill_ports]} </c> in the option list will
+ give the same effect regarding the port killing.</p>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameters are not given as described above. </p>
+ </desc>
+ </func>
+ <func>
+ <name>monitor(Tag, Item) -> MonitorRef</name>
+ <fsummary>Create a monitor for a driver</fsummary>
+ <type>
+ <v>Tag = driver </v>
+ <v>Item = {Name, When}</v>
+ <v>Name = atom() | string()</v>
+ <v>When = loaded | unloaded | unloaded_only</v>
+ <v>MonitorRef = ref()</v>
+ </type>
+ <desc>
+ <p>This function creates a driver monitor and works in many
+ ways as the function <seealso marker="erts:erlang#erlang:monitor/2">erlang:monitor/2</seealso>,
+ does for processes. When a driver changes state, the monitor
+ results in a monitor-message being sent to the calling
+ process. The <c>MonitorRef</c> returned by this function is
+ included in the message sent.</p>
+ <p>As with process monitors, each driver monitor set will only
+ generate <em>one single message</em>. The monitor is
+ "destroyed" after the message is sent and there is then no
+ need to call <seealso marker="#demonitor/1">demonitor/1</seealso>.</p>
+ <p>The <c>MonitorRef</c> can also be used in subsequent calls
+ to <seealso marker="#demonitor/1">demonitor/1</seealso> to
+ remove a monitor.</p>
+ <p>The function accepts the following parameters:</p>
+ <taglist>
+ <tag><em>Tag</em></tag>
+ <item>
+ <p>The monitor tag is always <c>driver</c> as this function
+ can only be used to create driver monitors. In the future,
+ driver monitors will be integrated with process monitors,
+ why this parameter has to be given for consistence.</p>
+ </item>
+ <tag><em>Item</em></tag>
+ <item>
+ <p>The <c>Item</c> parameter specifies which driver one
+ wants to monitor (the name of the driver) as well as
+ which state change one wants to monitor. The parameter
+ is a tuple of arity two whose first element is the
+ driver name and second element is either of:</p>
+ <taglist>
+ <tag><em>loaded</em></tag>
+ <item>
+ <p>Notify me when the driver is reloaded (or loaded if
+ loading is underway). It only makes sense to monitor
+ drivers that are in the process of being loaded or
+ reloaded. One cannot monitor a future-to-be driver
+ name for loading, that will only result in a
+ <c>'DOWN'</c> message being immediately sent.
+ Monitoring for loading is therefore most useful when
+ triggered by the <seealso marker="#try_load/3">try_load/3</seealso> function,
+ where the monitor is created <em>because</em> the
+ driver is in such a pending state.</p>
+ <p>Setting a driver monitor for <c>loading</c> will
+ eventually lead to one of the following messages
+ being sent:</p>
+ <taglist>
+ <tag><em>{'UP', ref(), driver, Name, loaded}</em></tag>
+ <item>
+ <p>This message is sent, either immediately if the
+ driver is already loaded and no reloading is
+ pending, or when reloading is executed if
+ reloading is pending. </p>
+ <p>The <seealso marker="#users">user</seealso> is
+ expected to know if reloading is demanded prior
+ to creating a monitor for loading.</p>
+ </item>
+ <tag><em>{'UP', ref(), driver, Name, permanent}</em></tag>
+ <item>
+ <p>This message will be sent if reloading was
+ expected, but the (old) driver made itself
+ permanent prior to reloading. It will also be
+ sent if the driver was permanent or statically
+ linked in when trying to create the monitor.</p>
+ </item>
+ <tag><em>{'DOWN', ref(), driver, Name, load_cancelled}</em></tag>
+ <item>
+ <p>This message will arrive if reloading was
+ underway, but the <seealso marker="#users">user</seealso> having requested
+ reload cancelled it by either dying or calling
+ <seealso marker="#try_unload/2">try_unload/2</seealso>
+ (or <c>unload/1</c>/<c>unload_driver/1</c>)
+ again before it was reloaded.</p>
+ </item>
+ <tag><em>{'DOWN', ref(), driver, Name, {load_failure, Failure}}</em></tag>
+ <item>
+ <p>This message will arrive if reloading was
+ underway but the loading for some reason
+ failed. The <c>Failure</c> term is one of the
+ errors that can be returned from <seealso marker="#try_load/3">try_load/3</seealso>. The
+ error term can be passed to <seealso marker="#format_error/1">format_error/1</seealso>
+ for translation into human readable form. Note
+ that the translation has to be done in the same
+ running erlang virtual machine as the error
+ was detected in.</p>
+ </item>
+ </taglist>
+ </item>
+ <tag><em>unloaded</em></tag>
+ <item>
+ <p>Monitor when a driver gets unloaded. If one
+ monitors a driver that is not present in the system,
+ one will immediately get notified that the driver got
+ unloaded. There is no guarantee that the driver was
+ actually ever loaded.</p>
+ <p>A driver monitor for unload will eventually result
+ in one of the following messages being sent:</p>
+ <taglist>
+ <tag><em>{'DOWN', ref(), driver, Name, unloaded}</em></tag>
+ <item>
+ <p>The driver instance monitored is now
+ unloaded. As the unload might have been due to a
+ <c>reload/2</c> request, the driver might once
+ again have been loaded when this message
+ arrives.</p>
+ </item>
+ <tag><em>{'UP', ref(), driver, Name, unload_cancelled}</em></tag>
+ <item>
+ <p>This message will be sent if unloading was
+ expected, but while the driver was waiting for
+ all ports to get closed, a new <seealso marker="#users">user</seealso> of the driver
+ appeared and the unloading was cancelled.</p>
+ <p>This message appears when an <c>{ok, pending_driver}</c>) was returned from <seealso marker="#try_unload/2">try_unload/2</seealso>)
+ for the last <seealso marker="#users">user</seealso> of the driver and
+ then a <c>{ok, already_loaded}</c> is returned
+ from a call to <seealso marker="#try_load/3">try_load/3</seealso>.</p>
+ <p>If one wants to <em>really</em> monitor when the
+ driver gets unloaded, this message will distort
+ the picture, no unloading was really done.
+ The <c>unloaded_only</c> option creates a monitor
+ similar to an <c>unloaded</c> monitor, but does
+ never result in this message.</p>
+ </item>
+ <tag><em>{'UP', ref(), driver, Name, permanent}</em></tag>
+ <item>
+ <p>This message will be sent if unloading was
+ expected, but the driver made itself
+ permanent prior to unloading. It will also be
+ sent if trying to monitor a permanent or
+ statically linked in driver.</p>
+ </item>
+ </taglist>
+ </item>
+ <tag><em>unloaded_only</em></tag>
+ <item>
+ <p>A monitor created as <c>unloaded_only</c> behaves
+ exactly as one created as <c>unloaded</c> with the
+ exception that the <c>{'UP', ref(), driver, Name, unload_cancelled}</c> message will never be
+ sent, but the monitor instead persists until the
+ driver <em>really</em> gets unloaded.</p>
+ </item>
+ </taglist>
+ </item>
+ </taglist>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameters are not given as described above. </p>
+ </desc>
+ </func>
+ <func>
+ <name>reload(Path, Name) -> ok | {error, ErrorDesc}</name>
+ <fsummary>Replace a driver</fsummary>
+ <type>
+ <v>Path = Name = string() | atom()</v>
+ <v>ErrorDesc = pending_process | OpaqueError</v>
+ <v>OpaqueError = term()</v>
+ </type>
+ <desc>
+ <p>Reloads the driver named <c>Name</c> from a possibly
+ different <c>Path</c> than was previously used. This
+ function is used in the code change <seealso marker="#scenarios">scenario</seealso> described in the
+ introduction.</p>
+ <p>If there are other <seealso marker="#users">users</seealso>
+ of this driver, the function will return <c>{error, pending_process}</c>, but if there are no more users, the
+ function call will hang until all open ports are closed.</p>
+ <note>
+ <p>Avoid mixing
+ several <seealso marker="#users">users</seealso>
+ with driver reload requests.</p>
+ </note>
+ <p>If one wants to avoid hanging on open ports, one should use
+ the <seealso marker="#try_load/3">try_load/3</seealso>
+ function instead.</p>
+ <p>The <c>Name</c> and <c>Path</c> parameters have exactly the
+ same meaning as when calling the plain <seealso marker="#load/2">load/2</seealso> function.</p>
+ <note>
+ <p>Avoid mixing
+ several <seealso marker="#users">users</seealso>
+ with driver reload requests.</p>
+ </note>
+ <p>On success, the function returns <c>ok</c>. On
+ failure, the function returns an opaque error, with the
+ exception of the <c>pending_process</c> error described
+ above. The opaque errors are to be translated into human
+ readable form by the <seealso marker="#format_error/1">format_error/1</seealso> function.</p>
+ <p>For more control over the error handling, again use the
+ <seealso marker="#try_load/3">try_load/3</seealso>
+ interface instead.</p>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameters are not given as described above. </p>
+ </desc>
+ </func>
+ <func>
+ <name>reload_driver(Path, Name) -> ok | {error, ErrorDesc}</name>
+ <fsummary>Replace a driver</fsummary>
+ <type>
+ <v>Path = Name = string() | atom()</v>
+ <v>ErrorDesc = pending_process | OpaqueError</v>
+ <v>OpaqueError = term()</v>
+ </type>
+ <desc>
+ <p>Works exactly as <seealso marker="#reload/2">reload/2</seealso>, but for drivers
+ loaded with the <seealso marker="#load_driver/2">load_driver/2</seealso> interface. </p>
+ <p>As this interface implies that ports are being killed when
+ the last user disappears, the function wont hang waiting for
+ ports to get closed.</p>
+ <p>For further details, see the <seealso marker="#scenarios">scenarios</seealso> in the module
+ description and refer to the <seealso marker="#reload/2">reload/2</seealso> function description.</p>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameters are not given as described above. </p>
+ </desc>
+ </func>
+ <func>
+ <name>try_load(Path, Name, OptionList) -> {ok,Status} | {ok, PendingStatus, Ref} | {error, ErrorDesc}</name>
+ <fsummary>Load a driver</fsummary>
+ <type>
+ <v>Path = Name = string() | atom()</v>
+ <v>OptionList = [ Option ]</v>
+ <v>Option = {driver_options, DriverOptionList} | {monitor, MonitorOption} | {reload, ReloadOption}</v>
+ <v>DriverOptionList = [ DriverOption ]</v>
+ <v>DriverOption = kill_ports</v>
+ <v>MonitorOption = pending_driver | pending</v>
+ <v>ReloadOption = pending_driver | pending</v>
+ <v>Status = loaded | already_loaded | PendingStatus </v>
+ <v>PendingStatus = pending_driver | pending_process</v>
+ <v>Ref = ref()</v>
+ <v>ErrorDesc = ErrorAtom | OpaqueError</v>
+ <v>ErrorAtom = linked_in_driver | inconsistent | permanent | not_loaded_by_this_process | not_loaded | pending_reload | pending_process</v>
+ </type>
+ <desc>
+ <p>This function provides more control than the
+ <c>load/2</c>/<c>reload/2</c> and
+ <c>load_driver/2</c>/<c>reload_driver/2</c> interfaces. It
+ will never wait for completion of other operations related
+ to the driver, but immediately return the status of the
+ driver as either:</p>
+ <taglist>
+ <tag><em>{ok, loaded}</em></tag>
+ <item>
+ <p>The driver was actually loaded and is immediately
+ usable.</p>
+ </item>
+ <tag><em>{ok, already_loaded}</em></tag>
+ <item>
+ <p>The driver was already loaded by another process
+ and/or is in use by a living port. The load by you is
+ registered and a corresponding <c>try_unload</c> is
+ expected sometime in the future.</p>
+ </item>
+ <tag><em>{ok, pending_driver}</em>or <em>{ok, pending_driver, ref()}</em></tag>
+ <item>
+ <p>The load request is registered, but the loading is
+ delayed due to the fact that an earlier instance of the
+ driver is still waiting to get unloaded (there are open
+ ports using it). Still, unload is expected when you are
+ done with the driver. This return value will
+ <em>mostly</em> happen when the
+ <c>{reload,pending_driver}</c> or
+ <c>{reload,pending}</c> options are used, but
+ <em>can</em> happen when another <seealso marker="#users">user</seealso> is unloading a driver in
+ parallel and the <c>kill_ports</c> driver option is
+ set. In other words, this return value will always need
+ to be handled!</p>
+ </item>
+ <tag><em>{ok, pending_process}</em>or <em>{ok, pending_process, ref()}</em></tag>
+ <item>
+ <p>The load request is registered, but the loading is
+ delayed due to the fact that an earlier instance of the
+ driver is still waiting to get unloaded by another
+ <seealso marker="#users">user</seealso> (not only by a
+ port, in which case <c>{ok,pending_driver}</c> would
+ have been returned). Still, unload is expected when you
+ are done with the driver. This return value will
+ <em>only</em> happen when the <c>{reload,pending}</c>
+ option is used.</p>
+ </item>
+ </taglist>
+ <p>When the function returns <c>{ok, pending_driver}</c> or
+ <c>{ok, pending_process}</c>, one might want to get information
+ about when the driver is <em>actually</em> loaded. This can
+ be achieved by using the <c>{monitor, PendingOption}</c> option.</p>
+ <p>When monitoring is requested, and a corresponding <c>{ok, pending_driver}</c> or <c>{ok, pending_process}</c> would be
+ returned, the function will instead return a tuple <c>{ok, PendingStatus, ref()}</c> and the process will, at a later
+ time when the driver actually gets loaded, get a monitor
+ message. The monitor message one can expect is described in
+ the <seealso marker="#monitor/2">monitor/2</seealso>
+ function description. </p>
+ <note>
+ <p>Note that in case of loading, monitoring can
+ <em>not</em> only get triggered by using the <c>{reload, ReloadOption}</c> option, but also in special cases where
+ the load-error is transient, why <c>{monitor, pending_driver}</c> should be used under basically
+ <em>all</em> real world circumstances!</p>
+ </note>
+ <p>The function accepts the following parameters:</p>
+ <taglist>
+ <tag><em>Path</em></tag>
+ <item>
+ <p>The filesystem path to the directory where the driver
+ object file is situated. The filename of the object file
+ (minus extension) must correspond to the driver name
+ (used in the name parameter) and the driver must
+ identify itself with the very same name. The
+ <c>Path</c> might be provided as an <em>io_list</em>,
+ meaning it can be a list of other io_lists, characters
+ (eight bit integers) or binaries, all to be flattened
+ into a sequence of characters.</p>
+ <p>The (possibly flattened) <c>Path</c> parameter must be
+ consistent throughout the system, a driver should, by
+ all <seealso marker="#users">users</seealso>, be loaded
+ using the same <em>literal</em><c>Path</c>. The
+ exception is when <em>reloading</em> is requested, in
+ which case the <c>Path</c> may be specified
+ differently. Note that all <seealso marker="#users">users</seealso> trying to load the
+ driver at a later time will need to use the <em>new</em><c>Path</c> if the <c>Path</c> is changed using a
+ <c>reload</c> option. This is yet another reason
+ to have <em>only one loader</em> of a driver one wants to
+ upgrade in a running system! </p>
+ </item>
+ <tag><em>Name</em></tag>
+ <item>
+ <p>The name parameter is the name of the driver to be used
+ in subsequent calls to <seealso marker="erts:erlang#open_port/2">open_port</seealso>. The
+ name can be specified either as an <c>io_list()</c> or
+ as an <c>atom()</c>. The name given when loading is used
+ to find the actual object file (with the
+ help of the <c>Path</c> and the system implied
+ extension suffix, i.e. <c>.so</c>). The name by which
+ the driver identifies itself must also be consistent
+ with this <c>Name</c> parameter, much as a beam-file's
+ module name much correspond to it's filename.</p>
+ </item>
+ <tag><em>OptionList</em></tag>
+ <item>
+ <p>A number of options can be specified to control the
+ loading operation. The options are given as a list of
+ two-tuples, the tuples having the following values and
+ meanings:</p>
+ <taglist>
+ <tag><em>{driver_options, DriverOptionsList}</em></tag>
+ <item>
+ <p>This option is to provide options that will change
+ it's general behavior and will "stick" to the driver
+ throughout it's lifespan.</p>
+ <p>The driver options for a given driver name need
+ always to be consistent, <em>even when the driver is reloaded</em>, meaning that they are as much a part
+ of the driver as the actual name.</p>
+ <p>Currently the only allowed driver option is
+ <c>kill_ports</c>, which means that all ports opened
+ towards the driver are killed with the exit-reason
+ <c>driver_unloaded</c> when no process any longer
+ has the driver loaded. This situation arises either
+ when the last <seealso marker="#users">user</seealso> calls <seealso marker="#try_unload/2">try_unload/2</seealso>, or
+ the last process having loaded the driver exits.</p>
+ </item>
+ <tag><em>{monitor, MonitorOption}</em></tag>
+ <item>
+ <p>A <c>MonitorOption</c> tells <c>try_load/3</c> to
+ trigger a driver monitor under certain
+ conditions. When the monitor is triggered, the
+ function will return a three-tuple <c>{ok, PendingStatus, ref()}</c>, where the <c>ref()</c> is
+ the monitor ref for the driver monitor.</p>
+ <p>Only one <c>MonitorOption</c> can be specified and
+ it is either the atom <c>pending</c>, which means
+ that a monitor should be created whenever a load
+ operation is delayed, and the atom
+ <c>pending_driver</c>, in which a monitor is
+ created whenever the operation is delayed due to
+ open ports towards an otherwise unused driver. The
+ <c>pending_driver</c> option is of little use, but
+ is present for completeness, it is very well defined
+ which reload-options might give rise to which
+ delays. It might, however, be a good idea to use the
+ same <c>MonitorOption</c> as the <c>ReloadOption</c>
+ if present.</p>
+ <p>If reloading is not requested, it might still be
+ useful to specify the <c>monitor</c> option, as
+ forced unloads (<c>kill_ports</c> driver option or
+ the <c>kill_ports</c> option to <seealso marker="#try_unload/2">try_unload/2</seealso>) will
+ trigger a transient state where driver loading
+ cannot be performed until all closing ports are
+ actually closed. So, as <c>try_unload</c> can, in
+ almost all situations, return <c>{ok, pending_driver}</c>, one should always specify at least
+ <c>{monitor, pending_driver}</c> in production
+ code (see the monitor discussion above). </p>
+ </item>
+ <tag><em>{reload,RealoadOption}</em></tag>
+ <item>
+ <p>This option is used when one wants to
+ <em>reload</em> a driver from disk, most often in a
+ code upgrade scenario. Having a <c>reload</c> option
+ also implies that the <c>Path</c> parameter need
+ <em>not</em> be consistent with earlier loads of
+ the driver.</p>
+ <p>To reload a driver, the process needs to have previously
+ loaded the driver, i.e there has to be an active <seealso marker="#users">user</seealso> of the driver in the process. </p>
+ <p>The <c>reload</c> option can be either the atom
+ <c>pending</c>, in which reloading is requested for
+ any driver and will be effectuated when <em>all</em>
+ ports opened against the driver are closed. The
+ replacement of the driver will in this case take
+ place regardless of if there are still
+ pending <seealso marker="#users">users</seealso>
+ having the driver loaded!
+ The option also triggers port-killing (if the
+ <c>kill_ports</c> driver option is used) even though
+ there are pending users, making it usable for forced
+ driver replacement, but laying a lot of
+ responsibility on the driver <seealso marker="#users">users</seealso>. The pending option is
+ seldom used as one does not want other <seealso marker="#users">users</seealso> to have loaded the
+ driver when code change is underway. </p>
+ <p>The more useful option is <c>pending_driver</c>,
+ which means that reloading will be queued if the
+ driver is <em>not</em> loaded by any other <seealso marker="#users">users</seealso>, but the driver has
+ opened ports, in which case <c>{ok, pending_driver}</c> will be returned (a
+ <c>monitor</c> option is of course recommended).</p>
+ <p>If the driver is unloaded (not present in the
+ system), the error code
+ <c>not_loaded</c> will be returned. The
+ <c>reload</c> option is intended for when the user
+ has already loaded the driver in advance.</p>
+ </item>
+ </taglist>
+ </item>
+ </taglist>
+ <p>The function might return numerous errors, of which some
+ only can be returned given a certain combination of options.</p>
+ <p>A number of errors are opaque and can only be interpreted by
+ passing them to the <seealso marker="#format_error/1">format_error/1</seealso> function,
+ but some can be interpreted directly:</p>
+ <taglist>
+ <tag><em>{error,linked_in_driver}</em></tag>
+ <item>
+ <p>The driver with the specified name is an erlang
+ statically linked in driver, which cannot be manipulated
+ with this API.</p>
+ </item>
+ <tag><em>{error,inconsistent}</em></tag>
+ <item>
+ <p>The driver has already been loaded with either other
+ <c>DriverOptions</c> or a different <em>literal</em><c>Path</c> argument.</p>
+ <p>This can happen even if a <c>reload</c> option is given,
+ if the <c>DriverOptions</c> differ from the current.</p>
+ </item>
+ <tag><em>{error, permanent}</em></tag>
+ <item>
+ <p>The driver has requested itself to be permanent, making
+ it behave like an erlang linked in driver and it can no
+ longer be manipulated with this API.</p>
+ </item>
+ <tag><em>{error, pending_process}</em></tag>
+ <item>
+ <p>The driver is loaded by other <seealso marker="#users">users</seealso> when the <c>{reload, pending_driver}</c> option was given.</p>
+ </item>
+ <tag><em>{error, pending_reload}</em></tag>
+ <item>
+ <p>Driver reload is already requested by another <seealso marker="#users">user</seealso> when the <c>{reload, ReloadOption}</c> option was given.</p>
+ </item>
+ <tag><em>{error, not_loaded_by_this_process}</em></tag>
+ <item>
+ <p>Appears when the <c>reload</c> option is given. The
+ driver <c>Name</c> is present in the system, but there is no
+ <seealso marker="#users">user</seealso> of it in this
+ process.</p>
+ </item>
+ <tag><em>{error, not_loaded}</em></tag>
+ <item>
+ <p>Appears when the <c>reload</c> option is given. The
+ driver <c>Name</c> is not in the system. Only drivers
+ loaded by this process can be reloaded.</p>
+ </item>
+ </taglist>
+ <p>All other error codes are to be translated by the <seealso marker="#format_error/1">format_error/1</seealso>
+ function. Note that calls to <c>format_error</c> should be
+ performed from the same running instance of the erlang
+ virtual machine as the error was detected in, due to system
+ dependent behavior concerning error values.</p>
+ <p>If the arguments or options are malformed, the function will
+ throw a <c>badarg</c> exception.</p>
+ </desc>
+ </func>
+ <func>
+ <name>try_unload(Name, OptionList) -> {ok,Status} | {ok, PendingStatus, Ref} | {error, ErrorAtom}</name>
+ <fsummary>Unload a driver</fsummary>
+ <type>
+ <v>Name = string() | atom()</v>
+ <v>OptionList = [ Option ]</v>
+ <v>Option = {monitor, MonitorOption} | kill_ports</v>
+ <v>MonitorOption = pending_driver | pending</v>
+ <v>Status = unloaded | PendingStatus </v>
+ <v>PendingStatus = pending_driver | pending_process</v>
+ <v>Ref = ref()</v>
+ <v>ErrorAtom = linked_in_driver | not_loaded | not_loaded_by_this_process | permanent</v>
+ </type>
+ <desc>
+ <p>This is the low level function to unload (or decrement
+ reference counts of) a driver. It can be used to force port
+ killing, in much the same way as the driver option
+ <c>kill_ports</c> implicitly does, and it can trigger a
+ monitor either due to other <seealso marker="#users">users</seealso> still having the driver
+ loaded or that there are open ports using the driver.</p>
+ <p>Unloading can be described as the process of telling the
+ emulator that this particular part of the code in this
+ particular process (i.e. this <seealso marker="#users">user</seealso>) no longer needs the
+ driver. That can, if there are no other users, trigger
+ actual unloading of the driver, in which case the driver
+ name disappears from the system and (if possible) the memory
+ occupied by the driver executable code is reclaimed. If the
+ driver has the <c>kill_ports</c> option set, or if
+ <c>kill_ports</c> was specified as an option to this
+ function, all pending ports using this driver will get
+ killed when unloading is done by the last <seealso marker="#users">user</seealso>. If no port-killing is
+ involved and there are open ports, the actual unloading
+ is delayed until there are no more open ports using the
+ driver. If, in this case, another <seealso marker="#users">user</seealso> (or even this user) loads the
+ driver again before the driver is actually unloaded, the
+ unloading will never take place.</p>
+ <p>To allow the <seealso marker="#users">user</seealso> that
+ <em>requests unloading</em> to wait for <em>actual unloading</em> to
+ take place, <c>monitor</c> triggers can be specified in much
+ the same way as when loading. As <seealso marker="#users">users</seealso> of this function however
+ seldom are interested in more than decrementing the
+ reference counts, monitoring is more seldom needed. If the
+ <c>kill_ports</c> option is used however, monitor trigging is
+ crucial, as the ports are not guaranteed to have been killed
+ until the driver is unloaded, why a monitor should be
+ triggered for at least the <c>pending_driver</c> case.</p>
+ <p>The possible monitor messages that can be expected are the
+ same as when using the <c>unloaded</c> option to the
+ <seealso marker="#monitor/2">monitor/2</seealso> function.</p>
+ <p>The function will return one of the following statuses upon
+ success:</p>
+ <taglist>
+ <tag><em>{ok, unloaded}</em></tag>
+ <item>
+ <p>The driver was immediately unloaded, meaning that the
+ driver name is now free to use by other drivers and, if
+ the underlying OS permits it, the memory occupied by the
+ driver object code is now reclaimed.</p>
+ <p>The driver can only be unloaded when there are no open
+ ports using it and there are no more <seealso marker="#users">users</seealso> requiring it to be
+ loaded.</p>
+ </item>
+ <tag><em>{ok, pending_driver}</em>or <em>{ok, pending_driver, ref()}</em></tag>
+ <item>
+ <p>This return value indicates that this call removed the
+ last <seealso marker="#users">user</seealso> from the
+ driver, but there are still open ports using it.
+ When all ports are closed and no new <seealso marker="#users">users</seealso> have arrived, the driver
+ will actually be reloaded and the name and memory
+ reclaimed.</p>
+ <p>This return value is valid even when the option
+ <c>kill_ports</c> was used, as killing ports may not be
+ a process that completes immediately. The condition is,
+ in that case, however transient. Monitors are as always
+ useful to detect when the driver is really unloaded.</p>
+ </item>
+ <tag><em>{ok, pending_process}</em>or <em>{ok, pending_process, ref()}</em></tag>
+ <item>
+ <p>The unload request is registered, but there are still
+ other <seealso marker="#users">users</seealso> holding
+ the driver. Note that the term <c>pending_process</c>
+ might refer to the running process, there might be more
+ than one <seealso marker="#users">user</seealso> in the
+ same process.</p>
+ <p>This is a normal, healthy return value if the call was
+ just placed to inform the emulator that you have no
+ further use of the driver. It is actually the most
+ common return value in the most common <seealso marker="#scenarios">scenario</seealso>
+ described in the introduction.</p>
+ </item>
+ </taglist>
+ <p>The function accepts the following parameters:</p>
+ <taglist>
+ <tag><em>Name</em></tag>
+ <item>
+ <p>The name parameter is the name of the driver to be
+ unloaded. The name can be specified either as an
+ <c>io_list()</c> or as an <c>atom()</c>. </p>
+ </item>
+ <tag><em>OptionList</em></tag>
+ <item>
+ <p>The <c>OptionList</c> argument can be used to specify
+ certain behavior regarding ports as well as triggering
+ monitors under certain conditions:</p>
+ <taglist>
+ <tag><em>kill_ports</em></tag>
+ <item>
+ <p>Force killing of all ports opened using this driver,
+ with the exit reason <c>driver_unloaded</c>, if you are
+ the <em>last</em><seealso marker="#users">user</seealso> of the driver.</p>
+ <p>If there are other <seealso marker="#users">users</seealso> having the driver
+ loaded, this option will have no effect.</p>
+ <p>If one wants the consistent behavior of killing ports
+ when the last <seealso marker="#users">user</seealso>
+ unloads, one should use the driver option
+ <c>kill_ports</c> when loading the driver instead.</p>
+ </item>
+ <tag><em>{monitor, MonitorOption}</em></tag>
+ <item>
+ <p>This option creates a driver monitor if the condition
+ given in <c>MonitorOptions</c> is true. The valid
+ options are:</p>
+ <taglist>
+ <tag><em>pending_driver</em></tag>
+ <item>
+ <p>Create a driver monitor if the return value is to
+ be <c>{ok, pending_driver}</c>.</p>
+ </item>
+ <tag><em>pending</em></tag>
+ <item>
+ <p>Create a monitor if the return value will be either
+ <c>{ok, pending_driver}</c> or <c>{ok, pending_process}</c>.</p>
+ </item>
+ </taglist>
+ <p>The <c>pending_driver</c><c>MonitorOption</c> is by far
+ the most useful and it has to be used to ensure that the
+ driver has really been unloaded and the ports closed
+ whenever the <c>kill_ports</c> option is used or the
+ driver may have been loaded with the <c>kill_ports</c>
+ driver option.</p>
+ <p>By using the monitor-triggers in the call to
+ <c>try_unload</c> one can be sure that the monitor is
+ actually added before the unloading is executed, meaning
+ that the monitor will always get properly triggered,
+ which would not be the case if one called
+ <c>erl_ddll:monitor/2</c> separately.</p>
+ </item>
+ </taglist>
+ </item>
+ </taglist>
+ <p>The function may return several error conditions, of which
+ all are well specified (no opaque values):</p>
+ <taglist>
+ <tag><em>{error, linked_in_driver}</em></tag>
+ <item>
+ <p>You were trying to unload an erlang statically linked in
+ driver, which cannot be manipulated with this interface
+ (and cannot be unloaded at all).</p>
+ </item>
+ <tag><em>{error, not_loaded}</em></tag>
+ <item>
+ <p>The driver <c>Name</c> is not present in the system.</p>
+ </item>
+ <tag><em>{error, not_loaded_by_this_process}</em></tag>
+ <item>
+ <p>The driver <c>Name</c> is present in the system, but
+ there is no <seealso marker="#users">user</seealso> of
+ it in this process. </p>
+ <p>As a special case, drivers can be unloaded from
+ processes that has done no corresponding call to
+ <c>try_load/3</c> if, and only if, there are <em>no users of the driver at all</em>, which may happen if the
+ process containing the last user dies.</p>
+ </item>
+ <tag><em>{error, permanent}</em></tag>
+ <item>
+ <p>The driver has made itself permanent, in which case it
+ can no longer be manipulated by this interface (much
+ like a statically linked in driver).</p>
+ </item>
+ </taglist>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameters are not given as described above. </p>
+ </desc>
+ </func>
+ <func>
+ <name>unload(Name) -> ok | {error, ErrorDesc}</name>
+ <fsummary>Unload a driver</fsummary>
+ <type>
+ <v>Name = string() | atom()</v>
+ <v>ErrorDesc = term()</v>
+ </type>
+ <desc>
+ <p>Unloads, or at least dereferences the driver named
+ <c>Name</c>. If the caller is the last <seealso marker="#users">user</seealso> of the driver, and there
+ are no more open ports using the driver, the driver will
+ actually get unloaded. In all other cases, actual unloading
+ will be delayed until all ports are closed and there are no
+ remaining <seealso marker="#users">users</seealso>.</p>
+ <p>If there are other <seealso marker="#users">users</seealso> of the driver, the reference
+ counts of the driver is merely decreased, so that the caller
+ is no longer considered a user of the driver. For usage
+ scenarios, see the <seealso marker="#scenarios">description</seealso> in the beginning
+ of this document. </p>
+ <p>The <c>ErrorDesc</c> returned is an opaque value to be
+ passed further on to the <seealso marker="#format_error/1">format_error/1</seealso>
+ function. For more control over the operation, use the
+ <seealso marker="#try_unload/2">try_unload/2</seealso>
+ interface.</p>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameters are not given as described above. </p>
+ </desc>
+ </func>
+ <func>
+ <name>unload_driver(Name) -> ok | {error, ErrorDesc}</name>
+ <fsummary>Unload a driver</fsummary>
+ <type>
+ <v>Name = string() | atom()</v>
+ <v>ErrorDesc = term()</v>
+ </type>
+ <desc>
+ <p>Unloads, or at least dereferences the driver named
+ <c>Name</c>. If the caller is the last <seealso marker="#users">user</seealso> of the driver, all
+ remaining open ports using the driver will get killed with
+ the reason <c>driver_unloaded</c> and the driver will
+ eventually get unloaded.</p>
+ <p>If there are other <seealso marker="#users">users</seealso>
+ of the driver, the reference counts of the driver is merely
+ decreased, so that the caller is no longer considered a
+ <seealso marker="#users">user</seealso>. For
+ usage scenarios, see the <seealso marker="#scenarios">description</seealso> in the beginning
+ of this document.</p>
+ <p>The <c>ErrorDesc</c> returned is an opaque value to be
+ passed further on to the <seealso marker="#format_error/1">format_error/1</seealso>
+ function. For more control over the operation, use the
+ <seealso marker="#try_unload/2">try_unload/2</seealso>
+ interface.</p>
+ <p>The function throws a <c>badarg</c> exception if the
+ parameters are not given as described above. </p>
+ </desc>
+ </func>
+ <func>
+ <name>loaded_drivers() -> {ok, Drivers}</name>
+ <fsummary>List loaded drivers</fsummary>
+ <type>
+ <v>Drivers = [Driver()]</v>
+ <v>Driver = string()</v>
+ </type>
+ <desc>
+ <p>Returns a list of all the available drivers, both
+ (statically) linked-in and dynamically loaded ones.</p>
+ <p>The driver names are returned as a list of strings rather
+ than a list of atoms for historical reasons.</p>
+ <p>More information about drivers can be obtained using one of
+ the <seealso marker="#info/0">info</seealso> functions.</p>
+ </desc>
+ </func>
+ <func>
+ <name>format_error(ErrorDesc) -> string()</name>
+ <fsummary>Format an error descriptor</fsummary>
+ <type>
+ <v>ErrorDesc -- see below</v>
+ </type>
+ <desc>
+ <p>Takes an <c>ErrorDesc</c> returned by load, unload or
+ reload functions and returns a string which
+ describes the error or warning.</p>
+ <note>
+ <p>Due to peculiarities in the dynamic loading interfaces on
+ different platform, the returned string is only guaranteed
+ to describe the correct error <em>if format_error/1 is called in the same instance of the erlang virtual machine as the error appeared in</em> (meaning the same operating
+ system process)!</p>
+ </note>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p>erl_driver(4), driver_entry(4)</p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/erl_prim_loader_stub.xml b/lib/kernel/doc/src/erl_prim_loader_stub.xml
new file mode 100644
index 0000000000..e6324b8168
--- /dev/null
+++ b/lib/kernel/doc/src/erl_prim_loader_stub.xml
@@ -0,0 +1,42 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year>
+ <year>2009</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>erl_prim_loader</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>2008-12-16</date>
+ <rev>A</rev>
+ </header>
+ <module>erl_prim_loader</module>
+ <modulesummary>Low Level Erlang Loader</modulesummary>
+ <description><p>
+
+ The module erl_prim_loader is moved to the runtime system
+ application. Please see <seealso
+ marker="erts:erl_prim_loader">erl_prim_loader(3)</seealso> in the
+ erts reference manual instead.
+
+ </p></description>
+</erlref>
diff --git a/lib/kernel/doc/src/erlang_stub.xml b/lib/kernel/doc/src/erlang_stub.xml
new file mode 100644
index 0000000000..333c4fedaf
--- /dev/null
+++ b/lib/kernel/doc/src/erlang_stub.xml
@@ -0,0 +1,42 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year>
+ <year>2009</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>erlang</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>2008-12-16</date>
+ <rev>A</rev>
+ </header>
+ <module>erlang</module>
+ <modulesummary>The Erlang BIFs</modulesummary>
+ <description><p>
+
+ The module erlang is moved to the runtime system
+ application. Please see <seealso
+ marker="erts:erlang">erlang(3)</seealso> in the
+ erts reference manual instead.
+
+ </p></description>
+</erlref>
diff --git a/lib/kernel/doc/src/error_handler.xml b/lib/kernel/doc/src/error_handler.xml
new file mode 100644
index 0000000000..94824688d1
--- /dev/null
+++ b/lib/kernel/doc/src/error_handler.xml
@@ -0,0 +1,98 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year>
+ <year>2007</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>error_handler</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>error_handler</module>
+ <modulesummary>Default System Error Handler</modulesummary>
+ <description>
+ <p>The error handler module defines what happens when certain types
+ of errors occur.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>undefined_function(Module, Function, Args) -> term()</name>
+ <fsummary>Called when an undefined function is encountered</fsummary>
+ <type>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <d>A (possibly empty) list of arguments <c>Arg1,..,ArgN</c></d>
+ </type>
+ <desc>
+ <p>This function is evaluated if a call is made to
+ <c>Module:Function(Arg1,.., ArgN)</c> and
+ <c>Module:Function/N</c> is undefined. Note that
+ <c>undefined_function/3</c> is evaluated inside the process
+ making the original call.</p>
+ <p>If <c>Module</c> is interpreted, the interpreter is invoked
+ and the return value of the interpreted
+ <c>Function(Arg1,.., ArgN)</c> call is returned.</p>
+ <p>Otherwise, it returns, if possible, the value of
+ <c>apply(Module, Function, Args)</c> after an attempt has been
+ made to autoload <c>Module</c>. If this is not possible, the
+ call to <c>Module:Function(Arg1,.., ArgN)</c> fails with
+ exit reason <c>undef</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>undefined_lambda(Module, Fun, Args) -> term()</name>
+ <fsummary>Called when an undefined lambda (fun) is encountered</fsummary>
+ <type>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <d>A (possibly empty) list of arguments <c>Arg1,..,ArgN</c></d>
+ </type>
+ <desc>
+ <p>This function is evaluated if a call is made to
+ <c>Fun(Arg1,.., ArgN)</c> when the module defining the fun is
+ not loaded. The function is evaluated inside the process
+ making the original call.</p>
+ <p>If <c>Module</c> is interpreted, the interpreter is invoked
+ and the return value of the interpreted
+ <c>Fun(Arg1,.., ArgN)</c> call is returned.</p>
+ <p>Otherwise, it returns, if possible, the value of
+ <c>apply(Fun, Args)</c> after an attempt has been made to
+ autoload <c>Module</c>. If this is not possible, the call
+ fails with exit reason <c>undef</c>.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>Notes</title>
+ <p>The code in <c>error_handler</c> is complex and should not be
+ changed without fully understanding the interaction between
+ the error handler, the <c>init</c> process of the code server,
+ and the I/O mechanism of the code.</p>
+ <p>Changes in the code which may seem small can cause a deadlock
+ as unforeseen consequences may occur. The use of <c>input</c> is
+ dangerous in this type of code.</p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/error_logger.xml b/lib/kernel/doc/src/error_logger.xml
new file mode 100644
index 0000000000..e107d9b746
--- /dev/null
+++ b/lib/kernel/doc/src/error_logger.xml
@@ -0,0 +1,450 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>error_logger</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>error_logger</module>
+ <modulesummary>Erlang Error Logger</modulesummary>
+ <description>
+ <p>The Erlang <em>error logger</em> is an event manager (see
+ <seealso marker="doc/design_principles:des_princ">OTP Design Principles</seealso> and
+ <seealso marker="stdlib:gen_event">gen_event(3)</seealso>),
+ registered as <c>error_logger</c>. Error, warning and info events
+ are sent to the error logger from the Erlang runtime system and
+ the different Erlang/OTP applications. The events are, by default,
+ logged to tty. Note that an event from a process <c>P</c> is
+ logged at the node of the group leader of <c>P</c>. This means
+ that log output is directed to the node from which a process was
+ created, which not necessarily is the same node as where it is
+ executing.</p>
+ <p>Initially, <c>error_logger</c> only has a primitive event
+ handler, which buffers and prints the raw event messages. During
+ system startup, the application Kernel replaces this with a
+ <em>standard event handler</em>, by default one which writes
+ nicely formatted output to tty. Kernel can also be configured so
+ that events are logged to file instead, or not logged at all, see
+ <seealso marker="kernel_app">kernel(6)</seealso>.</p>
+ <p>Also the SASL application, if started, adds its own event
+ handler, which by default writes supervisor-, crash- and progress
+ reports to tty. See
+ <seealso marker="sasl:sasl_app">sasl(6)</seealso>.</p>
+ <p>It is recommended that user defined applications should report
+ errors through the error logger, in order to get uniform reports.
+ User defined event handlers can be added to handle application
+ specific events. (<c>add_report_handler/1,2</c>). Also, there is
+ a useful event handler in STDLIB for multi-file logging of events,
+ see <c>log_mf_h(3)</c>.</p>
+ <p>Warning events was introduced in Erlang/OTP R9C. To retain
+ backwards compatibility, these are by default tagged as errors,
+ thus showing up as error reports in the logs. By using
+ the command line flag <c><![CDATA[+W <w | i>]]></c>, they can instead
+ be tagged as warnings or info. Tagging them as warnings may
+ require rewriting existing user defined event handlers.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>error_msg(Format) -> ok</name>
+ <name>error_msg(Format, Data) -> ok</name>
+ <name>format(Format, Data) -> ok</name>
+ <fsummary>Send an standard error event to the error logger</fsummary>
+ <type>
+ <v>Format = string()</v>
+ <v>Data = [term()]</v>
+ </type>
+ <desc>
+ <p>Sends a standard error event to the error logger.
+ The <c>Format</c> and <c>Data</c> arguments are the same as
+ the arguments of <c>io:format/2</c>. The event is handled by
+ the standard event handler.</p>
+ <pre>
+1> <input>error_logger:error_msg("An error occurred in ~p~n", [a_module]).</input>
+
+=ERROR REPORT==== 11-Aug-2005::14:03:19 ===
+An error occurred in a_module
+ok</pre>
+ <warning>
+ <p>If called with bad arguments, this function can crash
+ the standard event handler, meaning no further events are
+ logged. When in doubt, use <c>error_report/1</c> instead.</p>
+ </warning>
+ </desc>
+ </func>
+ <func>
+ <name>error_report(Report) -> ok</name>
+ <fsummary>Send a standard error report event to the error logger</fsummary>
+ <type>
+ <v>Report = [{Tag, Data} | term()] | string() | term()</v>
+ <v>&nbsp;Tag = Data = term()</v>
+ </type>
+ <desc>
+ <p>Sends a standard error report event to the error logger.
+ The event is handled by the standard event handler.</p>
+ <pre>
+2> <input>error_logger:error_report([{tag1,data1},a_term,{tag2,data}]).</input>
+
+=ERROR REPORT==== 11-Aug-2005::13:45:41 ===
+ tag1: data1
+ a_term
+ tag2: data
+ok
+3> <input>error_logger:error_report("Serious error in my module").</input>
+
+=ERROR REPORT==== 11-Aug-2005::13:45:49 ===
+Serious error in my module
+ok</pre>
+ </desc>
+ </func>
+ <func>
+ <name>error_report(Type, Report) -> ok</name>
+ <fsummary>Send a user defined error report event to the error logger</fsummary>
+ <type>
+ <v>Type = term()</v>
+ <v>Report = [{Tag, Data} | term()] | string() | term()</v>
+ <v>&nbsp;Tag = Data = term()</v>
+ </type>
+ <desc>
+ <p>Sends a user defined error report event to the error logger.
+ An event handler to handle the event is supposed to have been
+ added. The event is ignored by the standard event handler.</p>
+ <p>It is recommended that <c>Report</c> follows the same
+ structure as for <c>error_report/1</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>warning_map() -> Tag</name>
+ <fsummary>Return the current mapping for warning events</fsummary>
+ <type>
+ <v>Tag = error | warning | info</v>
+ </type>
+ <desc>
+ <p>Returns the current mapping for warning events. Events sent
+ using <c>warning_msg/1,2</c> or <c>warning_report/1,2</c>
+ are tagged as errors (default), warnings or info, depending
+ on the value of the command line flag <c>+W</c>.</p>
+ <pre>
+os$ <input>erl</input>
+Erlang (BEAM) emulator version 5.4.8 [hipe] [threads:0] [kernel-poll]
+
+Eshell V5.4.8 (abort with ^G)
+1> <input>error_logger:warning_map().</input>
+error
+2> <input>error_logger:warning_msg("Warnings tagged as: ~p~n", [error]).</input>
+
+=ERROR REPORT==== 11-Aug-2005::15:31:23 ===
+Warnings tagged as: error
+ok
+3>
+User switch command
+ --> q
+os$ <input>erl +W w</input>
+Erlang (BEAM) emulator version 5.4.8 [hipe] [threads:0] [kernel-poll]
+
+Eshell V5.4.8 (abort with ^G)
+1> <input>error_logger:warning_map().</input>
+warning
+2> <input>error_logger:warning_msg("Warnings tagged as: ~p~n", [warning]).</input>
+
+=WARNING REPORT==== 11-Aug-2005::15:31:55 ===
+Warnings tagged as: warning
+ok</pre>
+ </desc>
+ </func>
+ <func>
+ <name>warning_msg(Format) -> ok</name>
+ <name>warning_msg(Format, Data) -> ok</name>
+ <fsummary>Send a standard warning event to the error logger</fsummary>
+ <type>
+ <v>Format = string()</v>
+ <v>Data = [term()]</v>
+ </type>
+ <desc>
+ <p>Sends a standard warning event to the error logger.
+ The <c>Format</c> and <c>Data</c> arguments are the same as
+ the arguments of <c>io:format/2</c>. The event is handled by
+ the standard event handler. It is tagged either as an error,
+ warning or info, see
+ <seealso marker="#warning_map/0">warning_map/0</seealso>.</p>
+ <warning>
+ <p>If called with bad arguments, this function can crash
+ the standard event handler, meaning no further events are
+ logged. When in doubt, use <c>warning_report/1</c> instead.</p>
+ </warning>
+ </desc>
+ </func>
+ <func>
+ <name>warning_report(Report) -> ok</name>
+ <fsummary>Send a standard warning report event to the error logger</fsummary>
+ <type>
+ <v>Report = [{Tag, Data} | term()] | string() | term()</v>
+ <v>&nbsp;Tag = Data = term()</v>
+ </type>
+ <desc>
+ <p>Sends a standard warning report event to the error logger.
+ The event is handled by the standard event handler. It is
+ tagged either as an error, warning or info, see
+ <seealso marker="#warning_map/0">warning_map/0</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>warning_report(Type, Report) -> ok</name>
+ <fsummary>Send a user defined warning report event to the error logger</fsummary>
+ <type>
+ <v>Type = term()</v>
+ <v>Report = [{Tag, Data} | term()] | string() | term()</v>
+ <v>&nbsp;Tag = Data = term()</v>
+ </type>
+ <desc>
+ <p>Sends a user defined warning report event to the error
+ logger. An event handler to handle the event is supposed to
+ have been added. The event is ignored by the standard event
+ handler. It is tagged either as an error, warning or info,
+ depending on the value of
+ <seealso marker="#warning_map/0">warning_map/0</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>info_msg(Format) -> ok</name>
+ <name>info_msg(Format, Data) -> ok</name>
+ <fsummary>Send a standard information event to the error logger</fsummary>
+ <type>
+ <v>Format = string()</v>
+ <v>Data = [term()]</v>
+ </type>
+ <desc>
+ <p>Sends a standard information event to the error logger.
+ The <c>Format</c> and <c>Data</c> arguments are the same as
+ the arguments of <c>io:format/2</c>. The event is handled by
+ the standard event handler.</p>
+ <pre>
+1> <input>error_logger:info_msg("Something happened in ~p~n", [a_module]).</input>
+
+=INFO REPORT==== 11-Aug-2005::14:06:15 ===
+Something happened in a_module
+ok</pre>
+ <warning>
+ <p>If called with bad arguments, this function can crash
+ the standard event handler, meaning no further events are
+ logged. When in doubt, use <c>info_report/1</c> instead.</p>
+ </warning>
+ </desc>
+ </func>
+ <func>
+ <name>info_report(Report) -> ok</name>
+ <fsummary>Send a standard information report event to the error logger</fsummary>
+ <type>
+ <v>Report = [{Tag, Data} | term()] | string() | term()</v>
+ <v>&nbsp;Tag = Data = term()</v>
+ </type>
+ <desc>
+ <p>Sends a standard information report event to the error
+ logger. The event is handled by the standard event handler.</p>
+ <pre>
+2> <input>error_logger:info_report([{tag1,data1},a_term,{tag2,data}]).</input>
+
+=INFO REPORT==== 11-Aug-2005::13:55:09 ===
+ tag1: data1
+ a_term
+ tag2: data
+ok
+3> <input>error_logger:info_report("Something strange happened").</input>
+
+=INFO REPORT==== 11-Aug-2005::13:55:36 ===
+Something strange happened
+ok</pre>
+ </desc>
+ </func>
+ <func>
+ <name>info_report(Type, Report) -> ok</name>
+ <fsummary>Send a user defined information report event to the error logger</fsummary>
+ <type>
+ <v>Type = term()</v>
+ <v>Report = [{Tag, Data} | term()] | string() | term()</v>
+ <v>&nbsp;Tag = Data = term()</v>
+ </type>
+ <desc>
+ <p>Sends a user defined information report event to the error
+ logger. An event handler to handle the event is supposed to
+ have been added. The event is ignored by the standard event
+ handler.</p>
+ <p>It is recommended that <c>Report</c> follows the same
+ structure as for <c>info_report/1</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>add_report_handler(Handler) -> Result</name>
+ <name>add_report_handler(Handler, Args) -> Result</name>
+ <fsummary>Add an event handler to the error logger</fsummary>
+ <type>
+ <v>Handler, Args, Result -- see gen_event:add_handler/3</v>
+ </type>
+ <desc>
+ <p>Adds a new event handler to the error logger. The event
+ handler must be implemented as a <c>gen_event</c> callback
+ module, see
+ <seealso marker="stdlib:gen_event">gen_event(3)</seealso>.</p>
+ <p><c>Handler</c> is typically the name of the callback module
+ and <c>Args</c> is an optional term (defaults to []) passed
+ to the initialization callback function <c>Module:init/1</c>.
+ The function returns <c>ok</c> if successful.</p>
+ <p>The event handler must be able to handle the
+ <seealso marker="#events">events</seealso> described below.</p>
+ </desc>
+ </func>
+ <func>
+ <name>delete_report_handler(Handler) -> Result</name>
+ <fsummary>Delete an event handler from the error logger</fsummary>
+ <type>
+ <v>Handler, Result -- see gen_event:delete_handler/3</v>
+ </type>
+ <desc>
+ <p>Deletes an event handler from the error logger by calling
+ <c>gen_event:delete_handler(error_logger, Handler, [])</c>,
+ see <seealso marker="stdlib:gen_event">gen_event(3)</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>tty(Flag) -> ok</name>
+ <fsummary>Enable or disable printouts to the tty</fsummary>
+ <type>
+ <v>Flag = bool()</v>
+ </type>
+ <desc>
+ <p>Enables (<c>Flag == true</c>) or disables
+ (<c>Flag == false</c>) printout of standard events to the tty.</p>
+ <p>This is done by adding or deleting the standard event handler
+ for output to tty, thus calling this function overrides
+ the value of the Kernel <c>error_logger</c> configuration
+ parameter.</p>
+ </desc>
+ </func>
+ <func>
+ <name>logfile(Request) -> ok | Filename | {error, What}</name>
+ <fsummary>Enable or disable error printouts to a file</fsummary>
+ <type>
+ <v>Request = {open, Filename} | close | filename</v>
+ <v>&nbsp;Filename = atom() | string()</v>
+ <v>What = allready_have_logfile | no_log_file | term()</v>
+ </type>
+ <desc>
+ <p>Enables or disables printout of standard events to a file.</p>
+ <p>This is done by adding or deleting the standard event handler
+ for output to file, thus calling this function overrides
+ the value of the Kernel <c>error_logger</c> configuration
+ parameter.</p>
+ <p>Enabling file logging can be used in combination with calling
+ <c>tty(false)</c>, in order to have a silent system, where
+ all standard events are logged to a file only.
+ There can only be one active log file at a time.</p>
+ <p><c>Request</c> is one of:</p>
+ <taglist>
+ <tag><c>{open, Filename}</c></tag>
+ <item>
+ <p>Opens the log file <c>Filename</c>. Returns <c>ok</c> if
+ successful, or <c>{error, allready_have_logfile}</c> if
+ logging to file is already enabled, or an error tuple if
+ another error occurred. For example, if <c>Filename</c>
+ could not be opened.</p>
+ </item>
+ <tag><c>close</c></tag>
+ <item>
+ <p>Closes the current log file. Returns <c>ok</c>, or
+ <c>{error, What}</c>.</p>
+ </item>
+ <tag><c>filename</c></tag>
+ <item>
+ <p>Returns the name of the log file <c>Filename</c>, or
+ <c>{error, no_log_file}</c> if logging to file is not
+ enabled.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <marker id="events"></marker>
+ <title>Events</title>
+ <p>All event handlers added to the error logger must handle
+ the following events. <c>Gleader</c> is the group leader pid of
+ the process which sent the event, and <c>Pid</c> is the process
+ which sent the event.</p>
+ <taglist>
+ <tag><c>{error, Gleader, {Pid, Format, Data}}</c></tag>
+ <item>
+ <p>Generated when <c>error_msg/1,2</c> or <c>format</c> is
+ called.</p>
+ </item>
+ <tag><c>{error_report, Gleader, {Pid, std_error, Report}}</c></tag>
+ <item>
+ <p>Generated when <c>error_report/1</c> is called.</p>
+ </item>
+ <tag><c>{error_report, Gleader, {Pid, Type, Report}}</c></tag>
+ <item>
+ <p>Generated when <c>error_report/2</c> is called.</p>
+ </item>
+ <tag><c>{warning_msg, Gleader, {Pid, Format, Data}}</c></tag>
+ <item>
+ <p>Generated when <c>warning_msg/1,2</c> is called, provided
+ that warnings are set to be tagged as warnings.</p>
+ </item>
+ <tag><c>{warning_report, Gleader, {Pid, std_warning, Report}}</c></tag>
+ <item>
+ <p>Generated when <c>warning_report/1</c> is called, provided
+ that warnings are set to be tagged as warnings.</p>
+ </item>
+ <tag><c>{warning_report, Gleader, {Pid, Type, Report}}</c></tag>
+ <item>
+ <p>Generated when <c>warning_report/2</c> is called, provided
+ that warnings are set to be tagged as warnings.</p>
+ </item>
+ <tag><c>{info_msg, Gleader, {Pid, Format, Data}}</c></tag>
+ <item>
+ <p>Generated when <c>info_msg/1,2</c> is called.</p>
+ </item>
+ <tag><c>{info_report, Gleader, {Pid, std_info, Report}}</c></tag>
+ <item>
+ <p>Generated when <c>info_report/1</c> is called.</p>
+ </item>
+ <tag><c>{info_report, Gleader, {Pid, Type, Report}}</c></tag>
+ <item>
+ <p>Generated when <c>info_report/2</c> is called.</p>
+ </item>
+ </taglist>
+ <p>Note that also a number of system internal events may be
+ received, a catch-all clause last in the definition of
+ the event handler callback function <c>Module:handle_event/2</c>
+ is necessary. This also holds true for
+ <c>Module:handle_info/2</c>, as there are a number of system
+ internal messages the event handler must take care of as well.</p>
+ </section>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p>gen_event(3), log_mf_h(3), kernel(6), sasl(6)</p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/fascicules.xml b/lib/kernel/doc/src/fascicules.xml
new file mode 100644
index 0000000000..43090b4aed
--- /dev/null
+++ b/lib/kernel/doc/src/fascicules.xml
@@ -0,0 +1,15 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE fascicules SYSTEM "fascicules.dtd">
+
+<fascicules>
+ <fascicule file="ref_man" href="ref_man_frame.html" entry="yes">
+ Reference Manual
+ </fascicule>
+ <fascicule file="part_notes" href="part_notes_frame.html" entry="no">
+ Release Notes
+ </fascicule>
+ <fascicule file="" href="../../../../doc/print.html" entry="no">
+ Off-Print
+ </fascicule>
+</fascicules>
+
diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml
new file mode 100644
index 0000000000..2303617542
--- /dev/null
+++ b/lib/kernel/doc/src/file.xml
@@ -0,0 +1,2002 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>file</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>file</module>
+ <modulesummary>File Interface Module</modulesummary>
+ <description>
+ <p>The module <c>file</c> provides an interface to the file system.</p>
+ <p>On operating systems with thread support, it is possible to let
+ file operations be performed in threads of their own, allowing
+ other Erlang processes to continue executing in parallel with
+ the file operations. See the command line flag
+ <c>+A</c> in <seealso marker="erts:erl">erl(1)</seealso>.</p>
+ </description>
+
+ <section>
+ <title>DATA TYPES</title>
+ <code type="none">
+iodata() = iolist() | binary()
+ iolist() = [char() | binary() | iolist()]
+
+io_device()
+ as returned by file:open/2, a process handling IO protocols
+
+name() = string() | atom() | DeepList
+ DeepList = [char() | atom() | DeepList]
+
+posix()
+ an atom which is named from the POSIX error codes used in
+ Unix, and in the runtime libraries of most C compilers
+
+ext_posix() = posix() | badarg
+
+time() = {{Year, Month, Day}, {Hour, Minute, Second}}
+ Year = Month = Day = Hour = Minute = Second = int()
+ Must denote a valid date and time</code>
+ </section>
+ <funcs>
+ <func>
+ <name>change_group(Filename, Gid) -> ok | {error, Reason}</name>
+ <fsummary>Change group of a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Gid = int()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Changes group of a file. See
+ <seealso marker="#write_file_info/2">write_file_info/2</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>change_owner(Filename, Uid) -> ok | {error, Reason}</name>
+ <fsummary>Change owner of a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Uid = int()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Changes owner of a file. See
+ <seealso marker="#write_file_info/2">write_file_info/2</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>change_owner(Filename, Uid, Gid) -> ok | {error, Reason}</name>
+ <fsummary>Change owner and group of a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Uid = int()</v>
+ <v>Gid = int()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Changes owner and group of a file. See
+ <seealso marker="#write_file_info/2">write_file_info/2</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>change_time(Filename, Mtime) -> ok | {error, Reason}</name>
+ <fsummary>Change the modification time of a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Mtime = time()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Changes the modification and access times of a file. See
+ <seealso marker="#write_file_info/2">write_file_info/2</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>change_time(Filename, Mtime, Atime) -> ok | {error, Reason}</name>
+ <fsummary>Change the modification and last access time of a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Mtime = Atime = time()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Changes the modification and last access times of a file. See
+ <seealso marker="#write_file_info/2">write_file_info/2</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>close(IoDevice) -> ok | {error, Reason}</name>
+ <fsummary>Close a file</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Closes the file referenced by <c>IoDevice</c>. It mostly
+ returns <c>ok</c>, expect for some severe errors such as out
+ of memory.</p>
+ <p>Note that if the option <c>delayed_write</c> was
+ used when opening the file, <c>close/1</c> might return an
+ old write error and not even try to close the file. See
+ <seealso marker="#open/2">open/2</seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>consult(Filename) -> {ok, Terms} | {error, Reason}</name>
+ <fsummary>Read Erlang terms from a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Terms = [term()]</v>
+ <v>Reason = ext_posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see below</v>
+ </type>
+ <desc>
+ <p>Reads Erlang terms, separated by '.', from <c>Filename</c>.
+ Returns one of the following:</p>
+ <taglist>
+ <tag><c>{ok, Terms}</c></tag>
+ <item>
+ <p>The file was successfully read.</p>
+ </item>
+ <tag><c>{error, atom()}</c></tag>
+ <item>
+ <p>An error occurred when opening the file or reading it.
+ See <seealso marker="#open/2">open/2</seealso> for a list
+ of typical error codes.</p>
+ </item>
+ <tag><c>{error, {Line, Mod, Term}}</c></tag>
+ <item>
+ <p>An error occurred when interpreting the Erlang terms in
+ the file. Use <c>format_error/1</c> to convert
+ the three-element tuple to an English description of
+ the error.</p>
+ </item>
+ </taglist>
+ <p>Example:</p>
+ <code type="none">
+f.txt: {person, "kalle", 25}.
+ {person, "pelle", 30}.</code>
+ <pre>
+1> <input>file:consult("f.txt").</input>
+{ok,[{person,"kalle",25},{person,"pelle",30}]}</pre>
+ </desc>
+ </func>
+ <func>
+ <name>copy(Source, Destination) -></name>
+ <name>copy(Source, Destination, ByteCount) -> {ok, BytesCopied} | {error, Reason}</name>
+ <fsummary>Copy file contents</fsummary>
+ <type>
+ <v>Source = Destination = io_device() | Filename | {Filename, Modes}</v>
+ <v>&nbsp;Filename = name()</v>
+ <v>&nbsp;Modes = [Mode] -- see open/2</v>
+ <v>ByteCount = int() >= 0 | infinity</v>
+ <v>BytesCopied = int()</v>
+ </type>
+ <desc>
+ <p>Copies <c>ByteCount</c> bytes from <c>Source</c> to
+ <c>Destination</c>. <c>Source</c> and <c>Destination</c> refer
+ to either filenames or IO devices from e.g. <c>open/2</c>.
+ <c>ByteCount</c> defaults <c>infinity</c>, denoting an
+ infinite number of bytes.</p>
+ <p>The argument <c>Modes</c> is a list of possible modes, see
+ <seealso marker="#open/2">open/2</seealso>, and defaults to
+ [].</p>
+ <p>If both <c>Source</c> and <c>Destination</c> refer to
+ filenames, the files are opened with <c>[read, binary]</c>
+ and <c>[write, binary]</c> prepended to their mode lists,
+ respectively, to optimize the copy.</p>
+ <p>If <c>Source</c> refers to a filename, it is opened with
+ <c>read</c> mode prepended to the mode list before the copy,
+ and closed when done.</p>
+ <p>If <c>Destination</c> refers to a filename, it is opened
+ with <c>write</c> mode prepended to the mode list before
+ the copy, and closed when done.</p>
+ <p>Returns <c>{ok, BytesCopied}</c> where <c>BytesCopied</c> is
+ the number of bytes that actually was copied, which may be
+ less than <c>ByteCount</c> if end of file was encountered on
+ the source. If the operation fails, <c>{error, Reason}</c> is
+ returned.</p>
+ <p>Typical error reasons: As for <c>open/2</c> if a file had to
+ be opened, and as for <c>read/2</c> and <c>write/2</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>del_dir(Dir) -> ok | {error, Reason}</name>
+ <fsummary>Delete a directory</fsummary>
+ <type>
+ <v>Dir = name()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Tries to delete the directory <c>Dir</c>. The directory must
+ be empty before it can be deleted. Returns <c>ok</c> if
+ successful.</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing search or write permissions for the parent
+ directories of <c>Dir</c>.</p>
+ </item>
+ <tag><c>eexist</c></tag>
+ <item>
+ <p>The directory is not empty.</p>
+ </item>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The directory does not exist.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of <c>Dir</c> is not a directory. On some
+ platforms, <c>enoent</c> is returned instead.</p>
+ </item>
+ <tag><c>einval</c></tag>
+ <item>
+ <p>Attempt to delete the current directory. On some
+ platforms, <c>eacces</c> is returned instead.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>delete(Filename) -> ok | {error, Reason}</name>
+ <fsummary>Delete a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Tries to delete the file <c>Filename</c>. Returns <c>ok</c>
+ if successful.</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The file does not exist.</p>
+ </item>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing permission for the file or one of its parents.</p>
+ </item>
+ <tag><c>eperm</c></tag>
+ <item>
+ <p>The file is a directory and the user is not super-user.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of the file name is not a directory. On some
+ platforms, <c>enoent</c> is returned instead.</p>
+ </item>
+ <tag><c>einval</c></tag>
+ <item>
+ <p><c>Filename</c> had an improper type, such as tuple.</p>
+ </item>
+ </taglist>
+ <warning>
+ <p>In a future release, a bad type for the <c>Filename</c>
+ argument will probably generate an exception.</p>
+ <p></p>
+ </warning>
+ </desc>
+ </func>
+ <func>
+ <name>eval(Filename) -> ok | {error, Reason}</name>
+ <fsummary>Evaluate Erlang expressions in a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Reason = ext_posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see below</v>
+ </type>
+ <desc>
+ <p>Reads and evaluates Erlang expressions, separated by '.' (or
+ ',', a sequence of expressions is also an expression), from
+ <c>Filename</c>. The actual result of the evaluation is not
+ returned; any expression sequence in the file must be there
+ for its side effect. Returns one of the following:</p>
+ <taglist>
+ <tag><c>ok</c></tag>
+ <item>
+ <p>The file was read and evaluated.</p>
+ </item>
+ <tag><c>{error, atom()}</c></tag>
+ <item>
+ <p>An error occurred when opening the file or reading it.
+ See <c>open/2</c> for a list of typical error codes.</p>
+ </item>
+ <tag><c>{error, {Line, Mod, Term}}</c></tag>
+ <item>
+ <p>An error occurred when interpreting the Erlang
+ expressions in the file. Use <c>format_error/1</c> to
+ convert the three-element tuple to an English description
+ of the error.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>eval(Filename, Bindings) -> ok | {error, Reason}</name>
+ <fsummary>Evaluate Erlang expressions in a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Bindings -- see erl_eval(3)</v>
+ <v>Reason = ext_posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see eval/1</v>
+ </type>
+ <desc>
+ <p>The same as <c>eval/1</c> but the variable bindings
+ <c>Bindings</c> are used in the evaluation. See
+ <seealso marker="stdlib:erl_eval">erl_eval(3)</seealso> about
+ variable bindings.</p>
+ </desc>
+ </func>
+ <func>
+ <name>file_info(Filename) -> {ok, FileInfo} | {error, Reason}</name>
+ <fsummary>Get information about a file (deprecated)</fsummary>
+ <desc>
+ <p>This function is obsolete. Use <c>read_file_info/1</c>
+ instead.</p>
+ </desc>
+ </func>
+ <func>
+ <name>format_error(Reason) -> Chars</name>
+ <fsummary>Return a descriptive string for an error reason</fsummary>
+ <type>
+ <v>Reason = atom() | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see eval/1</v>
+ <v>Chars = [char() | Chars]</v>
+ </type>
+ <desc>
+ <p>Given the error reason returned by any function in this
+ module, returns a descriptive string of the error in English.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_cwd() -> {ok, Dir} | {error, Reason}</name>
+ <fsummary>Get the current working directory</fsummary>
+ <type>
+ <v>Dir = string()</v>
+ <v>Reason = posix()</v>
+ </type>
+ <desc>
+ <p>Returns <c>{ok, Dir}</c>, where <c>Dir</c> is the current
+ working directory of the file server.</p>
+ <note>
+ <p>In rare circumstances, this function can fail on Unix.
+ It may happen if read permission does not exist for
+ the parent directories of the current directory.</p>
+ </note>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing read permission for one of the parents of
+ the current directory.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>get_cwd(Drive) -> {ok, Dir} | {error, Reason}</name>
+ <fsummary>Get the current working directory for the drive specified</fsummary>
+ <type>
+ <v>Drive = string() -- see below</v>
+ <v>Dir = string()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p><c>Drive</c> should be of the form "<c>Letter</c><c>:</c>",
+ for example "c:". Returns <c>{ok, Dir}</c> or
+ <c>{error, Reason}</c>, where <c>Dir</c> is the current
+ working directory of the drive specified.</p>
+ <p>This function returns <c>{error, enotsup}</c> on platforms
+ which have no concept of current drive (Unix, for example).</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>enotsup</c></tag>
+ <item>
+ <p>The operating system have no concept of drives.</p>
+ </item>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>The drive does not exist.</p>
+ </item>
+ <tag><c>einval</c></tag>
+ <item>
+ <p>The format of <c>Drive</c> is invalid.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>list_dir(Dir) -> {ok, Filenames} | {error, Reason}</name>
+ <fsummary>List files in a directory</fsummary>
+ <type>
+ <v>Dir = name()</v>
+ <v>Filenames = [Filename]</v>
+ <v>&nbsp;Filename = string()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Lists all the files in a directory. Returns
+ <c>{ok, Filenames}</c> if successful. Otherwise, it returns
+ <c>{error, Reason}</c>. <c>Filenames</c> is a list of
+ the names of all the files in the directory. The names are
+ not sorted.</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing search or write permissions for <c>Dir</c> or
+ one of its parent directories.</p>
+ </item>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The directory does not exist.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>make_dir(Dir) -> ok | {error, Reason}</name>
+ <fsummary>Make a directory</fsummary>
+ <type>
+ <v>Dir = name()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Tries to create the directory <c>Dir</c>. Missing parent
+ directories are <em>not</em> created. Returns <c>ok</c> if
+ successful.</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing search or write permissions for the parent
+ directories of <c>Dir</c>.</p>
+ </item>
+ <tag><c>eexist</c></tag>
+ <item>
+ <p>There is already a file or directory named <c>Dir</c>.</p>
+ </item>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>A component of <c>Dir</c> does not exist.</p>
+ </item>
+ <tag><c>enospc</c></tag>
+ <item>
+ <p>There is a no space left on the device.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of <c>Dir</c> is not a directory. On some
+ platforms, <c>enoent</c> is returned instead.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>make_link(Existing, New) -> ok | {error, Reason}</name>
+ <fsummary>Make a hard link to a file</fsummary>
+ <type>
+ <v>Existing = New = name()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Makes a hard link from <c>Existing</c> to <c>New</c>, on
+ platforms that support links (Unix). This function returns
+ <c>ok</c> if the link was successfully created, or
+ <c>{error, Reason}</c>. On platforms that do not support
+ links, <c>{error,enotsup}</c> is returned.</p>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing read or write permissions for the parent
+ directories of <c>Existing</c> or <c>New</c>.</p>
+ </item>
+ <tag><c>eexist</c></tag>
+ <item>
+ <p><c>New</c> already exists.</p>
+ </item>
+ <tag><c>enotsup</c></tag>
+ <item>
+ <p>Hard links are not supported on this platform.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>make_symlink(Name1, Name2) -> ok | {error, Reason}</name>
+ <fsummary>Make a symbolic link to a file or directory</fsummary>
+ <type>
+ <v>Name1 = Name2 = name()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>This function creates a symbolic link <c>Name2</c> to
+ the file or directory <c>Name1</c>, on platforms that support
+ symbolic links (most Unix systems). <c>Name1</c> need not
+ exist. This function returns <c>ok</c> if the link was
+ successfully created, or <c>{error, Reason}</c>. On platforms
+ that do not support symbolic links, <c>{error, enotsup}</c>
+ is returned.</p>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing read or write permissions for the parent
+ directories of <c>Name1</c> or <c>Name2</c>.</p>
+ </item>
+ <tag><c>eexist</c></tag>
+ <item>
+ <p><c>Name2</c> already exists.</p>
+ </item>
+ <tag><c>enotsup</c></tag>
+ <item>
+ <p>Symbolic links are not supported on this platform.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>open(Filename, Modes) -> {ok, IoDevice} | {error, Reason}</name>
+ <fsummary>Open a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Modes = [Mode]</v>
+ <v>&nbsp;Mode = read | write | append | raw | binary | {delayed_write, Size, Delay} | delayed_write | {read_ahead, Size} | read_ahead | compressed</v>
+ <v>&nbsp;&nbsp;Size = Delay = int()</v>
+ <v>IoDevice = io_device()</v>
+ <v>Reason = ext_posix() | system_limit</v>
+ </type>
+ <desc>
+ <p>Opens the file <c>Filename</c> in the mode determined by
+ <c>Modes</c>, which may contain one or more of the following
+ items:</p>
+ <taglist>
+ <tag><c>read</c></tag>
+ <item>
+ <p>The file, which must exist, is opened for reading.</p>
+ </item>
+ <tag><c>write</c></tag>
+ <item>
+ <p>The file is opened for writing. It is created if it does
+ not exist. If the file exists, and if <c>write</c> is not
+ combined with <c>read</c>, the file will be truncated.</p>
+ </item>
+ <tag><c>append</c></tag>
+ <item>
+ <p>The file will be opened for writing, and it will be
+ created if it does not exist. Every write operation to a
+ file opened with <c>append</c> will take place at
+ the end of the file.</p>
+ </item>
+ <tag><c>raw</c></tag>
+ <item>
+ <p>The <c>raw</c> option allows faster access to a file,
+ because no Erlang process is needed to handle the file.
+ However, a file opened in this way has the following
+ limitations:</p>
+ <list type="bulleted">
+ <item>The functions in the <c>io</c> module cannot be used,
+ because they can only talk to an Erlang process.
+ Instead, use the <c>read/2</c>, <c>read_line/1</c> and
+ <c>write/2</c>
+ functions.</item>
+ <item>Especially if <c>read_line/1</c> is to be used on a <c>raw</c> file, it is recommended to combine this option with the <c>{read_ahead, Size}</c> option as line oriented I/O is inefficient without buffering.</item>
+ <item>Only the Erlang process which opened the file can use
+ it.</item>
+ <item>A remote Erlang file server cannot be used;
+ the computer on which the Erlang node is running must
+ have access to the file system (directly or through
+ NFS).</item>
+ </list>
+ </item>
+ <tag><c>binary</c></tag>
+ <item>
+ <p>When this option has been given, read operations on the file
+ will return binaries rather than lists.</p>
+ </item>
+ <tag><c>{delayed_write, Size, Delay}</c></tag>
+ <item>
+ <p>If this option is used, the data in subsequent
+ <c>write/2</c> calls is buffered until there are at least
+ <c>Size</c> bytes buffered, or until the oldest buffered
+ data is <c>Delay</c> milliseconds old. Then all buffered
+ data is written in one operating system call.
+ The buffered data is also flushed before some other file
+ operation than <c>write/2</c> is executed.</p>
+ <p>The purpose of this option is to increase performance
+ by reducing the number of operating system calls, so the
+ <c>write/2</c> calls should be for sizes significantly
+ less than <c>Size</c>, and not interspersed by to many
+ other file operations, for this to happen.</p>
+ <p>When this option is used, the result of <c>write/2</c>
+ calls may prematurely be reported as successful, and if
+ a write error should actually occur the error is
+ reported as the result of the next file operation, which
+ is not executed.</p>
+ <p>For example, when <c>delayed_write</c> is used, after a
+ number of <c>write/2</c> calls, <c>close/1</c> might
+ return <c>{error, enospc}</c> because there was not enough
+ space on the disc for previously written data, and
+ <c>close/1</c> should probably be called again since the
+ file is still open.</p>
+ </item>
+ <tag><c>delayed_write</c></tag>
+ <item>
+ <p>The same as <c>{delayed_write, Size, Delay}</c> with
+ reasonable default values for <c>Size</c> and
+ <c>Delay</c>. (Roughly some 64 KBytes, 2 seconds)</p>
+ </item>
+ <tag><c>{read_ahead, Size}</c></tag>
+ <item>
+ <p>This option activates read data buffering. If
+ <c>read/2</c> calls are for significantly less than
+ <c>Size</c> bytes, read operations towards the operating
+ system are still performed for blocks of <c>Size</c>
+ bytes. The extra data is buffered and returned in
+ subsequent <c>read/2</c> calls, giving a performance gain
+ since the number of operating system calls is reduced.</p>
+ <p>The <c>read_ahead</c> buffer is also highly utilized
+ by the <c>read_line/1</c> function in <c>raw</c> mode,
+ why this option is recommended (for performance reasons)
+ when accessing raw files using that function.</p>
+ <p>If <c>read/2</c> calls are for sizes not significantly
+ less than, or even greater than <c>Size</c> bytes, no
+ performance gain can be expected.</p>
+ </item>
+ <tag><c>read_ahead</c></tag>
+ <item>
+ <p>The same as <c>{read_ahead, Size}</c> with a reasonable
+ default value for <c>Size</c>. (Roughly some 64 KBytes)</p>
+ </item>
+ <tag><c>compressed</c></tag>
+ <item>
+ <p>Makes it possible to read or write gzip compressed
+ files. The <c>compressed</c> option must be combined
+ with either <c>read</c> or <c>write</c>, but not both.
+ Note that the file size obtained with
+ <c>read_file_info/1</c> will most probably not match the
+ number of bytes that can be read from a compressed file.</p>
+ </item>
+ <tag><c>{encoding, Encoding}</c></tag>
+ <item>
+ <p>Makes the file perform automatic translation of characters to and from a specific (Unicode) encoding. Note that the data supplied to file:write or returned by file:read still is byte oriented, this option only denotes how data is actually stored in the disk file.</p>
+ <p>Depending on the encoding, different methods of reading and writing data is preferred. The default encoding of <c>latin1</c> implies using this (the file) module for reading and writing data, as the interfaces provided here work with byte-oriented data, while using other (Unicode) encodings makes the <seealso marker="stdlib:io">io(3)</seealso> module's <c>get_chars</c>, <c>get_line</c> and <c>put_chars</c> functions more suitable, as they can work with the full Unicode range.</p>
+ <p>If data is sent to an <c>io_device()</c> in a format that cannot be converted to the specified encoding, or if data is read by a function that returns data in a format that cannot cope with the character range of the data, an error occurs and the file will be closed.</p>
+ <p>The allowed values for <c>Encoding</c> are:</p>
+ <taglist>
+ <tag><c>latin1</c></tag>
+ <item>
+ <p>The default encoding. Bytes supplied to i.e. file:write are written as is on the file, likewise bytes read from the file are returned to i.e. file:read as is. If the <seealso marker="stdlib:io">io(3)</seealso> module is used for writing, the file can only cope with Unicode characters up to codepoint 255 (the ISO-latin-1 range).</p>
+ </item>
+ <tag><c>unicode</c> or <c>utf8</c></tag>
+ <item>
+ <p>Characters are translated to and from the UTF-8 encoding before being written to or read from the file. A file opened in this way might be readable using the file:read function, as long as no data stored on the file lies beyond the ISO-latin-1 range (0..255), but failure will occur if the data contains Unicode codepoints beyond that range. The file is best read with the functions in the Unicode aware <seealso marker="stdlib:io">io(3)</seealso> module.</p>
+ <p>Bytes written to the file by any means are translated to UTF-8 encoding before actually being stored on the disk file.</p>
+ </item>
+ <tag><c>utf16</c> or <c>{utf16,big}</c></tag>
+ <item>
+ <p>Works like <c>unicode</c>, but translation is done to and from big endian UTF-16 instead of UTF-8.</p>
+ </item>
+ <tag><c>{utf16,little}</c></tag>
+ <item>
+ <p>Works like <c>unicode</c>, but translation is done to and from little endian UTF-16 instead of UTF-8.</p>
+ </item>
+ <tag><c>utf32</c> or <c>{utf32,big}</c></tag>
+ <item>
+ <p>Works like <c>unicode</c>, but translation is done to and from big endian UTF-32 instead of UTF-8.</p>
+ </item>
+ <tag><c>{utf32,little}</c></tag>
+ <item>
+ <p>Works like <c>unicode</c>, but translation is done to and from little endian UTF-32 instead of UTF-8.</p>
+ </item>
+ </taglist>
+ <p>The Encoding can be changed for a file "on the fly" by using the <seealso marker="stdlib:io#setopts/2">io:setopts/2</seealso> function, why a file can be analyzed in latin1 encoding for i.e. a BOM, positioned beyond the BOM and then be set for the right encoding before further reading.See the <seealso marker="stdlib:unicode">unicode(3)</seealso> module for functions identifying BOM's.</p>
+ <p>This option is not allowed on <c>raw</c> files.</p>
+ </item>
+ </taglist>
+ <p>Returns:</p>
+ <taglist>
+ <tag><c>{ok, IoDevice}</c></tag>
+ <item>
+ <p>The file has been opened in the requested mode.
+ <c>IoDevice</c> is a reference to the file.</p>
+ </item>
+ <tag><c>{error, Reason}</c></tag>
+ <item>
+ <p>The file could not be opened.</p>
+ </item>
+ </taglist>
+ <p><c>IoDevice</c> is really the pid of the process which
+ handles the file. This process is linked to the process
+ which originally opened the file. If any process to which
+ the <c>IoDevice</c> is linked terminates, the file will be
+ closed and the process itself will be terminated.
+ An <c>IoDevice</c> returned from this call can be used as an
+ argument to the IO functions (see
+ <seealso marker="stdlib:io">io(3)</seealso>).</p>
+ <note>
+ <p>In previous versions of <c>file</c>, modes were given
+ as one of the atoms <c>read</c>, <c>write</c>, or
+ <c>read_write</c> instead of a list. This is still allowed
+ for reasons of backwards compatibility, but should not be
+ used for new code. Also note that <c>read_write</c> is not
+ allowed in a mode list.</p>
+ </note>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The file does not exist.</p>
+ </item>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing permission for reading the file or searching one
+ of the parent directories.</p>
+ </item>
+ <tag><c>eisdir</c></tag>
+ <item>
+ <p>The named file is not a regular file. It may be a
+ directory, a fifo, or a device.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of the file name is not a directory. On some
+ platforms, <c>enoent</c> is returned instead.</p>
+ </item>
+ <tag><c>enospc</c></tag>
+ <item>
+ <p>There is a no space left on the device (if <c>write</c>
+ access was specified).</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>path_consult(Path, Filename) -> {ok, Terms, FullName} | {error, Reason}</name>
+ <fsummary>Read Erlang terms from a file</fsummary>
+ <type>
+ <v>Path = [Dir]</v>
+ <v>&nbsp;Dir = name()</v>
+ <v>Filename = name()</v>
+ <v>Terms = [term()]</v>
+ <v>FullName = string()</v>
+ <v>Reason = ext_posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see below</v>
+ </type>
+ <desc>
+ <p>Searches the path <c>Path</c> (a list of directory names)
+ until the file <c>Filename</c> is found. If <c>Filename</c>
+ is an absolute filename, <c>Path</c> is ignored.
+ Then reads Erlang terms, separated by '.', from the file.
+ Returns one of the following:</p>
+ <taglist>
+ <tag><c>{ok, Terms, FullName}</c></tag>
+ <item>
+ <p>The file was successfully read. <c>FullName</c> is
+ the full name of the file.</p>
+ </item>
+ <tag><c>{error, enoent}</c></tag>
+ <item>
+ <p>The file could not be found in any of the directories in
+ <c>Path</c>.</p>
+ </item>
+ <tag><c>{error, atom()}</c></tag>
+ <item>
+ <p>An error occurred when opening the file or reading it.
+ See <seealso marker="#open/2">open/2</seealso> for a list
+ of typical error codes.</p>
+ </item>
+ <tag><c>{error, {Line, Mod, Term}}</c></tag>
+ <item>
+ <p>An error occurred when interpreting the Erlang terms in
+ the file. Use <c>format_error/1</c> to convert
+ the three-element tuple to an English description of
+ the error.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>path_eval(Path, Filename) -> {ok, FullName} | {error, Reason}</name>
+ <fsummary>Evaluate Erlang expressions in a file</fsummary>
+ <type>
+ <v>Path = [Dir]</v>
+ <v>&nbsp;Dir = name()</v>
+ <v>Filename = name()</v>
+ <v>FullName = string()</v>
+ <v>Reason = ext_posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see below</v>
+ </type>
+ <desc>
+ <p>Searches the path <c>Path</c> (a list of directory names)
+ until the file <c>Filename</c> is found. If <c>Filename</c>
+ is an absolute file name, <c>Path</c> is ignored. Then reads
+ and evaluates Erlang expressions, separated by '.' (or ',', a
+ sequence of expressions is also an expression), from the file.
+ The actual result of evaluation is not returned; any
+ expression sequence in the file must be there for its side
+ effect. Returns one of the following:</p>
+ <taglist>
+ <tag><c>{ok, FullName}</c></tag>
+ <item>
+ <p>The file was read and evaluated. <c>FullName</c> is
+ the full name of the file.</p>
+ </item>
+ <tag><c>{error, enoent}</c></tag>
+ <item>
+ <p>The file could not be found in any of the directories in
+ <c>Path</c>.</p>
+ </item>
+ <tag><c>{error, atom()}</c></tag>
+ <item>
+ <p>An error occurred when opening the file or reading it.
+ See <seealso marker="#open/2">open/2</seealso> for a list
+ of typical error codes.</p>
+ </item>
+ <tag><c>{error, {Line, Mod, Term}}</c></tag>
+ <item>
+ <p>An error occurred when interpreting the Erlang
+ expressions in the file. Use <c>format_error/1</c> to
+ convert the three-element tuple to an English description
+ of the error.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>path_open(Path, Filename, Modes) -> {ok, IoDevice, FullName} | {error, Reason}</name>
+ <fsummary>Open a file</fsummary>
+ <type>
+ <v>Path = [Dir]</v>
+ <v>&nbsp;Dir = name()</v>
+ <v>Filename = name()</v>
+ <v>Modes = [Mode] -- see open/2</v>
+ <v>IoDevice = io_device()</v>
+ <v>FullName = string()</v>
+ <v>Reason = ext_posix() | system_limit</v>
+ </type>
+ <desc>
+ <p>Searches the path <c>Path</c> (a list of directory names)
+ until the file <c>Filename</c> is found. If <c>Filename</c>
+ is an absolute file name, <c>Path</c> is ignored.
+ Then opens the file in the mode determined by <c>Modes</c>.
+ Returns one of the following:</p>
+ <taglist>
+ <tag><c>{ok, IoDevice, FullName}</c></tag>
+ <item>
+ <p>The file has been opened in the requested mode.
+ <c>IoDevice</c> is a reference to the file and
+ <c>FullName</c> is the full name of the file.</p>
+ </item>
+ <tag><c>{error, enoent}</c></tag>
+ <item>
+ <p>The file could not be found in any of the directories in
+ <c>Path</c>.</p>
+ </item>
+ <tag><c>{error, atom()}</c></tag>
+ <item>
+ <p>The file could not be opened.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>path_script(Path, Filename) -> {ok, Value, FullName} | {error, Reason}</name>
+ <fsummary>Evaluate and return the value of Erlang expressions in a file</fsummary>
+ <type>
+ <v>Path = [Dir]</v>
+ <v>&nbsp;Dir = name()</v>
+ <v>Filename = name()</v>
+ <v>Value = term()</v>
+ <v>FullName = string()</v>
+ <v>Reason = ext_posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see below</v>
+ </type>
+ <desc>
+ <p>Searches the path <c>Path</c> (a list of directory names)
+ until the file <c>Filename</c> is found. If <c>Filename</c>
+ is an absolute file name, <c>Path</c> is ignored. Then reads
+ and evaluates Erlang expressions, separated by '.' (or ',', a
+ sequence of expressions is also an expression), from the file.
+ Returns one of the following:</p>
+ <taglist>
+ <tag><c>{ok, Value, FullName}</c></tag>
+ <item>
+ <p>The file was read and evaluated. <c>FullName</c> is
+ the full name of the file and <c>Value</c> the value of
+ the last expression.</p>
+ </item>
+ <tag><c>{error, enoent}</c></tag>
+ <item>
+ <p>The file could not be found in any of the directories in
+ <c>Path</c>.</p>
+ </item>
+ <tag><c>{error, atom()}</c></tag>
+ <item>
+ <p>An error occurred when opening the file or reading it.
+ See <seealso marker="#open/2">open/2</seealso> for a list
+ of typical error codes.</p>
+ </item>
+ <tag><c>{error, {Line, Mod, Term}}</c></tag>
+ <item>
+ <p>An error occurred when interpreting the Erlang
+ expressions in the file. Use <c>format_error/1</c> to
+ convert the three-element tuple to an English description
+ of the error.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>path_script(Path, Filename, Bindings) -> {ok, Value, FullName} | {error, Reason}</name>
+ <fsummary>Evaluate and return the value of Erlang expressions in a file</fsummary>
+ <type>
+ <v>Path = [Dir]</v>
+ <v>&nbsp;Dir = name()</v>
+ <v>Filename = name()</v>
+ <v>Bindings -- see erl_eval(3)</v>
+ <v>Value = term()</v>
+ <v>FullName = string()</v>
+ <v>Reason = posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see path_script/2</v>
+ </type>
+ <desc>
+ <p>The same as <c>path_script/2</c> but the variable bindings
+ <c>Bindings</c> are used in the evaluation. See
+ <seealso marker="stdlib:erl_eval">erl_eval(3)</seealso> about
+ variable bindings.</p>
+ </desc>
+ </func>
+ <func>
+ <name>pid2name(Pid) -> string() | undefined</name>
+ <fsummary>Return the name of the file handled by a pid</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ </type>
+ <desc>
+ <p>If <c>Pid</c> is an IO device, that is, a pid returned from
+ <c>open/2</c>, this function returns the filename, or rather:</p>
+ <taglist>
+ <tag><c>{ok, Filename}</c></tag>
+ <item>
+ <p>If this node's file server is not a slave, the file was
+ opened by this node's file server, (this implies that
+ <c>Pid</c> must be a local pid) and the file is not
+ closed. <c>Filename</c> is the filename in flat string
+ format.</p>
+ </item>
+ <tag><c>undefined</c></tag>
+ <item>
+ <p>In all other cases.</p>
+ </item>
+ </taglist>
+ <warning>
+ <p>This function is intended for debugging only.</p>
+ </warning>
+ </desc>
+ </func>
+ <func>
+ <name>position(IoDevice, Location) -> {ok, NewPosition} | {error, Reason}</name>
+ <fsummary>Set position in a file</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Location = Offset | {bof, Offset} | {cur, Offset} | {eof, Offset} | bof | cur | eof</v>
+ <v>&nbsp;Offset = int()</v>
+ <v>NewPosition = int()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Sets the position of the file referenced by <c>IoDevice</c>
+ to <c>Location</c>. Returns <c>{ok, NewPosition}</c> (as
+ absolute offset) if successful, otherwise
+ <c>{error, Reason}</c>. <c>Location</c> is one of
+ the following:</p>
+ <taglist>
+ <tag><c>Offset</c></tag>
+ <item>
+ <p>The same as <c>{bof, Offset}</c>.</p>
+ </item>
+ <tag><c>{bof, Offset}</c></tag>
+ <item>
+ <p>Absolute offset.</p>
+ </item>
+ <tag><c>{cur, Offset}</c></tag>
+ <item>
+ <p>Offset from the current position.</p>
+ </item>
+ <tag><c>{eof, Offset}</c></tag>
+ <item>
+ <p>Offset from the end of file.</p>
+ </item>
+ <tag><c>bof | cur | eof</c></tag>
+ <item>
+ <p>The same as above with <c>Offset</c> 0.</p>
+ </item>
+ </taglist>
+ <p>Note that offsets are counted in bytes, not in characters. If the file is opened using some other <c>encoding</c> than <c>latin1</c>, one byte does not correspond to one character. Positioning in such a file can only be done to known character boundaries, i.e. to a position earlier retrieved by getting a current position, to the beginning/end of the file or to some other position <em>known</em> to be on a correct character boundary by some other means (typically beyond a byte order mark in the file, which has a known byte-size).</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>einval</c></tag>
+ <item>
+ <p>Either <c>Location</c> was illegal, or it evaluated to a
+ negative offset in the file. Note that if the resulting
+ position is a negative value, the result is an error, and
+ after the call the file position is undefined.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>pread(IoDevice, LocNums) -> {ok, DataL} | eof | {error, Reason}</name>
+ <fsummary>Read from a file at certain positions</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>LocNums = [{Location, Number}]</v>
+ <v>&nbsp;Location -- see position/2</v>
+ <v>&nbsp;Number = int()</v>
+ <v>DataL = [Data]</v>
+ <v>&nbsp;Data = [char()] | binary()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Performs a sequence of <c>pread/3</c> in one operation,
+ which is more efficient than calling them one at a time.
+ Returns <c>{ok, [Data, ...]}</c> or <c>{error, Reason}</c>,
+ where each <c>Data</c>, the result of the corresponding
+ <c>pread</c>, is either a list or a binary depending on
+ the mode of the file, or <c>eof</c> if the requested position
+ was beyond end of file.</p>
+ <p>As the position is given as a byte-offset, special caution has to be taken when working with files where <c>encoding</c> is set to something else than <c>latin1</c>, as not every byte position will be a valid character boundary on such a file.</p>
+ </desc>
+ </func>
+ <func>
+ <name>pread(IoDevice, Location, Number) -> {ok, Data} | eof | {error, Reason}</name>
+ <fsummary>Read from a file at a certain position</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Location -- see position/2</v>
+ <v>Number = int()</v>
+ <v>Data = [char()] | binary()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Combines <c>position/2</c> and <c>read/2</c> in one
+ operation, which is more efficient than calling them one at a
+ time. If <c>IoDevice</c> has been opened in raw mode, some
+ restrictions apply: <c>Location</c> is only allowed to be an
+ integer; and the current position of the file is undefined
+ after the operation.</p>
+ <p>As the position is given as a byte-offset, special caution has to be taken when working with files where <c>encoding</c> is set to something else than <c>latin1</c>, as not every byte position will be a valid character boundary on such a file.</p>
+ </desc>
+ </func>
+ <func>
+ <name>pwrite(IoDevice, LocBytes) -> ok | {error, {N, Reason}}</name>
+ <fsummary>Write to a file at certain positions</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>LocBytes = [{Location, Bytes}]</v>
+ <v>&nbsp;Location -- see position/2</v>
+ <v>&nbsp;Bytes = iodata()</v>
+ <v>N = int()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Performs a sequence of <c>pwrite/3</c> in one operation,
+ which is more efficient than calling them one at a time.
+ Returns <c>ok</c> or <c>{error, {N, Reason}}</c>, where
+ <c>N</c> is the number of successful writes that was done
+ before the failure.</p>
+ <p>When positioning in a file with other <c>encoding</c> than <c>latin1</c>, caution must be taken to set the position on a correct character boundary, see <seealso marker="#position/2">position/2</seealso> for details.</p>
+ </desc>
+ </func>
+ <func>
+ <name>pwrite(IoDevice, Location, Bytes) -> ok | {error, Reason}</name>
+ <fsummary>Write to a file at a certain position</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Location -- see position/2</v>
+ <v>Bytes = iodata()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Combines <c>position/2</c> and <c>write/2</c> in one
+ operation, which is more efficient than calling them one at a
+ time. If <c>IoDevice</c> has been opened in raw mode, some
+ restrictions apply: <c>Location</c> is only allowed to be an
+ integer; and the current position of the file is undefined
+ after the operation.</p>
+ <p>When positioning in a file with other <c>encoding</c> than <c>latin1</c>, caution must be taken to set the position on a correct character boundary, see <seealso marker="#position/2">position/2</seealso> for details.</p>
+ </desc>
+ </func>
+ <func>
+ <name>read(IoDevice, Number) -> {ok, Data} | eof | {error, Reason}</name>
+ <fsummary>Read from a file</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Number = int()</v>
+ <v>Data = [char()] | binary()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Reads <c>Number</c> bytes/characters from the file referenced by
+ <c>IoDevice</c>. The functions <c>read/2</c>, <c>pread/3</c>
+ and <c>read_line/1</c> are the only ways to read from a file
+ opened in raw mode (although they work for normally opened
+ files, too).</p>
+ <p>For files where <c>encoding</c> is set to something else than <c>latin1</c>, one character might be represented by more than one byte on the file. The parameter <c>Number</c> always denotes the number of <em>characters</em> read from the file, why the position in the file might be moved a lot more than this number when reading a Unicode file.</p>
+ <p>Also if <c>encoding</c> is set to something else than <c>latin1</c>, the <c>read/3</c> call will fail if the data contains characters larger than 255, why the <seealso marker="stdlib:io">io(3)</seealso> module is to be preferred when reading such a file.</p>
+ <p>The function returns:</p>
+ <taglist>
+ <tag><c>{ok, Data}</c></tag>
+ <item>
+ <p>If the file was opened in binary mode, the read bytes are
+ returned in a binary, otherwise in a list. The list or
+ binary will be shorter than the number of bytes requested
+ if end of file was reached.</p>
+ </item>
+ <tag><c>eof</c></tag>
+ <item>
+ <p>Returned if <c>Number>0</c> and end of file was reached
+ before anything at all could be read.</p>
+ </item>
+ <tag><c>{error, Reason}</c></tag>
+ <item>
+ <p>An error occurred.</p>
+ </item>
+ </taglist>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>ebadf</c></tag>
+ <item>
+ <p>The file is not opened for reading.</p>
+ </item>
+ <tag><c>{no_translation, unicode, latin1}</c></tag>
+ <item>
+ <p>The file is was opened with another <c>encoding</c> than <c>latin1</c> and the data on the file can not be translated to the byte-oriented data that this function returns.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>read_file(Filename) -> {ok, Binary} | {error, Reason}</name>
+ <fsummary>Read a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Binary = binary()</v>
+ <v>Reason = ext_posix() | terminated | system_limit</v>
+ </type>
+ <desc>
+ <p>Returns <c>{ok, Binary}</c>, where <c>Binary</c> is a binary
+ data object that contains the contents of <c>Filename</c>, or
+ <c>{error, Reason}</c> if an error occurs.</p>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The file does not exist.</p>
+ </item>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing permission for reading the file, or for
+ searching one of the parent directories.</p>
+ </item>
+ <tag><c>eisdir</c></tag>
+ <item>
+ <p>The named file is a directory.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of the file name is not a directory. On some
+ platforms, <c>enoent</c> is returned instead.</p>
+ </item>
+ <tag><c>enomem</c></tag>
+ <item>
+ <p>There is not enough memory for the contents of the file.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>read_file_info(Filename) -> {ok, FileInfo} | {error, Reason}</name>
+ <fsummary>Get information about a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>FileInfo = #file_info{}</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Retrieves information about a file. Returns
+ <c>{ok, FileInfo}</c> if successful, otherwise
+ <c>{error, Reason}</c>. <c>FileInfo</c> is a record
+ <c>file_info</c>, defined in the Kernel include file
+ <c>file.hrl</c>. Include the following directive in the module
+ from which the function is called:</p>
+ <code type="none">
+-include_lib("kernel/include/file.hrl").</code>
+ <p>The record <c>file_info</c> contains the following fields.</p>
+ <taglist>
+ <tag><c>size = int()</c></tag>
+ <item>
+ <p>Size of file in bytes.</p>
+ </item>
+ <tag><c>type = device | directory | regular | other</c></tag>
+ <item>
+ <p>The type of the file.</p>
+ </item>
+ <tag><c>access = read | write | read_write | none</c></tag>
+ <item>
+ <p>The current system access to the file.</p>
+ </item>
+ <tag><c>atime = time()</c></tag>
+ <item>
+ <p>The last (local) time the file was read.</p>
+ </item>
+ <tag><c>mtime = time()</c></tag>
+ <item>
+ <p>The last (local) time the file was written.</p>
+ </item>
+ <tag><c>ctime = time()</c></tag>
+ <item>
+ <p>The interpretation of this time field depends on
+ the operating system. On Unix, it is the last time
+ the file or the inode was changed. In Windows, it is
+ the create time.</p>
+ </item>
+ <tag><c>mode = int()</c></tag>
+ <item>
+ <p>The file permissions as the sum of the following bit
+ values:</p>
+ <taglist>
+ <tag>8#00400</tag>
+ <item>read permission: owner</item>
+ <tag>8#00200</tag>
+ <item>write permission: owner</item>
+ <tag>8#00100</tag>
+ <item>execute permission: owner</item>
+ <tag>8#00040</tag>
+ <item>read permission: group</item>
+ <tag>8#00020</tag>
+ <item>write permission: group</item>
+ <tag>8#00010</tag>
+ <item>execute permission: group</item>
+ <tag>8#00004</tag>
+ <item>read permission: other</item>
+ <tag>8#00002</tag>
+ <item>write permission: other</item>
+ <tag>8#00001</tag>
+ <item>execute permission: other</item>
+ <tag>16#800</tag>
+ <item>set user id on execution</item>
+ <tag>16#400</tag>
+ <item>set group id on execution</item>
+ </taglist>
+ <p>On Unix platforms, other bits than those listed above
+ may be set.</p>
+ </item>
+ <tag><c>links = int()</c></tag>
+ <item>
+ <p>Number of links to the file (this will always be 1 for
+ file systems which have no concept of links).</p>
+ </item>
+ <tag><c>major_device = int()</c></tag>
+ <item>
+ <p>Identifies the file system where the file is located.
+ In Windows, the number indicates a drive as follows:
+ 0 means A:, 1 means B:, and so on.</p>
+ </item>
+ <tag><c>minor_device = int()</c></tag>
+ <item>
+ <p>Only valid for character devices on Unix. In all other
+ cases, this field is zero.</p>
+ </item>
+ <tag><c>inode = int()</c></tag>
+ <item>
+ <p>Gives the <c>inode</c> number. On non-Unix file systems,
+ this field will be zero.</p>
+ </item>
+ <tag><c>uid = int()</c></tag>
+ <item>
+ <p>Indicates the owner of the file. Will be zero for
+ non-Unix file systems.</p>
+ </item>
+ <tag><c>gid = int()</c></tag>
+ <item>
+ <p>Gives the group that the owner of the file belongs to.
+ Will be zero for non-Unix file systems.</p>
+ </item>
+ </taglist>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing search permission for one of the parent
+ directories of the file.</p>
+ </item>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The file does not exist.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of the file name is not a directory. On some
+ platforms, <c>enoent</c> is returned instead.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>read_line(IoDevice) -> {ok, Data} | eof | {error, Reason}</name>
+ <fsummary>Read a line from a file</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Data = [char()] | binary()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Reads a line of bytes/characters from the file referenced by
+ <c>IoDevice</c>. Lines are defined to be delimited by the linefeed (LF, <c>\\n</c>) character, but any carriage return (CR, <c>\\r</c>) followed by a newline is also treated as a single LF character (the carriage return is silently ignored). The line is returned <em>including</em> the LF, but excluding any CR immediately followed by a LF. This behaviour is consistent with the behaviour of <seealso marker="stdlib:io#get_line/2">io:get_line/2</seealso>. If end of file is reached without any LF ending the last line, a line with no trailing LF is returned.</p>
+ <p>The function can be used on files opened in <c>raw</c> mode. It is however inefficient to use it on <c>raw</c> files if the file is not opened with the option <c>{read_ahead, Size}</c> specified, why combining <c>raw</c> and <c>{read_ahead, Size}</c> is highly recommended when opening a text file for raw line oriented reading.</p>
+ <p>If <c>encoding</c> is set to something else than <c>latin1</c>, the <c>read_line/1</c> call will fail if the data contains characters larger than 255, why the <seealso marker="stdlib:io">io(3)</seealso> module is to be preferred when reading such a file.</p>
+ <p>The function returns:</p>
+ <taglist>
+ <tag><c>{ok, Data}</c></tag>
+ <item>
+ <p>One line from the file is returned, including the trailing LF, but with CRLF sequences replaced by a single LF (see above).</p>
+ <p>If the file was opened in binary mode, the read bytes are
+ returned in a binary, otherwise in a list.</p>
+ </item>
+ <tag><c>eof</c></tag>
+ <item>
+ <p>Returned if end of file was reached
+ before anything at all could be read.</p>
+ </item>
+ <tag><c>{error, Reason}</c></tag>
+ <item>
+ <p>An error occurred.</p>
+ </item>
+ </taglist>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>ebadf</c></tag>
+ <item>
+ <p>The file is not opened for reading.</p>
+ </item>
+ <tag><c>{no_translation, unicode, latin1}</c></tag>
+ <item>
+ <p>The file is was opened with another <c>encoding</c> than <c>latin1</c> and the data on the file can not be translated to the byte-oriented data that this function returns.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>read_link(Name) -> {ok, Filename} | {error, Reason}</name>
+ <fsummary>See what a link is pointing to</fsummary>
+ <type>
+ <v>Name = name()</v>
+ <v>Filename = string()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>This function returns <c>{ok, Filename}</c> if <c>Name</c>
+ refers to a symbolic link or <c>{error, Reason}</c> otherwise.
+ On platforms that do not support symbolic links, the return
+ value will be <c>{error,enotsup}</c>.</p>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>einval</c></tag>
+ <item>
+ <p><c>Linkname</c> does not refer to a symbolic link.</p>
+ </item>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The file does not exist.</p>
+ </item>
+ <tag><c>enotsup</c></tag>
+ <item>
+ <p>Symbolic links are not supported on this platform.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>read_link_info(Name) -> {ok, FileInfo} | {error, Reason}</name>
+ <fsummary>Get information about a link or file</fsummary>
+ <type>
+ <v>Name = name()</v>
+ <v>FileInfo = #file_info{}, see read_file_info/1</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>This function works like <c>read_file_info/1</c>, except that
+ if <c>Name</c> is a symbolic link, information about the link
+ will be returned in the <c>file_info</c> record and
+ the <c>type</c> field of the record will be set to
+ <c>symlink</c>.</p>
+ <p>If <c>Name</c> is not a symbolic link, this function returns
+ exactly the same result as <c>read_file_info/1</c>.
+ On platforms that do not support symbolic links, this function
+ is always equivalent to <c>read_file_info/1</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>rename(Source, Destination) -> ok | {error, Reason}</name>
+ <fsummary>Rename a file</fsummary>
+ <type>
+ <v>Source = Destination = name()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Tries to rename the file <c>Source</c> to <c>Destination</c>.
+ It can be used to move files (and directories) between
+ directories, but it is not sufficient to specify
+ the destination only. The destination file name must also be
+ specified. For example, if <c>bar</c> is a normal file and
+ <c>foo</c> and <c>baz</c> are directories,
+ <c>rename("foo/bar", "baz")</c> returns an error, but
+ <c>rename("foo/bar", "baz/bar")</c> succeeds. Returns
+ <c>ok</c> if it is successful.</p>
+ <note>
+ <p>Renaming of open files is not allowed on most platforms
+ (see <c>eacces</c> below).</p>
+ </note>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing read or write permissions for the parent
+ directories of <c>Source</c> or <c>Destination</c>. On
+ some platforms, this error is given if either
+ <c>Source</c> or <c>Destination</c> is open.</p>
+ </item>
+ <tag><c>eexist</c></tag>
+ <item>
+ <p><c>Destination</c> is not an empty directory. On some
+ platforms, also given when <c>Source</c> and
+ <c>Destination</c> are not of the same type.</p>
+ </item>
+ <tag><c>einval</c></tag>
+ <item>
+ <p><c>Source</c> is a root directory, or <c>Destination</c>
+ is a sub-directory of <c>Source</c>.</p>
+ </item>
+ <tag><c>eisdir</c></tag>
+ <item>
+ <p><c>Destination</c> is a directory, but <c>Source</c> is
+ not.</p>
+ </item>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p><c>Source</c> does not exist.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p><c>Source</c> is a directory, but <c>Destination</c> is
+ not.</p>
+ </item>
+ <tag><c>exdev</c></tag>
+ <item>
+ <p><c>Source</c> and <c>Destination</c> are on different
+ file systems.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>script(Filename) -> {ok, Value} | {error, Reason}</name>
+ <fsummary>Evaluate and return the value of Erlang expressions in a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Value = term()</v>
+ <v>Reason = ext_posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see below</v>
+ </type>
+ <desc>
+ <p>Reads and evaluates Erlang expressions, separated by '.' (or
+ ',', a sequence of expressions is also an expression), from
+ the file. Returns one of the following:</p>
+ <taglist>
+ <tag><c>{ok, Value}</c></tag>
+ <item>
+ <p>The file was read and evaluated. <c>Value</c> is
+ the value of the last expression.</p>
+ </item>
+ <tag><c>{error, atom()}</c></tag>
+ <item>
+ <p>An error occurred when opening the file or reading it.
+ See <seealso marker="#open/2">open/2</seealso> for a list
+ of typical error codes.</p>
+ </item>
+ <tag><c>{error, {Line, Mod, Term}}</c></tag>
+ <item>
+ <p>An error occurred when interpreting the Erlang
+ expressions in the file. Use <c>format_error/1</c> to
+ convert the three-element tuple to an English description
+ of the error.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>script(Filename, Bindings) -> {ok, Value} | {error, Reason}</name>
+ <fsummary>Evaluate and return the value of Erlang expressions in a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Bindings -- see erl_eval(3)</v>
+ <v>Value = term()</v>
+ <v>Reason = ext_posix() | terminated | system_limit
+ | {Line, Mod, Term}</v>
+ <v>&nbsp;Line, Mod, Term -- see below</v>
+ </type>
+ <desc>
+ <p>The same as <c>script/1</c> but the variable bindings
+ <c>Bindings</c> are used in the evaluation. See
+ <seealso marker="stdlib:erl_eval">erl_eval(3)</seealso> about
+ variable bindings.</p>
+ </desc>
+ </func>
+ <func>
+ <name>set_cwd(Dir) -> ok | {error,Reason}</name>
+ <fsummary>Set the current working directory</fsummary>
+ <type>
+ <v>Dir = name()</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Sets the current working directory of the file server to
+ <c>Dir</c>. Returns <c>ok</c> if successful.</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The directory does not exist.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of <c>Dir</c> is not a directory. On some
+ platforms, <c>enoent</c> is returned.</p>
+ </item>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing permission for the directory or one of its
+ parents.</p>
+ </item>
+ <tag><c>badarg</c></tag>
+ <item>
+ <p><c>Filename</c> had an improper type, such as tuple.</p>
+ </item>
+ </taglist>
+ <warning>
+ <p>In a future release, a bad type for the <c>Filename</c>
+ argument will probably generate an exception.</p>
+ <p></p>
+ </warning>
+ </desc>
+ </func>
+ <func>
+ <name>sync(IoDevice) -> ok | {error, Reason}</name>
+ <fsummary>Synchronizes the in-memory state of a file with that on the physical medium</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Makes sure that any buffers kept by the operating system
+ (not by the Erlang runtime system) are written to disk. On
+ some platforms, this function might have no effect.</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>enospc</c></tag>
+ <item>
+ <p>Not enough space left to write the file.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>truncate(IoDevice) -> ok | {error, Reason}</name>
+ <fsummary>Truncate a file</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Truncates the file referenced by <c>IoDevice</c> at
+ the current position. Returns <c>ok</c> if successful,
+ otherwise <c>{error, Reason}</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>write(IoDevice, Bytes) -> ok | {error, Reason}</name>
+ <fsummary>Write to a file</fsummary>
+ <type>
+ <v>IoDevice = io_device()</v>
+ <v>Bytes = iodata()</v>
+ <v>Reason = ext_posix() | terminated</v>
+ </type>
+ <desc>
+ <p>Writes <c>Bytes</c> to the file referenced by
+ <c>IoDevice</c>. This function is the only way to write to a
+ file opened in raw mode (although it works for normally
+ opened files, too). Returns <c>ok</c> if successful, and
+ <c>{error, Reason}</c> otherwise.</p>
+ <p>If the file is opened with <c>encoding</c> set to something else than <c>latin1</c>, each byte written might result in several bytes actually being written to the file, as the byte range 0..255 might represent anything between one and four bytes depending on value and UTF encoding type.</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>ebadf</c></tag>
+ <item>
+ <p>The file is not opened for writing.</p>
+ </item>
+ <tag><c>enospc</c></tag>
+ <item>
+ <p>There is a no space left on the device.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>write_file(Filename, Bytes) -> ok | {error, Reason}</name>
+ <fsummary>Write a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Bytes = iodata()</v>
+ <v>Reason = ext_posix() | terminated | system_limit</v>
+ </type>
+ <desc>
+ <p>Writes the contents of the iodata term <c>Bytes</c> to the
+ file <c>Filename</c>. The file is created if it does not
+ exist. If it exists, the previous contents are
+ overwritten. Returns <c>ok</c>, or <c>{error, Reason}</c>.</p>
+ <p>Typical error reasons are:</p>
+ <taglist>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>A component of the file name does not exist.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of the file name is not a directory. On some
+ platforms, <c>enoent</c> is returned instead.</p>
+ </item>
+ <tag><c>enospc</c></tag>
+ <item>
+ <p>There is a no space left on the device.</p>
+ </item>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing permission for writing the file or searching one
+ of the parent directories.</p>
+ </item>
+ <tag><c>eisdir</c></tag>
+ <item>
+ <p>The named file is a directory.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>write_file(Filename, Bytes, Modes) -> ok | {error, Reason}</name>
+ <fsummary>Write a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>Bytes = iodata()</v>
+ <v>Modes = [Mode] -- see open/2</v>
+ <v>Reason = ext_posix() | terminated | system_limit</v>
+ </type>
+ <desc>
+ <p>Same as <c>write_file/2</c>, but takes a third argument
+ <c>Modes</c>, a list of possible modes, see
+ <seealso marker="#open/2">open/2</seealso>. The mode flags
+ <c>binary</c> and <c>write</c> are implicit, so they should
+ not be used.</p>
+ </desc>
+ </func>
+ <func>
+ <name>write_file_info(Filename, FileInfo) -> ok | {error, Reason}</name>
+ <fsummary>Change information about a file</fsummary>
+ <type>
+ <v>Filename = name()</v>
+ <v>FileInfo = #file_info{} -- see also read_file_info/1</v>
+ <v>Reason = ext_posix()</v>
+ </type>
+ <desc>
+ <p>Change file information. Returns <c>ok</c> if successful,
+ otherwise <c>{error, Reason}</c>. <c>FileInfo</c> is a record
+ <c>file_info</c>, defined in the Kernel include file
+ <c>file.hrl</c>. Include the following directive in the module
+ from which the function is called:</p>
+ <code type="none">
+-include_lib("kernel/include/file.hrl").</code>
+ <p>The following fields are used from the record, if they are
+ given.</p>
+ <taglist>
+ <tag><c>atime = time()</c></tag>
+ <item>
+ <p>The last (local) time the file was read.</p>
+ </item>
+ <tag><c>mtime = time()</c></tag>
+ <item>
+ <p>The last (local) time the file was written.</p>
+ </item>
+ <tag><c>ctime = time()</c></tag>
+ <item>
+ <p>On Unix, any value give for this field will be ignored
+ (the "ctime" for the file will be set to the current
+ time). On Windows, this field is the new creation time to
+ set for the file.</p>
+ </item>
+ <tag><c>mode = int()</c></tag>
+ <item>
+ <p>The file permissions as the sum of the following bit
+ values:</p>
+ <taglist>
+ <tag>8#00400</tag>
+ <item>read permission: owner</item>
+ <tag>8#00200</tag>
+ <item>write permission: owner</item>
+ <tag>8#00100</tag>
+ <item>execute permission: owner</item>
+ <tag>8#00040</tag>
+ <item>read permission: group</item>
+ <tag>8#00020</tag>
+ <item>write permission: group</item>
+ <tag>8#00010</tag>
+ <item>execute permission: group</item>
+ <tag>8#00004</tag>
+ <item>read permission: other</item>
+ <tag>8#00002</tag>
+ <item>write permission: other</item>
+ <tag>8#00001</tag>
+ <item>execute permission: other</item>
+ <tag>16#800</tag>
+ <item>set user id on execution</item>
+ <tag>16#400</tag>
+ <item>set group id on execution</item>
+ </taglist>
+ <p>On Unix platforms, other bits than those listed above
+ may be set.</p>
+ </item>
+ <tag><c>uid = int()</c></tag>
+ <item>
+ <p>Indicates the owner of the file. Ignored for non-Unix
+ file systems.</p>
+ </item>
+ <tag><c>gid = int()</c></tag>
+ <item>
+ <p>Gives the group that the owner of the file belongs to.
+ Ignored non-Unix file systems.</p>
+ </item>
+ </taglist>
+ <p>Typical error reasons:</p>
+ <taglist>
+ <tag><c>eacces</c></tag>
+ <item>
+ <p>Missing search permission for one of the parent
+ directories of the file.</p>
+ </item>
+ <tag><c>enoent</c></tag>
+ <item>
+ <p>The file does not exist.</p>
+ </item>
+ <tag><c>enotdir</c></tag>
+ <item>
+ <p>A component of the file name is not a directory. On some
+ platforms, <c>enoent</c> is returned instead.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>POSIX Error Codes</title>
+ <list type="bulleted">
+ <item><c>eacces</c> - permission denied</item>
+ <item><c>eagain</c> - resource temporarily unavailable</item>
+ <item><c>ebadf</c> - bad file number</item>
+ <item><c>ebusy</c> - file busy</item>
+ <item><c>edquot</c> - disk quota exceeded</item>
+ <item><c>eexist</c> - file already exists</item>
+ <item><c>efault</c> - bad address in system call argument</item>
+ <item><c>efbig</c> - file too large</item>
+ <item><c>eintr</c> - interrupted system call</item>
+ <item><c>einval</c> - invalid argument</item>
+ <item><c>eio</c> - IO error</item>
+ <item><c>eisdir</c> - illegal operation on a directory</item>
+ <item><c>eloop</c> - too many levels of symbolic links</item>
+ <item><c>emfile</c> - too many open files</item>
+ <item><c>emlink</c> - too many links</item>
+ <item><c>enametoolong</c> - file name too long</item>
+ <item><c>enfile</c> - file table overflow</item>
+ <item><c>enodev</c> - no such device</item>
+ <item><c>enoent</c> - no such file or directory</item>
+ <item><c>enomem</c> - not enough memory</item>
+ <item><c>enospc</c> - no space left on device</item>
+ <item><c>enotblk</c> - block device required</item>
+ <item><c>enotdir</c> - not a directory</item>
+ <item><c>enotsup</c> - operation not supported</item>
+ <item><c>enxio</c> - no such device or address</item>
+ <item><c>eperm</c> - not owner</item>
+ <item><c>epipe</c> - broken pipe</item>
+ <item><c>erofs</c> - read-only file system</item>
+ <item><c>espipe</c> - invalid seek</item>
+ <item><c>esrch</c> - no such process</item>
+ <item><c>estale</c> - stale remote file handle</item>
+ <item><c>exdev</c> - cross-domain link</item>
+ </list>
+ </section>
+
+ <section>
+ <title>Performance</title>
+ <p>Some operating system file operations, for example a
+ <c>sync/1</c> or <c>close/1</c> on a huge file, may block their
+ calling thread for seconds. If this befalls the emulator main
+ thread, the response time is no longer in the order of
+ milliseconds, depending on the definition of "soft" in soft
+ real-time system.</p>
+ <p>If the device driver thread pool is active, file operations are
+ done through those threads instead, so the emulator can go on
+ executing Erlang processes. Unfortunately, the time for serving a
+ file operation increases due to the extra scheduling required
+ from the operating system.</p>
+ <p>If the device driver thread pool is disabled or of size 0, large
+ file reads and writes are segmented into several smaller, which
+ enables the emulator so server other processes during the file
+ operation. This gives the same effect as when using the thread
+ pool, but with larger overhead. Other file operations, for
+ example <c>sync/1</c> or <c>close/1</c> on a huge file, still are
+ a problem.</p>
+ <p>For increased performance, raw files are recommended. Raw files
+ uses the file system of the node's host machine. For normal files
+ (non-raw), the file server is used to find the files, and if
+ the node is running its file server as slave to another node's,
+ and the other node runs on some other host machine, they may have
+ different file systems. This is seldom a problem, but you have
+ now been warned.</p>
+ <p>A normal file is really a process so it can be used as an IO
+ device (see <c>io</c>). Therefore when data is written to a
+ normal file, the sending of the data to the file process, copies
+ all data that are not binaries. Opening the file in binary mode
+ and writing binaries is therefore recommended. If the file is
+ opened on another node, or if the file server runs as slave to
+ another node's, also binaries are copied.</p>
+ <p>Caching data to reduce the number of file operations, or rather
+ the number of calls to the file driver, will generally increase
+ performance. The following function writes 4 MBytes in 23
+ seconds when tested:</p>
+ <code type="none"><![CDATA[
+create_file_slow(Name, N) when integer(N), N >= 0 ->
+ {ok, FD} = file:open(Name, [raw, write, delayed_write, binary]),
+ ok = create_file_slow(FD, 0, N),
+ ok = ?FILE_MODULE:close(FD),
+ ok.
+
+create_file_slow(FD, M, M) ->
+ ok;
+create_file_slow(FD, M, N) ->
+ ok = file:write(FD, <<M:32/unsigned>>),
+ create_file_slow(FD, M+1, N).]]></code>
+ <p>The following, functionally equivalent, function collects 1024
+ entries into a list of 128 32-byte binaries before each call to
+ <c>file:write/2</c> and so does the same work in 0.52 seconds,
+ which is 44 times faster.</p>
+ <code type="none"><![CDATA[
+create_file(Name, N) when integer(N), N >= 0 ->
+ {ok, FD} = file:open(Name, [raw, write, delayed_write, binary]),
+ ok = create_file(FD, 0, N),
+ ok = ?FILE_MODULE:close(FD),
+ ok.
+
+create_file(FD, M, M) ->
+ ok;
+create_file(FD, M, N) when M + 1024 =&lt; N ->
+ create_file(FD, M, M + 1024, []),
+ create_file(FD, M + 1024, N);
+create_file(FD, M, N) ->
+ create_file(FD, M, N, []).
+
+create_file(FD, M, M, R) ->
+ ok = file:write(FD, R);
+create_file(FD, M, N0, R) when M + 8 =&lt; N0 ->
+ N1 = N0-1, N2 = N0-2, N3 = N0-3, N4 = N0-4,
+ N5 = N0-5, N6 = N0-6, N7 = N0-7, N8 = N0-8,
+ create_file(FD, M, N8,
+ [<<N8:32/unsigned, N7:32/unsigned,
+ N6:32/unsigned, N5:32/unsigned,
+ N4:32/unsigned, N3:32/unsigned,
+ N2:32/unsigned, N1:32/unsigned>> | R]);
+create_file(FD, M, N0, R) ->
+ N1 = N0-1,
+ create_file(FD, M, N1, [<<N1:32/unsigned>> | R]).]]></code>
+ <note>
+ <p>Trust only your own benchmarks. If the list length in
+ <c>create_file/2</c> above is increased, it will run slightly
+ faster, but consume more memory and cause more memory
+ fragmentation. How much this affects your application is
+ something that this simple benchmark can not predict.</p>
+ <p>If the size of each binary is increased to 64 bytes, it will
+ also run slightly faster, but the code will be twice as clumsy.
+ In the current implementation are binaries larger than 64 bytes
+ stored in memory common to all processes and not copied when
+ sent between processes, while these smaller binaries are stored
+ on the process heap and copied when sent like any other term.</p>
+ <p>So, with a binary size of 68 bytes <c>create_file/2</c> runs
+ 30 percent slower then with 64 bytes, and will cause much more
+ memory fragmentation. Note that if the binaries were to be sent
+ between processes (for example a non-raw file) the results
+ would probably be completely different.</p>
+ </note>
+ <p>A raw file is really a port. When writing data to a port, it is
+ efficient to write a list of binaries. There is no need to
+ flatten a deep list before writing. On Unix hosts, scatter output,
+ which writes a set of buffers in one operation, is used when
+ possible. In this way <c>file:write(FD, [Bin1, Bin2 | Bin3])</c>
+ will write the contents of the binaries without copying the data
+ at all except for perhaps deep down in the operating system
+ kernel.</p>
+ <p>For raw files, <c>pwrite/2</c> and <c>pread/2</c> are
+ efficiently implemented. The file driver is called only once for
+ the whole operation, and the list iteration is done in the file
+ driver.</p>
+ <p>The options <c>delayed_write</c> and <c>read_ahead</c> to
+ <c>file:open/2</c> makes the file driver cache data to reduce
+ the number of operating system calls. The function
+ <c>create_file/2</c> in the example above takes 60 seconds
+ seconds without the <c>delayed_write</c> option, which is 2.6
+ times slower.</p>
+ <p>And, as a really bad example, <c>create_file_slow/2</c> above
+ without the <c>raw</c>, <c>binary</c> and <c>delayed_write</c>
+ options, that is it calls <c>file:open(Name, [write])</c>, needs
+ 1 min 20 seconds for the job, which is 3.5 times slower than
+ the first example, and 150 times slower than the optimized
+ <c>create_file/2</c>. </p>
+ </section>
+
+ <section>
+ <title>Warnings</title>
+ <p>If an error occurs when accessing an open file with the <c>io</c>
+ module, the process which handles the file will exit. The dead
+ file process might hang if a process tries to access it later.
+ This will be fixed in a future release.</p>
+ </section>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><seealso marker="stdlib:filename">filename(3)</seealso></p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/gen_sctp.xml b/lib/kernel/doc/src/gen_sctp.xml
new file mode 100644
index 0000000000..de41178a17
--- /dev/null
+++ b/lib/kernel/doc/src/gen_sctp.xml
@@ -0,0 +1,1075 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2007</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>gen_sctp</title>
+ <prepared>[email protected]</prepared>
+ <responsible></responsible>
+ <docno>1</docno>
+ <approved></approved>
+ <checked></checked>
+ <date>2007-03-21</date>
+ <rev>A</rev>
+ <file>gen_sctp.sgml</file>
+ </header>
+ <module>gen_sctp</module>
+ <modulesummary>The gen_sctp module provides functions for communicating with sockets using the SCTP protocol.</modulesummary>
+ <description>
+ <p>The <c>gen_sctp</c> module provides functions for communicating with
+ sockets using the SCTP protocol. The implementation assumes that
+ the OS kernel supports SCTP
+ <url href="http://www.rfc-archive.org/getrfc.php?rfc=2960">(RFC2960)</url> through the user-level
+ <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">Sockets API Extensions.</url>
+ During development this implementation was tested on
+ Linux Fedora Core 5.0 (kernel 2.6.15-2054 or later is needed),
+ and on Solaris 10, 11. During OTP adaptation it was tested on
+ SUSE Linux Enterprise Server 10 (x86_64) kernel 2.6.16.27-0.6-smp,
+ with lksctp-tools-1.0.6, briefly on Solaris 10, and later on
+ SUSE Linux Enterprise Server 10 Service Pack 1 (x86_64)
+ kernel 2.6.16.54-0.2.3-smp with lksctp-tools-1.0.7.</p>
+ <p>Record definitions for the <c>gen_sctp</c> module can be found using:</p>
+ <pre>
+ -include_lib("kernel/include/inet_sctp.hrl"). </pre>
+ <p>These record definitions use the "new" spelling 'adaptation',
+ not the deprecated 'adaption', regardless of which
+ spelling the underlying C API uses.</p>
+ </description>
+
+ <section>
+ <marker id="contents"></marker>
+ <title>CONTENTS</title>
+ <list type="bulleted">
+ <item><seealso marker="#types">DATA TYPES</seealso></item>
+ <item><seealso marker="#exports">EXPORTS</seealso></item>
+ <item><seealso marker="#options">SCTP SOCKET OPTIONS</seealso></item>
+ <item><seealso marker="#examples">SCTP EXAMPLES</seealso></item>
+ <item><seealso marker="#seealso">SEE ALSO</seealso></item>
+ <item><seealso marker="#authors">AUTHORS</seealso></item>
+ </list>
+ </section>
+
+ <section>
+ <marker id="types"></marker>
+ <title>DATA TYPES</title>
+ <marker id="type-assoc_id"></marker>
+ <taglist>
+ <tag><c>assoc_id()</c></tag>
+ <item>
+ <p>An opaque term returned in for example #sctp_paddr_change{}
+ that identifies an association for an SCTP socket. The term
+ is opaque except for the special value <c>0</c> that has a
+ meaning such as "the whole endpoint" or "all future associations".</p>
+ <marker id="type-charlist"></marker>
+ </item>
+ <tag><c>charlist() = [char()]</c></tag>
+ <item> <marker id="type-iolist"></marker>
+</item>
+ <tag><c>iolist() = [char() | binary()]</c></tag>
+ <item> <marker id="type-ip_address"></marker>
+</item>
+ <tag><c>ip_address()</c></tag>
+ <item>
+ <p>Represents an address of an SCTP socket.
+ It is a tuple as explained in
+ <seealso marker="inet">inet(3)</seealso>.</p>
+ <marker id="type-port_number"></marker>
+ </item>
+ <tag><c>port_number() = 0 .. 65535</c></tag>
+ <item> <marker id="type-posix"></marker>
+</item>
+ <tag><c>posix()</c></tag>
+ <item>
+ <p>See
+ <seealso marker="inet#error_codes">inet(3); POSIX Error Codes.</seealso></p>
+ <marker id="type-sctp_option"></marker>
+ </item>
+ <tag><c>sctp_option()</c></tag>
+ <item>
+ <p>One of the
+ <seealso marker="#options">SCTP Socket Options.</seealso></p>
+ <marker id="type-sctp_socket"></marker>
+ </item>
+ <tag><c>sctp_socket()</c></tag>
+ <item>
+ <p>Socket identifier returned from <c>open/*</c>.</p>
+ <marker id="type-timeout"></marker>
+ </item>
+ <tag><c>timeout() = int() | infinity</c></tag>
+ <item>
+ <p>Timeout used in SCTP connect and receive calls.</p>
+ </item>
+ </taglist>
+ <marker id="exports"></marker>
+ </section>
+ <funcs>
+ <func>
+ <name>abort(sctp_socket(), Assoc) -&gt; ok | {error, posix()}</name>
+ <fsummary>Abnormally terminate the association given by Assoc, without flushing of unsent data</fsummary>
+ <type>
+ <v>Assoc = #sctp_assoc_change{}</v>
+ </type>
+ <desc>
+ <p>Abnormally terminates the association given by <c>Assoc</c>, without
+ flushing of unsent data. The socket itself remains open. Other
+ associations opened on this socket are still valid, and it can be
+ used in new associations.</p>
+ </desc>
+ </func>
+ <func>
+ <name>close(sctp_socket()) -&gt; ok | {error, posix()}</name>
+ <fsummary>Completely close the socket and all associations on it</fsummary>
+ <desc>
+ <p>Completely closes the socket and all associations on it. The unsent
+ data is flushed as in <c>eof/2</c>. The <c>close/1</c> call
+ is blocking or otherwise depending of the value of
+ the <seealso marker="#option-linger">linger</seealso> socket
+ <seealso marker="#options">option</seealso>.
+ If <c>close</c> does not linger or linger timeout expires,
+ the call returns and the data is flushed in the background.</p>
+ </desc>
+ </func>
+ <func>
+ <name>connect(Socket, Addr, Port, Opts) -&gt; {ok,Assoc} | {error, posix()}</name>
+ <fsummary>Same as <c>connect(Socket, Addr, Port, Opts, infinity)</c>.</fsummary>
+ <desc>
+ <p>Same as <c>connect(Socket, Addr, Port, Opts, infinity)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>connect(Socket, Addr, Port, [Opt], Timeout) -&gt; {ok, Assoc} | {error, posix()}</name>
+ <fsummary>Establish a new association for the socket <c>Socket</c>, with a peer (SCTP server socket)</fsummary>
+ <type>
+ <v>Socket = sctp_socket()</v>
+ <v>Addr = ip_address() | Host</v>
+ <v>Port = port_number()</v>
+ <v>Opt = sctp_option()</v>
+ <v>Timeout = timeout()</v>
+ <v>Host = atom() | string()</v>
+ <v>Assoc = #sctp_assoc_change{}</v>
+ </type>
+ <desc>
+ <p>Establishes a new association for the socket <c>Socket</c>,
+ with the peer (SCTP server socket) given by
+ <c>Addr</c> and <c>Port</c>. The <c>Timeout</c>,
+ is expressed in milliseconds.</p>
+ <p>A socket can be associated with multiple peers.
+ <marker id="record-sctp_assoc_change"></marker>
+
+ The result of <c>connect/*</c> is an <c>#sctp_assoc_change{}</c>
+ event which contains, in particular, the new
+ <seealso marker="#type-assoc_id">Association ID:</seealso></p>
+ <pre>
+ #sctp_assoc_change{
+ state = atom(),
+ error = atom(),
+ outbound_streams = int(),
+ inbound_streams = int(),
+ assoc_id = assoc_id()
+ } </pre>
+ <p>The number of outbound and inbound streams can be set by
+ giving an <c>sctp_initmsg</c> option to <c>connect</c>
+ as in:</p>
+ <pre>
+ connect(Socket, Ip, Port,
+ [{sctp_initmsg,#sctp_initmsg{num_ostreams=OutStreams,
+ max_instreams=MaxInStreams}}]) </pre>
+ <p>All options <c>Opt</c> are set on the socket before the
+ association is attempted. If an option record has got undefined
+ field values, the options record is first read from the socket
+ for those values. In effect, <c>Opt</c> option records only
+ define field values to change before connecting.</p>
+ <p>The returned <c>outbound_streams</c> and <c>inbound_streams</c>
+ are the actual stream numbers on the socket, which may be different
+ from the requested values (<c>OutStreams</c> and <c>MaxInStreams</c>
+ respectively) if the peer requires lower values.</p>
+ <p>The following values of <c>state</c> are possible:</p>
+ <list type="bulleted">
+ <item>
+ <p><c>comm_up</c>: association successfully established. This
+ indicates a successful completion of <c>connect</c>.</p>
+ </item>
+ <item>
+ <p><c>cant_assoc</c>: association cannot be established
+ (<c>connect/*</c> failure).</p>
+ </item>
+ </list>
+ <p>All other states do not normally occur in the output from
+ <c>connect/*</c>. Rather, they may occur in
+ <c>#sctp_assoc_change{}</c> events received instead of data in
+ <seealso marker="#recv/1">recv/*</seealso> calls.
+ All of them indicate losing the association due to various
+ error conditions, and are listed here for the sake of completeness.
+ The <c>error</c> field may provide more detailed diagnostics.</p>
+ <list type="bulleted">
+ <item>
+ <p><c>comm_lost</c>;</p>
+ </item>
+ <item>
+ <p><c>restart</c>;</p>
+ </item>
+ <item>
+ <p><c>shutdown_comp</c>.</p>
+ </item>
+ </list>
+ </desc>
+ </func>
+ <func>
+ <name>controlling_process(sctp_socket(), pid()) -&gt; ok</name>
+ <fsummary>Assign a new controlling process pid to the socket</fsummary>
+ <desc>
+ <p>Assigns a new controlling process Pid to Socket. Same implementation
+ as <c>gen_udp:controlling_process/2</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>eof(Socket, Assoc) -&gt; ok | {error, Reason}</name>
+ <fsummary>Gracefully terminate the association given by Assoc, with flushing of all unsent data</fsummary>
+ <type>
+ <v>Socket = sctp_socket()</v>
+ <v>Assoc = #sctp_assoc_change{}</v>
+ </type>
+ <desc>
+ <p>Gracefully terminates the association given by <c>Assoc</c>, with
+ flushing of all unsent data. The socket itself remains open. Other
+ associations opened on this socket are still valid, and it can be
+ used in new associations.</p>
+ </desc>
+ </func>
+ <func>
+ <name>listen(Socket, IsServer) -&gt; ok | {error, Reason}</name>
+ <fsummary>Set up a socket to listen.</fsummary>
+ <type>
+ <v>Socket = sctp_socket()</v>
+ <v>IsServer = bool()</v>
+ </type>
+ <desc>
+ <p>Sets up a socket to listen on the IP address and port number
+ it is bound to. IsServer must be 'true' or 'false'.
+ In the contrast to TCP, in SCTP there is no listening queue length.
+ If IsServer is 'true' the socket accepts new associations, i.e.
+ it will become an SCTP server socket.</p>
+ </desc>
+ </func>
+ <func>
+ <name>open() -&gt; {ok, Socket} | {error, posix()}</name>
+ <name>open(Port) -&gt; {ok, Socket} | {error, posix()}</name>
+ <name>open([Opt]) -&gt; {ok, Socket} | {error, posix()}</name>
+ <name>open(Port, [Opt]) -&gt; {ok, Socket} | {error, posix()}</name>
+ <fsummary>Create an SCTP socket and bind it to local addresses</fsummary>
+ <type>
+ <v>Opt = {ip,IP} | {ifaddr,IP} | {port,Port} | sctp_option()</v>
+ <v>IP = ip_address() | any | loopback</v>
+ <v>Port = port_number()</v>
+ </type>
+ <desc>
+ <p>Creates an SCTP socket and binds it to the local addresses
+ specified by all <c>{ip,IP}</c> (or synonymously <c>{ifaddr,IP}</c>)
+ options (this feature is called SCTP multi-homing).
+ The default <c>IP</c> and <c>Port</c> are <c>any</c>
+ and <c>0</c>, meaning bind to all local addresses on any
+ one free port.</p>
+ <p>A default set of socket <seealso marker="#options">options</seealso>
+ is used. In particular, the socket is opened in
+ <seealso marker="#option-binary">binary</seealso> and
+ <seealso marker="#option-active">passive</seealso> mode,
+ and with reasonably large
+ <seealso marker="#option-sndbuf">kernel</seealso> and driver
+ <seealso marker="#option-buffer">buffers.</seealso></p>
+ </desc>
+ </func>
+ <func>
+ <name>recv(sctp_socket()) -&gt; {ok, {FromIP, FromPort, AncData, BinMsg}} | {error, Reason}</name>
+ <name>recv(sctp_socket(), timeout()) -&gt; {ok, {FromIP, FromPort, AncData, Data}} | {error, Reason}</name>
+ <fsummary>Receive a message from a socket</fsummary>
+ <type>
+ <v>FromIP = ip_address()</v>
+ <v>FromPort = port_number()</v>
+ <v>AncData = [#sctp_sndrcvinfo{}]</v>
+ <v>Data = binary() | charlist() | #sctp_sndrcvinfo{} |
+ #sctp_assoc_change{} | #sctp_paddr_change{} |
+ #sctp_adaptation_event{} </v>
+ <v>Reason = posix() | #sctp_send_failed{} | #scpt_paddr_change{} |
+ #sctp_pdapi_event{} | #sctp_remote_error{} |
+ #sctp_shutdown_event{}</v>
+ </type>
+ <desc>
+ <p>Receives the <c>Data</c> message from any association of the socket.
+ If the receive times out <c>{error,timeout</c> is returned.
+ The default timeout is <c>infinity</c>.
+ <c>FromIP</c> and <c>FromPort</c> indicate the sender's address.</p>
+ <p><c>AncData</c> is a list of Ancillary Data items which
+ may be received along with the main <c>Data</c>.
+ This list can be empty, or contain a single
+ <seealso marker="#record-sctp_sndrcvinfo">#sctp_sndrcvinfo{}</seealso>
+ record, if receiving of such ancillary data is enabled
+ (see option
+ <seealso marker="#option-sctp_events">sctp_events</seealso>).
+ It is enabled by default, since such ancillary data
+ provide an easy way of determining the association and stream
+ over which the message has been received.
+ (An alternative way would be to get the Association ID from the
+ <c>FromIP</c> and <c>FromPort</c> using the
+ <seealso marker="#option-sctp_get_peer_addr_info">sctp_get_peer_addr_info</seealso> socket option,
+ but this would still not produce the Stream number).</p>
+ <p>The actual <c>Data</c> received may be a <c>binary()</c>,
+ or <c>list()</c> of bytes (integers in the range 0 through 255)
+ depending on the socket mode, or an SCTP Event.
+ <marker id="sctp_events"></marker>
+
+ The following SCTP Events are possible:</p>
+ <list type="bulleted">
+ <item>
+ <p><seealso marker="#record-sctp_sndrcvinfo">#sctp_sndrcvinfo{}</seealso></p>
+ </item>
+ <item>
+ <p><seealso marker="#record-sctp_assoc_change">#sctp_assoc_change{}</seealso>;</p>
+ </item>
+ <item>
+ <pre>
+ #sctp_paddr_change{
+ addr = {ip_address(),port()},
+ state = atom(),
+ error = int(),
+ assoc_id = assoc_id()
+ } </pre>
+ <p>Indicates change of the status of the peer's IP address given by
+ <c>addr</c> within the association <c>assoc_id</c>.
+ Possible values of <c>state</c> (mostly self-explanatory) include:</p>
+ <list type="bulleted">
+ <item>
+ <p><c>addr_unreachable</c>;</p>
+ </item>
+ <item>
+ <p><c>addr_available</c>;</p>
+ </item>
+ <item>
+ <p><c>addr_removed</c>;</p>
+ </item>
+ <item>
+ <p><c>addr_added</c>;</p>
+ </item>
+ <item>
+ <p><c>addr_made_prim</c>.</p>
+ </item>
+ <item>
+ <p><c>addr_confirmed</c>.</p>
+ </item>
+ </list>
+ <p>In case of an error (e.g. <c>addr_unreachable</c>), the
+ <c>error</c> field provides additional diagnostics. In such cases,
+ the <c>#sctp_paddr_change{}</c> Event is automatically
+ converted into an <c>error</c> term returned by
+ <c>gen_sctp:recv</c>. The <c>error</c> field value can be
+ converted into a string using <c>error_string/1</c>.</p>
+ </item>
+ <item>
+ <pre>
+ #sctp_send_failed{
+ flags = true | false,
+ error = int(),
+ info = #sctp_sndrcvinfo{},
+ assoc_id = assoc_id()
+ data = binary()
+ } </pre>
+ <p>The sender may receive this event if a send operation fails.
+ The <c>flags</c> is a Boolean specifying whether the data have
+ actually been transmitted over the wire; <c>error</c> provides
+ extended diagnostics, use <c>error_string/1</c>;
+ <c>info</c> is the original
+ <seealso marker="#record-sctp_sndrcvinfo">#sctp_sndrcvinfo{}</seealso> record used in the failed
+ <seealso marker="#send/3">send/*,</seealso> and <c>data</c>
+ is the whole original data chunk attempted to be sent.</p>
+ <p>In the current implementation of the Erlang/SCTP binding,
+ this Event is internally converted into an <c>error</c> term
+ returned by <c>recv/*</c>.</p>
+ </item>
+ <item>
+ <pre>
+ #sctp_adaptation_event{
+ adaptation_ind = int(),
+ assoc_id = assoc_id()
+ } </pre>
+ <p>Delivered when a peer sends an Adaptation Layer Indication
+ parameter (configured through the option
+ <seealso marker="#option-sctp_adaptation_layer">sctp_adaptation_layer</seealso>).
+ Note that with the current implementation of
+ the Erlang/SCTP binding, this event is disabled by default.</p>
+ </item>
+ <item>
+ <pre>
+ #sctp_pdapi_event{
+ indication = sctp_partial_delivery_aborted,
+ assoc_id = assoc_id()
+ } </pre>
+ <p>A partial delivery failure. In the current implementation of
+ the Erlang/SCTP binding, this Event is internally converted
+ into an <c>error</c> term returned by <c>recv/*</c>.</p>
+ </item>
+ </list>
+ </desc>
+ </func>
+ <func>
+ <name>send(Socket, SndRcvInfo, Data) -&gt; ok | {error, Reason}</name>
+ <fsummary>Send a message using an <c>#sctp_sndrcvinfo{}</c>record</fsummary>
+ <type>
+ <v>Socket = sctp_socket()</v>
+ <v>SndRcvInfo = #sctp_sndrcvinfo{}</v>
+ <v>Data = binary() | iolist()</v>
+ </type>
+ <desc>
+ <p>Sends the <c>Data</c> message with all sending parameters from a
+ <seealso marker="#record-sctp_sndrcvinfo">#sctp_sndrcvinfo{}</seealso> record.
+ This way, the user can specify the PPID (passed to the remote end)
+ and Context (passed to the local SCTP layer) which can be used
+ for example for error identification.
+ However, such a fine level of user control is rarely required.
+ The send/4 function is sufficient for most applications.</p>
+ </desc>
+ </func>
+ <func>
+ <name>send(Socket, Assoc, Stream, Data) -&gt; ok | {error, Reason}</name>
+ <fsummary>Send a message over an existing association and given stream</fsummary>
+ <type>
+ <v>Socket = sctp_socket()</v>
+ <v>Assoc = #sctp_assoc_change{} | assoc_id()</v>
+ <v>Stream = integer()</v>
+ <v>Data = binary() | iolist()</v>
+ </type>
+ <desc>
+ <p>Sends <c>Data</c> message over an existing association and given
+ stream.</p>
+ </desc>
+ </func>
+ <func>
+ <name>error_string(integer()) -> ok | string() | undefined</name>
+ <fsummary>Translate an SCTP error number into a string</fsummary>
+ <desc>
+ <p>Translates an SCTP error number from for example
+ <c>#sctp_remote_error{}</c> or <c>#sctp_send_failed{}</c> into
+ an explanatory string, or one of the atoms <c>ok</c> for no
+ error and <c>undefined</c> for an unrecognized error.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <marker id="options"></marker>
+ <title>SCTP SOCKET OPTIONS</title>
+ <p>The set of admissible SCTP socket options is by construction
+ orthogonal to the sets of TCP, UDP and generic INET options:
+ only those options which are explicitly listed below are allowed
+ for SCTP sockets. Options can be set on the socket using
+ <c>gen_sctp:open/1,2</c> or <c>inet:setopts/2</c>,
+ retrieved using <c>inet:getopts/2</c>, and when calling
+ <c>gen_sctp:connect/4,5</c> options can be changed.</p>
+ <marker id="option-binary"></marker>
+ <marker id="option-list"></marker>
+ <taglist>
+ <tag><c>{mode, list|binary}</c>or just <c>list</c> or <c>binary</c>.</tag>
+ <item>
+ <p>Determines the type of data returned from <c>gen_sctp:recv/1,2</c>.</p>
+ <marker id="option-active"></marker>
+ </item>
+ <tag><c>{active, true|false|once}</c></tag>
+ <item>
+ <list type="bulleted">
+ <item>
+ <p>If <c>false</c> (passive mode, the default),
+ the caller needs to do an explicit <c>gen_sctp:recv</c> call
+ in order to retrieve the available data from the socket.</p>
+ </item>
+ <item>
+ <p>If <c>true</c> (full active mode), the pending data or events are
+ sent to the owning process.</p>
+ <p><em>NB:</em> This can cause the message queue to overflow,
+ as there is no way to throttle the sender in this case
+ (no flow control!).</p>
+ </item>
+ <item>
+ <p>If <c>once</c>, only one message is automatically placed
+ in the message queue, after that the mode is automatically
+ re-set to passive. This provides flow control as well as
+ the possibility for the receiver to listen for its incoming
+ SCTP data interleaved with other inter-process messages.</p>
+ </item>
+ </list>
+ <marker id="option-buffer"></marker>
+ </item>
+ <tag><c>{buffer, int()}</c></tag>
+ <item>
+ <p>Determines the size of the user-level software buffer used by
+ the SCTP driver. Not to be confused with <c>sndbuf</c>
+ and <c>recbuf</c> options which correspond to
+ the kernel socket buffers. It is recommended
+ to have <c>val(buffer) &gt;= max(val(sndbuf),val(recbuf))</c>.
+ In fact, the <c>val(buffer)</c> is automatically set to
+ the above maximum when <c>sndbuf</c> or <c>recbuf</c> values are set.</p>
+ </item>
+ <tag><c>{tos, int()}</c></tag>
+ <item>
+ <p>Sets the Type-Of-Service field on the IP datagrams being sent,
+ to the given value, which effectively determines a prioritization
+ policy for the outbound packets. The acceptable values
+ are system-dependent. TODO: we do not provide
+ symbolic names for these values yet.</p>
+ </item>
+ <tag><c>{priority, int()}</c></tag>
+ <item>
+ <p>A protocol-independent equivalent of <c>tos</c> above. Setting
+ priority implies setting tos as well.</p>
+ </item>
+ <tag><c>{dontroute, true|false}</c></tag>
+ <item>
+ <p>By default <c>false</c>. If <c>true</c>, the kernel does not
+ send packets via any gateway, only sends them to directly
+ connected hosts.</p>
+ </item>
+ <tag><c>{reuseaddr, true|false}</c></tag>
+ <item>
+ <p>By default <c>false</c>. If true, the local binding address
+ <c>{IP,Port}</c> of the socket can be re-used immediately:
+ no waiting in the CLOSE_WAIT state is performed (may be
+ required for high-throughput servers).</p>
+ <marker id="option-linger"></marker>
+ </item>
+ <tag><c>{linger, {true|false, int()}</c></tag>
+ <item>
+ <p>Determines the timeout in seconds for flushing unsent data in the
+ <c>gen_sctp:close/1</c> socket call. If the 1st component of the value
+ tuple is <c>false</c>, the 2nd one is ignored, which means that
+ <c>gen_sctp:close/1</c> returns immediately not waiting
+ for data to be flushed. Otherwise, the 2nd component is
+ the flushing time-out in seconds.</p>
+ <marker id="option-sndbuf"></marker>
+ </item>
+ <tag><c>{sndbuf, int()}</c></tag>
+ <item>
+ <p>The size, in bytes, of the *kernel* send buffer for this socket.
+ Sending errors would occur for datagrams larger than
+ <c>val(sndbuf)</c>. Setting this option also adjusts
+ the size of the driver buffer (see <c>buffer</c> above).</p>
+ </item>
+ <tag><c>{recbuf, int()}</c></tag>
+ <item>
+ <p>The size, in bytes, of the *kernel* recv buffer for this socket.
+ Sending errors would occur for datagrams larger than
+ <c>val(sndbuf)</c>. Setting this option also adjusts
+ the size of the driver buffer (see <c>buffer</c> above).</p>
+ </item>
+ <tag><c>{sctp_rtoinfo, #sctp_rtoinfo{}}</c></tag>
+ <item>
+ <pre>
+ #sctp_rtoinfo{
+ assoc_id = assoc_id(),
+ initial = int(),
+ max = int(),
+ min = int()
+ } </pre>
+ <p>Determines re-transmission time-out parameters, in milliseconds,
+ for the association(s) given by <c>assoc_id</c>.
+ If <c>assoc_id = 0</c> (default) indicates the whole endpoint. See
+ <url href="http://www.rfc-archive.org/getrfc.php?rfc=2960">RFC2960</url> and
+ <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">Sockets API Extensions for SCTP</url> for the exact semantics of the fields values.</p>
+ </item>
+ <tag><c>{sctp_associnfo, #sctp_assocparams{}}</c></tag>
+ <item>
+ <pre>
+ #sctp_assocparams{
+ assoc_id = assoc_id(),
+ asocmaxrxt = int(),
+ number_peer_destinations = int(),
+ peer_rwnd = int(),
+ local_rwnd = int(),
+ cookie_life = int()
+ } </pre>
+ <p>Determines association parameters for the association(s) given by
+ <c>assoc_id</c>. <c>assoc_id = 0</c> (default) indicates
+ the whole endpoint. See
+ <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">Sockets API Extensions for SCTP</url> for the discussion of their semantics. Rarely used.</p>
+ </item>
+ <tag><c>{sctp_initmsg, #sctp_initmsg{}}</c></tag>
+ <item>
+ <pre>
+ #sctp_initmsg{
+ num_ostreams = int(),
+ max_instreams = int(),
+ max_attempts = int(),
+ max_init_timeo = int()
+ } </pre>
+ <p>Determines the default parameters which this socket attempts
+ to negotiate with its peer while establishing an association with it.
+ Should be set after <c>open/*</c> but before the first
+ <c>connect/*</c>. <c>#sctp_initmsg{}</c> can also be used
+ as ancillary data with the first call of <c>send/*</c> to
+ a new peer (when a new association is created).</p>
+ <list type="bulleted">
+ <item>
+ <p><c>num_ostreams</c>: number of outbound streams;</p>
+ </item>
+ <item>
+ <p><c>max_instreams</c>: max number of in-bound streams;</p>
+ </item>
+ <item>
+ <p><c>max_attempts</c>: max re-transmissions while
+ establishing an association;</p>
+ </item>
+ <item>
+ <p><c>max_init_timeo</c>: time-out in milliseconds
+ for establishing an association.</p>
+ </item>
+ </list>
+ <p></p>
+ </item>
+ <tag><c>{sctp_autoclose, int()|infinity}</c></tag>
+ <item>
+ <p>Determines the time (in seconds) after which an idle association is
+ automatically closed.</p>
+ </item>
+ <tag><c>{sctp_nodelay, true|false}</c></tag>
+ <item>
+ <p>Turns on|off the Nagle algorithm for merging small packets
+ into larger ones (which improves throughput at the expense
+ of latency).</p>
+ </item>
+ <tag><c>{sctp_disable_fragments, true|false}</c></tag>
+ <item>
+ <p>If <c>true</c>, induces an error on an attempt to send
+ a message which is larger than the current PMTU size
+ (which would require fragmentation/re-assembling).
+ Note that message fragmentation does not affect
+ the logical atomicity of its delivery; this option
+ is provided for performance reasons only.</p>
+ </item>
+ <tag><c>{sctp_i_want_mapped_v4_addr, true|false}</c></tag>
+ <item>
+ <p>Turns on|off automatic mapping of IPv4 addresses into IPv6 ones
+ (if the socket address family is AF_INET6).</p>
+ </item>
+ <tag><c>{sctp_maxseg, int()}</c></tag>
+ <item>
+ <p>Determines the maximum chunk size if message fragmentation is used.
+ If <c>0</c>, the chunk size is limited by the Path MTU only.</p>
+ </item>
+ <tag><c>{sctp_primary_addr, #sctp_prim{}}</c></tag>
+ <item>
+ <pre>
+ #sctp_prim{
+ assoc_id = assoc_id(),
+ addr = {IP, Port}
+ }
+ IP = ip_address()
+ Port = port_number() </pre>
+ <p>For the association given by <c>assoc_id</c>,
+ <c>{IP,Port}</c> must be one of the peer's addresses.
+ This option determines that the given address is
+ treated by the local SCTP stack as the peer's primary address.</p>
+ </item>
+ <tag><c>{sctp_set_peer_primary_addr, #sctp_setpeerprim{}}</c></tag>
+ <item>
+ <pre>
+ #sctp_setpeerprim{
+ assoc_id = assoc_id(),
+ addr = {IP, Port}
+ }
+ IP = ip_address()
+ Port = port_number() </pre>
+ <p>When set, informs the peer that it should use <c>{IP, Port}</c>
+ as the primary address of the local endpoint for the association
+ given by <c>assoc_id</c>.</p>
+ <marker id="option-sctp_adaptation_layer"></marker>
+ </item>
+ <tag><c>{sctp_adaptation_layer, #sctp_setadaptation{}}</c></tag>
+ <item>
+ <marker id="record-sctp_setadaptation"></marker>
+ <pre>
+ #sctp_setadaptation{
+ adaptation_ind = int()
+ } </pre>
+ <p>When set, requests that the local endpoint uses the value given by
+ <c>adaptation_ind</c> as the Adaptation Indication parameter for
+ establishing new associations. See
+ <url href="http://www.rfc-archive.org/getrfc.php?rfc=2960">RFC2960</url> and
+ <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">Sockets API Extenstions for SCTP</url> for more details.</p>
+ </item>
+ <tag><c>{sctp_peer_addr_params, #sctp_paddrparams{}}</c></tag>
+ <item>
+ <pre>
+ #sctp_paddrparams{
+ assoc_id = assoc_id(),
+ address = {IP, Port},
+ hbinterval = int(),
+ pathmaxrxt = int(),
+ pathmtu = int(),
+ sackdelay = int(),
+ flags = list()
+ }
+ IP = ip_address()
+ Port = port_number() </pre>
+ <p>This option determines various per-address parameters for
+ the association given by <c>assoc_id</c> and the peer address
+ <c>address</c> (the SCTP protocol supports multi-homing,
+ so more than 1 address can correspond to a given association).</p>
+ <list type="bulleted">
+ <item>
+ <p><c>hbinterval</c>: heartbeat interval, in milliseconds;</p>
+ </item>
+ <item>
+ <p><c>pathmaxrxt</c>: max number of retransmissions
+ before this address is considered unreachable (and an
+ alternative address is selected);</p>
+ </item>
+ <item>
+ <p><c>pathmtu</c>: fixed Path MTU, if automatic discovery is
+ disabled (see <c>flags</c> below);</p>
+ </item>
+ <item>
+ <p><c>sackdelay</c>: delay in milliseconds for SAC messages
+ (if the delay is enabled, see <c>flags</c> below);</p>
+ </item>
+ <item>
+ <p><c>flags</c>: the following flags are available:</p>
+ <list type="bulleted">
+ <item>
+ <p><c>hb_enable</c>: enable heartbeat; </p>
+ </item>
+ <item>
+ <p><c>hb_disable</c>: disable heartbeat;</p>
+ </item>
+ <item>
+ <p><c>hb_demand</c>: initiate heartbeat immediately;</p>
+ </item>
+ <item>
+ <p><c>pmtud_enable</c>: enable automatic Path MTU discovery;</p>
+ </item>
+ <item>
+ <p><c>pmtud_disable</c>: disable automatic Path MTU discovery;</p>
+ </item>
+ <item>
+ <p><c>sackdelay_enable</c>: enable SAC delay;</p>
+ </item>
+ <item>
+ <p><c>sackdelay_disable</c>: disable SAC delay.</p>
+ </item>
+ </list>
+ <p></p>
+ </item>
+ </list>
+ <p></p>
+ </item>
+ <tag><c>{sctp_default_send_param, #sctp_sndrcvinfo{}}</c></tag>
+ <item>
+ <marker id="record-sctp_sndrcvinfo"></marker>
+ <pre>
+ #sctp_sndrcvinfo{
+ stream = int(),
+ ssn = int(),
+ flags = list(),
+ ppid = int(),
+ context = int(),
+ timetolive = int(),
+ tsn = int(),
+ cumtsn = int(),
+ assoc_id = assoc_id()
+ } </pre>
+ <p><c>#sctp_sndrcvinfo{}</c> is used both in this socket option, and as
+ ancillary data while sending or receiving SCTP messages. When
+ set as an option, it provides a default values for subsequent
+ <c>gen_sctp:send</c>calls on the association given by
+ <c>assoc_id</c>. <c>assoc_id = 0</c> (default) indicates
+ the whole endpoint. The following fields typically need
+ to be specified by the sender:</p>
+ <list type="bulleted">
+ <item>
+ <p><c>sinfo_stream</c>: stream number (0-base) within the association
+ to send the messages through;</p>
+ </item>
+ <item>
+ <p><c>sinfo_flags</c>: the following flags are recognised:</p>
+ <list type="bulleted">
+ <item>
+ <p><c>unordered</c>: the message is to be sent unordered;</p>
+ </item>
+ <item>
+ <p><c>addr_over</c>: the address specified in
+ <c>gen_sctp:send</c> overwrites the primary peer address;</p>
+ </item>
+ <item>
+ <p><c>abort</c>: abort the current association without
+ flushing any unsent data;</p>
+ </item>
+ <item>
+ <p><c>eof</c>: gracefully shut down the current
+ association, with flushing of unsent data.</p>
+ </item>
+ </list>
+ <p></p>
+ <p>Other fields are rarely used. See
+ <url href="http://www.rfc-archive.org/getrfc.php?rfc=2960">RFC2960</url> and
+ <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">Sockets API Extensions for SCTP</url> for full information.</p>
+ </item>
+ </list>
+ <p></p>
+ <marker id="option-sctp_events"></marker>
+ </item>
+ <tag><c>{sctp_events, #sctp_event_subscribe{}}</c></tag>
+ <item>
+ <marker id="record-sctp_event_subscribe"></marker>
+ <pre>
+ #sctp_event_subscribe{
+ data_io_event = true | false,
+ association_event = true | false,
+ address_event = true | false,
+ send_failure_event = true | false,
+ peer_error_event = true | false,
+ shutdown_event = true | false,
+ partial_delivery_event = true | false,
+ adaptation_layer_event = true | false
+ } </pre>
+ <p>This option determines which
+ <seealso marker="#sctp_events">SCTP Events</seealso> are to be
+ received (via <seealso marker="#recv/1">recv/*</seealso>)
+ along with the data. The only
+ exception is <c>data_io_event</c> which enables or disables
+ receiving of
+ <seealso marker="#record-sctp_sndrcvinfo">#sctp_sndrcvinfo{}</seealso>
+ ancillary data, not events.
+ By default, all flags except <c>adaptation_layer_event</c> are
+ enabled, although <c>sctp_data_io_event</c> and
+ <c>association_event</c> are used by the driver itself and not
+ exported to the user level.</p>
+ </item>
+ <tag><c>{sctp_delayed_ack_time, #sctp_assoc_value{}}</c></tag>
+ <item>
+ <pre>
+ #sctp_assoc_value{
+ assoc_id = assoc_id(),
+ assoc_value = int()
+ } </pre>
+ <p>Rarely used. Determines the ACK time
+ (given by <c>assoc_value</c> in milliseconds) for
+ the given association or the whole endpoint
+ if <c>assoc_value = 0</c> (default).</p>
+ </item>
+ <tag><c>{sctp_status, #sctp_status{}}</c></tag>
+ <item>
+ <pre>
+ #sctp_status{
+ assoc_id = assoc_id(),
+ state = atom(),
+ rwnd = int(),
+ unackdata = int(),
+ penddata = int(),
+ instrms = int(),
+ outstrms = int(),
+ fragmentation_point = int(),
+ primary = #sctp_paddrinfo{}
+ } </pre>
+ <p>This option is read-only. It determines the status of
+ the SCTP association given by <c>assoc_id</c>. Possible values of
+ <c>state</c> follows. The state designations are mostly
+ self-explanatory. <c>state_empty</c> is the default which means
+ that no other state is active:</p>
+ <list type="bulleted">
+ <item>
+ <p><c>sctp_state_empty</c></p>
+ </item>
+ <item>
+ <p><c>sctp_state_closed</c></p>
+ </item>
+ <item>
+ <p><c>sctp_state_cookie_wait</c></p>
+ </item>
+ <item>
+ <p><c>sctp_state_cookie_echoed</c></p>
+ </item>
+ <item>
+ <p><c>sctp_state_established</c></p>
+ </item>
+ <item>
+ <p><c>sctp_state_shutdown_pending</c></p>
+ </item>
+ <item>
+ <p><c>sctp_state_shutdown_sent</c></p>
+ </item>
+ <item>
+ <p><c>sctp_state_shutdown_received</c></p>
+ </item>
+ <item>
+ <p><c>sctp_state_shutdown_ack_sent</c></p>
+ </item>
+ </list>
+ <p>The semantics of other fields is the following:</p>
+ <list type="bulleted">
+ <item>
+ <p><c>sstat_rwnd</c>: the association peer's current receiver
+ window size;</p>
+ </item>
+ <item>
+ <p><c>sstat_unackdata</c>: number of unacked data chunks;</p>
+ </item>
+ <item>
+ <p><c>sstat_penddata</c>: number of data chunks pending receipt;</p>
+ </item>
+ <item>
+ <p><c>sstat_instrms</c>: number of inbound streams;</p>
+ </item>
+ <item>
+ <p><c>sstat_outstrms</c>: number of outbound streams;</p>
+ </item>
+ <item>
+ <p><c>sstat_fragmentation_point</c>: message size at which SCTP
+ fragmentation will occur;</p>
+ </item>
+ <item>
+ <p><c>sstat_primary</c>: information on the current primary peer
+ address (see below for the format of <c>#sctp_paddrinfo{}</c>).</p>
+ </item>
+ </list>
+ <p></p>
+ <marker id="option-sctp_get_peer_addr_info"></marker>
+ </item>
+ <tag><c>{sctp_get_peer_addr_info, #sctp_paddrinfo{}}</c></tag>
+ <item>
+ <marker id="record-sctp_paddrinfo"></marker>
+ <pre>
+ #sctp_paddrinfo{
+ assoc_id = assoc_id(),
+ address = {IP, Port},
+ state = inactive | active,
+ cwnd = int(),
+ srtt = int(),
+ rto = int(),
+ mtu = int()
+ }
+ IP = ip_address()
+ Port = port_number() </pre>
+ <p>This option is read-only. It determines the parameters specific to
+ the peer's address given by <c>address</c> within the association
+ given by <c>assoc_id</c>. The <c>address</c> field must be set by the
+ caller; all other fields are filled in on return.
+ If <c>assoc_id = 0</c> (default), the <c>address</c>
+ is automatically translated into the corresponding
+ association ID. This option is rarely used; see
+ <url href="http://www.rfc-archive.org/getrfc.php?rfc=2960">RFC2960</url> and
+ <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">Sockets API Extensions for SCTP</url> for the semantics of all fields.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <marker id="examples"></marker>
+ <title>SCTP EXAMPLES</title>
+ <list type="bulleted">
+ <item>
+ <p>Example of an Erlang SCTP Server which receives SCTP messages and
+ prints them on the standard output:</p>
+ <pre>
+ -module(sctp_server).
+
+ -export([server/0,server/1,server/2]).
+ -include_lib("kernel/include/inet.hrl").
+ -include_lib("kernel/include/inet_sctp.hrl").
+
+ server() -&gt;
+ server(any, 2006).
+
+ server([Host,Port]) when is_list(Host), is_list(Port) -&gt;
+ {ok, #hostent{h_addr_list = [IP|_]}} = inet:gethostbyname(Host),
+ io:format("~w -&gt; ~w~n", [Host, IP]),
+ server([IP, list_to_integer(Port)]).
+
+ server(IP, Port) when is_tuple(IP) orelse IP == any orelse IP == loopback,
+ is_integer(Port) -&gt;
+ {ok,S} = gen_sctp:open([{ip,IP},{port,Port}],[{recbuf,65536}]),
+ io:format("Listening on ~w:~w. ~w~n", [IP,Port,S]),
+ ok = gen_sctp:listen(S, true),
+ server_loop(S).
+
+ server_loop(S) -&gt;
+ case gen_sctp:recv(S) of
+ {error, Error} -&gt;
+ io:format("SCTP RECV ERROR: ~p~n", [Error]);
+ Data -&gt;
+ io:format("Received: ~p~n", [Data])
+ end,
+ server_loop(S). </pre>
+ <p></p>
+ </item>
+ <item>
+ <p>Example of an Erlang SCTP Client which interacts with the above Server.
+ Note that in this example, the Client creates an association with
+ the Server with 5 outbound streams. For this reason, sending of
+ "Test 0" over Stream 0 succeeds, but sending of "Test 5"
+ over Stream 5 fails. The client then <c>abort</c>s the association,
+ which results in the corresponding Event being received on
+ the Server side.</p>
+ <pre>
+ -module(sctp_client).
+
+ -export([client/0, client/1, client/2]).
+ -include_lib("kernel/include/inet.hrl").
+ -include_lib("kernel/include/inet_sctp.hrl").
+
+ client() -&gt;
+ client([localhost]).
+
+ client([Host]) -&gt;
+ client(Host, 2006);
+
+ client([Host, Port]) when is_list(Host), is_list(Port) -&gt;
+ client(Host,list_to_integer(Port)),
+ init:stop().
+
+ client(Host, Port) when is_integer(Port) -&gt;
+ {ok,S} = gen_sctp:open(),
+ {ok,Assoc} = gen_sctp:connect
+ (S, Host, Port, [{sctp_initmsg,#sctp_initmsg{num_ostreams=5}}]),
+ io:format("Connection Successful, Assoc=~p~n", [Assoc]),
+
+ io:write(gen_sctp:send(S, Assoc, 0, &lt;&lt;"Test 0"&gt;&gt;)),
+ io:nl(),
+ timer:sleep(10000),
+ io:write(gen_sctp:send(S, Assoc, 5, &lt;&lt;"Test 5"&gt;&gt;)),
+ io:nl(),
+ timer:sleep(10000),
+ io:write(gen_sctp:abort(S, Assoc)),
+ io:nl(),
+
+ timer:sleep(1000),
+ gen_sctp:close(S). </pre>
+ <p></p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <marker id="seealso"></marker>
+ <title>SEE ALSO</title>
+ <p><seealso marker="inet">inet(3)</seealso>,
+ <seealso marker="gen_tcp">gen_tcp(3)</seealso>,
+ <seealso marker="gen_udp">gen_upd(3)</seealso>,
+ <url href="http://www.rfc-archive.org/getrfc.php?rfc=2960">RFC2960</url> (Stream Control Transmission Protocol),
+ <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">Sockets API Extensions for SCTP.</url></p>
+ <marker id="authors"></marker>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml
new file mode 100644
index 0000000000..032dcc5251
--- /dev/null
+++ b/lib/kernel/doc/src/gen_tcp.xml
@@ -0,0 +1,464 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>gen_tcp</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>1997-10-24</date>
+ <rev>A</rev>
+ </header>
+ <module>gen_tcp</module>
+ <modulesummary>Interface to TCP/IP sockets</modulesummary>
+ <description>
+ <p>The <c>gen_tcp</c> module provides functions for communicating
+ with sockets using the TCP/IP protocol.</p>
+ <p>The following code fragment provides a simple example of
+ a client connecting to a server at port 5678, transferring a
+ binary and closing the connection:</p>
+ <code type="none">
+client() ->
+ SomeHostInNet = "localhost" % to make it runnable on one machine
+ {ok, Sock} = gen_tcp:connect(SomeHostInNet, 5678,
+ [binary, {packet, 0}]),
+ ok = gen_tcp:send(Sock, "Some Data"),
+ ok = gen_tcp:close(Sock).</code>
+ <p>At the other end a server is listening on port 5678, accepts
+ the connection and receives the binary:</p>
+ <code type="none">
+server() ->
+ {ok, LSock} = gen_tcp:listen(5678, [binary, {packet, 0},
+ {active, false}]),
+ {ok, Sock} = gen_tcp:accept(LSock),
+ {ok, Bin} = do_recv(Sock, []),
+ ok = gen_tcp:close(Sock),
+ Bin.
+
+do_recv(Sock, Bs) ->
+ case gen_tcp:recv(Sock, 0) of
+ {ok, B} ->
+ do_recv(Sock, [Bs, B]);
+ {error, closed} ->
+ {ok, list_to_binary(Bs)}
+ end.</code>
+ <p>For more examples, see the <seealso marker="#examples">examples</seealso> section.</p>
+ </description>
+
+ <section>
+ <title>DATA TYPES</title>
+ <code type="none">
+ip_address()
+ see inet(3)
+
+posix()
+ see inet(3)
+
+socket()
+ as returned by accept/1,2 and connect/3,4</code>
+ </section>
+ <funcs>
+ <func>
+ <name>connect(Address, Port, Options) -> {ok, Socket} | {error, Reason}</name>
+ <name>connect(Address, Port, Options, Timeout) -> {ok, Socket} | {error, Reason}</name>
+ <fsummary>Connect to a TCP port</fsummary>
+ <type>
+ <v>Address = string() | atom() | ip_address()</v>
+ <v>Port = 0..65535</v>
+ <v>Options = [Opt]</v>
+ <v>&nbsp;Opt -- see below</v>
+ <v>Timeout = int() | infinity</v>
+ <v>Socket = socket()</v>
+ <v>Reason = posix()</v>
+ </type>
+ <desc>
+ <p>Connects to a server on TCP port <c>Port</c> on the host
+ with IP address <c>Address</c>. The <c>Address</c> argument
+ can be either a hostname, or an IP address.</p>
+ <p>The available options are:</p>
+ <taglist>
+ <tag><c>list</c></tag>
+ <item>
+ <p>Received <c>Packet</c> is delivered as a list.</p>
+ </item>
+ <tag><c>binary</c></tag>
+ <item>
+ <p>Received <c>Packet</c> is delivered as a binary.</p>
+ </item>
+ <tag><c>{ip, ip_address()}</c></tag>
+ <item>
+ <p>If the host has several network interfaces, this option
+ specifies which one to use.</p>
+ </item>
+ <tag><c>{port, Port}</c></tag>
+ <item>
+ <p>Specify which local port number to use.</p>
+ </item>
+ <tag><c>{fd, int()}</c></tag>
+ <item>
+ <p>If a socket has somehow been connected without using
+ <c>gen_tcp</c>, use this option to pass the file
+ descriptor for it.</p>
+ </item>
+ <tag><c>inet6</c></tag>
+ <item>
+ <p>Set up the socket for IPv6.</p>
+ </item>
+ <tag><c>inet</c></tag>
+ <item>
+ <p>Set up the socket for IPv4.</p>
+ </item>
+ <tag>Opt</tag>
+ <item>
+ <p>See
+ <seealso marker="inet#setopts/2">inet:setopts/2</seealso>.</p>
+ </item>
+ </taglist>
+ <p>Packets can be sent to the returned socket <c>Socket</c>
+ using <c>send/2</c>. Packets sent from the peer are delivered
+ as messages:</p>
+ <code type="none">
+{tcp, Socket, Data}</code>
+ <p>If the socket is closed, the following message is delivered:</p>
+ <code type="none">
+{tcp_closed, Socket}</code>
+ <p>If an error occurs on the socket, the following message is
+ delivered:</p>
+ <code type="none">
+{tcp_error, Socket, Reason}</code>
+ <p>unless <c>{active, false}</c> is specified in the option list
+ for the socket, in which case packets are retrieved by
+ calling <c>recv/2</c>.</p>
+ <p>The optional <c>Timeout</c> parameter specifies a timeout in
+ milliseconds. The default value is <c>infinity</c>.</p>
+ <note>
+ <p>The default values for options given to <c>connect</c> can
+ be affected by the Kernel configuration parameter
+ <c>inet_default_connect_options</c>. See
+ <seealso marker="inet">inet(3)</seealso> for details.</p>
+ </note>
+ </desc>
+ </func>
+ <func>
+ <name>listen(Port, Options) -> {ok, ListenSocket} | {error, Reason}</name>
+ <fsummary>Set up a socket to listen on a port</fsummary>
+ <type>
+ <v>Port = 0..65535</v>
+ <v>Options = [Opt]</v>
+ <v>&nbsp;Opt -- see below</v>
+ <v>ListenSocket -- see below</v>
+ <v>Reason = posix()</v>
+ </type>
+ <desc>
+ <p>Sets up a socket to listen on the port <c>Port</c> on
+ the local host.</p>
+ <p>If <c>Port == 0</c>, the underlying OS assigns an available
+ port number, use <c>inet:port/1</c> to retrieve it.</p>
+ <p>The available options are:</p>
+ <taglist>
+ <tag><c>list</c></tag>
+ <item>
+ <p>Received <c>Packet</c> is delivered as a list.</p>
+ </item>
+ <tag><c>binary</c></tag>
+ <item>
+ <p>Received <c>Packet</c> is delivered as a binary.</p>
+ </item>
+ <tag><c>{backlog, B}</c></tag>
+ <item>
+ <p><c>B</c> is an integer &gt;= 0. The backlog value defaults
+ to 5. The backlog value defines the maximum length that
+ the queue of pending connections may grow to.</p>
+ </item>
+ <tag><c>{ip, ip_address()}</c></tag>
+ <item>
+ <p>If the host has several network interfaces, this option
+ specifies which one to listen on.</p>
+ </item>
+ <tag><c>{fd, Fd}</c></tag>
+ <item>
+ <p>If a socket has somehow been connected without using
+ <c>gen_tcp</c>, use this option to pass the file
+ descriptor for it.</p>
+ </item>
+ <tag><c>inet6</c></tag>
+ <item>
+ <p>Set up the socket for IPv6.</p>
+ </item>
+ <tag><c>inet</c></tag>
+ <item>
+ <p>Set up the socket for IPv4.</p>
+ </item>
+ <tag><c>Opt</c></tag>
+ <item>
+ <p>See
+ <seealso marker="inet#setopts/2">inet:setopts/2</seealso>.</p>
+ </item>
+ </taglist>
+ <p>The returned socket <c>ListenSocket</c> can only be used in
+ calls to <c>accept/1,2</c>.</p>
+ <note>
+ <p>The default values for options given to <c>listen</c> can
+ be affected by the Kernel configuration parameter
+ <c>inet_default_listen_options</c>. See
+ <seealso marker="inet">inet(3)</seealso> for details.</p>
+ </note>
+ </desc>
+ </func>
+ <func>
+ <name>accept(ListenSocket) -> {ok, Socket} | {error, Reason}</name>
+ <name>accept(ListenSocket, Timeout) -> {ok, Socket} | {error, Reason}</name>
+ <fsummary>Accept an incoming connection request on a listen socket</fsummary>
+ <type>
+ <v>ListenSocket -- see listen/2</v>
+ <v>Timeout = int() | infinity</v>
+ <v>Socket = socket()</v>
+ <v>Reason = closed | timeout | posix()</v>
+ </type>
+ <desc>
+ <p>Accepts an incoming connection request on a listen socket.
+ <c>Socket</c> must be a socket returned from <c>listen/2</c>.
+ <c>Timeout</c> specifies a timeout value in ms, defaults to
+ <c>infinity</c>.</p>
+ <p>Returns <c>{ok, Socket}</c> if a connection is established,
+ or <c>{error, closed}</c> if <c>ListenSocket</c> is closed,
+ or <c>{error, timeout}</c> if no connection is established
+ within the specified time. May also return a POSIX error
+ value if something else goes wrong, see inet(3) for possible
+ error values.</p>
+ <p>Packets can be sent to the returned socket <c>Socket</c>
+ using <c>send/2</c>. Packets sent from the peer are delivered
+ as messages:</p>
+ <code type="none">
+{tcp, Socket, Data}</code>
+ <p>unless <c>{active, false}</c> was specified in the option
+ list for the listen socket, in which case packets are
+ retrieved by calling <c>recv/2</c>.</p>
+ <note>
+ <p>It is worth noting that the <c>accept</c> call does
+ <em>not</em> have to be issued from the socket owner
+ process. Using version 5.5.3 and higher of the emulator,
+ multiple simultaneous accept calls can be issued from
+ different processes, which allows for a pool of acceptor
+ processes handling incoming connections.</p>
+ </note>
+ </desc>
+ </func>
+ <func>
+ <name>send(Socket, Packet) -> ok | {error, Reason}</name>
+ <fsummary>Send a packet</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Packet = [char()] | binary()</v>
+ <v>Reason = posix()</v>
+ </type>
+ <desc>
+ <p>Sends a packet on a socket. </p>
+ <p>There is no <c>send</c> call with timeout option, you use the
+ <c>send_timeout</c> socket option if timeouts are
+ desired. See the <seealso marker="#examples">examples</seealso> section.</p>
+ </desc>
+ </func>
+ <func>
+ <name>recv(Socket, Length) -> {ok, Packet} | {error, Reason}</name>
+ <name>recv(Socket, Length, Timeout) -> {ok, Packet} | {error, Reason}</name>
+ <fsummary>Receive a packet from a passive socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Length = int()</v>
+ <v>Packet = [char()] | binary()</v>
+ <v>Timeout = int() | infinity</v>
+ <v>Reason = closed | posix()</v>
+ </type>
+ <desc>
+ <p>This function receives a packet from a socket in passive
+ mode. A closed socket is indicated by a return value
+ <c>{error, closed}</c>.</p>
+ <p>The <c>Length</c> argument is only meaningful when
+ the socket is in <c>raw</c> mode and denotes the number of
+ bytes to read. If <c>Length</c> = 0, all available bytes are
+ returned. If <c>Length</c> &gt; 0, exactly <c>Length</c>
+ bytes are returned, or an error; possibly discarding less
+ than <c>Length</c> bytes of data when the socket gets closed
+ from the other side.</p>
+ <p>The optional <c>Timeout</c> parameter specifies a timeout in
+ milliseconds. The default value is <c>infinity</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>controlling_process(Socket, Pid) -> ok | {error, Reason}</name>
+ <fsummary>Change controlling process of a socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = closed | not_owner | posix()</v>
+ </type>
+ <desc>
+ <p>Assigns a new controlling process <c>Pid</c> to
+ <c>Socket</c>. The controlling process is the process which
+ receives messages from the socket. If called by any other
+ process than the current controlling process,
+ <c>{error, eperm}</c> is returned.</p>
+ </desc>
+ </func>
+ <func>
+ <name>close(Socket) -> ok | {error, Reason}</name>
+ <fsummary>Close a TCP socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Reason = posix()</v>
+ </type>
+ <desc>
+ <p>Closes a TCP socket.</p>
+ </desc>
+ </func>
+ <func>
+ <name>shutdown(Socket, How) -> ok | {error, Reason}</name>
+ <fsummary>Immediately close a socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>How = read | write | read_write</v>
+ <v>Reason = posix()</v>
+ </type>
+ <desc>
+ <p>Immediately close a socket in one or two directions.</p>
+ <p><c>How == write</c> means closing the socket for writing,
+ reading from it is still possible.</p>
+ <p>To be able to handle that the peer has done a shutdown on
+ the write side, the <c>{exit_on_close, false}</c> option
+ is useful.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>Examples</title>
+ <marker id="examples"></marker>
+ <p>The following example illustrates usage of the {active,once}
+ option and multiple accepts by implementing a server as a
+ number of worker processes doing accept on one single listen
+ socket. The start/2 function takes the number of worker
+ processes as well as a port number to listen for incoming
+ connections on. If <c>LPort</c> is specified as <c>0</c>, an
+ ephemeral portnumber is used, why the start function returns
+ the actual portnumber allocated:</p>
+ <code type="none">
+start(Num,LPort) ->
+ case gen_tcp:listen(LPort,[{active, false},{packet,2}]) of
+ {ok, ListenSock} ->
+ start_servers(Num,ListenSock),
+ {ok, Port} = inet:port(ListenSock),
+ Port;
+ {error,Reason} ->
+ {error,Reason}
+ end.
+
+start_servers(0,_) ->
+ ok;
+start_servers(Num,LS) ->
+ spawn(?MODULE,server,[LS]),
+ start_servers(Num-1,LS).
+
+server(LS) ->
+ case gen_tcp:accept(LS) of
+ {ok,S} ->
+ loop(S),
+ server(LS);
+ Other ->
+ io:format("accept returned ~w - goodbye!~n",[Other]),
+ ok
+ end.
+
+loop(S) ->
+ inet:setopts(S,[{active,once}]),
+ receive
+ {tcp,S,Data} ->
+ Answer = process(Data), % Not implemented in this example
+ gen_tcp:send(S,Answer),
+ loop(S);
+ {tcp_closed,S} ->
+ io:format("Socket ~w closed [~w]~n",[S,self()]),
+ ok
+ end.</code>
+ <p>A simple client could look like this:</p>
+ <code type="none">
+client(PortNo,Message) ->
+ {ok,Sock} = gen_tcp:connect("localhost",PortNo,[{active,false},
+ {packet,2}]),
+ gen_tcp:send(Sock,Message),
+ A = gen_tcp:recv(Sock,0),
+ gen_tcp:close(Sock),
+ A.</code>
+ <p>The fact that the <c>send</c> call does not accept a timeout
+ option, is because timeouts on send is handled through the socket
+ option <c>send_timeout</c>. The behavior of a send operation with
+ no receiver is in a very high degree defined by the underlying TCP
+ stack, as well as the network infrastructure. If one wants to write
+ code that handles a hanging receiver that might eventually cause
+ the sender to hang on a <c>send</c> call, one writes code like
+ the following.</p>
+ <p>Consider a process that receives data from a client process that
+ is to be forwarded to a server on the network. The process has
+ connected to the server via TCP/IP and does not get any acknowledge
+ for each message it sends, but has to rely on the send timeout
+ option to detect that the other end is unresponsive. We could use
+ the <c>send_timeout</c> option when connecting:</p>
+ <code type="none">
+ ...
+ {ok,Sock} = gen_tcp:connect(HostAddress, Port,
+ [{active,false},
+ {send_timeout, 5000},
+ {packet,2}]),
+ loop(Sock), % See below
+ ... </code>
+ <p>In the loop where requests are handled, we can now detect send
+ timeouts:</p>
+ <code type="none">
+loop(Sock) ->
+ receive
+ {Client, send_data, Binary} ->
+ case gen_tcp:send(Sock,[Binary]) of
+ {error, timeout} ->
+ io:format("Send timeout, closing!~n",
+ []),
+ handle_send_timeout(), % Not implemented here
+ Client ! {self(),{error_sending, timeout}},
+ %% Usually, it's a good idea to give up in case of a
+ %% send timeout, as you never know how much actually
+ %% reached the server, maybe only a packet header?!
+ gen_tcp:close(Sock);
+ {error, OtherSendError} ->
+ io:format("Some other error on socket (~p), closing",
+ [OtherSendError]),
+ Client ! {self(),{error_sending, OtherSendError}},
+ gen_tcp:close(Sock);
+ ok ->
+ Client ! {self(), data_sent},
+ loop(Sock)
+ end
+ end. </code>
+ <p>Usually it would suffice to detect timeouts on receive, as most
+ protocols include some sort of acknowledgment from the server,
+ but if the protocol is strictly one way, the <c>send_timeout</c>
+ option comes in handy!</p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml
new file mode 100644
index 0000000000..71f2e9bd83
--- /dev/null
+++ b/lib/kernel/doc/src/gen_udp.xml
@@ -0,0 +1,179 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>gen_udp</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>1997-12-03</date>
+ <rev>A</rev>
+ </header>
+ <module>gen_udp</module>
+ <modulesummary>Interface to UDP sockets</modulesummary>
+ <description>
+ <p>The <c>gen_udp</c> module provides functions for communicating
+ with sockets using the UDP protocol.</p>
+ </description>
+
+ <section>
+ <title>DATA TYPES</title>
+ <code type="none">
+ip_address()
+ see inet(3)
+
+posix()
+ see inet(3)
+
+socket()
+ as returned by open/1,2</code>
+ </section>
+ <funcs>
+ <func>
+ <name>open(Port) -> {ok, Socket} | {error, Reason}</name>
+ <name>open(Port, Options) -> {ok, Socket} | {error, Reason}</name>
+ <fsummary>Associate a UDP port number with the process calling it</fsummary>
+ <type>
+ <v>Port = 0..65535</v>
+ <v>Options = [Opt]</v>
+ <v>&nbsp;Opt -- see below</v>
+ <v>Socket = socket()</v>
+ <v>Reason = posix()</v>
+ </type>
+ <desc>
+ <p>Associates a UDP port number (<c>Port</c>) with the calling
+ process.</p>
+ <p>The available options are:</p>
+ <taglist>
+ <tag><c>list</c></tag>
+ <item>
+ <p>Received <c>Packet</c> is delivered as a list.</p>
+ </item>
+ <tag><c>binary</c></tag>
+ <item>
+ <p>Received <c>Packet</c> is delivered as a binary.</p>
+ </item>
+ <tag><c>{ip, ip_address()}</c></tag>
+ <item>
+ <p>If the host has several network interfaces, this option
+ specifies which one to use.</p>
+ </item>
+ <tag><c>{fd, int()}</c></tag>
+ <item>
+ <p>If a socket has somehow been opened without using
+ <c>gen_udp</c>, use this option to pass the file
+ descriptor for it.</p>
+ </item>
+ <tag><c>inet6</c></tag>
+ <item>
+ <p>Set up the socket for IPv6.</p>
+ </item>
+ <tag><c>inet</c></tag>
+ <item>
+ <p>Set up the socket for IPv4.</p>
+ </item>
+ <tag><c>Opt</c></tag>
+ <item>
+ <p>See
+ <seealso marker="inet#setopts/2">inet:setopts/2</seealso>.</p>
+ </item>
+ </taglist>
+ <p>The returned socket <c>Socket</c> is used to send packets
+ from this port with <c>send/4</c>. When UDP packets arrive at
+ the opened port, they are delivered as messages:</p>
+ <code type="none">
+{udp, Socket, IP, InPortNo, Packet}</code>
+ <p>Note that arriving UDP packets that are longer than
+ the receive buffer option specifies, might be truncated
+ without warning.</p>
+ <p><c>IP</c> and <c>InPortNo</c> define the address from which
+ <c>Packet</c> came. <c>Packet</c> is a list of bytes if
+ the option <c>list</c> was specified. <c>Packet</c> is a
+ binary if the option <c>binary</c> was specified.</p>
+ <p>Default value for the receive buffer option is
+ <c>{recbuf, 8192}</c>.</p>
+ <p>If <c>Port == 0</c>, the underlying OS assigns a free UDP
+ port, use <c>inet:port/1</c> to retrieve it.</p>
+ </desc>
+ </func>
+ <func>
+ <name>send(Socket, Address, Port, Packet) -> ok | {error, Reason}</name>
+ <fsummary>Send a packet</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Address = string() | atom() | ip_address()</v>
+ <v>Port = 0..65535</v>
+ <v>Packet = [char()] | binary()</v>
+ <v>Reason = not_owner | posix()</v>
+ </type>
+ <desc>
+ <p>Sends a packet to the specified address and port.
+ The <c>Address</c> argument can be either a hostname, or an
+ IP address.</p>
+ </desc>
+ </func>
+ <func>
+ <name>recv(Socket, Length) -> {ok, {Address, Port, Packet}} | {error, Reason}</name>
+ <name>recv(Socket, Length, Timeout) -> {ok, {Address, Port, Packet}} | {error, Reason}</name>
+ <fsummary>Receive a packet from a passive socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Length = int()</v>
+ <v>Address = ip_address()</v>
+ <v>Port = 0..65535</v>
+ <v>Packet = [char()] | binary()</v>
+ <v>Timeout = int() | infinity</v>
+ <v>Reason = not_owner | posix()</v>
+ </type>
+ <desc>
+ <p>This function receives a packet from a socket in passive
+ mode.</p>
+ <p>The optional <c>Timeout</c> parameter specifies a timeout in
+ milliseconds. The default value is <c>infinity</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>controlling_process(Socket, Pid) -> ok</name>
+ <fsummary>Change controlling process of a socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Pid = pid()</v>
+ </type>
+ <desc>
+ <p>Assigns a new controlling process <c>Pid</c> to
+ <c>Socket</c>. The controlling process is the process which
+ receives messages from the socket.</p>
+ </desc>
+ </func>
+ <func>
+ <name>close(Socket) -> ok | {error, Reason}</name>
+ <fsummary>Close a UDP socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Reason = not_owner | posix()</v>
+ </type>
+ <desc>
+ <p>Closes a UDP socket.</p>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
diff --git a/lib/kernel/doc/src/global.xml b/lib/kernel/doc/src/global.xml
new file mode 100644
index 0000000000..077109d6c9
--- /dev/null
+++ b/lib/kernel/doc/src/global.xml
@@ -0,0 +1,399 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>global</title>
+ <prepared>Martin Bj&ouml;rklund</prepared>
+ <docno></docno>
+ <date>1997-11-17</date>
+ <rev></rev>
+ </header>
+ <module>global</module>
+ <modulesummary>A Global Name Registration Facility</modulesummary>
+ <description>
+ <p>This documentation describes the Global module which consists
+ of the following functionalities:</p>
+
+ <list type="bulleted">
+ <item>registration of global names;</item>
+ <item>global locks;</item>
+ <item>maintenance of the fully connected network.</item>
+ </list>
+
+ <p>These services are controlled via the process
+ <c>global_name_server</c> which exists on every node. The global
+ name server is started automatically when a node is started.
+ With the term <em>global</em> is meant over a system consisting
+ of several Erlang nodes.</p>
+
+ <p>The ability to globally register names is a central concept in
+ the programming of distributed Erlang systems. In this module,
+ the equivalent of the <c>register/2</c> and <c>whereis/1</c>
+ BIFs (for local name registration) are implemented, but for a
+ network of Erlang nodes. A registered name is an alias for a
+ process identifier (pid). The global name server monitors
+ globally registered pids. If a process terminates, the name will
+ also be globally unregistered.</p>
+
+ <p>The registered names are stored in replica global name tables on
+ every node. There is no central storage point. Thus,
+ the translation of a name to a pid is fast, as it is always done
+ locally. When any action in taken which results in a change to
+ the global name table, all tables on other nodes are automatically
+ updated.</p>
+
+ <p>Global locks have lock identities and are set on a specific
+ resource. For instance, the specified resource could be a pid.
+ When a global lock is set, access to the locked resource is
+ denied for all other resources other than the lock requester.</p>
+
+ <p>Both the registration and lock functionalities are atomic. All
+ nodes involved in these actions will have the same view of
+ the information.</p>
+
+ <p>The global name server also performs the critical task of
+ continuously monitoring changes in node configuration: if a node
+ which runs a globally registered process goes down, the name
+ will be globally unregistered. To this end the global name
+ server subscribes to <c>nodeup</c> and <c>nodedown</c> messages
+ sent from the <c>net_kernel</c> module. Relevant Kernel
+ application variables in this context are <c>net_setuptime</c>,
+ <c>net_ticktime</c>, and <c>dist_auto_connect</c>. See also
+ <seealso marker="kernel_app#net_setuptime">kernel(6)</seealso>.</p>
+
+ <p>The name server will also maintain a fully connected network. For
+ example, if node <c>N1</c> connects to node <c>N2</c> (which is
+ already connected to <c>N3</c>), the global name servers on the
+ nodes <c>N1</c> and <c>N3</c> will make sure that also <c>N1</c>
+ and <c>N3</c> are connected. If this is not desired, the command
+ line flag <c>-connect_all false</c> can be used (see also
+ <seealso marker="erts:erl#connect_all">erl(1)</seealso>). In
+ this case the name registration facility cannot be used, but the
+ lock mechanism will still work.</p>
+
+ <p>If the global name server fails to connect nodes (<c>N1</c> and
+ <c>N3</c> in the example above) a warning event is sent to the
+ error logger. The presence of such an event does not exclude the
+ possibility that the nodes will later connect--one can for
+ example try the command <c>rpc:call(N1, net_adm, ping, [N2])</c> in
+ the Erlang shell--but it indicates some kind of problem with
+ the network.</p>
+
+ <note>
+ <p>If the fully connected network is not set up properly, the
+ first thing to try is to increase the value of
+ <c>net_setuptime</c>.</p>
+ </note>
+
+ </description>
+
+ <funcs>
+ <func>
+ <name>del_lock(Id)</name>
+ <name>del_lock(Id, Nodes) -> void()</name>
+ <fsummary>Delete a lock</fsummary>
+ <type>
+ <v>Id = {ResourceId, LockRequesterId}</v>
+ <v>&nbsp;ResourceId = term()</v>
+ <v>&nbsp;LockRequesterId = term()</v>
+ <v>Nodes = [node()]</v>
+ </type>
+ <desc>
+ <p>Deletes the lock <c>Id</c> synchronously.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>notify_all_name(Name, Pid1, Pid2) -> none</name>
+ <fsummary>Name resolving function that notifies both pids</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid1 = Pid2 = pid()</v>
+ </type>
+ <desc>
+ <p>This function can be used as a name resolving function for
+ <c>register_name/3</c> and <c>re_register_name/3</c>. It
+ unregisters both pids, and sends the message
+ <c>{global_name_conflict, Name, OtherPid}</c> to both
+ processes.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>random_exit_name(Name, Pid1, Pid2) -> Pid1 | Pid2</name>
+ <fsummary>Name resolving function that kills one pid</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid1 = Pid2 = pid()</v>
+ </type>
+ <desc>
+ <p>This function can be used as a name resolving function for
+ <c>register_name/3</c> and <c>re_register_name/3</c>. It
+ randomly chooses one of the pids for registration and kills
+ the other one.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>random_notify_name(Name, Pid1, Pid2) -> Pid1 | Pid2</name>
+ <fsummary>Name resolving function that notifies one pid</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid1 = Pid2 = pid()</v>
+ </type>
+ <desc>
+ <p>This function can be used as a name resolving function for
+ <c>register_name/3</c> and <c>re_register_name/3</c>. It
+ randomly chooses one of the pids for registration, and sends
+ the message <c>{global_name_conflict, Name}</c> to the other
+ pid.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>register_name(Name, Pid)</name>
+ <name>register_name(Name, Pid, Resolve) -> yes | no</name>
+ <fsummary>Globally register a name for a pid</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid = pid()</v>
+ <v>Resolve = fun() or {Module, Function} where</v>
+ <v>&nbsp;&nbsp;Resolve(Name, Pid, Pid2) -> Pid | Pid2 | none</v>
+ </type>
+ <desc>
+ <p>Globally associates the name <c>Name</c> with a pid, that is,
+ Globally notifies all nodes of a new global name in a network
+ of Erlang nodes.</p>
+
+ <p>When new nodes are added to the network, they are informed
+ of the globally registered names that already exist.
+ The network is also informed of any global names in newly
+ connected nodes. If any name clashes are discovered,
+ the <c>Resolve</c> function is called. Its purpose is to
+ decide which pid is correct. If the function crashes, or
+ returns anything other than one of the pids, the name is
+ unregistered. This function is called once for each name
+ clash.</p>
+
+ <p>There are three pre-defined resolve functions:
+ <c>random_exit_name/3</c>, <c>random_notify_name/3</c>, and
+ <c>notify_all_name/3</c>. If no <c>Resolve</c> function is
+ defined, <c>random_exit_name</c> is used. This means that one
+ of the two registered processes will be selected as correct
+ while the other is killed.</p>
+
+ <p>This function is completely synchronous. This means that
+ when this function returns, the name is either registered on
+ all nodes or none.</p>
+
+ <p>The function returns <c>yes</c> if successful, <c>no</c> if
+ it fails. For example, <c>no</c> is returned if an attempt
+ is made to register an already registered process or to
+ register a process with a name that is already in use.</p>
+
+ <note>
+ <p>Releases up to and including OTP R10 did not check if the
+ process was already registered. As a consequence the
+ global name table could become inconsistent. The old
+ (buggy) behavior can be chosen by giving the Kernel
+ application variable <c>global_multi_name_action</c> the
+ value <c>allow</c>.</p>
+ </note>
+
+ <p>If a process with a registered name dies, or the node goes
+ down, the name is unregistered on all nodes.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>registered_names() -> [Name]</name>
+ <fsummary>All globally registered names</fsummary>
+ <type>
+ <v>Name = term()</v>
+ </type>
+ <desc>
+ <p>Returns a lists of all globally registered names.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>re_register_name(Name, Pid)</name>
+ <name>re_register_name(Name, Pid, Resolve) -> void()</name>
+ <fsummary>Atomically re-register a name</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid = pid()</v>
+ <v>Resolve = fun() or {Module, Function} where</v>
+ <v>&nbsp;&nbsp;Resolve(Name, Pid, Pid2) -> Pid | Pid2 | none</v>
+ </type>
+ <desc>
+ <p>Atomically changes the registered name <c>Name</c> on all
+ nodes to refer to <c>Pid</c>.</p>
+
+ <p>The <c>Resolve</c> function has the same behavior as in
+ <c>register_name/2,3</c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>send(Name, Msg) -> Pid</name>
+ <fsummary>Send a message to a globally registered pid</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Msg = term()</v>
+ <v>Pid = pid()</v>
+ </type>
+ <desc>
+ <p>Sends the message <c>Msg</c> to the pid globally registered
+ as <c>Name</c>.</p>
+
+ <p>Failure: If <c>Name</c> is not a globally registered
+ name, the calling function will exit with reason
+ <c>{badarg, {Name, Msg}}</c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>set_lock(Id)</name>
+ <name>set_lock(Id, Nodes)</name>
+ <name>set_lock(Id, Nodes, Retries) -> boolean()</name>
+ <fsummary>Set a lock on the specified nodes</fsummary>
+ <type>
+ <v>Id = {ResourceId, LockRequesterId}</v>
+ <v>&nbsp;ResourceId = term()</v>
+ <v>&nbsp;LockRequesterId = term()</v>
+ <v>Nodes = [node()]</v>
+ <v>Retries = int() >= 0 | infinity</v>
+ </type>
+ <desc>
+ <p>Sets a lock on the specified nodes (or on all nodes if none
+ are specified) on <c>ResourceId</c> for
+ <c>LockRequesterId</c>. If a lock already exists on
+ <c>ResourceId</c> for another requester than
+ <c>LockRequesterId</c>, and <c>Retries</c> is not equal to 0,
+ the process sleeps for a while and will try to execute
+ the action later. When <c>Retries</c> attempts have been made,
+ <c>false</c> is returned, otherwise <c>true</c>. If
+ <c>Retries</c> is <c>infinity</c>, <c>true</c> is eventually
+ returned (unless the lock is never released).</p>
+
+ <p>If no value for <c>Retries</c> is given, <c>infinity</c> is
+ used.</p>
+
+ <p>This function is completely synchronous.</p>
+
+ <p>If a process which holds a lock dies, or the node goes
+ down, the locks held by the process are deleted.</p>
+
+ <p>The global name server keeps track of all processes sharing
+ the same lock, that is, if two processes set the same lock,
+ both processes must delete the lock.</p>
+
+ <p>This function does not address the problem of a deadlock. A
+ deadlock can never occur as long as processes only lock one
+ resource at a time. But if some processes try to lock two or
+ more resources, a deadlock may occur. It is up to the
+ application to detect and rectify a deadlock.</p>
+
+ <note>
+ <p>Some values of <c>ResourceId</c> should be avoided or
+ Erlang/OTP will not work properly. A list of resources to
+ avoid: <c>global</c>, <c>dist_ac</c>,
+ <c>mnesia_table_lock</c>, <c>mnesia_adjust_log_writes</c>,
+ <c>pg2</c>.</p>
+ </note>
+
+ </desc>
+ </func>
+
+ <func>
+ <name>sync() -> void()</name>
+ <fsummary>Synchronize the global name server</fsummary>
+ <desc>
+ <p>Synchronizes the global name server with all nodes known to
+ this node. These are the nodes which are returned from
+ <c>erlang:nodes()</c>. When this function returns,
+ the global name server will receive global information from
+ all nodes. This function can be called when new nodes are
+ added to the network.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>trans(Id, Fun)</name>
+ <name>trans(Id, Fun, Nodes)</name>
+ <name>trans(Id, Fun, Nodes, Retries) -> Res | aborted</name>
+ <fsummary>Micro transaction facility</fsummary>
+ <type>
+ <v>Id = {ResourceId, LockRequesterId}</v>
+ <v>&nbsp;ResourceId = term()</v>
+ <v>&nbsp;LockRequesterId = term()</v>
+ <v>Fun = fun() | {M, F}</v>
+ <v>Nodes = [node()]</v>
+ <v>Retries = int() >= 0 | infinity</v>
+ <v>Res = term()</v>
+ </type>
+ <desc>
+ <p>Sets a lock on <c>Id</c> (using <c>set_lock/3</c>). If this
+ succeeds, <c>Fun()</c> is evaluated and the result <c>Res</c>
+ is returned. Returns <c>aborted</c> if the lock attempt
+ failed. If <c>Retries</c> is set to <c>infinity</c>,
+ the transaction will not abort.</p>
+
+ <p><c>infinity</c> is the default setting and will be used if
+ no value is given for <c>Retries</c>.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>unregister_name(Name) -> void()</name>
+ <fsummary>Remove a globally registered name for a pid</fsummary>
+ <type>
+ <v>Name = term()</v>
+ </type>
+ <desc>
+ <p>Removes the globally registered name <c>Name</c> from
+ the network of Erlang nodes.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>whereis_name(Name) -> pid() | undefined</name>
+ <fsummary>Get the pid with a given globally registered name</fsummary>
+ <type>
+ <v>Name = term()</v>
+ </type>
+ <desc>
+ <p>Returns the pid with the globally registered name
+ <c>Name</c>. Returns <c>undefined</c> if the name is not
+ globally registered.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>See Also</title>
+ <p><seealso marker="global_group">global_group(3)</seealso>,
+ <seealso marker="net_kernel">net_kernel(3)</seealso></p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/global_group.xml b/lib/kernel/doc/src/global_group.xml
new file mode 100644
index 0000000000..4facf4a4aa
--- /dev/null
+++ b/lib/kernel/doc/src/global_group.xml
@@ -0,0 +1,284 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1998</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>global_group</title>
+ <prepared>Esko Vierum&auml;ki</prepared>
+ <docno></docno>
+ <date>1998-12-18</date>
+ <rev>b</rev>
+ </header>
+ <module>global_group</module>
+ <modulesummary>Grouping Nodes to Global Name Registration Groups</modulesummary>
+ <description>
+ <p>The global group function makes it possible to group the nodes
+ in a system into partitions, each partition having its own global
+ name space, refer to <c>global(3)</c>. These partitions are
+ called global groups.</p>
+ <p>The main advantage of dividing systems to global groups is that
+ the background load decreases while the number of nodes to be
+ updated is reduced when manipulating globally registered names.</p>
+ <p>The Kernel configuration parameter <c>global_groups</c> defines
+ the global groups (see also
+ <seealso marker="kernel_app">kernel(6)</seealso>,
+ <seealso marker="config">config(4)</seealso>:</p>
+ <code type="none">
+{global_groups, [GroupTuple]}</code>
+ <p>Types:</p>
+ <list type="bulleted">
+ <item><c>GroupTuple = {GroupName, [Node]} | {GroupName, PublishType, [Node]}</c></item>
+ <item><c>GroupName = atom()</c> (naming a global group)</item>
+ <item><c>PublishType = normal | hidden</c></item>
+ <item><c>Node = atom()</c> (naming a node)</item>
+ </list>
+ <p>A <c>GroupTuple</c> without <c>PublishType</c> is the same as a
+ <c>GroupTuple</c> with <c>PublishType == normal</c>.</p>
+ <p>A node started with the command line flag <c>-hidden</c>, see
+ <seealso marker="erts:erl">erl(1)</seealso>, is said to be a
+ <em>hidden</em> node. A hidden node will establish hidden
+ connections to nodes not part of the same global group, but
+ normal (visible) connections to nodes part of the same global
+ group.</p>
+ <p>A global group defined with <c>PublishType == hidden</c>, is
+ said to be a hidden global group. All nodes in a hidden global
+ group are hidden nodes, regardless if they are started with
+ the <c>-hidden</c> command line flag or not.</p>
+ <p>For the processes and nodes to run smoothly using the global
+ group functionality, the following criteria must be met:</p>
+ <list type="bulleted">
+ <item>
+ <p>An instance of the global group server, <c>global_group</c>,
+ must be running on each node. The processes are automatically
+ started and synchronized when a node is started.</p>
+ </item>
+ <item>
+ <p>All involved nodes must agree on the global group definition,
+ or the behavior of the system is undefined.</p>
+ </item>
+ <item>
+ <p><em>All</em> nodes in the system should belong to exactly
+ one global group.</p>
+ </item>
+ </list>
+ <p>In the following description, a <em>group node</em> is a node
+ belonging to the same global group as the local node.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>global_groups() -> {GroupName, GroupNames} | undefined</name>
+ <fsummary>Return the global group names</fsummary>
+ <type>
+ <v>GroupName = atom()</v>
+ <v>GroupNames = [GroupName]</v>
+ </type>
+ <desc>
+ <p>Returns a tuple containing the name of the global group
+ the local node belongs to, and the list of all other known
+ group names. Returns <c>undefined</c> if no global groups are
+ defined.</p>
+ </desc>
+ </func>
+ <func>
+ <name>info() -> [{Item, Info}]</name>
+ <fsummary>Information about global groups</fsummary>
+ <type>
+ <v>Item, Info -- see below</v>
+ </type>
+ <desc>
+ <p>Returns a list containing information about the global
+ groups. Each element of the list is a tuple. The order of
+ the tuples is not defined.</p>
+ <taglist>
+ <tag><c>{state, State}</c></tag>
+ <item>
+ <p>If the local node is part of a global group,
+ <c>State == synced</c>. If no global groups are defined,
+ <c>State == no_conf</c>.</p>
+ </item>
+ <tag><c>{own_group_name, GroupName}</c></tag>
+ <item>
+ <p>The name (atom) of the group that the local node belongs
+ to.</p>
+ </item>
+ <tag><c>{own_group_nodes, Nodes}</c></tag>
+ <item>
+ <p>A list of node names (atoms), the group nodes.</p>
+ </item>
+ <tag><c>{synced_nodes, Nodes}</c></tag>
+ <item>
+ <p>A list of node names, the group nodes currently
+ synchronized with the local node.</p>
+ </item>
+ <tag><c>{sync_error, Nodes}</c></tag>
+ <item>
+ <p>A list of node names, the group nodes with which
+ the local node has failed to synchronize.</p>
+ </item>
+ <tag><c>{no_contact, Nodes}</c></tag>
+ <item>
+ <p>A list of node names, the group nodes to which there are
+ currently no connections.</p>
+ </item>
+ <tag><c>{other_groups, Groups}</c></tag>
+ <item>
+ <p><c>Groups</c> is a list of tuples
+ <c>{GroupName, Nodes}</c>, specifying the name and nodes
+ of the other global groups.</p>
+ </item>
+ <tag><c>{monitoring, Pids}</c></tag>
+ <item>
+ <p>A list of pids, specifying the processes which have
+ subscribed to <c>nodeup</c> and <c>nodedown</c> messages.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>monitor_nodes(Flag) -> ok </name>
+ <fsummary>Subscribe to node status changes</fsummary>
+ <type>
+ <v>Flag = bool()</v>
+ </type>
+ <desc>
+ <p>Depending on <c>Flag</c>, the calling process starts
+ subscribing (<c>Flag == true</c>) or stops subscribing
+ (<c>Flag == false</c>) to node status change messages.</p>
+ <p>A process which has subscribed will receive the messages
+ <c>{nodeup, Node}</c> and <c>{nodedown, Node}</c> when a
+ group node connects or disconnects, respectively.</p>
+ </desc>
+ </func>
+ <func>
+ <name>own_nodes() -> Nodes</name>
+ <fsummary>Return the group nodes</fsummary>
+ <type>
+ <v>Nodes = [Node]</v>
+ <v>&nbsp;Node = node()</v>
+ </type>
+ <desc>
+ <p>Returns the names of all group nodes, regardless of their
+ current status.</p>
+ </desc>
+ </func>
+ <func>
+ <name>registered_names(Where) -> Names</name>
+ <fsummary>Return globally registered names</fsummary>
+ <type>
+ <v>Where = {node, Node} | {group, GroupName}</v>
+ <v>&nbsp;Node = node()</v>
+ <v>&nbsp;GroupName = atom()</v>
+ <v>Names = [Name]</v>
+ <v>&nbsp;Name = atom()</v>
+ </type>
+ <desc>
+ <p>Returns a list of all names which are globally registered
+ on the specified node or in the specified global group.</p>
+ </desc>
+ </func>
+ <func>
+ <name>send(Name, Msg) -> pid() | {badarg, {Name, Msg}}</name>
+ <name>send(Where, Name, Msg) -> pid() | {badarg, {Name, Msg}}</name>
+ <fsummary>Send a message to a globally registered pid</fsummary>
+ <type>
+ <v>Where = {node, Node} | {group, GroupName}</v>
+ <v>&nbsp;Node = node()</v>
+ <v>&nbsp;GroupName = atom()</v>
+ <v>Name = atom()</v>
+ <v>Msg = term()</v>
+ </type>
+ <desc>
+ <p>Searches for <c>Name</c>, globally registered on
+ the specified node or in the specified global group, or --
+ if the <c>Where</c> argument is not provided -- in any global
+ group. The global groups are searched in the order in which
+ they appear in the value of the <c>global_groups</c>
+ configuration parameter.</p>
+ <p>If <c>Name</c> is found, the message <c>Msg</c> is sent to
+ the corresponding pid. The pid is also the return value of
+ the function. If the name is not found, the function returns
+ <c>{badarg, {Name, Msg}}</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>sync() -> ok</name>
+ <fsummary>Synchronize the group nodes</fsummary>
+ <desc>
+ <p>Synchronizes the group nodes, that is, the global name
+ servers on the group nodes. Also check the names globally
+ registered in the current global group and unregisters them
+ on any known node not part of the group.</p>
+ <p>If synchronization is not possible, an error report is sent
+ to the error logger (see also <c>error_logger(3)</c>).</p>
+ <p>Failure:
+ <c>{error, {'invalid global_groups definition', Bad}}</c> if
+ the <c>global_groups</c> configuration parameter has an
+ invalid value <c>Bad</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>whereis_name(Name) -> pid() | undefined</name>
+ <name>whereis_name(Where, Name) -> pid() | undefined</name>
+ <fsummary>Get the pid with a given globally registered name</fsummary>
+ <type>
+ <v>Where = {node, Node} | {group, GroupName}</v>
+ <v>&nbsp;Node = node()</v>
+ <v>&nbsp;GroupName = atom()</v>
+ <v>Name = atom()</v>
+ </type>
+ <desc>
+ <p>Searches for <c>Name</c>, globally registered on
+ the specified node or in the specified global group, or -- if
+ the <c>Where</c> argument is not provided -- in any global
+ group. The global groups are searched in the order in which
+ they appear in the value of the <c>global_groups</c>
+ configuration parameter.</p>
+ <p>If <c>Name</c> is found, the corresponding pid is returned.
+ If the name is not found, the function returns
+ <c>undefined</c>.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>NOTE</title>
+ <p>In the situation where a node has lost its connections to other
+ nodes in its global group, but has connections to nodes in other
+ global groups, a request from another global group may produce an
+ incorrect or misleading result. For example, the isolated node may
+ not have accurate information about registered names in its
+ global group.</p>
+ <p>Note also that the <c>send/2,3</c> function is not secure.</p>
+ <p>Distribution of applications is highly dependent of the global
+ group definitions. It is not recommended that an application is
+ distributed over several global groups of the obvious reason that
+ the registered names may be moved to another global group at
+ failover/takeover. There is nothing preventing doing this, but
+ the application code must in such case handle the situation.</p>
+ </section>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><seealso marker="erts:erl">erl(1)</seealso>,
+ <seealso marker="global">global(3)</seealso></p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml
new file mode 100644
index 0000000000..0df699572d
--- /dev/null
+++ b/lib/kernel/doc/src/heart.xml
@@ -0,0 +1,116 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>heart</title>
+ <prepared>Magnus Fr&ouml;berg</prepared>
+ <docno></docno>
+ <date>1998-01-28</date>
+ <rev>A</rev>
+ </header>
+ <module>heart</module>
+ <modulesummary>Heartbeat Monitoring of an Erlang Runtime System</modulesummary>
+ <description>
+ <p>This modules contains the interface to the <c>heart</c> process.
+ <c>heart</c> sends periodic heartbeats to an external port
+ program, which is also named <c>heart</c>. The purpose of
+ the heart port program is to check that the Erlang runtime system
+ it is supervising is still running. If the port program has not
+ received any heartbeats within <c>HEART_BEAT_TIMEOUT</c> seconds
+ (default is 60 seconds), the system can be rebooted. Also, if
+ the system is equipped with a hardware watchdog timer and is
+ running Solaris, the watchdog can be used to supervise the entire
+ system.</p>
+ <p>An Erlang runtime system to be monitored by a heart program,
+ should be started with the command line flag <c>-heart</c> (see
+ also <seealso marker="erts:erl">erl(1)</seealso>. The <c>heart</c>
+ process is then started automatically:</p>
+ <pre>
+% <input>erl -heart ...</input></pre>
+ <p>If the system should be rebooted because of missing heart-beats,
+ or a terminated Erlang runtime system, the environment variable
+ <c>HEART_COMMAND</c> has to be set before the system is started.
+ If this variable is not set, a warning text will be printed but
+ the system will not reboot. However, if the hardware watchdog is
+ used, it will trigger a reboot <c>HEART_BEAT_BOOT_DELAY</c>
+ seconds later nevertheless (default is 60).</p>
+ <p>To reboot on the WINDOWS platform <c>HEART_COMMAND</c> can be
+ set to <c>heart -shutdown</c> (included in the Erlang delivery)
+ or of course to any other suitable program which can activate a
+ reboot.</p>
+ <p>The hardware watchdog will not be started under Solaris if
+ the environment variable <c>HW_WD_DISABLE</c> is set.</p>
+ <p>The <c>HEART_BEAT_TIMEOUT</c> and <c>HEART_BEAT_BOOT_DELAY</c>
+ environment variables can be used to configure the heart timeouts,
+ they can be set in the operating system shell before Erlang is
+ started or be specified at the command line:</p>
+ <pre>
+% <input>erl -heart -env HEART_BEAT_TIMEOUT 30 ...</input></pre>
+ <p>The value (in seconds) must be in the range 10 &lt; X &lt;= 65535.</p>
+ <p>It should be noted that if the system clock is adjusted with
+ more than <c>HEART_BEAT_TIMEOUT</c> seconds, <c>heart</c> will
+ timeout and try to reboot the system. This can happen, for
+ example, if the system clock is adjusted automatically by use of
+ NTP (Network Time Protocol).</p>
+ <p>In the following descriptions, all function fails with reason
+ <c>badarg</c> if <c>heart</c> is not started.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>set_cmd(Cmd) -> ok | {error, {bad_cmd, Cmd}}</name>
+ <fsummary>Set a temporary reboot command</fsummary>
+ <type>
+ <v>Cmd = string()</v>
+ </type>
+ <desc>
+ <p>Sets a temporary reboot command. This command is used if
+ a <c>HEART_COMMAND</c> other than the one specified with
+ the environment variable should be used in order to reboot
+ the system. The new Erlang runtime system will (if it
+ misbehaves) use the environment variable
+ <c>HEART_COMMAND</c> to reboot.</p>
+ <p>Limitations: The length of the <c>Cmd</c> command string
+ must be less than 2047 characters.</p>
+ </desc>
+ </func>
+ <func>
+ <name>clear_cmd() -> ok</name>
+ <fsummary>Clear the temporary boot command</fsummary>
+ <desc>
+ <p>Clears the temporary boot command. If the system terminates,
+ the normal <c>HEART_COMMAND</c> is used to reboot.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_cmd() -> {ok, Cmd}</name>
+ <fsummary>Get the temporary reboot command</fsummary>
+ <type>
+ <v>Cmd = string()</v>
+ </type>
+ <desc>
+ <p>Get the temporary reboot command. If the command is cleared,
+ the empty string will be returned.</p>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml
new file mode 100644
index 0000000000..cae5fef2f8
--- /dev/null
+++ b/lib/kernel/doc/src/inet.xml
@@ -0,0 +1,827 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>inet</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>1998-02-04</date>
+ <rev>A</rev>
+ </header>
+ <module>inet</module>
+ <modulesummary>Access to TCP/IP Protocols</modulesummary>
+ <description>
+ <p>Provides access to TCP/IP protocols.</p>
+ <p>See also <em>ERTS User's Guide, Inet configuration</em> for more
+ information on how to configure an Erlang runtime system for IP
+ communication.</p>
+ <p>Two Kernel configuration parameters affect the behaviour of all
+ sockets opened on an Erlang node:
+ <c>inet_default_connect_options</c> can contain a list of default
+ options used for all sockets returned when doing <c>connect</c>,
+ and <c>inet_default_listen_options</c> can contain a list of
+ default options used when issuing a <c>listen</c> call. When
+ <c>accept</c> is issued, the values of the listensocket options
+ are inherited, why no such application variable is needed for
+ <c>accept</c>.</p>
+ <p>Using the Kernel configuration parameters mentioned above, one
+ can set default options for all TCP sockets on a node. This should
+ be used with care, but options like <c>{delay_send,true}</c>
+ might be specified in this way. An example of starting an Erlang
+ node with all sockets using delayed send could look like this:</p>
+ <pre>
+$ <input>erl -sname test -kernel \\</input>
+<input>inet_default_connect_options '[{delay_send,true}]' \\</input>
+<input>inet_default_listen_options '[{delay_send,true}]'</input></pre>
+ <p>Note that the default option <c>{active, true}</c> currently
+ cannot be changed, for internal reasons.</p>
+ </description>
+
+ <section>
+ <title>DATA TYPES</title>
+ <code type="none">
+#hostent{h_addr_list = [ip_address()] % list of addresses for this host
+ h_addrtype = inet | inet6
+ h_aliases = [hostname()] % list of aliases
+ h_length = int() % length of address in bytes
+ h_name = hostname() % official name for host
+ The record is defined in the Kernel include file "inet.hrl"
+ Add the following directive to the module:
+ -include_lib("kernel/include/inet.hrl").
+
+hostname() = atom() | string()
+
+ip_address() = {N1,N2,N3,N4} % IPv4
+ | {K1,K2,K3,K4,K5,K6,K7,K8} % IPv6
+ Ni = 0..255
+ Ki = 0..65535
+
+posix()
+ an atom which is named from the Posix error codes used in
+ Unix, and in the runtime libraries of most C compilers
+
+socket()
+ see gen_tcp(3), gen_udp(3)</code>
+ <p>Addresses as inputs to functions can be either a string or a
+ tuple. For instance, the IP address 150.236.20.73 can be passed to
+ <c>gethostbyaddr/1</c> either as the string "150.236.20.73"
+ or as the tuple <c>{150, 236, 20, 73}</c>.</p>
+ <p>IPv4 address examples:</p>
+ <code type="none">
+Address ip_address()
+------- ------------
+127.0.0.1 {127,0,0,1}
+192.168.42.2 {192,168,42,2}</code>
+ <p>IPv6 address examples:</p>
+ <code type="none">
+Address ip_address()
+------- ------------
+::1 {0,0,0,0,0,0,0,1}
+::192.168.42.2 {0,0,0,0,0,0,(192 bsl 8) bor 168,(42 bsl 8) bor 2}
+FFFF::192.168.42.2
+ {16#FFFF,0,0,0,0,0,(192 bsl 8) bor 168,(42 bsl 8) bor 2}
+3ffe:b80:1f8d:2:204:acff:fe17:bf38
+ {16#3ffe,16#b80,16#1f8d,16#2,16#204,16#acff,16#fe17,16#bf38}
+fe80::204:acff:fe17:bf38
+ {16#fe80,0,0,0,0,16#204,16#acff,16#fe17,16#bf38}</code>
+ <p>A function that may be useful is <c>inet_parse:address/1</c>:</p>
+ <pre>
+1> <input>inet_parse:address("192.168.42.2").</input>
+{ok,{192,168,42,2}}
+2> <input>inet_parse:address("FFFF::192.168.42.2").</input>
+{ok,{65535,0,0,0,0,0,49320,10754}}</pre>
+ </section>
+ <funcs>
+ <func>
+ <name>close(Socket) -> ok</name>
+ <fsummary>Close a socket of any type</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ </type>
+ <desc>
+ <p>Closes a socket of any type.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_rc() -> [{Par, Val}]</name>
+ <fsummary>Return a list of IP configuration parameters</fsummary>
+ <type>
+ <v>Par, Val -- see below</v>
+ </type>
+ <desc>
+ <p>Returns the state of the Inet configuration database in
+ form of a list of recorded configuration parameters. (See the
+ ERTS User's Guide, Inet configuration, for more information).
+ Only parameters with other than default values are returned.</p>
+ </desc>
+ </func>
+ <func>
+ <name>format_error(Posix) -> string()</name>
+ <fsummary>Return a descriptive string for an error reason</fsummary>
+ <type>
+ <v>Posix = posix()</v>
+ </type>
+ <desc>
+ <p>Returns a diagnostic error string. See the section below
+ for possible <c>Posix</c> values and the corresponding
+ strings.</p>
+ </desc>
+ </func>
+ <func>
+ <name>getaddr(Host, Family) -> {ok, Address} | {error, posix()}</name>
+ <fsummary>Return the IP-address for a host</fsummary>
+ <type>
+ <v>Host = ip_address() | string() | atom()</v>
+ <v>Family = inet | inet6</v>
+ <v>Address = ip_address()</v>
+ <v>posix() = term()</v>
+ </type>
+ <desc>
+ <p>Returns the IP-address for <c>Host</c> as a tuple of
+ integers. <c>Host</c> can be an IP-address, a single hostname
+ or a fully qualified hostname.</p>
+ </desc>
+ </func>
+ <func>
+ <name>getaddrs(Host, Family) -> {ok, Addresses} | {error, posix()}</name>
+ <fsummary>Return the IP-addresses for a host</fsummary>
+ <type>
+ <v>Host = ip_address() | string() | atom()</v>
+ <v>Addresses = [ip_address()]</v>
+ <v>Family = inet | inet6</v>
+ </type>
+ <desc>
+ <p>Returns a list of all IP-addresses for <c>Host</c>.
+ <c>Host</c> can be an IP-address, a single hostname or a fully
+ qualified hostname.</p>
+ </desc>
+ </func>
+ <func>
+ <name>gethostbyaddr(Address) -> {ok, Hostent} | {error, posix()}</name>
+ <fsummary>Return a hostent record for the host with the given address</fsummary>
+ <type>
+ <v>Address = string() | ip_address()</v>
+ <v>Hostent = #hostent{}</v>
+ </type>
+ <desc>
+ <p>Returns a <c>hostent</c> record given an address.</p>
+ </desc>
+ </func>
+ <func>
+ <name>gethostbyname(Name) -> {ok, Hostent} | {error, posix()}</name>
+ <fsummary>Return a hostent record for the host with the given name</fsummary>
+ <type>
+ <v>Hostname = hostname()</v>
+ <v>Hostent = #hostent{}</v>
+ </type>
+ <desc>
+ <p>Returns a <c>hostent</c> record given a hostname.</p>
+ </desc>
+ </func>
+ <func>
+ <name>gethostbyname(Name, Family) -> {ok, Hostent} | {error, posix()}</name>
+ <fsummary>Return a hostent record for the host with the given name</fsummary>
+ <type>
+ <v>Hostname = hostname()</v>
+ <v>Family = inet | inet6</v>
+ <v>Hostent = #hostent{}</v>
+ </type>
+ <desc>
+ <p>Returns a <c>hostent</c> record given a hostname, restricted
+ to the given address family.</p>
+ </desc>
+ </func>
+ <func>
+ <name>gethostname() -> {ok, Hostname}</name>
+ <fsummary>Return the local hostname</fsummary>
+ <type>
+ <v>Hostname = string()</v>
+ </type>
+ <desc>
+ <p>Returns the local hostname. Will never fail.</p>
+ </desc>
+ </func>
+ <func>
+ <name>getopts(Socket, Options) -> OptionValues | {error, posix()}</name>
+ <fsummary>Get one or more options for a socket</fsummary>
+ <type>
+ <v>Socket = term()</v>
+ <v>Options = [Opt | RawOptReq]</v>
+ <v>Opt = atom()</v>
+ <v>RawOptReq = {raw, Protocol, OptionNum, ValueSpec}</v>
+ <v>Protocol = int()</v>
+ <v>OptionNum = int()</v>
+ <v>ValueSpec = ValueSize | ValueBin</v>
+ <v>ValueSize = int()</v>
+ <v>ValueBin = binary()</v>
+ <v>OptionValues = [{Opt, Val} | {raw, Protocol, OptionNum, ValueBin}]</v>
+ </type>
+ <desc>
+ <p>Gets one or more options for a socket.
+ See <seealso marker="#setopts/2">setopts/2</seealso>
+ for a list of available options.</p>
+ <p>The number of elements in the returned <c>OptionValues</c>
+ list does not necessarily correspond to the number of options
+ asked for. If the operating system fails to support an option,
+ it is simply left out in the returned list. An error tuple is only
+ returned when getting options for the socket is impossible
+ (i.e. the socket is closed or the buffer size in a raw request
+ is too large). This behavior is kept for backward
+ compatibility reasons.</p>
+ <p>A <c>RawOptReq</c> can be used to get information about
+ socket options not (explicitly) supported by the emulator. The
+ use of raw socket options makes the code non portable, but
+ allows the Erlang programmer to take advantage of unusual features
+ present on the current platform.</p>
+ <p>The <c>RawOptReq</c> consists of the tag <c>raw</c> followed
+ by the protocol level, the option number and either a binary
+ or the size, in bytes, of the
+ buffer in which the option value is to be stored. A binary
+ should be used when the underlying <c>getsockopt</c> requires
+ <em>input</em>
+ in the argument field, in which case the size of the binary
+ should correspond to the required buffer
+ size of the return value. The supplied values in a <c>RawOptReq</c>
+ correspond to the second, third and fourth/fifth parameters to the
+ <c>getsockopt</c> call in the C socket API. The value stored
+ in the buffer is returned as a binary <c>ValueBin</c>
+ where all values are coded in the native endianess.</p>
+ <p>Asking for and inspecting raw socket options require low
+ level information about the current operating system and TCP
+ stack.</p>
+ <p>As an example, consider a Linux machine where the
+ <c>TCP_INFO</c> option could be used to collect TCP statistics
+ for a socket. Lets say we're interested in the
+ <c>tcpi_sacked</c> field of the <c>struct tcp_info</c>
+ filled in when asking for <c>TCP_INFO</c>. To
+ be able to access this information, we need to know both the
+ numeric value of the protocol level <c>IPPROTO_TCP</c>, the
+ numeric value of the option <c>TCP_INFO</c>, the size of the
+ <c>struct tcp_info</c> and the size and offset of
+ the specific field. By inspecting the headers or writing a small C
+ program, we found <c>IPPROTO_TCP</c> to be 6,
+ <c>TCP_INFO</c> to be 11, the structure size to be 92 (bytes),
+ the offset of <c>tcpi_sacked</c> to be 28 bytes and the actual
+ value to be a 32 bit integer. We could use the following
+ code to retrieve the value:</p>
+ <code type="none"><![CDATA[
+ get_tcpi_sacked(Sock) ->
+ {ok,[{raw,_,_,Info}]} = inet:getopts(Sock,[{raw,6,11,92}]),
+ <<_:28/binary,TcpiSacked:32/native,_/binary>> = Info,
+ TcpiSacked.]]></code>
+ <p>Preferably, you would check the machine type, the OS
+ and the kernel version prior to executing anything similar to the
+ code above.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name>getstat(Socket)</name>
+ <name>getstat(Socket, Options) -> {ok, OptionValues} | {error, posix()}</name>
+ <fsummary>Get one or more statistic options for a socket</fsummary>
+ <type>
+ <v>Socket = term()</v>
+ <v>Options = [Opt]</v>
+ <v>OptionValues = [{Opt, Val}]</v>
+ <v>&nbsp;Opt, Val -- see below</v>
+ </type>
+ <desc>
+ <p>Gets one or more statistic options for a socket.</p>
+ <p><c>getstat(Socket)</c> is equivalent to
+ <c>getstat(Socket,&nbsp;[recv_avg,&nbsp;recv_cnt,&nbsp;recv_dvi,&nbsp;recv_max,&nbsp;recv_oct,&nbsp;send_avg,&nbsp;send_cnt,&nbsp;send_dvi,&nbsp;send_max,&nbsp;send_oct])</c></p>
+ <p>The following options are available:</p>
+ <taglist>
+ <tag><c>recv_avg</c></tag>
+ <item>
+ <p>Average size of packets in bytes received to the socket.</p>
+ </item>
+ <tag><c>recv_cnt</c></tag>
+ <item>
+ <p>Number of packets received to the socket.</p>
+ </item>
+ <tag><c>recv_dvi</c></tag>
+ <item>
+ <p>Average packet size deviation in bytes received to the socket.</p>
+ </item>
+ <tag><c>recv_max</c></tag>
+ <item>
+ <p>The size of the largest packet in bytes received to the socket.</p>
+ </item>
+ <tag><c>recv_oct</c></tag>
+ <item>
+ <p>Number of bytes received to the socket.</p>
+ </item>
+
+ <tag><c>send_avg</c></tag>
+ <item>
+ <p>Average size of packets in bytes sent from the socket.</p>
+ </item>
+ <tag><c>send_cnt</c></tag>
+ <item>
+ <p>Number of packets sent from the socket.</p>
+ </item>
+ <tag><c>send_dvi</c></tag>
+ <item>
+ <p>Average packet size deviation in bytes received sent from the socket.</p>
+ </item>
+ <tag><c>send_max</c></tag>
+ <item>
+ <p>The size of the largest packet in bytes sent from the socket.</p>
+ </item>
+ <tag><c>send_oct</c></tag>
+ <item>
+ <p>Number of bytes sent from the socket.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+
+ <func>
+ <name>peername(Socket) -> {ok, {Address, Port}} | {error, posix()}</name>
+ <fsummary>Return the address and port for the other end of a connection</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Address = ip_address()</v>
+ <v>Port = int()</v>
+ </type>
+ <desc>
+ <p>Returns the address and port for the other end of a
+ connection.</p>
+ </desc>
+ </func>
+ <func>
+ <name>port(Socket) -> {ok, Port}</name>
+ <fsummary>Return the local port number for a socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Port = int()</v>
+ </type>
+ <desc>
+ <p>Returns the local port number for a socket.</p>
+ </desc>
+ </func>
+ <func>
+ <name>sockname(Socket) -> {ok, {Address, Port}} | {error, posix()}</name>
+ <fsummary>Return the local address and port number for a socket</fsummary>
+ <type>
+ <v>Socket = socket()</v>
+ <v>Address = ip_address()</v>
+ <v>Port = int()</v>
+ </type>
+ <desc>
+ <p>Returns the local address and port number for a socket.</p>
+ </desc>
+ </func>
+ <func>
+ <name>setopts(Socket, Options) -> ok | {error, posix()}</name>
+ <fsummary>Set one or more options for a socket</fsummary>
+ <type>
+ <v>Socket = term()</v>
+ <v>Options = [{Opt, Val} | {raw, Protocol, Option, ValueBin}]</v>
+ <v>Protocol = int()</v>
+ <v>OptionNum = int()</v>
+ <v>ValueBin = binary()</v>
+ <v>&nbsp;Opt, Val -- see below</v>
+ </type>
+ <desc>
+ <p>Sets one or more options for a socket. The following options
+ are available:</p>
+ <taglist>
+ <tag><c>{active, true | false | once}</c></tag>
+ <item>
+ <p>If the value is <c>true</c>, which is the default,
+ everything received from the socket will be sent as
+ messages to the receiving process. If the value is
+ <c>false</c> (passive mode), the process must explicitly
+ receive incoming data by calling <c>gen_tcp:recv/2,3</c>
+ or <c>gen_udp:recv/2,3</c> (depending on the type of
+ socket).</p>
+ <p>If the value is <c>once</c> (<c>{active, once}</c>),
+ <em>one</em> data message from the socket will be sent
+ to the process. To receive one more message,
+ <c>setopts/2</c> must be called again with the
+ <c>{active, once}</c> option.</p>
+ <p>When using <c>{active, once}</c>, the socket changes
+ behaviour automatically when data is received. This can
+ sometimes be confusing in combination with connection
+ oriented sockets (i.e. <c>gen_tcp</c>) as a socket with
+ <c>{active, false}</c> behaviour reports closing
+ differently than a socket with <c>{active, true}</c>
+ behaviour. To make programming easier, a socket where
+ the peer closed and this was detected while in
+ <c>{active, false}</c> mode, will still generate the
+ message
+ <c>{tcp_closed,Socket}</c> when set to <c>{active, once}</c> or <c>{active, true}</c> mode. It is therefore
+ safe to assume that the message
+ <c>{tcp_closed,Socket}</c>, possibly followed by socket
+ port termination (depending on the <c>exit_on_close</c>
+ option) will eventually appear when a socket changes
+ back and forth between <c>{active, true}</c> and
+ <c>{active, false}</c> mode. However,
+ <em>when</em> peer closing is detected is all up to the
+ underlying TCP/IP stack and protocol.</p>
+ <p>Note that <c>{active,true}</c> mode provides no flow
+ control; a fast sender could easily overflow the
+ receiver with incoming messages. Use active mode only if
+ your high-level protocol provides its own flow control
+ (for instance, acknowledging received messages) or the
+ amount of data exchanged is small. <c>{active,false}</c>
+ mode or use of the <c>{active, once}</c> mode provides
+ flow control; the other side will not be able send
+ faster than the receiver can read.</p>
+ </item>
+ <tag><c>{broadcast, Boolean}</c>(UDP sockets)</tag>
+ <item>
+ <p>Enable/disable permission to send broadcasts.</p>
+ </item>
+ <tag><c>{delay_send, Boolean}</c></tag>
+ <item>
+ <p>Normally, when an Erlang process sends to a socket,
+ the driver will try to immediately send the data. If that
+ fails, the driver will use any means available to queue
+ up the message to be sent whenever the operating system
+ says it can handle it. Setting <c>{delay_send, true}</c>
+ will make <em>all</em> messages queue up. This makes
+ the messages actually sent onto the network be larger but
+ fewer. The option actually affects the scheduling of send
+ requests versus Erlang processes instead of changing any
+ real property of the socket. Needless to say it is an
+ implementation specific option. Default is <c>false</c>.</p>
+ </item>
+ <tag><c>{dontroute, Boolean}</c></tag>
+ <item>
+ <p>Enable/disable routing bypass for outgoing messages.</p>
+ </item>
+ <tag><c>{exit_on_close, Boolean}</c></tag>
+ <item>
+ <p>By default this option is set to <c>true</c>.</p>
+ <p>The only reason to set it to <c>false</c> is if you want
+ to continue sending data to the socket after a close has
+ been detected, for instance if the peer has used
+ <seealso marker="gen_tcp#shutdown/2">gen_tcp:shutdown/2</seealso>
+ to shutdown the write side.</p>
+ </item>
+ <tag><c>{header, Size}</c></tag>
+ <item>
+ <p>This option is only meaningful if the <c>binary</c>
+ option was specified when the socket was created. If
+ the <c>header</c> option is specified, the first
+ <c>Size</c> number bytes of data received from the socket
+ will be elements of a list, and the rest of the data will
+ be a binary given as the tail of the same list. If for
+ example <c>Size == 2</c>, the data received will match
+ <c>[Byte1,Byte2|Binary]</c>.</p>
+ </item>
+ <tag><c>{keepalive, Boolean}</c>(TCP/IP sockets)</tag>
+ <item>
+ <p>Enables/disables periodic transmission on a connected
+ socket, when no other data is being exchanged. If
+ the other end does not respond, the connection is
+ considered broken and an error message will be sent to
+ the controlling process. Default disabled.</p>
+ </item>
+ <tag><c>{nodelay, Boolean}</c>(TCP/IP sockets)</tag>
+ <item>
+ <p>If <c>Boolean == true</c>, the <c>TCP_NODELAY</c> option
+ is turned on for the socket, which means that even small
+ amounts of data will be sent immediately.</p>
+ </item>
+ <tag><c>{packet, PacketType}</c>(TCP/IP sockets)</tag>
+ <item>
+ <p>Defines the type of packets to use for a socket.
+ The following values are valid:</p>
+ <taglist>
+ <tag><c>raw | 0</c></tag>
+ <item>
+ <p>No packaging is done.</p>
+ </item>
+ <tag><c>1 | 2 | 4</c></tag>
+ <item>
+ <p>Packets consist of a header specifying the number of
+ bytes in the packet, followed by that number of bytes.
+ The length of header can be one, two, or four bytes;
+ containing an unsigned integer in big-endian byte order.
+ Each send operation will generate the header, and the header
+ will be stripped off on each receive operation.</p>
+ <p>In current implementation the 4-byte header is limited to 2Gb.</p>
+ </item>
+ <tag><c>asn1 | cdr | sunrm | fcgi | tpkt | line</c></tag>
+ <item>
+ <p>These packet types only have effect on receiving.
+ When sending a packet, it is the responsibility of
+ the application to supply a correct header. On
+ receiving, however, there will be one message sent to
+ the controlling process for each complete packet
+ received, and, similarly, each call to
+ <c>gen_tcp:recv/2,3</c> returns one complete packet.
+ The header is <em>not</em> stripped off.</p>
+ <p>The meanings of the packet types are as follows:
+ <br></br>
+<c>asn1</c> - ASN.1 BER,
+ <br></br>
+<c>sunrm</c> - Sun's RPC encoding,
+ <br></br>
+<c>cdr</c> - CORBA (GIOP 1.1),
+ <br></br>
+<c>fcgi</c> - Fast CGI,
+ <br></br>
+<c>tpkt</c> - TPKT format [RFC1006],
+ <br></br>
+<c>line</c> - Line mode, a packet is a line
+ terminated with newline, lines longer than
+ the receive buffer are truncated.</p>
+ </item>
+ <tag><c>http | http_bin</c></tag>
+ <item>
+ <p>The Hypertext Transfer Protocol. The packets
+ are returned with the format according to <c>HttpPacket</c>
+ described in <seealso marker="erts:erlang#decode_packet/3">
+ erlang:decode_packet/3</seealso>. A socket in passive
+ mode will return <c>{ok, HttpPacket}</c> from <c>gen_tcp:recv</c>
+ while an active socket will send messages like <c>{http,
+ Socket, HttpPacket}</c>.</p>
+ <p>Note that the packet type <c>httph</c> is not
+ needed when reading from a socket.</p>
+ </item>
+ </taglist>
+ </item>
+ <tag><c>{packet_size, Integer}</c>(TCP/IP sockets)</tag>
+ <item>
+ <p>Sets the max allowed length of the packet body. If
+ the packet header indicates that the length of the packet
+ is longer than the max allowed length, the packet is
+ considered invalid. The same happens if the packet header
+ is too big for the socket receive buffer.</p>
+ </item>
+ <tag><c>{read_packets, Integer}</c>(UDP sockets)</tag>
+ <item>
+ <p>Sets the max number of UDP packets to read without
+ intervention from the socket when data is available.
+ When this many packets have been read and delivered
+ to the destination process, new packets are not read
+ until a new notification of available data has arrived.
+ The default is 5, and if this parameter is set too
+ high the system can become unresponsive due to
+ UDP packet flooding.</p>
+ </item>
+ <tag><c>{recbuf, Integer}</c></tag>
+ <item>
+ <p>Gives the size of the receive buffer to use for
+ the socket.</p>
+ </item>
+ <tag><c>{reuseaddr, Boolean}</c></tag>
+ <item>
+ <p>Allows or disallows local reuse of port numbers. By
+ default, reuse is disallowed.</p>
+ </item>
+ <tag><c>{send_timeout, Integer}</c></tag>
+ <item>
+ <p>Only allowed for connection oriented sockets.</p>
+ <p>Specifies a longest time to wait for a send operation to
+ be accepted by the underlying TCP stack. When the limit is
+ exceeded, the send operation will return
+ <c>{error,timeout}</c>. How much of a packet that actually
+ got sent is unknown, why the socket should be closed
+ whenever a timeout has occurred (see <c>send_timeout_close</c>).
+ Default is <c>infinity</c>.</p>
+ </item>
+ <tag><c>{send_timeout_close, Boolean}</c></tag>
+ <item>
+ <p>Only allowed for connection oriented sockets.</p>
+ <p>Used together with <c>send_timeout</c> to specify whether
+ the socket will be automatically closed when the send operation
+ returns <c>{error,timeout}</c>. The recommended setting is
+ <c>true</c> which will automatically close the socket.
+ Default is <c>false</c> due to backward compatibility.</p>
+ </item>
+
+ <tag><c>{sndbuf, Integer}</c></tag>
+ <item>
+ <p>Gives the size of the send buffer to use for the socket.</p>
+ </item>
+ <tag><c>{priority, Integer}</c></tag>
+ <item>
+ <p>Sets the SO_PRIORITY socket level option on platforms where
+ this is implemented. The behaviour and allowed range varies on
+ different systems. The option is ignored on platforms where the
+ option is not implemented. Use with caution.</p>
+ </item>
+ <tag><c>{tos, Integer}</c></tag>
+ <item>
+ <p>Sets IP_TOS IP level options on platforms where this is
+ implemented. The behaviour and allowed range varies on different
+ systems. The option is ignored on platforms where the option is
+ not implemented. Use with caution.</p>
+ </item>
+ </taglist>
+ <p>In addition to the options mentioned above, <em>raw</em>
+ option specifications can be used. The raw options are
+ specified as a tuple of arity four, beginning with the tag
+ <c>raw</c>, followed by the protocol level, the option number
+ and the actual option value specified as a binary. This
+ corresponds to the second, third and fourth argument to the
+ <c>setsockopt</c> call in the C socket API. The option value
+ needs to be coded in the native endianess of the platform and,
+ if a structure is required, needs to follow the struct
+ alignment conventions on the specific platform.</p>
+ <p>Using raw socket options require detailed knowledge about
+ the current operating system and TCP stack.</p>
+ <p>As an example of the usage of raw options, consider a Linux
+ system where you want to set the <c>TCP_LINGER2</c> option on
+ the <c>IPPROTO_TCP</c> protocol level in the stack. You know
+ that on this particular system it defaults to 60 (seconds),
+ but you would like to lower it to 30 for a particular
+ socket. The <c>TCP_LINGER2</c> option is not explicitly
+ supported by inet, but you know that the protocol level
+ translates to the number 6, the option number to the number 8
+ and the value is to be given as a 32 bit integer. You can use
+ this line of code to set the option for the socket named
+ <c>Sock</c>:</p>
+ <code type="none"><![CDATA[
+ inet:setopts(Sock,[{raw,6,8,<<30:32/native>>}]),]]></code>
+ <p>As many options are silently discarded by the stack if they
+ are given out of range, it could be a good idea to check that
+ a raw option really got accepted. This code places the value
+ in the variable TcpLinger2:</p>
+ <code type="none"><![CDATA[
+ {ok,[{raw,6,8,<<TcpLinger2:32/native>>}]}=inet:getopts(Sock,[{raw,6,8,4}]),]]></code>
+ <p>Code such as the examples above is inherently non portable,
+ even different versions of the same OS on the same platform
+ may respond differently to this kind of option
+ manipulation. Use with care.</p>
+ <p>Note that the default options for TCP/IP sockets can be
+ changed with the Kernel configuration parameters mentioned in
+ the beginning of this document.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <marker id="error_codes"></marker>
+ <title>POSIX Error Codes</title>
+ <list type="bulleted">
+ <item><c>e2big</c> - argument list too long</item>
+ <item><c>eacces</c> - permission denied</item>
+ <item><c>eaddrinuse</c> - address already in use</item>
+ <item><c>eaddrnotavail</c> - cannot assign requested address</item>
+ <item><c>eadv</c> - advertise error</item>
+ <item><c>eafnosupport</c> - address family not supported by
+ protocol family</item>
+ <item><c>eagain</c> - resource temporarily unavailable</item>
+ <item><c>ealign</c> - EALIGN</item>
+ <item><c>ealready</c> - operation already in progress</item>
+ <item><c>ebade</c> - bad exchange descriptor</item>
+ <item><c>ebadf</c> - bad file number</item>
+ <item><c>ebadfd</c> - file descriptor in bad state</item>
+ <item><c>ebadmsg</c> - not a data message</item>
+ <item><c>ebadr</c> - bad request descriptor</item>
+ <item><c>ebadrpc</c> - RPC structure is bad</item>
+ <item><c>ebadrqc</c> - bad request code</item>
+ <item><c>ebadslt</c> - invalid slot</item>
+ <item><c>ebfont</c> - bad font file format</item>
+ <item><c>ebusy</c> - file busy</item>
+ <item><c>echild</c> - no children</item>
+ <item><c>echrng</c> - channel number out of range</item>
+ <item><c>ecomm</c> - communication error on send</item>
+ <item><c>econnaborted</c> - software caused connection abort</item>
+ <item><c>econnrefused</c> - connection refused</item>
+ <item><c>econnreset</c> - connection reset by peer</item>
+ <item><c>edeadlk</c> - resource deadlock avoided</item>
+ <item><c>edeadlock</c> - resource deadlock avoided</item>
+ <item><c>edestaddrreq</c> - destination address required</item>
+ <item><c>edirty</c> - mounting a dirty fs w/o force</item>
+ <item><c>edom</c> - math argument out of range</item>
+ <item><c>edotdot</c> - cross mount point</item>
+ <item><c>edquot</c> - disk quota exceeded</item>
+ <item><c>eduppkg</c> - duplicate package name</item>
+ <item><c>eexist</c> - file already exists</item>
+ <item><c>efault</c> - bad address in system call argument</item>
+ <item><c>efbig</c> - file too large</item>
+ <item><c>ehostdown</c> - host is down</item>
+ <item><c>ehostunreach</c> - host is unreachable</item>
+ <item><c>eidrm</c> - identifier removed</item>
+ <item><c>einit</c> - initialization error</item>
+ <item><c>einprogress</c> - operation now in progress</item>
+ <item><c>eintr</c> - interrupted system call</item>
+ <item><c>einval</c> - invalid argument</item>
+ <item><c>eio</c> - I/O error</item>
+ <item><c>eisconn</c> - socket is already connected</item>
+ <item><c>eisdir</c> - illegal operation on a directory</item>
+ <item><c>eisnam</c> - is a named file</item>
+ <item><c>el2hlt</c> - level 2 halted</item>
+ <item><c>el2nsync</c> - level 2 not synchronized</item>
+ <item><c>el3hlt</c> - level 3 halted</item>
+ <item><c>el3rst</c> - level 3 reset</item>
+ <item><c>elbin</c> - ELBIN</item>
+ <item><c>elibacc</c> - cannot access a needed shared library</item>
+ <item><c>elibbad</c> - accessing a corrupted shared library</item>
+ <item><c>elibexec</c> - cannot exec a shared library directly</item>
+ <item><c>elibmax</c> - attempting to link in more shared
+ libraries than system limit</item>
+ <item><c>elibscn</c> - .lib section in a.out corrupted</item>
+ <item><c>elnrng</c> - link number out of range</item>
+ <item><c>eloop</c> - too many levels of symbolic links</item>
+ <item><c>emfile</c> - too many open files</item>
+ <item><c>emlink</c> - too many links</item>
+ <item><c>emsgsize</c> - message too long</item>
+ <item><c>emultihop</c> - multihop attempted</item>
+ <item><c>enametoolong</c> - file name too long</item>
+ <item><c>enavail</c> - not available</item>
+ <item><c>enet</c> - ENET</item>
+ <item><c>enetdown</c> - network is down</item>
+ <item><c>enetreset</c> - network dropped connection on reset</item>
+ <item><c>enetunreach</c> - network is unreachable</item>
+ <item><c>enfile</c> - file table overflow</item>
+ <item><c>enoano</c> - anode table overflow</item>
+ <item><c>enobufs</c> - no buffer space available</item>
+ <item><c>enocsi</c> - no CSI structure available</item>
+ <item><c>enodata</c> - no data available</item>
+ <item><c>enodev</c> - no such device</item>
+ <item><c>enoent</c> - no such file or directory</item>
+ <item><c>enoexec</c> - exec format error</item>
+ <item><c>enolck</c> - no locks available</item>
+ <item><c>enolink</c> - link has be severed</item>
+ <item><c>enomem</c> - not enough memory</item>
+ <item><c>enomsg</c> - no message of desired type</item>
+ <item><c>enonet</c> - machine is not on the network</item>
+ <item><c>enopkg</c> - package not installed</item>
+ <item><c>enoprotoopt</c> - bad protocol option</item>
+ <item><c>enospc</c> - no space left on device</item>
+ <item><c>enosr</c> - out of stream resources or not a stream
+ device</item>
+ <item><c>enosym</c> - unresolved symbol name</item>
+ <item><c>enosys</c> - function not implemented</item>
+ <item><c>enotblk</c> - block device required</item>
+ <item><c>enotconn</c> - socket is not connected</item>
+ <item><c>enotdir</c> - not a directory</item>
+ <item><c>enotempty</c> - directory not empty</item>
+ <item><c>enotnam</c> - not a named file</item>
+ <item><c>enotsock</c> - socket operation on non-socket</item>
+ <item><c>enotsup</c> - operation not supported</item>
+ <item><c>enotty</c> - inappropriate device for ioctl</item>
+ <item><c>enotuniq</c> - name not unique on network</item>
+ <item><c>enxio</c> - no such device or address</item>
+ <item><c>eopnotsupp</c> - operation not supported on socket</item>
+ <item><c>eperm</c> - not owner</item>
+ <item><c>epfnosupport</c> - protocol family not supported</item>
+ <item><c>epipe</c> - broken pipe</item>
+ <item><c>eproclim</c> - too many processes</item>
+ <item><c>eprocunavail</c> - bad procedure for program</item>
+ <item><c>eprogmismatch</c> - program version wrong</item>
+ <item><c>eprogunavail</c> - RPC program not available</item>
+ <item><c>eproto</c> - protocol error</item>
+ <item><c>eprotonosupport</c> - protocol not supported</item>
+ <item><c>eprototype</c> - protocol wrong type for socket</item>
+ <item><c>erange</c> - math result unrepresentable</item>
+ <item><c>erefused</c> - EREFUSED</item>
+ <item><c>eremchg</c> - remote address changed</item>
+ <item><c>eremdev</c> - remote device</item>
+ <item><c>eremote</c> - pathname hit remote file system</item>
+ <item><c>eremoteio</c> - remote i/o error</item>
+ <item><c>eremoterelease</c> - EREMOTERELEASE</item>
+ <item><c>erofs</c> - read-only file system</item>
+ <item><c>erpcmismatch</c> - RPC version is wrong</item>
+ <item><c>erremote</c> - object is remote</item>
+ <item><c>eshutdown</c> - cannot send after socket shutdown</item>
+ <item><c>esocktnosupport</c> - socket type not supported</item>
+ <item><c>espipe</c> - invalid seek</item>
+ <item><c>esrch</c> - no such process</item>
+ <item><c>esrmnt</c> - srmount error</item>
+ <item><c>estale</c> - stale remote file handle</item>
+ <item><c>esuccess</c> - Error 0</item>
+ <item><c>etime</c> - timer expired</item>
+ <item><c>etimedout</c> - connection timed out</item>
+ <item><c>etoomanyrefs</c> - too many references</item>
+ <item><c>etxtbsy</c> - text file or pseudo-device busy</item>
+ <item><c>euclean</c> - structure needs cleaning</item>
+ <item><c>eunatch</c> - protocol driver not attached</item>
+ <item><c>eusers</c> - too many users</item>
+ <item><c>eversion</c> - version mismatch</item>
+ <item><c>ewouldblock</c> - operation would block</item>
+ <item><c>exdev</c> - cross-domain link</item>
+ <item><c>exfull</c> - message tables full</item>
+ <item><c>nxdomain</c> - the hostname or domain name could not be
+ found</item>
+ </list>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/inet_res.xml b/lib/kernel/doc/src/inet_res.xml
new file mode 100644
index 0000000000..d8fe23544b
--- /dev/null
+++ b/lib/kernel/doc/src/inet_res.xml
@@ -0,0 +1,482 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2009</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>inet_res</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>2009-09-11</date>
+ <rev>A</rev>
+ </header>
+ <module>inet_res</module>
+ <modulesummary>A Rudimentary DNS Client</modulesummary>
+ <description>
+ <p>Performs DNS name resolving towards recursive name servers</p>
+ <p>See also
+ <seealso marker="erts:inet_cfg">
+ ERTS User's Guide: Inet configuration
+ </seealso> for more
+ information on how to configure an Erlang runtime system for IP
+ communication and how to enable this DNS client by defining
+ <c><![CDATA['dns']]></c> as a lookup method. It then acts
+ as a backend for the resolving functions in
+ <seealso marker="kernel:inet">inet</seealso>.</p>
+ <p>This DNS client can resolve DNS records even if it
+ is not used for normal name resolving in the node.</p>
+ <p>This is not a full-fledged resolver. It is just a
+ DNS client that relies on asking trusted recursive nameservers.</p>
+ </description>
+
+ <section>
+ <title>Name Resolving</title>
+ <p>UDP queries are used unless resolver option
+ <c>usevc</c> is <c>true</c>, which forces TCP queries.
+ If the query is to large for UDP, TCP is used instead.
+ For regular DNS queries 512 bytes is the size limit.
+ When EDNS is enabled (resolver option
+ <c>edns</c> is set to the EDNS version i.e <c>0</c>
+ instead of <c>false</c>), resolver option
+ <c>udp_payload_size</c> sets the limit. If a nameserver
+ replies with the TC bit set (truncation), indicating
+ the answer is incomplete, the query is retried
+ to that nameserver using TCP. The resolver option
+ <c>udp_payload_size</c> also sets the advertised
+ size for the max allowed reply size, if EDNS is
+ enabled, otherwise the nameserver uses the limit
+ 512 byte. If the reply is larger it gets truncated,
+ forcing a TCP re-query.</p>
+ <p>For UDP queries, the resolver options <c>timeout</c>
+ and <c>retry</c> control retransmission.
+ Each nameserver in the <c>nameservers</c> list is
+ tried with a timeout of <c>timeout</c> / <c>retry</c>.
+ Then all nameservers are tried again doubling the
+ timeout, for a total of <c>retry</c> times.</p>
+ <p>For queries that not use the <c>search</c> list,
+ if the query to all <c>nameservers</c> results in
+ <c>{error,nxdomain}</c>or an empty answer, the same
+ query is tried for the <c>alt_nameservers</c>.</p>
+ </section>
+
+
+
+
+ <section>
+ <title>DATA TYPES</title>
+ <p>As defined in the module
+ <seealso marker="kernel:inet">inet</seealso>:</p>
+ <code type="none">
+hostent() = #hostent{}
+posix() = some atom()s
+ip_address() = tuple of integers of arity 4 or 8</code>
+
+ <p>Resolver types:</p>
+ <code type="none">These correspond to resolver options:
+
+res_option() =
+ [ {alt_nameservers, [ nameserver() ]}
+ | {edns, 0 | false} % Use EDNS
+ | {inet6, bool()} % Return IPv6 addresses
+ | {nameservers, [ nameserver() ]} % List of nameservers
+ | {recurse, bool()} % Request server recursion
+ | {retry, integer()} % UDP retries
+ | {timeout, integer()} % UDP query timeout
+ | {udp_payload_size, integer()} % EDNS payload size
+ | {usevc, bool()} ] % Use TCP (Virtual Circuit)
+
+nameserver() = {ip_address(),Port}
+ Port = integer(1..65535)
+
+res_error() =
+ formerr |
+ qfmterror |
+ servfail |
+ nxdomain |
+ notimp |
+ refused |
+ badvers |
+ timeout
+</code>
+
+ <p>DNS types:</p>
+ <marker id="dns_types"/>
+ <code type="none">dns_name() = string() with no adjacent dots
+
+rr_type() = a | aaaa | cname | gid | hinfo | ns | mb | md | mg | mf
+ | minfo | mx | naptr | null | ptr | soa | spf | srv | txt
+ | uid | uinfo | unspec | wks
+
+query_type() = axfr | mailb | maila | any | rr_type()
+
+dns_class() = in | chaos | hs | any
+
+dns_msg() = DnsMsg
+ This is the start of a hiearchy of opaque data structures
+ that can be examined with access functions in inet_dns
+ that return lists of {Field,Value} tuples. The arity 2
+ functions just return the value for a given field.
+
+ inet_dns:msg(DnsMsg) ->
+ [ {header, dns_header()}
+ | {qdlist, dns_query()}
+ | {anlist, dns_rr()}
+ | {nslist, dns_rr()}
+ | {arlist, dns_rr()} ]
+ inet_dns:msg(DnsMsg, header) -> dns_header() % for example
+ inet_dns:msg(DnsMsg, Field) -> Value
+
+dhs_header() = DnsHeader
+ inet_dns:header(DnsHeader) ->
+ [ {id, integer()}
+ | {qr, bool()}
+ | {opcode, 'query' | iquery | status | integer()}
+ | {aa, bool()}
+ | {tc, bool()}
+ | {rd, bool()}
+ | {ra, bool()}
+ | {pr, bool()}
+ | {rcode, integer(0..16)} ]
+ inet_dns:header(DnsHeader, Field) -> Value
+
+dns_query() = DnsQuery
+ inet_dns:dns_query(DnsQuery) ->
+ [ {domain, dns_name()}
+ | {type, query_type()}
+ | {class, dns_class()} ]
+ inet_dns:dns_query(DnsQuery, Field) -> Value
+
+dns_rr() = DnsRr
+ inet_dns:rr(DnsRr) -> DnsRrFields | DnsRrOptFields
+ DnsRrFields = [ {domain, dns_name()}
+ | {type, rr_type()}
+ | {class, dns_class()}
+ | {ttl, integer()}
+ | {data, dns_data()} ]
+ DnsRrOptFields = [ {domain, dns_name()}
+ | {type, opt}
+ | {udp_payload_size, integer()}
+ | {ext_rcode, integer()}
+ | {version, integer()}
+ | {z, integer()}
+ | {data, dns_data()} ]
+ inet_dns:rr(DnsRr, Field) -> Value
+
+dns_data() = % for dns_type()
+ [ dns_name() % ns, md, mf, cname, mb, mg, mr, ptr
+ | ip_address(v4) % a
+ | ip_address(v6) % aaaa
+ | {MName,RName,Serial,Refresh,Retry,Expiry,Minimum} % soa
+ | {ip_address(v4),Proto,BitMap} % wks
+ | {CpuString,OsString} % hinfo
+ | {RM,EM} % minfo
+ | {Prio,dns_name()} % mx
+ | {Prio,Weight,Port,dns_name()} % srv
+ | {Order,Preference,Flags,Services,Regexp,dns_name()} % naptr
+ | [ string() ] % txt, spf
+ | binary() ] % null, integer()
+MName, RName = dns_name()
+Serial, Refresh, Retry, Expiry, Minimum = integer(),
+Proto = integer()
+BitMap = binary()
+CpuString, OsString = string()
+RM = EM = dns_name()
+Prio, Weight, Port = integer()
+Order, Preference = integer()
+Flags, Services = string(),
+Regexp = string(utf8)
+
+
+
+There is an info function for the types above:
+
+inet_dns:record_type(dns_msg()) -> msg;
+inet_dns:record_type(dns_header()) -> header;
+inet_dns:record_type(dns_query()) -> dns_query;
+inet_dns:record_type(dns_rr()) -> rr;
+inet_dns:record_type(_) -> undefined.
+
+So; inet_dns:(inet_dns:record_type(X))(X) will convert
+any of these data structures into a {Field,Value} list.</code>
+ </section>
+
+
+
+ <funcs>
+
+ <func>
+ <name>getbyname(Name, Type) -> {ok,hostent()} | {error,Reason}</name>
+ <name>getbyname(Name, Type, Timeout) ->
+ {ok,hostent()} | {error,Reason}
+ </name>
+ <fsummary>Resolve a DNS record of the given type for the given host
+ </fsummary>
+ <type>
+ <v>Name = dns_name()</v>
+ <v>Type = rr_type()</v>
+ <v>Timeout = integer() >= 0 | infinity</v>
+ <v>Reason = posix() | res_error()</v>
+ </type>
+ <desc>
+ <p>Resolve a DNS record of the given type for the given host,
+ of class <c>in</c>. On success returns a <c>hostent()</c> record with
+ <c>dns_data()</c> elements in the address list field.
+ </p><p>
+ This function uses the resolver option <c>search</c> that
+ is a list of domain names. If the name to resolve contains
+ no dots, it is prepended to each domain name in the
+ search list, and they are tried in order. If the name
+ contains dots, it is first tried as an absolute name
+ and if that fails the search list is used. If the name
+ has a trailing dot it is simply supposed to be
+ an absolute name and the search list is not used.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>gethostbyaddr(Address) -> {ok,hostent()} | {error,Reason}</name>
+ <name>gethostbyaddr(Address, Timeout) ->
+ {ok,hostent()} | {error,Reason}
+ </name>
+ <fsummary>Return a hostent record for the host with the given address
+ </fsummary>
+ <type>
+ <v>Address = ip_address()</v>
+ <v>Timeout = integer() >= 0 | infinity</v>
+ <v>Reason = posix() | res_error()</v>
+ </type>
+ <desc>
+ <p>Backend functions used by
+ <seealso marker="kernel:inet#gethostbyaddr/1">
+ inet:gethostbyaddr/1
+ </seealso>.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>gethostbyname(Name) -> {ok,hostent()} | Reason}</name>
+ <name>gethostbyname(Name, Family) ->
+ {ok,hostent()} | {error,Reason}}
+ </name>
+ <name>gethostbyname(Name, Family, Timeout) ->
+ {ok,hostent()} | {error,Reason}
+ </name>
+ <fsummary>Return a hostent record for the host with the given name
+ </fsummary>
+ <type>
+ <v>Name = dns_name()</v>
+ <v>Timeout = integer() >= 0 | infinity</v>
+ <v>Reason = posix() | res_error()</v>
+ </type>
+ <desc>
+ <p>Backend functions used by
+ <seealso marker="kernel:inet#gethostbyname/1">
+ inet:gethostbyname/1,2
+ </seealso>.
+ </p><p>
+ This function uses the resolver option <c>search</c> just like
+ <seealso marker="#getbyname/2">getbyname/2,3</seealso>.
+ </p><p>
+ If the resolver option <c>inet6</c> is <c>true</c>,
+ an IPv6 address is looked up, and if that fails
+ the IPv4 address is looked up and returned on
+ IPv6 mapped IPv4 format.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>lookup(Name, Class, Type) -> [ dns_data() ]
+ </name>
+ <name>lookup(Name, Class, Type, Opts) -> [ dns_data() ]
+ </name>
+ <name>lookup(Name, Class, Type, Opts, Timeout) -> [ dns_data() ]
+ </name>
+ <fsummary>Resolve the DNS data for the record of the given type and class
+ for the given name
+ </fsummary>
+ <type>
+ <v>Name = dns_name() | ip_address()</v>
+ <v>Type = rr_type()</v>
+ <v>Opts = res_option() | verbose</v>
+ <v>Timeout = integer() >= 0 | infinity</v>
+ <v>Reason = posix() | res_error()</v>
+ </type>
+ <desc>
+ <p>Resolve the DNS data for the record of the given type and class
+ for the given name. On success filters out the answer records
+ with the correct <c>Class</c> and <c>Type</c> and returns
+ a list of their data fields. So a lookup for type <c>any</c>
+ will give an empty answer since the answer records have
+ specific types that are not <c>any</c>. An empty answer
+ as well as a failed lookup returns an empty list.
+ </p><p>
+ Calls <seealso marker="#resolve/3">resolve/2..4</seealso>
+ with the same arguments and filters the result, so
+ <c>Opts</c> is explained there.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>resolve(Name, Class, Type) -> {ok,dns_msg()} | Error
+ </name>
+ <name>resolve(Name, Class, Type, Opts) -> {ok,dns_msg()} | Error
+ </name>
+ <name>resolve(Name, Class, Type, Opts, Timeout) -> {ok,dns_msg()} | Error
+ </name>
+ <fsummary>Resolve a DNS record of the given type and class
+ for the given name
+ </fsummary>
+ <type>
+ <v>Name = dns_name() | ip_address()</v>
+ <v>Type = rr_type()</v>
+ <v>Opts = res_option() | verbose | atom()</v>
+ <v>Timeout = integer() >= 0 | infinity</v>
+ <v>Error = {error,Reason} | {error,{Reason,dns_msg()}}</v>
+ <v>Reason = posix() | res_error()</v>
+ </type>
+ <desc>
+ <p>Resolve a DNS record of the given type and class for the given name.
+ The returned <c>dns_msg()</c> can be examined using
+ access functions in <c>inet_db</c> as described
+ in <seealso marker="#dns_types">DNS types</seealso>.
+ </p><p>
+ If <c>Name</c> is an <c>ip_address()</c>, the domain name
+ to query for is generated as the standard reverse
+ ".IN-ADDR.ARPA." name for an IPv4 address, or the
+ ".IP6.ARPA." name for an IPv6 address.
+ In this case you most probably want to use
+ <c>Class = in</c> and <c>Type = ptr</c> but it
+ is not done automatically.
+ </p><p>
+ <c>Opts</c> override the corresponding resolver options.
+ If the option <c>nameservers</c> is given, it is
+ also assumed that it is the complete list of nameserves,
+ so the resolver option <c>alt_nameserves</c> is ignored.
+ Of course, if that option is also given to this function,
+ it is used.
+ </p><p>
+ The <c>verbose</c> option (or rather <c>{verbose,true}</c>),
+ causes diagnostics printout through
+ <seealso marker="stdlib:io#format/3">io:format/2</seealso>
+ of queries, replies retransmissions, etc, similar
+ to from utilities like <c>dig</c>, <c>nslookup</c> et.al.
+ </p><p>
+ If <c>Opt</c> is an arbitrary atom it is interpreted
+ as <c>{Opt,true}</c> unless the atom string starts with
+ <c>"no"</c> making the interpretation <c>{Opt,false}</c>.
+ For example: <c>usevc</c> is an alias for <c>{usevc,true}</c>,
+ and <c>nousevc</c> an alias for <c>{usevc,false}</c>.
+ </p><p>
+ The <c>inet6</c> option currently has no effect on this function.
+ You probably want to use <c>Type = a | aaaa</c> instead.
+ </p>
+ </desc>
+ </func>
+
+ </funcs>
+
+
+
+ <section>
+ <title>Examples</title>
+ <p>Access functions example: how
+ <seealso marker="#lookup/3">lookup/3</seealso>
+ could have been implemented using
+ <seealso marker="#resolve/3">resolve/3</seealso>
+ from outside the module.
+ </p><code type="none">
+ example_lookup(Name, Class, Type) ->
+ case inet_res:resolve(Name, Class, Type) of
+ {ok,Msg} ->
+ [inet_dns:rr(RR, data)
+ || RR &lt;- inet_dns:msg(Msg, anlist),
+ inet_dns:rr(RR, type) =:= Type,
+ inet_dns:rr(RR, class) =:= Class];
+ {error,_} ->
+ []
+ end.</code>
+ </section>
+
+
+
+ <section>
+ <title>Legacy Functions</title>
+ <p>These have been deprecated due to the annoying double
+ meaning of the nameservers/timeout argument, and
+ because they had no decent place for a resolver options list.</p>
+ </section>
+
+ <funcs>
+
+ <func>
+ <name>nslookup(Name, Class, Type) -> {ok,dns_msg()} | {error,Reason}
+ </name>
+ <name>nslookup(Name, Class, Type, Timeout) ->
+ {ok,dns_msg()} | {error,Reason}
+ </name>
+ <name>nslookup(Name, Class, Type, Nameservers) ->
+ {ok,dns_msg()} | {error,Reason}
+ </name>
+ <fsummary>Resolve a DNS record of the given type and class
+ for the given name
+ </fsummary>
+ <type>
+ <v>Name = dns_name() | ip_address()</v>
+ <v>Type = rr_type()</v>
+ <v>Nameservers = [ nameserver() ]</v>
+ <v>Timeout = integer() >= 0 | infinity</v>
+ <v>Reason = posix() | res_error()</v>
+ </type>
+ <desc>
+ <p>Resolve a DNS record of the given type and class for the given name.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>nnslookup(Name, Class, Type, Nameservers) ->
+ {ok,dns_msg()} | {error,posix()}
+ </name>
+ <name>nnslookup(Name, Class, Type, Nameservers, Timeout) ->
+ {ok,dns_msg()} | {error,posix()}
+ </name>
+ <fsummary>Resolve a DNS record of the given type and class
+ for the given name
+ </fsummary>
+ <type>
+ <v>Name = dns_name() | ip_address()</v>
+ <v>Type = rr_type()</v>
+ <v>Nameservers = [ nameserver() ]</v>
+ <v>Timeout = integer() >= 0 | infinity</v>
+ <v>Reason = posix() | res_error()</v>
+ </type>
+ <desc>
+ <p>Resolve a DNS record of the given type and class for the given name.
+ </p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
diff --git a/lib/kernel/doc/src/init_stub.xml b/lib/kernel/doc/src/init_stub.xml
new file mode 100644
index 0000000000..e8645458e4
--- /dev/null
+++ b/lib/kernel/doc/src/init_stub.xml
@@ -0,0 +1,42 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year>
+ <year>2009</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>init</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>2008-12-16</date>
+ <rev>A</rev>
+ </header>
+ <module>init</module>
+ <modulesummary>Coordination of System Startup</modulesummary>
+ <description><p>
+
+ The module init is moved to the runtime system
+ application. Please see <seealso
+ marker="erts:init">init(3)</seealso> in the
+ erts reference manual instead.
+
+ </p></description>
+</erlref>
diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
new file mode 100644
index 0000000000..bf513b7815
--- /dev/null
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -0,0 +1,348 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE appref SYSTEM "appref.dtd">
+
+<appref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>kernel</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <app>kernel</app>
+ <appsummary>The Kernel Application</appsummary>
+ <description>
+ <p>The Kernel application is the first application started. It is
+ mandatory in the sense that the minimal system based on
+ Erlang/OTP consists of Kernel and STDLIB. The Kernel application
+ contains the following services:</p>
+ <list type="bulleted">
+ <item>application controller, see <c>application(3)</c></item>
+ <item><c>code</c></item>
+ <item><c>disk_log</c></item>
+ <item><c>dist_ac</c>, distributed application controller</item>
+ <item><c>erl_boot_server</c></item>
+ <item><c>erl_ddll</c></item>
+ <item><c>error_logger</c></item>
+ <item><c>file</c></item>
+ <item><c>global</c></item>
+ <item><c>global_group</c></item>
+ <item><c>heart</c></item>
+ <item><c>inet</c></item>
+ <item><c>net_kernel</c></item>
+ <item><c>os</c></item>
+ <item><c>pg2</c></item>
+ <item><c>rpc</c></item>
+ <item><c>seq_trace</c></item>
+ <item><c>user</c></item>
+ </list>
+ </description>
+
+ <section>
+ <title>Error Logger Event Handlers</title>
+ <p>Two standard error logger event handlers are defined in
+ the Kernel application. These are described in
+ <seealso marker="error_logger">error_logger(3)</seealso>.</p>
+ </section>
+
+ <section>
+ <title>Configuration</title>
+ <p>The following configuration parameters are defined for the Kernel
+ application. See <c>app(3)</c> for more information about
+ configuration parameters.</p>
+ <taglist>
+ <tag><c>browser_cmd = string() | {M,F,A}</c></tag>
+ <item>
+ <p>When pressing the Help button in a tool such as Debugger or
+ TV, the help text (an HTML file <c>File</c>) is by default
+ displayed in a Netscape browser which is required to be up and
+ running. This parameter can be used to change the command for
+ how to display the help text if another browser than Netscape
+ is preferred, or another platform than Unix or Windows is
+ used.</p>
+ <p>If set to a string <c>Command</c>, the command
+ <c>"Command File"</c> will be evaluated using <c>os:cmd/1</c>.</p>
+ <p>If set to a module-function-args tuple <c>{M,F,A}</c>,
+ the call <c>apply(M,F,[File|A])</c> will be evaluated.</p>
+ </item>
+ <tag><c>distributed = [Distrib]</c></tag>
+ <item>
+ <p>Specifies which applications are distributed and on which
+ nodes they may execute. In this parameter:</p>
+ <list type="bulleted">
+ <item><c>Distrib = {App,Nodes} | {App,Time,Nodes}</c></item>
+ <item><c>App = atom()</c></item>
+ <item><c>Time = integer()>0</c></item>
+ <item><c>Nodes = [node() | {node(),...,node()}]</c></item>
+ </list>
+ <p>The parameter is described in <c>application(3)</c>, function
+ <c>load/2</c>.</p>
+ </item>
+ <tag><c>dist_auto_connect = Value</c></tag>
+ <item>
+ <p>Specifies when nodes will be automatically connected. If
+ this parameter is not specified, a node is always
+ automatically connected, e.g when a message is to be sent to
+ that node. <c>Value</c> is one of:</p>
+ <taglist>
+ <tag><c>never</c></tag>
+ <item>Connections are never automatically connected, they
+ must be explicitly connected. See <c>net_kernel(3)</c>.</item>
+ <tag><c>once</c></tag>
+ <item>Connections will be established automatically, but only
+ once per node. If a node goes down, it must thereafter be
+ explicitly connected. See <c>net_kernel(3)</c>.</item>
+ </taglist>
+ </item>
+ <tag><c>permissions = [Perm]</c></tag>
+ <item>
+ <p>Specifies the default permission for applications when they
+ are started. In this parameter:</p>
+ <list type="bulleted">
+ <item><c>Perm = {ApplName,Bool}</c></item>
+ <item><c>ApplName = atom()</c></item>
+ <item><c>Bool = boolean()</c></item>
+ </list>
+ <p>Permissions are described in <c>application(3)</c>, function
+ <c>permit/2</c>.</p>
+ </item>
+ <tag><c>error_logger = Value</c></tag>
+ <item>
+ <p><c>Value</c> is one of:</p>
+ <taglist>
+ <tag><c>tty</c></tag>
+ <item>Installs the standard event handler which prints error
+ reports to <c>stdio</c>. This is the default option.</item>
+ <tag><c>{file, FileName}</c></tag>
+ <item>Installs the standard event handler which prints error
+ reports to the file <c>FileName</c>, where <c>FileName</c>
+ is a string.</item>
+ <tag><c>false</c></tag>
+ <item>
+ <p>No standard event handler is installed, but
+ the initial, primitive event handler is kept, printing
+ raw event messages to tty.</p>
+ </item>
+ <tag><c>silent</c></tag>
+ <item>
+ <p>Error logging is turned off.</p>
+ </item>
+ </taglist>
+ </item>
+ <tag><c>global_groups = [GroupTuple]</c></tag>
+ <item>
+ <p>Defines global groups, see <c>global_group(3)</c>.</p>
+ <list type="bulleted">
+ <item><c>GroupTuple = {GroupName, [Node]} | {GroupName, PublishType, [Node]}</c></item>
+ <item><c>GroupName = atom()</c></item>
+ <item><c>PublishType = normal | hidden</c></item>
+ <item><c>Node = node()</c></item>
+ </list>
+ </item>
+ <tag><c>inet_default_connect_options = [{Opt, Val}]</c></tag>
+ <item>
+ <p>Specifies default options for <c>connect</c> sockets,
+ see <c>inet(3)</c>.</p>
+ </item>
+ <tag><c>inet_default_listen_options = [{Opt, Val}]</c></tag>
+ <item>
+ <p>Specifies default options for <c>listen</c> (and
+ <c>accept</c>) sockets, see <c>inet(3)</c>.</p>
+ </item>
+ <tag><c>{inet_dist_use_interface, ip_address()}</c></tag>
+ <item>
+ <p>If the host of an Erlang node has several network interfaces,
+ this parameter specifies which one to listen on. See
+ <c>inet(3)</c> for the type definition of <c>ip_address()</c>.</p>
+ </item>
+ <tag><c>{inet_dist_listen_min, First}</c></tag>
+ <item>
+ <p>See below.</p>
+ </item>
+ <tag><c>{inet_dist_listen_max, Last}</c></tag>
+ <item>
+ <p>Define the <c>First..Last</c> port range for the listener
+ socket of a distributed Erlang node.</p>
+ </item>
+ <tag><c>inet_parse_error_log = silent</c></tag>
+ <item>
+ <p>If this configuration parameter is set, no
+ <c>error_logger</c> messages are generated when erroneous
+ lines are found and skipped in the various Inet configuration
+ files.</p>
+ </item>
+ <tag><c>inetrc = Filename</c></tag>
+ <item>
+ <p>The name (string) of an Inet user configuration file. See
+ ERTS User's Guide, Inet configuration.</p>
+ </item>
+ <tag><c>net_setuptime = SetupTime</c></tag>
+ <item>
+ <marker id="net_setuptime"></marker>
+ <p><c>SetupTime</c> must be a positive integer or floating point
+ number, and will be interpreted as the maximally allowed time
+ for each network operation during connection setup to another
+ Erlang node. The maximum allowed value is 120; if higher values
+ are given, 120 will be used. The default value if the variable
+ is not given, or if the value is incorrect (e.g. not a number),
+ is 7 seconds.</p>
+ <p>Note that this value does not limit the total connection
+ setup time, but rather each individual network operation during
+ the connection setup and handshake.</p>
+ </item>
+ <tag><c>net_ticktime = TickTime</c></tag>
+ <item>
+ <marker id="net_ticktime"></marker>
+ <p>Specifies the <c>net_kernel</c> tick time. <c>TickTime</c>
+ is given in seconds. Once every <c>TickTime/4</c> second, all
+ connected nodes are ticked (if anything else has been written
+ to a node) and if nothing has been received from another node
+ within the last four (4) tick times that node is considered
+ to be down. This ensures that nodes which are not responding,
+ for reasons such as hardware errors, are considered to be
+ down.</p>
+ <p>The time <c>T</c>, in which a node that is not responding is
+ detected, is calculated as: <c><![CDATA[MinT < T < MaxT]]></c> where:</p>
+ <code type="none">
+MinT = TickTime - TickTime / 4
+MaxT = TickTime + TickTime / 4</code>
+ <p><c>TickTime</c> is by default 60 (seconds). Thus,
+ <c><![CDATA[45 < T < 75]]></c> seconds.</p>
+ <p><em>Note:</em> All communicating nodes should have the same
+ <c>TickTime</c> value specified.</p>
+ <p><em>Note:</em> Normally, a terminating node is detected
+ immediately.</p>
+ </item>
+ <tag><c>sync_nodes_mandatory = [NodeName]</c></tag>
+ <item>
+ <p>Specifies which other nodes <em>must</em> be alive in order
+ for this node to start properly. If some node in the list
+ does not start within the specified time, this node will not
+ start either. If this parameter is undefined, it defaults to
+ [].</p>
+ </item>
+ <tag><c>sync_nodes_optional = [NodeName]</c></tag>
+ <item>
+ <p>Specifies which other nodes <em>can</em> be alive in order
+ for this node to start properly. If some node in this list
+ does not start within the specified time, this node starts
+ anyway. If this parameter is undefined, it defaults to
+ the empty list.</p>
+ </item>
+ <tag><c>sync_nodes_timeout = integer() | infinity</c></tag>
+ <item>
+ <p>Specifies the amount of time (in milliseconds) this node
+ will wait for the mandatory and optional nodes to start. If
+ this parameter is undefined, no node synchronization is
+ performed. This option also makes sure that <c>global</c> is
+ synchronized.</p>
+ </item>
+ <tag><c>start_dist_ac = true | false</c></tag>
+ <item>
+ <p>Starts the <c>dist_ac</c> server if the parameter is
+ <c>true</c>. This parameter should be set to <c>true</c> for
+ systems that use distributed applications.</p>
+ <p>The default value is <c>false</c>. If this parameter is
+ undefined, the server is started if the parameter
+ <c>distributed</c> is set.</p>
+ </item>
+ <tag><c>start_boot_server = true | false</c></tag>
+ <item>
+ <p>Starts the <c>boot_server</c> if the parameter is <c>true</c>
+ (see <c>erl_boot_server(3)</c>). This parameter should be
+ set to <c>true</c> in an embedded system which uses this
+ service.</p>
+ <p>The default value is <c>false</c>.</p>
+ </item>
+ <tag><c>boot_server_slaves = [SlaveIP]</c></tag>
+ <item>
+ <p>If the <c>start_boot_server</c> configuration parameter is
+ <c>true</c>, this parameter can be used to initialize
+ <c>boot_server</c> with a list of slave IP addresses.
+ <c>SlaveIP = string() | atom | {integer(),integer(),integer(),integer()}</c></p>
+ <p>where <c><![CDATA[0 <= integer() <=255]]></c>.</p>
+ <p>Examples of <c>SlaveIP</c> in atom, string and tuple form
+ are: <br></br>
+<c>'150.236.16.70', "150,236,16,70", {150,236,16,70}</c>.</p>
+ <p>The default value is <c>[]</c>.</p>
+ </item>
+ <tag><c>start_disk_log = true | false</c></tag>
+ <item>
+ <p>Starts the <c>disk_log_server</c> if the parameter is
+ <c>true</c> (see <c>disk_log(3)</c>). This parameter should be
+ set to true in an embedded system which uses this service.</p>
+ <p>The default value is <c>false</c>.</p>
+ </item>
+ <tag><c>start_pg2 = true | false</c></tag>
+ <item>
+ <p>Starts the <c>pg2</c> server (see <c>pg2(3)</c>) if
+ the parameter is <c>true</c>. This parameter should be set to
+ <c>true</c> in an embedded system which uses this service.</p>
+ <p>The default value is <c>false</c>.</p>
+ </item>
+ <tag><c>start_timer = true | false</c></tag>
+ <item>
+ <p>Starts the <c>timer_server</c> if the parameter is
+ <c>true</c> (see <c>timer(3)</c>). This parameter should be
+ set to <c>true</c> in an embedded system which uses this
+ service.</p>
+ <p>The default value is <c>false</c>.</p>
+ </item>
+ <tag><c>shutdown_func = {Mod, Func}</c></tag>
+ <item>
+ <p>Where:</p>
+ <list type="bulleted">
+ <item><c>Mod = atom()</c></item>
+ <item><c>Func = atom()</c></item>
+ </list>
+ <p>Sets a function that <c>application_controller</c> calls
+ when it starts to terminate. The function is called as:
+ <c>Mod:Func(Reason)</c>, where <c>Reason</c> is the terminate
+ reason for <c>application_controller</c>, and it must
+ return as soon as possible for <c>application_controller</c>
+ to terminate properly.</p>
+ </item>
+ </taglist>
+ </section>
+
+ <section>
+ <title>See Also</title>
+ <p><seealso marker="app">app(4)</seealso>,
+ <seealso marker="application">application(3)</seealso>,
+ <seealso marker="code">code(3)</seealso>,
+ <seealso marker="disk_log">disk_log(3)</seealso>,
+ <seealso marker="erl_boot_server">erl_boot_server(3)</seealso>,
+ <seealso marker="erl_ddll">erl_ddll(3)</seealso>,
+ <seealso marker="error_logger">error_logger(3)</seealso>,
+ <seealso marker="file">file(3)</seealso>,
+ <seealso marker="global">global(3)</seealso>,
+ <seealso marker="global_group">global_group(3)</seealso>,
+ <seealso marker="heart">heart(3)</seealso>,
+ <seealso marker="inet">inet(3)</seealso>,
+ <seealso marker="net_kernel">net_kernel(3)</seealso>,
+ <seealso marker="os">os(3)</seealso>,
+ <seealso marker="pg2">pg2(3)</seealso>,
+ <seealso marker="rpc">rpc(3)</seealso>,
+ <seealso marker="seq_trace">seq_trace(3)</seealso>,
+ <seealso marker="user">user(3)</seealso></p>
+ </section>
+</appref>
+
diff --git a/lib/kernel/doc/src/make.dep b/lib/kernel/doc/src/make.dep
new file mode 100644
index 0000000000..f79d1c6367
--- /dev/null
+++ b/lib/kernel/doc/src/make.dep
@@ -0,0 +1,28 @@
+# ----------------------------------------------------
+# >>>> Do not edit this file <<<<
+# This file was automaticly generated by
+# /home/otp/bin/docdepend
+# ----------------------------------------------------
+
+
+# ----------------------------------------------------
+# TeX files that the DVI file depend on
+# ----------------------------------------------------
+
+book.dvi: app.tex application.tex auth.tex book.tex \
+ code.tex config.tex disk_log.tex erl_boot_server.tex \
+ erl_ddll.tex erl_prim_loader_stub.tex erlang_stub.tex \
+ error_handler.tex error_logger.tex file.tex \
+ gen_sctp.tex gen_tcp.tex gen_udp.tex global.tex \
+ global_group.tex heart.tex inet.tex inet_res.tex \
+ init_stub.tex kernel_app.tex net_adm.tex net_kernel.tex \
+ os.tex packages.tex pg2.tex ref_man.tex rpc.tex \
+ seq_trace.tex user.tex wrap_log_reader.tex \
+ zlib_stub.tex
+
+# ----------------------------------------------------
+# Source inlined when transforming from source to LaTeX
+# ----------------------------------------------------
+
+book.tex: ref_man.xml
+
diff --git a/lib/kernel/doc/src/net_adm.xml b/lib/kernel/doc/src/net_adm.xml
new file mode 100644
index 0000000000..7ec4f7f0e7
--- /dev/null
+++ b/lib/kernel/doc/src/net_adm.xml
@@ -0,0 +1,166 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>net_adm</title>
+ <prepared>Claes Wikstrom</prepared>
+ <docno>1</docno>
+ <date>96-09-10</date>
+ <rev>A</rev>
+ </header>
+ <module>net_adm</module>
+ <modulesummary>Various Erlang Net Administration Routines</modulesummary>
+ <description>
+ <p>This module contains various network utility functions.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>dns_hostname(Host) -> {ok, Name} | {error, Host}</name>
+ <fsummary>Official name of a host</fsummary>
+ <type>
+ <v>Host = atom() | string()</v>
+ <v>Name = string()</v>
+ </type>
+ <desc>
+ <p>Returns the official name of <c>Host</c>, or
+ <c>{error, Host}</c> if no such name is found. See also
+ <c>inet(3)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>host_file() -> Hosts | {error, Reason}</name>
+ <fsummary>Read the <c>.hosts.erlang</c>file</fsummary>
+ <type>
+ <v>Hosts = [Host]</v>
+ <v>&nbsp;Host = atom()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Reads the <c>.hosts.erlang</c> file, see the section
+ <em>Files</em> below. Returns the hosts in this file as a
+ list, or returns <c>{error, Reason}</c> if the file could not
+ be read. See <c>file(3)</c> for possible values of
+ <c>Reason</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>localhost() -> Name</name>
+ <fsummary>Name of the local host</fsummary>
+ <type>
+ <v>Name = string()</v>
+ </type>
+ <desc>
+ <p>Returns the name of the local host. If Erlang was started
+ with the <c>-name</c> command line flag, <c>Name</c> is
+ the fully qualified name.</p>
+ </desc>
+ </func>
+ <func>
+ <name>names() -> {ok, [{Name, Port}]} | {error, Reason}</name>
+ <name>names(Host) -> {ok, [{Name, Port}]} | {error, Reason}</name>
+ <fsummary>Names of Erlang nodes at a host</fsummary>
+ <type>
+ <v>Name = string()</v>
+ <v>Port = int()</v>
+ <v>Reason = address | term()</v>
+ </type>
+ <desc>
+ <p>Similar to <c>epmd -names</c>, see <c>epmd(1)</c>.
+ <c>Host</c> defaults to the local host. Returns the names and
+ associated port numbers of the Erlang nodes that <c>epmd</c>
+ at the specified host has registered.</p>
+ <p>Returns <c>{error, address}</c> if <c>epmd</c> is not
+ running. See <c>inet(3)</c> for other possible values of
+ <c>Reason</c>.</p>
+ <pre>
+(arne@dunn)1> <input>net_adm:names().</input>
+{ok,[{"arne",40262}]}</pre>
+ </desc>
+ </func>
+ <func>
+ <name>ping(Node) -> pong | pang</name>
+ <fsummary>Set up a connection to a node</fsummary>
+ <type>
+ <v>Node = node()</v>
+ </type>
+ <desc>
+ <p>Tries to set up a connection to <c>Node</c>. Returns
+ <c>pang</c> if it fails, or <c>pong</c> if it is successful.</p>
+ </desc>
+ </func>
+ <func>
+ <name>world() -> [node()]</name>
+ <name>world(Arg) -> [node()]</name>
+ <fsummary>Lookup and connect to all nodes at all hosts in <c>.hosts.erlang</c></fsummary>
+ <type>
+ <v>Arg = silent | verbose</v>
+ </type>
+ <desc>
+ <p>This function calls <c>names(Host)</c> for all hosts which
+ are specified in the Erlang host file <c>.hosts.erlang</c>,
+ collects the replies and then evaluates <c>ping(Node)</c> on
+ all those nodes. Returns the list of all nodes that were,
+ successfully pinged.</p>
+ <p><c>Arg</c> defaults to <c>silent</c>.
+ If <c>Arg == verbose</c>, the function writes information about which
+ nodes it is pinging to stdout.</p>
+ <p>This function can be useful when a node is started, and
+ the names of the other nodes in the network are not initially
+ known.</p>
+ <p>Failure: <c>{error, Reason}</c> if <c>host_file()</c>
+ returns <c>{error, Reason}</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>world_list(Hosts) -> [node()]</name>
+ <name>world_list(Hosts, Arg) -> [node()]</name>
+ <fsummary>Lookup and connect to all nodes at specified hosts</fsummary>
+ <type>
+ <v>Hosts = [Host]</v>
+ <v>&nbsp;Host = atom()</v>
+ <v>Arg = silent | verbose</v>
+ </type>
+ <desc>
+ <p>As <c>world/0,1</c>, but the hosts are given as argument
+ instead of being read from <c>.hosts.erlang</c>.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>Files</title>
+ <p>The <c>.hosts.erlang</c> file consists of a number of host names
+ written as Erlang terms. It is looked for in the current work
+ directory, the user's home directory, and <c>$OTP_ROOT</c>
+ (the root directory of Erlang/OTP), in that order.</p>
+ <p>The format of the <c>.hosts.erlang</c> file must be one host
+ name per line. The host names must be within quotes as shown in
+ the following example:</p>
+ <pre>
+'super.eua.ericsson.se'.
+'renat.eua.ericsson.se'.
+'grouse.eua.ericsson.se'.
+'gauffin1.eua.ericsson.se'.
+^ (new line)</pre>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml
new file mode 100644
index 0000000000..a18226e779
--- /dev/null
+++ b/lib/kernel/doc/src/net_kernel.xml
@@ -0,0 +1,331 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>net_kernel</title>
+ <prepared>Claes Wikstrom</prepared>
+ <docno>1</docno>
+ <date>96-09-10</date>
+ <rev>A</rev>
+ </header>
+ <module>net_kernel</module>
+ <modulesummary>Erlang Networking Kernel</modulesummary>
+ <description>
+ <p>The net kernel is a system process, registered as
+ <c>net_kernel</c>, which must be running for distributed Erlang
+ to work. The purpose of this process is to implement parts of
+ the BIFs <c>spawn/4</c> and <c>spawn_link/4</c>, and to provide
+ monitoring of the network.</p>
+ <p>An Erlang node is started using the command line flag
+ <c>-name</c> or <c>-sname</c>:</p>
+ <pre>
+$ <input>erl -sname foobar</input></pre>
+ <p>It is also possible to call <c>net_kernel:start([foobar])</c>
+ directly from the normal Erlang shell prompt:</p>
+ <p></p>
+ <pre>
+1> <input>net_kernel:start([foobar, shortnames]).</input>
+{ok,&lt;0.64.0>}
+(foobar@gringotts)2></pre>
+ <p>If the node is started with the command line flag <c>-sname</c>,
+ the node name will be <c>foobar@Host</c>, where <c>Host</c> is
+ the short name of the host (not the fully qualified domain name).
+ If started with the <c>-name</c> flag, <c>Host</c> is the fully
+ qualified domain name. See <c>erl(1)</c>.</p>
+ <p>Normally, connections are established automatically when
+ another node is referenced. This functionality can be disabled
+ by setting the Kernel configuration parameter
+ <c>dist_auto_connect</c> to <c>false</c>, see
+ <seealso marker="kernel_app">kernel(6)</seealso>. In this case,
+ connections must be established explicitly by calling
+ <c>net_kernel:connect_node/1</c>.</p>
+ <p>Which nodes are allowed to communicate with each other is handled
+ by the magic cookie system, see
+ <seealso marker="doc/reference_manual:distributed">Distributed Erlang</seealso> in the Erlang Reference Manual.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>allow(Nodes) -> ok | error</name>
+ <fsummary>Limit access to a specified set of nodes</fsummary>
+ <type>
+ <v>Nodes = [node()]</v>
+ </type>
+ <desc>
+ <p>Limits access to the specified set of nodes. Any access
+ attempts made from (or to) nodes not in <c>Nodes</c> will be
+ rejected.</p>
+ <p>Returns <c>error</c> if any element in <c>Nodes</c> is not
+ an atom.</p>
+ </desc>
+ </func>
+ <func>
+ <name>connect_node(Node) -> true | false | ignored</name>
+ <fsummary>Establish a connection to a node</fsummary>
+ <type>
+ <v>Node = node()</v>
+ </type>
+ <desc>
+ <p>Establishes a connection to <c>Node</c>. Returns <c>true</c>
+ if successful, <c>false</c> if not, and <c>ignored</c> if
+ the local node is not alive.</p>
+ </desc>
+ </func>
+ <func>
+ <name>monitor_nodes(Flag) -> ok | Error</name>
+ <name>monitor_nodes(Flag, Options) -> ok | Error</name>
+ <fsummary>Subscribe to node status change messages</fsummary>
+ <type>
+ <v>Flag = true | false</v>
+ <v>Options = [Option]</v>
+ <v>&nbsp;Option -- see below</v>
+ <v>Error = error | {error, term()}</v>
+ </type>
+ <desc>
+ <p>The calling process subscribes or unsubscribes to node
+ status change messages. A <c>nodeup</c> message is delivered
+ to all subscribing process when a new node is connected, and
+ a <c>nodedown</c> message is delivered when a node is
+ disconnected.</p>
+ <p>If <c>Flag</c> is <c>true</c>, a new subscription is started.
+ If <c>Flag</c> is <c>false</c>, all previous subscriptions --
+ started with the same <c>Options</c> -- are stopped. Two
+ option lists are considered the same if they contain the same
+ set of options.</p>
+ <p>As of <c>kernel</c> version 2.11.4, and <c>erts</c> version
+ 5.5.4, the following is guaranteed:</p>
+ <list type="bulleted">
+ <item><c>nodeup</c> messages will be delivered before delivery
+ of any message from the remote node passed through the
+ newly established connection.</item>
+ <item><c>nodedown</c> messages will not be delivered until all
+ messages from the remote node that have been passed
+ through the connection have been delivered.</item>
+ </list>
+ <p>Note, that this is <em>not</em> guaranteed for <c>kernel</c>
+ versions before 2.11.4.</p>
+ <p>As of <c>kernel</c> version 2.11.4 subscriptions can also be
+ made before the <c>net_kernel</c> server has been started,
+ i.e., <c>net_kernel:monitor_nodes/[1,2]</c> does not return
+ <c>ignored</c>.</p>
+ <p>As of <c>kernel</c> version 2.13, and <c>erts</c> version
+ 5.7, the following is guaranteed:</p>
+ <list type="bulleted">
+ <item><c>nodeup</c> messages will be delivered after the
+ corresponding node appears in results from
+ <c>erlang:nodes/X</c>.</item>
+ <item><c>nodedown</c> messages will be delivered after the
+ corresponding node has disappeared in results from
+ <c>erlang:nodes/X</c>.</item>
+ </list>
+ <p>Note, that this is <em>not</em> guaranteed for <c>kernel</c>
+ versions before 2.13.</p>
+ <p>The format of the node status change messages depends on
+ <c>Options</c>. If <c>Options</c> is [], which is the default,
+ the format is:</p>
+ <code type="none">
+{nodeup, Node} | {nodedown, Node}
+ Node = node()</code>
+ <p>If <c>Options /= []</c>, the format is:</p>
+ <code type="none">
+{nodeup, Node, InfoList} | {nodedown, Node, InfoList}
+ Node = node()
+ InfoList = [{Tag, Val}]</code>
+ <p><c>InfoList</c> is a list of tuples. Its contents depends on
+ <c>Options</c>, see below.</p>
+ <p>Also, when <c>OptionList == []</c> only visible nodes, that
+ is, nodes that appear in the result of
+ <seealso marker="erts:erlang#nodes/0">nodes/0</seealso>, are
+ monitored.</p>
+ <p><c>Option</c> can be any of the following:</p>
+ <taglist>
+ <tag><c>{node_type, NodeType}</c></tag>
+ <item>
+ <p>Currently valid values for <c>NodeType</c> are:</p>
+ <taglist>
+ <tag><c>visible</c></tag>
+ <item>Subscribe to node status change messages for visible
+ nodes only. The tuple <c>{node_type, visible}</c> is
+ included in <c>InfoList</c>.</item>
+ <tag><c>hidden</c></tag>
+ <item>Subscribe to node status change messages for hidden
+ nodes only. The tuple <c>{node_type, hidden}</c> is
+ included in <c>InfoList</c>.</item>
+ <tag><c>all</c></tag>
+ <item>Subscribe to node status change messages for both
+ visible and hidden nodes. The tuple
+ <c>{node_type, visible | hidden}</c> is included in
+ <c>InfoList</c>.</item>
+ </taglist>
+ </item>
+ <tag><c>nodedown_reason</c></tag>
+ <item>
+ <p>The tuple <c>{nodedown_reason, Reason}</c> is included in
+ <c>InfoList</c> in <c>nodedown</c> messages. <c>Reason</c>
+ can be:</p>
+ <taglist>
+ <tag><c>connection_setup_failed</c></tag>
+ <item>The connection setup failed (after <c>nodeup</c>
+ messages had been sent).</item>
+ <tag><c>no_network</c></tag>
+ <item>No network available.</item>
+ <tag><c>net_kernel_terminated</c></tag>
+ <item>The <c>net_kernel</c> process terminated.</item>
+ <tag><c>shutdown</c></tag>
+ <item>Unspecified connection shutdown.</item>
+ <tag><c>connection_closed</c></tag>
+ <item>The connection was closed.</item>
+ <tag><c>disconnect</c></tag>
+ <item>The connection was disconnected (forced from the
+ current node).</item>
+ <tag><c>net_tick_timeout</c></tag>
+ <item>Net tick timeout.</item>
+ <tag><c>send_net_tick_failed</c></tag>
+ <item>Failed to send net tick over the connection.</item>
+ <tag><c>get_status_failed</c></tag>
+ <item>Status information retrieval from the <c>Port</c>
+ holding the connection failed.</item>
+ </taglist>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>get_net_ticktime() -> Res</name>
+ <fsummary>Get <c>net_ticktime</c></fsummary>
+ <type>
+ <v>Res = NetTicktime | {ongoing_change_to, NetTicktime}</v>
+ <v>&nbsp;NetTicktime = int()</v>
+ </type>
+ <desc>
+ <p>Gets <c>net_ticktime</c> (see
+ <seealso marker="kernel_app">kernel(6)</seealso>).</p>
+ <p>Currently defined return values (<c>Res</c>):</p>
+ <taglist>
+ <tag><c>NetTicktime</c></tag>
+ <item>
+ <p><c>net_ticktime</c> is <c>NetTicktime</c> seconds.</p>
+ </item>
+ <tag><c>{ongoing_change_to, NetTicktime}</c></tag>
+ <item>
+ <p><c>net_kernel</c> is currently changing
+ <c>net_ticktime</c> to <c>NetTicktime</c> seconds.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>set_net_ticktime(NetTicktime) -> Res</name>
+ <name>set_net_ticktime(NetTicktime, TransitionPeriod) -> Res</name>
+ <fsummary>Set <c>net_ticktime</c></fsummary>
+ <type>
+ <v>NetTicktime = int() > 0</v>
+ <v>TransitionPeriod = int() >= 0</v>
+ <v>Res = unchanged | change_initiated | {ongoing_change_to, NewNetTicktime}</v>
+ <v>&nbsp;NewNetTicktime = int() > 0</v>
+ </type>
+ <desc>
+ <p>Sets <c>net_ticktime</c> (see
+ <seealso marker="kernel_app">kernel(6)</seealso>) to
+ <c>NetTicktime</c> seconds. <c>TransitionPeriod</c> defaults
+ to 60.</p>
+ <p>Some definitions:</p>
+ <p></p>
+ <taglist>
+ <tag>The minimum transition traffic interval (<c>MTTI</c>)</tag>
+ <item>
+ <p><c>minimum(NetTicktime, PreviousNetTicktime)*1000 div 4</c> milliseconds.</p>
+ </item>
+ <tag>The transition period</tag>
+ <item>
+ <p>The time of the least number of consecutive <c>MTTI</c>s
+ to cover <c>TransitionPeriod</c> seconds following
+ the call to <c>set_net_ticktime/2</c> (i.e.
+ ((<c>TransitionPeriod*1000 - 1) div MTTI + 1)*MTTI</c>
+ milliseconds).</p>
+ </item>
+ </taglist>
+ <p>If <c><![CDATA[NetTicktime < PreviousNetTicktime]]></c>, the actual
+ <c>net_ticktime</c> change will be done at the end of
+ the transition period; otherwise, at the beginning. During
+ the transition period, <c>net_kernel</c> will ensure that
+ there will be outgoing traffic on all connections at least
+ every <c>MTTI</c> millisecond.</p>
+ <note>
+ <p>The <c>net_ticktime</c> changes have to be initiated on all
+ nodes in the network (with the same <c>NetTicktime</c>)
+ before the end of any transition period on any node;
+ otherwise, connections may erroneously be disconnected.</p>
+ </note>
+ <p>Returns one of the following:</p>
+ <taglist>
+ <tag><c>unchanged</c></tag>
+ <item>
+ <p><c>net_ticktime</c> already had the value of
+ <c>NetTicktime</c> and was left unchanged.</p>
+ </item>
+ <tag><c>change_initiated</c></tag>
+ <item>
+ <p><c>net_kernel</c> has initiated the change of
+ <c>net_ticktime</c> to <c>NetTicktime</c> seconds.</p>
+ </item>
+ <tag><c>{ongoing_change_to, NewNetTicktime}</c></tag>
+ <item>
+ <p>The request was <em>ignored</em>; because,
+ <c>net_kernel</c> was busy changing <c>net_ticktime</c> to
+ <c>NewTicktime</c> seconds.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>start([Name]) -> {ok, pid()} | {error, Reason}</name>
+ <name>start([Name, NameType]) -> {ok, pid()} | {error, Reason}</name>
+ <name>start([Name, NameType, Ticktime]) -> {ok, pid()} | {error, Reason}</name>
+ <fsummary>Turn an Erlang runtime system into a distributed node</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>NameType = shortnames | longnames</v>
+ <v>Reason = {already_started, pid()} | term()</v>
+ </type>
+ <desc>
+ <p>Note that the argument is a list with exactly one, two or
+ three arguments. <c>NameType</c> defaults to <c>longnames</c>
+ and <c>Ticktime</c> to 15000.</p>
+ <p>Turns a non-distributed node into a distributed node by
+ starting <c>net_kernel</c> and other necessary processes.</p>
+ </desc>
+ </func>
+ <func>
+ <name>stop() -> ok | {error, not_allowed | not_found}</name>
+ <fsummary>Turn a node into a non-distributed Erlang runtime system</fsummary>
+ <desc>
+ <p>Turns a distributed node into a non-distributed node. For
+ other nodes in the network, this is the same as the node
+ going down. Only possible when the net kernel was started
+ using <c>start/1</c>, otherwise returns
+ <c>{error, not_allowed}</c>. Returns <c>{error, not_found}</c>
+ if the local node is not alive.</p>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml
new file mode 100644
index 0000000000..5bac964535
--- /dev/null
+++ b/lib/kernel/doc/src/notes.xml
@@ -0,0 +1,2273 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2004</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>Kernel Release Notes</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ <file>notes.xml</file>
+ </header>
+ <p>This document describes the changes made to the Kernel application.</p>
+
+<section><title>Kernel 2.13.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>A link in <c>pg2(3)</c> has been fixed. (Thanks to
+ Christophe Romain.)</p>
+ <p>
+ Own Id: OTP-8198</p>
+ </item>
+ <item>
+ <p>
+ A ticker process could potentially be blocked
+ indefinitely trying to send a tick to a node not
+ responding. If this happened, the connection would not be
+ brought down as it should.</p>
+ <p>
+ Own Id: OTP-8218</p>
+ </item>
+ <item>
+ <p>A bug in <c>pg2</c> when members who died did not
+ leave process groups has been fixed. (Thanks to Matthew
+ Dempsky.)</p>
+ <p>
+ Own Id: OTP-8259</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ The documentation is now built with open source tools
+ (xsltproc and fop) that exists on most platforms. One
+ visible change is that the frames are removed.</p>
+ <p>
+ Own Id: OTP-8201</p>
+ </item>
+ <item>
+ <p>
+ The top directory in archive files does not need to have
+ a <c>-vsn</c> suffix anymore. For example if the archive
+ file has the name like <c>mnesia-4.4.7.ez</c> the top
+ directory in the archive can either be named
+ <c>mnesia</c> or <c>mnesia-4.4.7</c>. If the archive file
+ has a name like <c>mnesia.ez</c> the top directory in the
+ archive must be named <c>mnesia</c> as earlier.</p>
+ <p>
+ Own Id: OTP-8266</p>
+ </item>
+ <item>
+ <p>The -on_load() directive can be used to run a function
+ when a module is loaded. It is documented in the section
+ about code loading in the Reference Manual.</p>
+ <p>
+ Own Id: OTP-8295</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.13.3</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p> The DNS resolver client inet_res has been rewritten,
+ documented and released. See inet_res(3) and Erts User's
+ Guide: Inet configuration. </p><p> It can formally not be
+ incompatible with respect to earlier versions since there
+ was no earlier official version. However it was used
+ before and some details have changed. </p><p>
+ Configuration now initializes from /etc/resolv.conf and
+ /etc/hosts on all unix platforms regardless of which
+ distribution mode the node is started in. The directory
+ (/etc) these files are supposed to reside in can be
+ changed via an environment variable. These configuration
+ file locations can also be changed in the inet
+ configuration. The files are monitored for change and
+ re-read, which makes a few resolver configuration
+ variables out of application control. The /etc/hosts
+ entries have now their own cache table that is shadowed
+ (with lookup method 'file' is used) by the application
+ configured host entries. This problem (that inet_res
+ configuration only worked for distribution mode long
+ names) was among other reported by Matthew O'Gorman many
+ moons ago. </p><p> The lookup methods are still 'native'
+ only per default. Resolver configuration is done on all
+ Unix platforms just to get a usable configuration for
+ direct calls to inet_res. </p><p> The functions
+ <c>inet_res:nslookup/3..5</c> and
+ <c>inet_res:nnslookup/4..4</c> are no longer recommended
+ to use, instead use <c>inet_res:lookup/3..5</c> and
+ <c>inet_res:resolve/3..5</c> which provide clearer
+ argument types and the possibility to override options in
+ the call. </p><p> Users of previous unsupported versions
+ of inet_res have included internal header files to get to
+ the internal record definitions in order to examine DNS
+ replies. This is still unsupported and there are access
+ functions in inet_dns to use instead. These are
+ documented in inet_res(3). </p><p> Bug fix: a compression
+ reference loop would make DNS message decoding loop
+ forever. Problem reported by Florian Weimer. </p><p> Bug
+ fix and patch suggestion by Sergei Golovan: configuring
+ IPv6 nameservers did not work. His patch (as he warned)
+ created many UDP sockets; one per nameserver. This has
+ been fixed in the released version. </p><p> Improvement:
+ <c>inet_res</c> is now EDNS0 capable. The current
+ implementation is simple and does not probe and cache
+ EDNS info for nameservers, which a fully capable
+ implementation probably should do. EDNS has to be enabled
+ via resolver configuration, and if a nameserver replies
+ that it does not support EDNS, <c>inet_res</c> falls back
+ to a regular DNS query. </p><p> Improvement: now
+ <c>inet_res</c> automatically falls back to TCP if it
+ gets a truncated answer from a nameserver. </p><p>
+ Warning: some of the ancient and exotic record types
+ handled by <c>inet_res</c> and <c>inet_dns</c> are not
+ supported by current versions of BIND, so they could not
+ be tested after the rewrite, with reasonable effort, e.g
+ MD, MF, NULL, and SPF. The risk for bugs in these
+ particular records is still low since their code is
+ mostly shared with other tested record types. </p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-7955 Aux Id: OTP-7107 OTP-6852 </p>
+ </item>
+ <item>
+ <p>
+ A TCP socket with option <c>{packet,4}</c> could crash
+ the emulator if it received a packet header with a very
+ large size value (>2Gb). The same bug caused
+ <c>erlang:decode_packet/3</c> to return faulty values.
+ (Thanks to Georgos Seganos.)</p>
+ <p>
+ Own Id: OTP-8102</p>
+ </item>
+ <item>
+ <p>
+ The file module has now a read_line/1 function similar to
+ the io:get_line/2, but with byte oriented semantics. The
+ function file:read_line/1 works for raw files as well,
+ but for good performance it is recommended to use it
+ together with the 'read_ahead' option for raw file
+ access.</p>
+ <p>
+ Own Id: OTP-8108</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.13.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ A bug when doing io:get_line (among other calls) from a
+ file opened with encoding other than latin1, causing
+ false unicode errors to occur, is now corrected.</p>
+ <p>
+ Own Id: OTP-7974</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Added functionality to get higher resolution timestamp
+ from system. The erlang:now function returns a timestamp
+ that's not always consistent with the actual operating
+ system time (due to resilience against large time changes
+ in the operating system). The function os:timestamp/0 is
+ added to get a similar timestamp as the one being
+ returned by erlang:now, but untouched by Erlangs time
+ correcting and smoothing algorithms. The timestamp
+ returned by os:timestamp is always consistent with the
+ operating systems view of time, like the calendar
+ functions for getting wall clock time, but with higher
+ resolution. Example of usage can be found in the os
+ manual page.</p>
+ <p>
+ Own Id: OTP-7971</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.13.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Many concurrent calls to <c>os:cmd/1</c> will only block
+ one scheduler thread at a time, making an smp emulator
+ more responsive if the OS is slow forking processes.</p>
+ <p>
+ Own Id: OTP-7890 Aux Id: seq11219 </p>
+ </item>
+ <item>
+ <p>
+ Fixed hanging early RPC that did IO operation during node
+ start.</p>
+ <p>
+ Own Id: OTP-7903 Aux Id: seq11224 </p>
+ </item>
+ <item>
+ <p>
+ The error behavior of gen_tcp and gen_udp has been
+ corrected. gen_tcp:connect/3,4 and gen_udp:send/4 now
+ returns {error,eafnosupport} for conflicting destination
+ address versus socket address family. Other corner cases
+ for IP address string host names combined with not using
+ the native (OS) resolver (which is not default) has also
+ been changed to return {error,nxdomain} instead of
+ {error,einval}. Those changes just may surprise old
+ existing code. gen_tcp:listen/2 and gen_udp:open/2 now
+ fails for conflicting local address versus socket address
+ family instead of trying to use an erroneous address.
+ Problem reported by Per Hedeland.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-7929</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Several glitches and performance issues in the Unicode
+ and I/O-system implementation of R13A have been
+ corrected.</p>
+ <p>
+ Own Id: OTP-7896 Aux Id: OTP-7648 OTP-7887 </p>
+ </item>
+ <item>
+ <p>
+ The unsupported DNS resolver client inet_res has now been
+ improved to handle NAPTR queries.</p>
+ <p>
+ Own Id: OTP-7925 Aux Id: seq11231 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+
+<section><title>Kernel 2.13</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The old Erlang DNS resolver inet_res has been corrected
+ to handle TXT records with more than one character
+ string. Patch courtesy of Geoff Cant.</p>
+ <p>
+ Own Id: OTP-7588</p>
+ </item>
+ <item>
+ <p>When chunk reading a disk log opened in read_only
+ mode, bad terms could crash the disk log process.</p>
+ <p>
+ Own Id: OTP-7641 Aux Id: seq11090 </p>
+ </item>
+ <item>
+ <p>
+ <c>gen_tcp:send()</c> did sometimes (only observed on
+ Solaris) return <c>{error,enotconn}</c> instead of the
+ expected <c>{error,closed}</c> as the peer socket had
+ been explicitly closed.</p>
+ <p>
+ Own Id: OTP-7647</p>
+ </item>
+ <item>
+ <p>
+ The gen_sctp option sctp_peer_addr_params,
+ #sctp_paddrparams{address={IP,Port} was erroneously
+ decoded in the inet driver. This bug has now been
+ corrected.</p>
+ <p>
+ Own Id: OTP-7755</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Erlang programs can now access STDERR on platforms where
+ such a file descriptor is available by using the
+ io_server 'standard_error', i.e.
+ io:format(standard_error,"~s~n",[ErrorMessage]),</p>
+ <p>
+ Own Id: OTP-6688</p>
+ </item>
+ <item>
+ <p>
+ The format of the string returned by
+ <c>erlang:system_info(system_version)</c> (as well as the
+ first message when Erlang is started) has changed. The
+ string now contains the both the OTP version number as
+ well as the erts version number.</p>
+ <p>
+ Own Id: OTP-7649</p>
+ </item>
+ <item>
+ <p>As of this version, the global name server no longer
+ supports nodes running Erlang/OTP R10B.</p>
+ <p>
+ Own Id: OTP-7661</p>
+ </item>
+ <item>
+ <p>
+ A <c>{nodedown, Node}</c> message passed by the
+ <c>net_kernel:monitor_nodes/X</c> functionality is now
+ guaranteed to be sent after <c>Node</c> has been removed
+ from the result returned by <c>erlang:nodes/Y</c>.</p>
+ <p>
+ Own Id: OTP-7725</p>
+ </item>
+ <item>
+ <p>The deprecated functions <c>erlang:fault/1</c>,
+ <c>erlang:fault/2</c>, and <c>file:rawopen/2</c> have
+ been removed.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-7812</p>
+ </item>
+ <item>
+ <p>
+ Nodes belonging to different independent clusters can now
+ co-exist on the same host with the help of a new
+ environment variable setting ERL_EPMD_PORT.</p>
+ <p>
+ Own Id: OTP-7826</p>
+ </item>
+ <item>
+ <p>The copyright notices have been updated.</p>
+ <p>
+ Own Id: OTP-7851</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.12.5.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>When chunk reading a disk log opened in read_only
+ mode, bad terms could crash the disk log process.</p>
+ <p>
+ Own Id: OTP-7641 Aux Id: seq11090 </p>
+ </item>
+ <item>
+ <p>
+ Calling <c>gen_tcp:send()</c> from several processes on
+ socket with option <c>send_timeout</c> could lead to much
+ longer timeout than specified. The solution is a new
+ socket option <c>{send_timeout_close,true}</c> that will
+ do automatic close on timeout. Subsequent calls to send
+ will then immediately fail due to the closed connection.</p>
+ <p>
+ Own Id: OTP-7731 Aux Id: seq11161 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.12.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>The documentation of <c>rpc:pmap/3</c> has been
+ corrected. (Thanks to Kirill Zaborski.)</p>
+ <p>
+ Own Id: OTP-7537</p>
+ </item>
+ <item>
+ <p>
+ The listen socket used for the distributed Erlang
+ protocol now uses the socket option 'reuseaddr', which is
+ useful when you force the listen port number using kernel
+ options 'inet_dist_listen_min' and 'inet_dist_listen_max'
+ and restarts a node with open connections.</p>
+ <p>
+ Own Id: OTP-7563</p>
+ </item>
+ <item>
+ <p>
+ Fixed memory leak of unclosed TCP-ports. A gen_tcp:send()
+ followed by a failing gen_tcp:recv() could in some cases
+ cause the port to linger after being closed.</p>
+ <p>
+ Own Id: OTP-7615</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>Processes spawned using <c>proc_lib</c> (including
+ <c>gen_server</c> and other library modules that use
+ <c>proc_lib</c>) no longer keep the entire argument list
+ for the initial call, but only the arity.</p>
+ <p>Also, if <c>proc_lib:spawn/1</c> is used to spawn a
+ fun, the actual fun is not kept, but only module,
+ function name, and arity of the function that implements
+ the fun.</p>
+ <p>The reason for the change is that keeping the initial
+ fun (or a fun in an argument list), would prevent
+ upgrading the code for the module. A secondary reason is
+ that keeping the fun and function arguments could waste a
+ significant amount of memory.</p>
+ <p>The drawback with the change is that the crash reports
+ will provide less precise information about the initial
+ call (only <c>Module:Function/Arity</c> instead of
+ <c>Module:Function(Arguments)</c>). The function
+ <c>proc_lib:initial_call/1</c> still returns a list, but
+ each argument has been replaced with a dummy atom.</p>
+ <p>
+ Own Id: OTP-7531 Aux Id: seq11036 </p>
+ </item>
+ <item>
+ <p>
+ <c>io:get_line/1</c> when reading from standard input is
+ now substantially faster. There are also some minor
+ performance improvements in <c>io:get_line/1</c> when
+ reading from any file opened in binary mode. (Thanks to
+ Fredrik Svahn.)</p>
+ <p>
+ Own Id: OTP-7542</p>
+ </item>
+ <item>
+ <p>
+ There is now experimental support for loading of code
+ from archive files. See the documentation of <c>code</c>,
+ <c>init</c>, <c>erl_prim_loader </c> and <c>escript</c>
+ for more info.</p>
+ <p>
+ The error handling of <c>escripts</c> has been improved.</p>
+ <p>
+ An <c>escript</c> may now set explicit arguments to the
+ emulator, such as <c>-smp enabled</c>.</p>
+ <p>
+ An <c>escript</c> may now contain a precompiled beam
+ file.</p>
+ <p>
+ An <c>escript</c> may now contain an archive file
+ containing one or more applications (experimental).</p>
+ <p>
+ The internal module <c>code_aux</c> has been removed.</p>
+ <p>
+ Own Id: OTP-7548 Aux Id: otp-6622 </p>
+ </item>
+ <item>
+ <p>
+ <c>code:is_sticky/1</c> is now documented. (Thanks to
+ Vlad Dumitrescu.)</p>
+ <p>
+ Own Id: OTP-7561</p>
+ </item>
+ <item>
+ <p>
+ In the job control mode, the "s" and "r" commands now
+ take an optional argument to specify which shell to
+ start. (Thanks to Robert Virding.)</p>
+ <p>
+ Own Id: OTP-7617</p>
+ </item>
+ <item>
+ <p>
+ <c>net_adm:world/0,1</c> could crash if called in an
+ emulator that has not been started with either the
+ <c>-sname</c> or <c>-name</c> option; now it will return
+ an empty list. (Thanks to Edwin Fine.)</p>
+ <p>
+ Own Id: OTP-7618</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.12.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Large files are now handled on Windows, where the
+ filesystem supports it.</p>
+ <p>
+ Own Id: OTP-7410</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ New BIF <c>erlang:decode_packet/3</c> that extracts a
+ protocol packet from a binary. Similar to the socket
+ option <c>{packet, Type}</c>. Also documented the socket
+ packet type <c>http</c> and made it official.
+ <em>NOTE</em>: The tuple format for <c>http</c> packets
+ sent from an active socket has been changed in an
+ incompatible way.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-7404</p>
+ </item>
+ <item>
+ <p>
+ Setting the <c>{active,once}</c> for a socket (using
+ inets:setopts/2) is now specially optimized (because the
+ <c>{active,once}</c> option is typically used much more
+ frequently than other options).</p>
+ <p>
+ Own Id: OTP-7520</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.12.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ SCTP_ADDR_CONFIRMED events are now handled by gen_sctp.</p>
+ <p>
+ Own Id: OTP-7276</p>
+ </item>
+ <item>
+ <p>When leaving a process group with <c>pg2:leave/2</c>
+ the process was falsely assumed to be a member of the
+ group. This bug has been fixed.</p>
+ <p>
+ Own Id: OTP-7277</p>
+ </item>
+ <item>
+ <p>
+ In the Erlang shell, using up and down arrow keys, the
+ wrong previous command could sometimes be retrieved.</p>
+ <p>
+ Own Id: OTP-7278</p>
+ </item>
+ <item>
+ <p>
+ The documentation for <c>erlang:trace/3</c> has been
+ corrected.</p>
+ <p>
+ Own Id: OTP-7279 Aux Id: seq10927 </p>
+ </item>
+ <item>
+ <p>
+ In the SMP emulator, there was small risk that
+ <c>code:purge(Mod)</c> would kill a process that was
+ running code in <c>Mod</c> and unload the module
+ <c>Mod</c> before the process had terminated.
+ <c>code:purge(Mod)</c> now waits for confirmation (using
+ <c>erlang:monitor/2</c>) that the process has been killed
+ before proceeding.</p>
+ <p>
+ Own Id: OTP-7282</p>
+ </item>
+ <item>
+ <p>
+ <c>zlib:inflate</c> failed when the size of the inflated
+ data was an exact multiple of the internal buffer size
+ (4000 bytes by default).</p>
+ <p>
+ Own Id: OTP-7359</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Additional library directories can now be specified in
+ the environment variable ERL_LIBS. See the manual page
+ for the <c>code</c> module. (Thanks to Serge Aleynikov.)</p>
+ <p>
+ Own Id: OTP-6940</p>
+ </item>
+ <item>
+ <p>
+ crypto and zlib drivers improved to allow concurrent smp
+ access.</p>
+ <p>
+ Own Id: OTP-7262</p>
+ </item>
+ <item>
+ <p>
+ There is a new function <c>init:stop/1</c> which can be
+ used to shutdown the system cleanly AND generate a
+ non-zero exit status or crash dump. (Thanks to Magnus
+ Froberg.)</p>
+ <p>
+ Own Id: OTP-7308</p>
+ </item>
+ <item>
+ <p>
+ The <c>hide</c> option for <c>open_port/2</c> is now
+ documented. (Thanks to Richard Carlsson.)</p>
+ <p>
+ Own Id: OTP-7358</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+
+<section><title>Kernel 2.12.2.1</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ <c>os:cmd/1</c> on unix platforms now use <c>/bin/sh</c>
+ as shell instead of looking for <c>sh</c> in the
+ <c>PATH</c> environment.</p>
+ <p>
+ Own Id: OTP-7283</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+<section><title>Kernel 2.12.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>A bug caused by a race condition involving
+ <c>disk_log</c> and <c>pg2</c> has been fixed.</p>
+ <p>
+ Own Id: OTP-7209 Aux Id: seq10890 </p>
+ </item>
+ <item>
+ <p>The beta testing module <c>gen_sctp</c> now supports
+ active mode as stated in the documentation. Active mode
+ is still rather untested, and there are some issues about
+ what should be the right semantics for
+ <c>gen_sctp:connect/5</c>. In particular: should it be
+ blocking or non-blocking or choosable. There is a high
+ probability it will change semantics in a (near) future
+ patch.</p> <p>Try it, give comments and send in bug
+ reports!</p>
+ <p>
+ Own Id: OTP-7225</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p><c>erlang:system_info/1</c> now accepts the
+ <c>logical_processors</c>, and <c>debug_compiled</c>
+ arguments. For more info see the, <c>erlang(3)</c>
+ documentation.</p> <p>The scale factor returned by
+ <c>test_server:timetrap_scale_factor/0</c> is now also
+ effected if the emulator uses a larger amount of
+ scheduler threads than the amount of logical processors
+ on the system. </p>
+ <p>
+ Own Id: OTP-7175</p>
+ </item>
+ <item>
+ <p>
+ Updated the documentation for
+ <c>erlang:function_exported/3</c> and <c>io:format/2</c>
+ functions to no longer state that those functions are
+ kept mainly for backwards compatibility.</p>
+ <p>
+ Own Id: OTP-7186</p>
+ </item>
+ <item>
+ <p>
+ A process executing the <c>processes/0</c> BIF can now be
+ preempted by other processes during its execution. This
+ in order to disturb the rest of the system as little as
+ possible. The returned result is, of course, still a
+ consistent snapshot of existing processes at a time
+ during the call to <c>processes/0</c>.</p>
+ <p>
+ The documentation of the <c>processes/0</c> BIF and the
+ <c>is_process_alive/1</c> BIF have been updated in order
+ to clarify the difference between an existing process and
+ a process that is alive.</p>
+ <p>
+ Own Id: OTP-7213</p>
+ </item>
+ <item>
+ <p><c>tuple_size/1</c> and <c>byte_size/1</c> have been
+ substituted for <c>size/1</c> in the documentation.</p>
+ <p>
+ Own Id: OTP-7244</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.12.1.2</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>The <c>{allocator_sizes, Alloc}</c> and
+ <c>alloc_util_allocators</c> arguments are now accepted
+ by <c>erlang:system_info/1</c>. For more information see
+ the <c>erlang(3)</c> documentation.</p>
+ <p>
+ Own Id: OTP-7167</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.12.1.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fixed a problem in group that could cause the ssh server
+ to lose answers or hang.</p>
+ <p>
+ Own Id: OTP-7185 Aux Id: seq10871 </p>
+ </item>
+ </list>
+ </section>
+</section>
+<section><title>Kernel 2.12.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ file:read/2 and file:consult_stream/1,3 did not use an
+ empty prompt on I/O devices. This bug has now been
+ corrected.</p>
+ <p>
+ Own Id: OTP-7013</p>
+ </item>
+ <item>
+ <p>
+ The sctp driver has been updated to work against newer
+ lksctp packages e.g 1.0.7 that uses the API spelling
+ change adaption -> adaptation. Older lksctp (1.0.6) still
+ work. The erlang API in gen_sctp.erl and inet_sctp.hrl
+ now spells 'adaptation' regardless of the underlying C
+ API.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-7120</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>The documentation has been updated so as to reflect
+ the last updates of the Erlang shell as well as the minor
+ modifications of the control sequence <c>p</c> of the
+ <c>io_lib</c> module.</p> <p>Superfluous empty lines have
+ been removed from code examples and from Erlang shell
+ examples.</p>
+ <p>
+ Own Id: OTP-6944 Aux Id: OTP-6554, OTP-6911 </p>
+ </item>
+ <item>
+ <p><c>tuple_size/1</c> and <c>byte_size/1</c> have been
+ substituted for <c>size/1</c>.</p>
+ <p>
+ Own Id: OTP-7009</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.12</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ A bug for raw files when reading 0 bytes returning 'eof'
+ instead of empty data has been corrected.</p>
+ <p>
+ Own Id: OTP-6291 Aux Id: OTP-6967 </p>
+ </item>
+ <item>
+ <p>
+ A bug in gen_udp:fdopen reported by David Baird and also
+ found by Dialyzer has been fixed.</p>
+ <p>
+ Own Id: OTP-6836 Aux Id: OTP-6594 </p>
+ </item>
+ <item>
+ <p>
+ Calling <c>error_logger:tty(true)</c> multiple times does
+ not give multiple error log printouts.</p>
+ <p>
+ Own Id: OTP-6884 Aux Id: seq10767 </p>
+ </item>
+ <item>
+ <p>The global name server now ignores <c>nodeup</c>
+ messages when the command line flag <c>-connect_all
+ false</c> has been used. (Thanks to Trevor
+ Woollacott.)</p>
+ <p>
+ Own Id: OTP-6931</p>
+ </item>
+ <item>
+ <p>file:write_file/3, file:write/2 and file:read/2 could
+ crash (contrary to documentation) for odd enough file
+ system problems, e.g write to full file system. This bug
+ has now been corrected.</p> <p>In this process the file
+ module has been rewritten to produce better error codes.
+ Posix error codes now originate from the OS file system
+ calls or are generated only for very similar causes (for
+ example 'enomem' is generated if a memory allocation
+ fails, and 'einval' is generated if the file handle in
+ Erlang is a file handle but currently invalid).</p>
+ <p>More Erlang-ish error codes are now generated. For
+ example <c>{error,badarg}</c> is now returned from
+ <c>file:close/1</c> if the argument is not of a file
+ handle type. See file(3).</p> <p>The possibility to write
+ a single byte using <c>file:write/2</c> instead of a list
+ or binary of one byte, contradictory to the
+ documentation, has been removed.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-6967 Aux Id: OTP-6597 OTP-6291 </p>
+ </item>
+ <item>
+ <p>
+ Monitor messages produced by the system monitor
+ functionality, and garbage collect trace messages could
+ contain erroneous heap and/or stack sizes when the actual
+ heaps and/or stacks were huge.</p>
+ <p>
+ As of erts version 5.6 the <c>large_heap</c> option to
+ <c>erlang:system_monitor/[1,2]</c> has been modified. The
+ monitor message is sent if the sum of the sizes of all
+ memory blocks allocated for all heap generations is equal
+ to or larger than the specified size. Previously the
+ monitor message was sent if the memory block allocated
+ for the youngest generation was equal to or larger than
+ the specified size.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-6974 Aux Id: seq10796 </p>
+ </item>
+ <item>
+ <p>
+ <c>inet:getopts/2</c> returned random values on Windows
+ Vista.</p>
+ <p>
+ Own Id: OTP-7003</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Minor documentation corrections for file:pread/2 and
+ file:pread/3.</p>
+ <p>
+ Own Id: OTP-6853</p>
+ </item>
+ <item>
+ <p>
+ The deprecated functions <c>file:file_info/1</c>,
+ <c>init:get_flag/1</c>, <c>init:get_flags/0</c>, and
+ <c>init:get_args/0</c> have been removed.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-6886</p>
+ </item>
+ <item>
+ <p>
+ Contract directives for modules in Kernel and STDLIB.</p>
+ <p>
+ Own Id: OTP-6895</p>
+ </item>
+ <item>
+ <p>The functions io:columns/0, io:columns/1, io:rows/0
+ and io:rows/1 are added to allow the user to get
+ information about the terminal geometry. The shell takes
+ some advantage of this when formatting output. For
+ regular files and other io-devices where height and width
+ are not applicable, the functions return
+ {error,enotsup}.</p>
+ <p>Potential incompatibility: If one has written a custom
+ io-handler, the handler has to either return an error or
+ take care of io-requests regarding terminal height and
+ width. Usually that is no problem as io-handlers, as a
+ rule of thumb, should give an error reply when receiving
+ unknown io-requests, instead of crashing.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-6933</p>
+ </item>
+ <item>
+ <p>
+ The undocumented and unsupported functions
+ <c>inet:ip_to_bytes/1</c>, <c>inet:ip4_to_bytes/1</c>,
+ <c>inet:ip6_to_bytes/1</c>, and
+ <c>inet:bytes_to_ip6/16</c> have been removed.</p>
+ <p>
+ Own Id: OTP-6938</p>
+ </item>
+ <item>
+ <p>
+ Added new checksum combine functions to <c>zlib</c>. And
+ fixed a bug in <c>zlib:deflate</c>. Thanks Matthew
+ Dempsky.</p>
+ <p>
+ Own Id: OTP-6970</p>
+ </item>
+ <item>
+ <p>
+ The <c>spawn_monitor/1</c> and <c>spawn_monitor/3</c> BIFs
+ are now auto-imported (i.e. they no longer need an
+ <c>erlang:</c> prefix).</p>
+ <p>
+ Own Id: OTP-6975</p>
+ </item>
+ <item>
+ <p>All functions in the <c>code</c> module now fail with
+ an exception if they are called with obviously bad
+ arguments, such as a tuple when an atom was expected.
+ Some functions now also fail for undocumented argument
+ types (for instance, <c>ensure_loaded/1</c> now only
+ accepts an atom as documented; it used to accept a string
+ too).</p>
+ <p><c>Dialyzer</c> will generally emit warnings for any
+ calls that use undocumented argument types. Even if the
+ call happens to still work in R12B, you should correct
+ your code. A future release will adhere to the
+ documentation.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-6983</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.11.5.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The kernel parameter dist_auto_connect once could fail to
+ block a node if massive parallel sends were issued
+ during a transient failure of network communication</p>
+ <p>
+ Own Id: OTP-6893 Aux Id: seq10753 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Kernel 2.11.5.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The internal (rarely used) DNS resolver has been modified
+ to not use the domain search list when asked to resolve
+ an absolute name; a name with a terminating dot. There
+ was also a bug causing it to create malformed DNS queries
+ for absolute names that has been corrected, correction
+ suggested by Scott Lystig Fritchie. The code has also
+ been corrected to look up cached RRs in the same search
+ order as non-cached, now allows having the root domain
+ among the search domains, and can now actually do a zone
+ transfer request.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-6806 Aux Id: seq10714 EABln35459 </p>
+ </item>
+ <item>
+ <p>
+ zlib:close/1 would leave an EXIT message in the message
+ queue if the calling process had the trap_exit flag
+ enabled.</p>
+ <p>
+ Own Id: OTP-6811</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>The documentation of <c>process_flag(priority,
+ Level)</c> has been updated, see the <c>erlang(3)</c>
+ documentation. </p>
+ <p>
+ Own Id: OTP-6745 Aux Id: OTP-6715 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+ <section>
+ <title>Kernel 2.11.5</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>The shell has been updated to fix the following flaws:
+ Shell process exit left you with an unresponsive initial
+ shell if not using oldshell. Starting a restricted shell
+ with a nonexisting callback module resulted in a shell
+ where no commands could be used, not even init:stop/0.
+ Fun's could not be used as parameters to local shell
+ functions (in shell_default or user_default) when
+ restricted_shell was active.</p>
+ <p>Own Id: OTP-6537</p>
+ </item>
+ <item>
+ <p>The undocumented feature gen_tcp:fdopen/2 was broken
+ in R11B-4. It is now fixed again.</p>
+ <p>Own Id: OTP-6615</p>
+ </item>
+ <item>
+ <p>Corrected cancellation of timers in three places in the
+ inet_res module. (Problem found by Dialyzer.)</p>
+ <p>Own Id: OTP-6676</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Corrected protocol layer flue for socket options
+ SO_LINGER, SO_SNDBUF and SO_RCVBUF, for SCTP.</p>
+ <p>Own Id: OTP-6625 Aux Id: OTP-6336 </p>
+ </item>
+ <item>
+ <p>The behaviour of the inet option {active,once} on peer
+ close is improved and documented.</p>
+ <p>Own Id: OTP-6681</p>
+ </item>
+ <item>
+ <p>The inet option send_timeout for connection oriented
+ sockets is added to allow for timeouts in communicating
+ send requests to the underlying TCP stack.</p>
+ <p>Own Id: OTP-6684 Aux Id: seq10637 OTP-6681 </p>
+ </item>
+ <item>
+ <p>Minor Makefile changes.</p>
+ <p>Own Id: OTP-6689 Aux Id: OTP-6742 </p>
+ </item>
+ <item>
+ <p>The documentation of <c>process_flag(priority, Level)</c> has been updated, see the <c>erlang(3)</c>
+ documentation. </p>
+ <p>Own Id: OTP-6715</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11.4.2</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>process_flag/2 accepts the new flag <c>sensitive</c>.</p>
+ <p>Own Id: OTP-6592 Aux Id: seq10555 </p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11.4.1</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>A bug in gen_udp:open that broke the 'fd' option has been
+ fixed.</p>
+ <p>Own Id: OTP-6594 Aux Id: seq10619 </p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11.4</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Added a warning to the documentation for the
+ <c>error_logger</c> functions <c>error_msg/1,2</c>,
+ <c>warning_msg/1,2</c> and <c>info_msg/1,2</c> that
+ calling these function with bad arguments can crash the
+ standard event handler.</p>
+ <p>Own Id: OTP-4575 Aux Id: seq7693 </p>
+ </item>
+ <item>
+ <p>A bug in <c>inet_db</c> concerning getting the resolver
+ option <c>retry</c> has been corrected.</p>
+ <p>Own Id: OTP-6380 Aux Id: seq10534 </p>
+ </item>
+ <item>
+ <p>Names registered by calling
+ <c>global:register_name()</c> or
+ <c>global:re_register_name()</c> were not always
+ unregistered when the registering or registered process
+ died. This bug has been fixed.</p>
+ <p>Own Id: OTP-6428</p>
+ </item>
+ <item>
+ <p>When setting the kernel configuration parameter
+ <c>error_logger</c> to <c>false</c>, the documentation
+ stated that "No error logger handler is installed". This
+ is true, but error logging is not turned off, as the
+ initial, primitive error logger event handler is kept,
+ printing raw event messages to tty.</p>
+ <p>Changing this behavior can be viewed as a backward
+ incompatible change. Instead a new value <c>silent</c>
+ for the configuration parameter has been added, which
+ ensures that error logging is completely turned off.</p>
+ <p>Own Id: OTP-6445</p>
+ </item>
+ <item>
+ <p>Clarified the documentation for <c>code:lib_dir/1</c> and
+ <c>code:priv_dir/1</c>. The functions traverse the names
+ of the code path, they do not search the actual
+ directories.</p>
+ <p>Own Id: OTP-6466</p>
+ </item>
+ <item>
+ <p><c>io:setopts</c> returned <c>{error,badarg}</c>, when
+ called with only an <c>expand_fun</c> argument. (Thanks to
+ igwan.)</p>
+ <p>Own Id: OTP-6508</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>An interface towards the SCTP Socket API Extensions
+ has been implemented.It is an Open Source patch courtesy
+ of Serge Aleynikov and Leonid Timochouk. The Erlang code
+ parts has been adapted by the OTP team, changing the
+ Erlang API somewhat.</p>
+ <p>The Erlang interface consists of the module
+ <c>gen_sctp</c> and an include file
+ <c>-include_lib("kernel/include/inet_sctp.hrl").</c> for
+ option record definitions. The <c>gen_sctp</c> module is
+ documented.</p>
+ <p>The delivered Open Source patch, before the OTP team
+ rewrites, was written according to
+ <url href="http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13">http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13</url>
+ and was claimed to work fine, tested on Linux Fedora Core
+ 5.0 (kernel 2.6.15-2054 or later) and on Solaris 10 and
+ 11. The OTP team rewrites used the same standard document
+ but might have accidentally broken some functionality. If
+ so, it will soon be patched to working state. The tricky
+ parts in C and the general design has essentially not
+ changed. During the rewrites the code was hand tested on
+ SuSE Linux Enterprise Server 10, and briefly on Solaris
+ 10. Feedbach on code and docs is very much
+ appreciated.</p>
+ <p>The SCTP interface is in beta state. It has only been
+ hand tested and has no automatic test suites in OTP
+ meaning everything is most certainly not tested. Socket
+ active mode is broken. IPv6 is not tested. The documentation
+ has been reworked due to the API changes,
+ but has not been proofread after this.</p>
+ <p>Thank you from the OTP team to Serge Aleynikov and
+ Leonid Timochouk for a valuable contribution. We hope we
+ have not messed it up too much.</p>
+ <p>Own Id: OTP-6336</p>
+ </item>
+ <item>
+ <p>A <c>{minor_version,Version}</c> option is now recognized
+ by <c>term_to_binary/2</c>. {minor_version,1} will cause
+ floats to be encoded in an exact and more space-efficient
+ way compared to the previous encoding.</p>
+ <p>Own Id: OTP-6434</p>
+ </item>
+ <item>
+ <p>Monitoring of nodes has been improved. Now the following
+ properties apply to
+ <c>net_kernel:monitor_nodes/[1,2]</c>:</p>
+ <list type="bulleted">
+ <item><c>nodeup</c> messages will be delivered before delivery
+ of any message from the remote node passed through the
+ newly established connection. </item>
+ <item><c>nodedown</c> messages will not be delivered until all
+ messages from the remote node that have been passed
+ through the connection have been delivered. </item>
+ <item>Subscriptions can also be made before the
+ <c>net_kernel</c> server has been started. </item>
+ </list>
+ <p>Own Id: OTP-6481</p>
+ </item>
+ <item>
+ <p>Setting and getting socket options in a "raw" fashion is
+ now allowed. Using this feature will inevitably produce
+ non portable code, but will allow setting ang getting
+ arbitrary uncommon options on TCP stacks that do have
+ them.</p>
+ <p>Own Id: OTP-6519</p>
+ </item>
+ <item>
+ <p>Dialyzer warnings have been eliminated.</p>
+ <p>Own Id: OTP-6523</p>
+ </item>
+ <item>
+ <p>The documentation for <c>file:delete/1</c> and
+ <c>file:set_cwd/1</c> has been updated to clarify what
+ happens if the input arguments are of an incorrect type.</p>
+ <p>Own Id: OTP-6535</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11.3.1</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>An erroneous packet size could be used for the first
+ messages passed through a newly established connection
+ between two Erlang nodes. This could cause messages to be
+ discarded, or termination of the connection.</p>
+ <p>Own Id: OTP-6473</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11.3</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>On Unix, the <c>unix:cmd/1</c> function could leave an
+ 'EXIT' message in the message queue for the calling
+ process That problem was more likely to happen in an SMP
+ emulator.</p>
+ <p>Own Id: OTP-6368</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>More interfaces are added in erl_ddll, to support
+ different usage scenarios.</p>
+ <p>Own Id: OTP-6307 Aux Id: OTP-6234 </p>
+ </item>
+ <item>
+ <p>Locks set by calling <c>global:set_lock()</c> were not
+ always deleted when the locking process died. This bug
+ has been fixed.</p>
+ <p>Own Id: OTP-6341 Aux Id: seq10445 </p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11.2</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Behavior in case of disappeared nodes when using he
+ dist_auto_connect once got changed in R11B-1. The
+ timeouts regarding normal distributed operations is now
+ reverted to the old (pre R11B-1).</p>
+ <p>Own Id: OTP-6258 Aux Id: OTP-6200, seq10449 </p>
+ </item>
+ <item>
+ <p>Start-up problems for the internal process used by the
+ <c>inet:gethostbyname()</c> functions were eliminated. If
+ the internal process (<c>inet_gethost_native</c>) had not
+ previously been started, and if several processes at the
+ same time called one of the <c>inet:gethostbyname()</c>
+ functions, the calls could fail.</p>
+ <p>Own Id: OTP-6286</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Code cleanup: the old internal obsolete file_server has
+ been removed. It was only used when communicating with R7
+ and older nodes.</p>
+ <p>Own Id: OTP-6245</p>
+ </item>
+ <item>
+ <p>Trying to open a non-existent or badly formed disk log
+ no longer results in a crash report. In particular,
+ <c>ets:file2tab/1</c> reports no error when the argument
+ is not a well-formed disk log file. (The return value has
+ not been changed, it is still an error tuple.)</p>
+ <p>Own Id: OTP-6278 Aux Id: seq10421 </p>
+ </item>
+ <item>
+ <p>There are new BIFs <c>erlang:spawn_monitor/1,3</c>,
+ and the new option <c>monitor</c> for
+ <c>spawn_opt/2,3,4,5</c>.</p>
+ <p>The <c>observer_backend</c> module has been updated to
+ handle the new BIFs.</p>
+ <p>Own Id: OTP-6281</p>
+ </item>
+ <item>
+ <p>To help Dialyzer find more bugs, many functions in the
+ Kernel and STDLIB applications now only accept arguments
+ of the type that is documented.</p>
+ <p>For instance, the functions <c>lists:prefix/2</c> and
+ <c>lists:suffix/2</c> are documented to only accept lists
+ as their arguments, but they actually accepted anything
+ and returned <c>false</c>. That has been changed so that
+ the functions cause an exception if one or both arguments
+ are not lists.</p>
+ <p>Also, the <c>string:strip/3</c> function is documented
+ to take a character argument that is a character to strip
+ from one or both ends of the string. Given a list instead
+ of a character, it used to do nothing, but will now cause
+ an exception.</p>
+ <p>Dialyzer will find most cases where those functions
+ are passed arguments of the wrong type.</p>
+ <p>*** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>Own Id: OTP-6295</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11.1.1</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>There is now an option read_packets for UDP sockets that
+ sets the maximum number of UDP packets that will be read
+ for each invocation of the socket driver.</p>
+ <p>Own Id: OTP-6249 Aux Id: seq10452 </p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11.1</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>In R11B-0, the erl_ddll server process is always started.
+ Despite that, the configuration parameter
+ <c>start_ddll</c> for the Kernel application was still
+ obeyed, which would cause the erl_ddll server to be
+ started TWICE (and the system shutting down as a result).
+ In this release, <c>start_ddll</c> is no longer used and
+ its documentation has been removed.</p>
+ <p>Own Id: OTP-6163</p>
+ </item>
+ <item>
+ <p>The kernel option {dist_auto_connect,once} could block
+ out nodes that had never been connected, causing
+ persistent partitioning of networks. Furthermore, partial
+ restarts of networks could cause inconsistent global name
+ databases. Both problems are now solved.</p>
+ <p>Own Id: OTP-6200 Aux Id: seq10377 </p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Late arriving tcp_closed and udp_closed messages are now
+ removed from the message queue of a process calling
+ gen_tcp:close/1, gen_udp:close/1, and inet:close/1.</p>
+ <p>Own Id: OTP-6197</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.11</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>When repairing a disk log with a corrupt index file
+ (caused by for instance a hard disk failure) the old
+ contents of the index file is kept unmodified. This will
+ make repeated attempts to open the disk log fail every
+ time.</p>
+ <p>Own Id: OTP-5558 Aux Id: seq9823 </p>
+ </item>
+ <item>
+ <p>Previously <c>unlink/1</c> and <c>erlang:demonitor/2</c>
+ behaved completely asynchronous. This had one undesirable
+ effect, though. You could never know when you were
+ guaranteed <em>not</em> to be affected by a link that you
+ had unlinked or a monitor that you had demonitored.</p>
+ <p>The new behavior of <c>unlink/1</c> and
+ <c>erlang:demonitor/2</c> can be viewed as two operations
+ performed atomically. Asynchronously send an unlink
+ signal or a demonitor signal, and ignore any future
+ results of the link or monitor.</p>
+ <p><em>NOTE</em>: This change can cause some obscure code
+ to fail which previously did not. For example, the
+ following code might hang:</p>
+ <code type="none">
+ Mon = erlang:monitor(process, Pid),
+ %% ...
+ exit(Pid, bang),
+ erlang:demonitor(Mon),
+ receive
+ {'DOWN', Mon, process, Pid, _} -> ok
+ %% We were previously guaranteed to get a down message
+ %% (since we exited the process ourself), so we could
+ %% in this case leave out:
+ %% after 0 -> ok
+ end,
+ </code>
+ <p>*** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>Own Id: OTP-5772</p>
+ </item>
+ <item>
+ <p>The behavior when an application fails to start and
+ possibly causes the runtime system to halt has been
+ cleaned up, including fixing some minor bugs.</p>
+ <p><c>application_controller</c> should now always terminate
+ with a non-nested string, meaning the slogan in an
+ <c>erl_crash.dump</c> should always be easy to read.</p>
+ <p><c>init</c> now makes sure that the slogan passed to
+ <c>erlang:halt/1</c> does not exceed the maximum allowed
+ length.</p>
+ <p>Redundant calls to <c>list_to_atom/1</c> has been removed
+ from the primitive <c>error_logger</c> event handler.
+ (Thanks Serge Aleynikov for pointing this out).</p>
+ <p>The changes only affects the contents of the error
+ messages and crashdump file slogan.</p>
+ <p>Own Id: OTP-5964</p>
+ </item>
+ <item>
+ <p>The <c>erl_ddll</c> server is now started when OTP is
+ started and placed under the Kernel supervisor. This
+ fixes several minor issues. It used to be started on
+ demand.</p>
+ <p>The documentation for the <c>start</c> and <c>stop</c>
+ functions in the <c>erl_ddll</c> module has been removed,
+ as those functions are not meant to be used by other
+ applications.</p>
+ <p>Furthermore, the <c>erl_ddll:stop/1</c> function no longer
+ terminates the <c>erl_ddll</c> server, as that would
+ terminate the entire runtime system.</p>
+ <p>Own Id: OTP-6033</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Removed some unused functions from
+ <c>application_master</c>.</p>
+ <p>Own Id: OTP-3889</p>
+ </item>
+ <item>
+ <p>Global no longer allows the registration of a process
+ under more than one name. If the old (buggy) behavior is
+ desired the Kernel application variable
+ <c>global_multi_name_action</c> can be given the value
+ <c>allow</c>.</p>
+ <p>Own Id: OTP-5640 Aux Id: OTP-5603</p>
+ </item>
+ <item>
+ <p>The (slightly misleading) warnings that was shown when
+ the <c>erlang.erl</c> file was compiled has been
+ eliminated.</p>
+ <p>Own Id: OTP-5947</p>
+ </item>
+ <item>
+ <p>The <c>auth</c> module API is deprecated.</p>
+ <p>Own Id: OTP-6037</p>
+ </item>
+ <item>
+ <p>Added <c>erlang:demonitor/2</c>, making it possible to at
+ the same time flush a received <c>'DOWN'</c> message, if
+ there is one. See <c>erlang(3)</c>.</p>
+ <p>Own Id: OTP-6100 Aux Id: OTP-5772 </p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.13</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Large files (more than 2 GBytes) are now handled on
+ Solaris 8.</p>
+ <p>Own Id: OTP-5849 Aux Id: seq10157</p>
+ </item>
+ <item>
+ <p>During startup, a garbage <c>{'DOWN', ...}</c> message was
+ left by <c>inet_gethost_native</c>, that caused problems
+ for the starting code server.</p>
+ <p>Own Id: OTP-5978 Aux Id: OTP-5974</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p><c>global</c> now makes several attempts to connect nodes
+ when maintaining the fully connected network. More than one
+ attempt is sometimes needed under very heavy load.</p>
+ <p>Own Id: OTP-5889</p>
+ </item>
+ <item>
+ <p><c>erl_epmd</c> now explicitly sets the timeout to
+ <c>infinity</c> when calling <c>gen_server:call</c>. The
+ old timeout of 15 seconds could time out under very heavy
+ load.</p>
+ <p>Own Id: OTP-5959</p>
+ </item>
+ <item>
+ <p>Corrected the start of code server to use reference-tagged
+ tuples to ensure that an unexpected message sent to
+ the parent process does not cause a halt of the system.
+ Also removed the useless <c>start/*</c> functions in both
+ <c>code.erl</c> and <c>code_server.erl</c> and no longer
+ exports the <c>init</c> function from
+ <c>code_server.erl</c>.</p>
+ <p>Own Id: OTP-5974 Aux Id: seq10243, OTP-5978</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.12</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>A bug in <c>global</c> has been fixed: the locker process
+ added <c>nonode@nohost</c> to the list of nodes to lock.
+ This could happen before any nodes got known to the global
+ name server. Depending on net configuration the symptom was
+ a delay.</p>
+ <p>Own Id: OTP-5792 Aux Id: OTP-5563</p>
+ </item>
+ <item>
+ <p>If an <c>.app</c> file is missing, the error reason
+ returned by <c>application:load/1</c> has been corrected
+ to <c>{"no such file or directory", "FILE.app"}</c>,
+ instead of the less informative <c>{"unknown POSIX error","FILE.app"}</c>.</p>
+ <p>Own Id: OTP-5809</p>
+ </item>
+ <item>
+ <p>Bug fixes: <c>disk_log:accessible_logs/0</c> no longer
+ reports all <c>pg2</c> process groups as distributed disk
+ logs; <c>disk_log:pid2name/1</c> did not recognize
+ processes of distributed disk logs.</p>
+ <p>Own Id: OTP-5810</p>
+ </item>
+ <item>
+ <p>The functions <c>file:consult/1</c>,
+ <c>file:path_consult/2</c>, <c>file:eval/1,2</c>,
+ <c>file:path_eval/2,3</c>, <c>file:script/1,2</c>,
+ <c>file:path_script/2,3</c> now return correct line
+ numbers in error tuples.</p>
+ <p>Own Id: OTP-5814</p>
+ </item>
+ <item>
+ <p>If there were user-defined variables in the boot script,
+ and their values were not provided using
+ the <c>-boot_var</c> option, the emulator would refuse to
+ start with a confusing error message. Corrected to show a
+ clear, understandable message.</p>
+ <p>The <c>prim_file</c> module was modified to not depend
+ on the <c>lists</c> module, to make it possible to start
+ the emulator using a user-defined loader. (Thanks to
+ Martin Bjorklund.)</p>
+ <p>Own Id: OTP-5828 Aux Id: seq10151</p>
+ </item>
+ <item>
+ <p>Minor corrections in the description of open modes.
+ (Thanks to Richard Carlsson.)</p>
+ <p>Own Id: OTP-5856</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p><c>application_controller</c> now terminates with the
+ actual error reason, instead of <c>shutdown</c>. This
+ means that the crash dump now should be somewhat more
+ informative, in the case where the runtime system is
+ terminated due to an error in an application.</p>
+ <p>Example: If the (permanent) application <c>app1</c> fails
+ to start, the slogan now will be: "<c>Kernel pid terminated (application_controller) ({application_start_failure,app1,{shutdown, {app1,start,[normal,[]]}}})</c>"</p>
+ <p>rather than the previous "<c>Kernel pid terminated (application_controller) (shutdown)</c>".</p>
+ <p>Own Id: OTP-5811</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.11.1</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Timers could sometimes timeout too early. This bug has
+ now been fixed.</p>
+ <p>Automatic cancellation of timers created by
+ <c>erlang:send_after(Time,</c> pid(), Msg), and
+ <c>erlang:start_timer(Time,</c> pid(), Msg) has been
+ introduced.
+ Timers created with the receiver specified by a pid, will
+ automatically be cancelled when the receiver exits. For
+ more information see the <c>erlang(3)</c> man page.</p>
+ <p>In order to be able to maintain a larger amount of timers
+ without increasing the maintenance cost, the internal
+ timer wheel and bif timer table have been enlarged.</p>
+ <p>Also a number of minor bif timer optimizations have been
+ implemented.</p>
+ <p>Own Id: OTP-5795 Aux Id: OTP-5090, seq8913, seq10139,
+ OTP-5782</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Documentation improvements:</p>
+ <p>- documentation for <c>erlang:link/1</c> corrected</p>
+ <p>- command line flag <c>-code_path_cache</c> added</p>
+ <p>- <c>erl</c> command line flags clarifications</p>
+ <p>- <c>net_kernel(3)</c> clarifications</p>
+ <p>Own Id: OTP-5847</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.11</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Several bug fixes and improvements in the global name
+ registration facility (see <c>global(3)</c>):</p>
+ <list type="bulleted">
+ <item>the name resolving procedure did not always unlink no
+ longer registered processes;</item>
+ <item>the global name could sometimes hang when a
+ <c>nodedown</c> was immediately followed by a
+ <c>nodeup</c>;</item>
+ <item>global names were not always unregistered when a node
+ went down;</item>
+ <item>it is now possible to set and delete locks at
+ the same time as the global name server is resolving
+ names--the handling of global locks has been separated
+ from registration of global names;</item>
+ </list>
+ <p>As of this version, <c>global</c> no longer supports nodes
+ running Erlang/OTP R7B or earlier.</p>
+ <p>*** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>Own Id: OTP-5563</p>
+ </item>
+ <item>
+ <p>The functions <c>global:set_lock/3</c> and
+ <c>global:trans/4</c> now accept the value <c>0</c>
+ (zero) of the <c>Retries</c> argument.</p>
+ <p>Own Id: OTP-5737</p>
+ </item>
+ <item>
+ <p>The <c>inet:getaddr(Addr, Family)</c> no longer
+ validates the <c>Addr</c> argument if it is a 4 or 8
+ tuple containing the IP address, except for the size of
+ the tuple and that it contains integers in the correct
+ range.</p>
+ <p>The reason for the change is that validation could
+ cause the following sequence of calls to fail:</p>
+ <p><c>{ok,Addr} = inet:getaddr(localhost, inet6), gen_tcp:connect(Addr, 7, [inet6])</c></p>
+ <p>Own Id: OTP-5743</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>The previously undocumented and UNSUPPORTED <c>zlib</c>
+ module has been updated in an incompatible way and many
+ bugs have been corrected. It is now also documented.</p>
+ <p>*** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>Own Id: OTP-5715</p>
+ </item>
+ <item>
+ <p>Added <c>application</c> interface functions
+ <c>which_applications/1</c>, <c>set_env/4</c> and
+ <c>unset_env/3</c>, which take an additional
+ <c>Timeout</c> argument. To be used in situations where
+ the standard gen_server timeout (5000ms) is not adequate.</p>
+ <p>Own Id: OTP-5724 Aux Id: seq10083</p>
+ </item>
+ <item>
+ <p>Improved documentation regarding synchronized start of
+ applications with included applications (using start
+ phases and <c>application_starter</c>).</p>
+ <p>Own Id: OTP-5754</p>
+ </item>
+ <item>
+ <p>New socket options <c>priority</c> and <c>tos</c> for
+ platforms that support them (currently only Linux).</p>
+ <p>Own Id: OTP-5756</p>
+ </item>
+ <item>
+ <p>The global name server has been optimized when it comes
+ to maintaining a fully connected network.</p>
+ <p>Own Id: OTP-5770</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.10.1</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>The native resolver has gotten an control API for
+ extended debugging and soft restart. It is:
+ <c>inet_gethost_native:control(Control)</c> <br></br>
+<c>Control = {debug_level,Level} | soft_restart</c> <br></br>
+<c>Level = integer() in the range 0-4</c>.</p>
+ <p>Own Id: OTP-5751 Aux Id: EABln25013</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.10</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>If several processes (at the same node) simultaneously
+ tried to start the same distributed application, this
+ could lead to <c>application:start</c> returning an
+ erroneous value, or even hang.</p>
+ <p>Own Id: OTP-5606 Aux Id: seq9838</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>The manual pages for most of the Kernel and some of
+ the STDLIB modules have been updated, in particular
+ regarding type definitions.</p>
+ <p>The documentation of the return value for
+ <c>erts:info/1</c> has been corrected.</p>
+ <p>The documentation for <c>erlang:statistics/1</c> now
+ lists all possible arguments.</p>
+ <p>Own Id: OTP-5360</p>
+ </item>
+ <item>
+ <p>When the native resolver fails a <c>gethostbyaddr</c>
+ lookup, <c>nxdomain</c> should be returned. There should be
+ no attempt to fallback on a routine that succeeds if only
+ the syntax of the IP address is valid. This has been fixed.</p>
+ <p>Own Id: OTP-5598 Aux Id: OTP-5576</p>
+ </item>
+ <item>
+ <p>Replaced some tuple funs with the new <c>fun M:F/A</c>
+ construct.</p>
+ <p>The high-order functions in the <c>lists</c> module no
+ longer accept bad funs under any circumstances.
+ '<c>lists:map(bad_fun, [])</c>' used to return
+ '<c>[]</c>' but now causes an exception.</p>
+ <p>Unused, broken compatibility code in the <c>ets</c>
+ module was removed. (Thanks to Dialyzer.)</p>
+ <p>Eliminated 5 discrepancies found by Dialyzer in the
+ Appmon application.</p>
+ <p>Own Id: OTP-5633</p>
+ </item>
+ <item>
+ <p>The possibility to have comments following the list of
+ tuples in a config file (file specified with
+ the <c>-config</c> flag) has been added.</p>
+ <p>Own Id: OTP-5661 Aux Id: seq10003</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.9</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>'<c>erl -config sys.config</c>' would fail to start if
+ the <c>sys.config</c> file did not contain any whitespace
+ at all after the dot. (Thanks to Anders Nygren.)</p>
+ <p>Own Id: OTP-5543</p>
+ </item>
+ <item>
+ <p>A bug regarding tcp sockets which results in hanging
+ <c>gen_tcp:send/2</c> has been corrected. To encounter
+ this bug you needed one process that read from a socket,
+ one that wrote more date than the reader read out so the
+ sender got suspended, and then the reader closed the
+ socket. (Reported and diagnosed by Alexey Shchepin.)</p>
+ <p>Corrected a bug in the (undocumented and unsupported)
+ option <c>{packet,http}</c> for <c>gen_tcp.</c>
+ (Thanks to Claes Wikstrom and Luke Gorrie.)</p>
+ <p>Updated the documentation regarding the second argument to
+ <c>gen_tcp:recv/2</c>, the <c>Length</c> to receive.</p>
+ <p>Own Id: OTP-5582 Aux Id: seq9839</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>At startup, the Erlang resolver hosts table was used to
+ look up the name of the local (and possibly stand alone)
+ host. This was incorrect. The configured resolver method
+ is now used for this purpose.</p>
+ <p>Own Id: OTP-5393</p>
+ </item>
+ <item>
+ <p>The <c>erlang:port_info/1</c> BIF is now documented. Minor
+ corrections of the documentation for
+ <c>erlang:port_info/2</c>.</p>
+ <p>Added a note to the documentation of the <c>math</c> module
+ that all functions are not available on all platforms.</p>
+ <p>Added more information about the <c>+c</c> option in
+ the <c>erl</c> man page in the ERTS documentation.</p>
+ <p>Own Id: OTP-5555</p>
+ </item>
+ <item>
+ <p>The new <c>fun M:F/A</c> construct creates a fun that
+ refers to the latest version of <c>M:F/A.</c> This syntax is
+ meant to replace tuple funs <c>{M,F}</c> which have many
+ problems.</p>
+ <p>The new type test <c>is_function(Fun,A)</c> (which may be
+ used in guards) test whether <c>Fun</c> is a fun that can be
+ applied with <c>A</c> arguments. (Currently, <c>Fun</c> can
+ also be a tuple fun.)</p>
+ <p>Own Id: OTP-5584</p>
+ </item>
+ <item>
+ <p>According to the documentation <c>global</c> implements
+ the equivalent of <c>register/2</c>, which returns
+ <c>badarg</c> if a process is already registered. As it
+ turns out there is no check in <c>global</c> if a process is
+ registered under more than one name. If some process is
+ accidentaly or by design given several names, it is
+ possible that the name registry becomes inconsistent due
+ to the way the resolve function is called when name
+ clashes are discovered (see <c>register_name/3</c> in
+ <c>global(3)</c>).</p>
+ <p>In OTP R11B <c>global</c> will not allow the registration of
+ a process under more than one name. To help finding code
+ where <c>no</c> will be returned, a Kernel application
+ variable, <c>global_multi_name_action</c>, is hereby
+ introduced. Depending on its value (<c>info</c>,
+ <c>warning</c>, or <c>error</c>), messages are sent to
+ the error logger when <c>global</c> discovers that some
+ process is given more than one name. The variable only
+ affects the node where it is defined.</p>
+ <p>Own Id: OTP-5603</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.8</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>In case of a DNS lookup loop, <c>inet_db:getbyname</c> ends
+ up building an infinite list. This has been fixed.</p>
+ <p>Own Id: OTP-5449</p>
+ </item>
+ <item>
+ <p>When doing an <c>inet6</c> name lookup on an IPv4 address
+ it was possible to get an address on IPv4 format back. This
+ has been corrected. Some other minor inconsistencies
+ regarding IPv6 name lookup have also been corrected.</p>
+ <p>Own Id: OTP-5576</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.7</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Under certain circumstances the <c>net_kernel</c> could
+ emit spurious nodedown messages. This bug has been fixed.</p>
+ <p>Own Id: OTP-5396</p>
+ </item>
+ <item>
+ <p>Removed description of the <c>keep_zombies</c>
+ configuration parameter in the <c>kernel</c> man page.</p>
+ <p>Own Id: OTP-5497</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Eliminated Dialyzer warnings (caused by dead code) in
+ the <c>init</c> and <c>prim_file</c> modules.</p>
+ <p>Own Id: OTP-5496</p>
+ </item>
+ <item>
+ <p><c>inet_config</c> now also checks the environment variable
+ <c>ERL_INETRC</c> for a possible user configuration file.
+ See the ERTS User's Guide for details.</p>
+ <p>Own Id: OTP-5512</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.6</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>The <c>c</c> option for the <c>+B</c> flag has been
+ introduced which makes it possible to use Ctrl-C
+ (Ctrl-Break on Windows) to interrupt the shell process
+ rather than to invoke the emulator break handler. All new
+ <c>+B</c> options are also supported on Windows (werl) as
+ of now. Furthermore, Ctrl-C on Windows has now been
+ reserved for copying text (what Ctrl-Ins was used for
+ previously). Ctrl-Break should be used for break handling.
+ Lastly, the documentation of the system flags has been
+ updated.</p>
+ <p>Own Id: OTP-5388</p>
+ </item>
+ <item>
+ <p>The possibility to start the Erlang shell in parallel
+ with the rest of the system was reintroduced for backwards
+ compatibility in STDLIB 1.13.1. The flag to be used for
+ this is now called <c>async_shell_start</c> and has
+ been documented. New shells started from the JCL menu are
+ not synchronized with <c>init</c> anymore. This makes it
+ possible to start a new shell (e.g. for debugging purposes)
+ even if the initial shell has not come up.</p>
+ <p>Own Id: OTP-5406 Aux Id: OTP-5218</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.5</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Documentation for <c>erlang:binary_to_float/1</c> deleted.
+ The BIF itself was removed several releases ago.</p>
+ <p>Updated documentation for <c>apply/2</c> and
+ <c>apply/3</c>.</p>
+ <p>Own Id: OTP-5391</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p><c>net_kernel:monitor_nodes/2</c> which takes a flag and an
+ option list has been added. By use of
+ <c>net_kernel:monitor_nodes/2</c> one can subscribe for
+ <c>nodeup/nodedown</c> messages with extra information. It
+ is now possible to monitor hidden nodes, and get
+ <c>nodedown</c> reason. See the <c>net_kernel(3)</c>
+ documentation for more information.</p>
+ <p>Own Id: OTP-5374</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.4</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>The application master for an application now terminates
+ the application faster, which reduces the risk for
+ timeouts in other parts of the system.</p>
+ <p>Own Id: OTP-5363 Aux Id: EABln19084</p>
+ </item>
+ <item>
+ <p>A BIF <c>erlang:raise/3</c> has been added. See the manual
+ for details. It is intended for internal system programming
+ only, advanced error handling.</p>
+ <p>Own Id: OTP-5376 Aux Id: OTP-5257</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.3</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>With the <c>-eval</c> flag (<c>erl -eval Expr</c>), an
+ arbitrary expression can be evaluated during system
+ initialization. This is documented in <c>init(3)</c>.</p>
+ <p>Own Id: OTP-5260</p>
+ </item>
+ <item>
+ <p>The unsupported and undocumented modules <c>socks5</c>,
+ <c>socks5_auth</c>, <c>socks5_tcp</c>, and <c>socks5_udp</c>
+ have been removed.</p>
+ <p>Own Id: OTP-5266</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.10.1</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>The Pman 'trace shell' functionality was broken and has
+ now been fixed. Furthermore, Pman could not correctly
+ find the pid of the active shell if more than one shell
+ process was running on the node. This has also been
+ corrected.</p>
+ <p>Own Id: OTP-5191</p>
+ </item>
+ <item>
+ <p>The documentation for the <c>auth:open/1</c> function
+ which no longer exists has been removed. (Thanks to
+ Miguel Barreiro.)</p>
+ <p>Own Id: OTP-5208</p>
+ </item>
+ <item>
+ <p>Corrected the <c>crc32/3</c> function in the undocumented
+ and unsupported <c>zlib</c> module.</p>
+ <p>Own Id: OTP-5227</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>You can now start Erlang with the <c>-rsh</c> flag which
+ gives you a remote initial shell instead of a local one.
+ Example:</p>
+ <pre>
+ erl -sname this_node -rsh other_node@other_host
+ </pre>
+ <p>Own Id: OTP-5210</p>
+ </item>
+ <item>
+ <p>If <c>/etc/hosts</c> specified two hosts with the same IP
+ address (on separate lines), only the last host would be
+ registered by inet_db during inet configuration. This has
+ been corrected now so that both aliases are registered
+ with the same IP address.</p>
+ <p>Own Id: OTP-5212 Aux Id: seq7128</p>
+ </item>
+ <item>
+ <p>The documentation for BIFs that take I/O lists have
+ been clarified. Those are <c>list_to_binary/1</c>,
+ <c>port_command/2</c>, <c>port_control/3</c>.</p>
+ <p>Documentation for all <c>is_*</c> BIFs (such as
+ <c>is_atom/1</c>) has been added.</p>
+ <p>Removed the documentation for
+ <c>erlang:float_to_binary/2</c> which was removed from
+ the run-time system several releases ago.</p>
+ <p>Own Id: OTP-5222</p>
+ </item>
+ </list>
+ </section>
+ </section>
+</chapter>
+
diff --git a/lib/kernel/doc/src/notes_history.xml b/lib/kernel/doc/src/notes_history.xml
new file mode 100644
index 0000000000..2f6ceb9d42
--- /dev/null
+++ b/lib/kernel/doc/src/notes_history.xml
@@ -0,0 +1,415 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2006</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>Kernel Release Notes History</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+
+ <section>
+ <title>Kernel 2.10</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Added documentation of configuration parameter
+ <c>net_setuptime</c>.</p>
+ <p>Own Id: OTP-5117 Aux Id: seq8908</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>The <c>disk_log</c> module has been slightly changed for
+ the purpose of reducing the risk of memory problems due
+ to corrupt files. The <c>chunk</c> commands have been
+ optimized by increasing the chunk size from 8 kilobytes
+ to 64 kilobytes.</p>
+ <p>Own Id: OTP-4530 Aux Id: seq7646</p>
+ </item>
+ <item>
+ <p>The code server used <c>prim_file</c> for its file
+ operations. This made it impossible to load code from a
+ boot server. Now the code server uses <c>erl_prim_loader</c>
+ for these operations instead.</p>
+ <p>Own Id: OTP-4819 Aux Id: OTP-4802, OTP-4846</p>
+ </item>
+ <item>
+ <p>New functions - <c>rpc:call/5</c> and
+ <c>rpc:block_call/5</c>. They have a timeout argument! See
+ the documentation for details.</p>
+ <p>Own Id: OTP-4849 Aux Id: seq8250</p>
+ </item>
+ <item>
+ <p>A new environment parameter <c>browser_cmd</c> has been
+ introduced which defines how to display help text (HTML
+ files).</p>
+ <p>Own Id: OTP-4852</p>
+ </item>
+ <item>
+ <p>The system configuration file <c>sys.config</c> can now
+ contain names of other configuration files as well as
+ application configuration data.</p>
+ <p>Thus, it is now possible to have several configuration
+ files in connection with release handling. See
+ <c>config(4)</c> and <em>OTP Design Principles</em> for
+ more information.</p>
+ <p>Own Id: OTP-4867 Aux Id: OTP-1968</p>
+ </item>
+ <item>
+ <p>It is now possible to compile files with <c>erlc</c> without
+ getting a lot of (for compilation) unnecessary code
+ loaded and executed (like distribution, inet config,
+ etc). <c>erlc</c> now also calls <c>erl</c> with <c>-boot start_clean</c> (so that SASL is not started even if
+ <c>start_sasl</c> is default boot script).</p>
+ <p>Own Id: OTP-4878</p>
+ </item>
+ <item>
+ <p>Disk logs can now be opened or closed in parallel. In
+ particular, if some log is being repaired, other logs can
+ still be opened or closed.</p>
+ <p>Own Id: OTP-4913</p>
+ </item>
+ <item>
+ <p>Native lookup (system calls) is now default resolver
+ method on all platforms. Also the user inet configuration
+ method has changed so that a Kernel variable, <c>inetrc</c>,
+ should now be used to specify the name of the user inet
+ config file (if it exists). This is all documented in the
+ ERTS User's Guide.</p>
+ <p>*** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>Own Id: OTP-4983</p>
+ </item>
+ <item>
+ <p>Previously missing documentation of
+ <c>erlang:system_info/1</c> and <c>erlang:system_flag/2</c>
+ have been added.</p>
+ <p>Own Id: OTP-5038 Aux Id: seq8708</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.6.8</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>The code server now caches <c>.app</c> files as well as
+ <c>.beam</c> files. Application controller calls
+ the function <c>code:where_is_file/1</c> to locate
+ the cached <c>.app</c> file so that <c>file:consult/1</c>
+ may be used instead of <c>file:path_consult/2</c> to read
+ the file. This is much more efficient.</p>
+ <p>Own Id: OTP-5097 Aux Id: seq8956</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.6.7</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Improved setup of connection between nodes to avoid that
+ some nodes get lower priority (and thus times out) when
+ many nodes are connected simultaneously.</p>
+ <p>Own Id: OTP-5116 Aux Id: seq8908</p>
+ </item>
+ <item>
+ <p>There is now a packet size limit option for <c>gen_tcp</c>
+ sockets. See the manual for <c>inet:setopts/2</c>.</p>
+ <p>The ASN.1 BER packet decoding for <c>gen_tcp</c> sockets
+ can now decode indefinite length packets.</p>
+ <p>Own Id: OTP-5128</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.6.6</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>A helper for <c>global</c> would terminate if it received
+ unknown types of messages, causing <c>global</c> to
+ terminate too. Changed so that the helper process logs and
+ ignore strange messages.</p>
+ <p>Own Id: OTP-5078 Aux Id: seq_8839</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>The ability to set system wide options for TCP sockets is
+ added through the Kernel application variables
+ <c>inet_default_listen_options</c> and
+ <c>inet_default_connect_options</c>, see the <c>inet</c>
+ manual page for details.</p>
+ <p>Own Id: OTP-5080</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.6.5</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Fixed error that made code server crash if invalid
+ directories were added to the path.</p>
+ <p>Own Id: OTP-5070 Aux Id: OTP-5060, EABln14115</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.6.4</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Speed improvements in <c>code:add_path(s)[az]/1</c> when
+ the cache is activated.</p>
+ <p>Own Id: OTP-5060 Aux Id: seq8315, EABln14115</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.6.2</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Remote spawn on a nonreachable node now gives warning
+ instead of error in the error_log.</p>
+ <p>Own Id: OTP-5030 Aux Id: seq8663]</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.6.1</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>An error that made the code server ignore version numbers
+ on <c>lib</c> directories has been corrected.</p>
+ <p>Own Id: OTP-5020</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.5</title>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>A possibility to make distribution messages be queued up
+ during running of Erlang code, so that larger packages is
+ sent over the network is added.</p>
+ <p>Own Id: OTP-4916</p>
+ </item>
+ <item>
+ <p>When code loading failed it was impossible to know
+ exactly what caused it, only <c>{undef,[{M,F,A}|...]}</c>
+ would be reported. Now the primitive loader lets the
+ <c>error_logger</c> print an error report if a file
+ operation fails. All file errors except <c>enoent</c> and
+ <c>enotdir</c> are reported this way.</p>
+ <p>Own Id: OTP-4925 Aux Id: OTP-4952</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.4</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>Bugs have been fixed in the <c>disk_log</c> module: if
+ <c>reopen</c> failed to rename a file, a message could
+ erroneously be sent to the client; if requests were
+ queued while a log was blocked, no replies were sent to
+ the blocked processes should the log be closed.</p>
+ <p>Own Id: OTP-4880 Aux Id: seq7902</p>
+ </item>
+ <item>
+ <p>In rare cases, the <c>global</c> name registration could
+ hang during simultaneous startup of several nodes, due to a
+ cyclic deadlock in the <c>global:loop_the_locker</c>
+ processes.</p>
+ <p>Own Id: OTP-4902 Aux Id: seq8275</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>The Kernel variable <c>net_setuptime</c> can now be defined
+ in fractions of seconds (using a floating point number).</p>
+ <p>Own Id: OTP-4915</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.3</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>The driver for dynamically linked in drivers has been
+ fixed to delete loaded drivers when its Erlang server
+ dies. The Erlang server has also been updated to improve
+ the start-on-demand behaviour.</p>
+ <p>Own Id: OTP-4876 Aux Id: OTP-4855 seq8272</p>
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Improvements and New Features</title>
+ <list type="bulleted">
+ <item>
+ <p>Starting Erlang with the <c>+Bi</c> flag (to ignore ^C), now
+ also disables the quit ('q') option in the JCL menu.</p>
+ <p>Own Id: OTP-4897</p>
+ </item>
+ <item>
+ <p>A STDLIB application variable, <c>shell_esc</c>, has been
+ introduced that controls the behaviour of ^G. If
+ <c>shell_esc</c> is set to <c>abort</c>, ^G restarts the
+ shell. If set to <c>jcl</c>, ^G invokes the JCL menu. The
+ latter is default.</p>
+ <p>Own Id: OTP-4898 Aux Id: OTP-4897</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.2</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>The boot server had become broken. Now it works again.</p>
+ <p>Own Id: OTP-4846 Aux Id: OTP-4802, OTP-4819</p>
+ </item>
+ <item>
+ <p>When loading a dynamically linked in driver through
+ <c>erl_ddll</c>, the server <c>ddll_server</c> that held
+ the port for the driver handling shared libraries got
+ the group leader of the invoking application. Later, when
+ the application was terminated, it killed all processes in
+ its group, also the <c>ddll_server</c>, so the driver still
+ had some shared libraries loaded. Finally, when
+ the <c>ddll_server</c> was restarted it assumed that all
+ shared libraries its driver knew of was statically linked,
+ so the dynamically linked in drivers that was loaded when
+ <c>ddll_server</c> was killed could neither be loaded nor
+ unloaded. This bug has now been fixed by setting the group
+ leader of <c>ddll_server</c> to something harmless and more
+ eternal, and by unloading all remaining dynamically linked
+ in drivers when <c>ddll_server</c> starts. A race condition
+ when starting <c>ddll_server</c> has also been fixed.</p>
+ <p>Own Id: OTP-4855 Aux Id: OTP-4876 seq8272</p>
+ </item>
+ </list>
+ </section>
+ </section>
+
+ <section>
+ <title>Kernel 2.9.1</title>
+
+ <section>
+ <title>Fixed Bugs and Malfunctions</title>
+ <list type="bulleted">
+ <item>
+ <p>When the emulator was started with command line arguments
+ <c>-run</c> or <c>-s</c> and the started code did an
+ uncatched <c>erlang:throw/1</c>, the emulator ignored
+ the throw which is rather strange. Now the init process
+ exits with <c>nocatch</c> as expected.</p>
+ <p>Own Id: OTP-4788 Aux Id: seq8129</p>
+ </item>
+ <item>
+ <p>The code server could hang if invoked early in the startup.
+ For example if the emulator was started with <c>"-s file eval Filename"</c> and <c>Filename</c> contained a
+ call to <c>code:add_patha/1</c> the code server accidentally
+ tried to execute code in an unloaded module from inside
+ the code that loaded a module - hence hangup. This bug has
+ now been fixed.</p>
+ <p>Note! Starting Erlang through code loading from a remote
+ Erlang boot server will not work after this patch. It will
+ be fixed in a later patch. Rumours has it that remote boot
+ server code loading did not work before this patch either.
+ It is not a commonly used feature.</p>
+ <p>*** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>Own Id: OTP-4802 Aux Id: seq8314</p>
+ </item>
+ </list>
+ </section>
+ </section>
+</chapter>
+
diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml
new file mode 100644
index 0000000000..2c9cc33eb7
--- /dev/null
+++ b/lib/kernel/doc/src/os.xml
@@ -0,0 +1,212 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>os</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <module>os</module>
+ <modulesummary>Operating System Specific Functions</modulesummary>
+ <description>
+ <p>The functions in this module are operating system specific.
+ Careless use of these functions will result in programs that will
+ only run on a specific platform. On the other hand, with careful
+ use these functions can be of help in enabling a program to run on
+ most platforms.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>cmd(Command) -> string()</name>
+ <fsummary>Execute a command in a shell of the target OS</fsummary>
+ <type>
+ <v>Command = string() | atom()</v>
+ </type>
+ <desc>
+ <p>Executes <c>Command</c> in a command shell of the target OS,
+ captures the standard output of the command and returns this
+ result as a string. This function is a replacement of
+ the previous <c>unix:cmd/1</c>; on a Unix platform they are
+ equivalent.</p>
+ <p>Examples:</p>
+ <code type="none">
+LsOut = os:cmd("ls"), % on unix platform
+DirOut = os:cmd("dir"), % on Win32 platform</code>
+ <p>Note that in some cases, standard output of a command when
+ called from another program (for example, <c>os:cmd/1</c>)
+ may differ, compared to the standard output of the command
+ when called directly from an OS command shell.</p>
+ </desc>
+ </func>
+ <func>
+ <name>find_executable(Name) -> Filename | false</name>
+ <name>find_executable(Name, Path) -> Filename | false</name>
+ <fsummary>Absolute filename of a program</fsummary>
+ <type>
+ <v>Name = string()</v>
+ <v>Path = string()</v>
+ <v>Filename = string()</v>
+ </type>
+ <desc>
+ <p>These two functions look up an executable program given its
+ name and a search path, in the same way as the underlying
+ operating system. <c>find_executable/1</c> uses the current
+ execution path (that is, the environment variable PATH on
+ Unix and Windows).</p>
+ <p><c>Path</c>, if given, should conform to the syntax of
+ execution paths on the operating system. The absolute
+ filename of the executable program <c>Name</c> is returned,
+ or <c>false</c> if the program was not found.</p>
+ </desc>
+ </func>
+ <func>
+ <name>getenv() -> [string()]</name>
+ <fsummary>List all environment variables</fsummary>
+ <desc>
+ <p>Returns a list of all environment variables.
+ Each environment variable is given as a single string on
+ the format <c>"VarName=Value"</c>, where <c>VarName</c> is
+ the name of the variable and <c>Value</c> its value.</p>
+ </desc>
+ </func>
+ <func>
+ <name>getenv(VarName) -> Value | false</name>
+ <fsummary>Get the value of an environment variable</fsummary>
+ <type>
+ <v>VarName = string() </v>
+ <v>Value = string()</v>
+ </type>
+ <desc>
+ <p>Returns the <c>Value</c> of the environment variable
+ <c>VarName</c>, or <c>false</c> if the environment variable
+ is undefined.</p>
+ </desc>
+ </func>
+ <func>
+ <name>getpid() -> Value </name>
+ <fsummary>Return the process identifier of the emulator process</fsummary>
+ <type>
+ <v>Value = string()</v>
+ </type>
+ <desc>
+ <p>Returns the process identifier of the current Erlang emulator
+ in the format most commonly used by the operating system
+ environment. <c>Value</c> is returned as a string containing
+ the (usually) numerical identifier for a process. On Unix,
+ this is typically the return value of the <c>getpid()</c>
+ system call. On VxWorks, <c>Value</c> contains the task id
+ (decimal notation) of the Erlang task. On Windows,
+ the process id as returned by the <c>GetCurrentProcessId()</c>
+ system call is used.</p>
+ </desc>
+ </func>
+ <func>
+ <name>putenv(VarName, Value) -> true</name>
+ <fsummary>Set a new value for an environment variable</fsummary>
+ <type>
+ <v>VarName = string() </v>
+ <v>Value = string()</v>
+ </type>
+ <desc>
+ <p>Sets a new <c>Value</c> for the environment variable
+ <c>VarName</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>timestamp() -> {MegaSecs, Secs, MicroSecs}</name>
+ <fsummary>Returna a timestamp from the OS in the erlang:now/0 format</fsummary>
+ <type>
+ <v>MegaSecs = Secs = MicroSecs = int()</v>
+ </type>
+ <desc>
+ <p>Returns a tuple in the same format as <seealso marker="erts:erlang#now/0">erlang:now/0</seealso>. The difference is that this function returns what the operating system thinks (a.k.a. the wall clock time) without any attempts at time correction. The result of two different calls to this function is <em>not</em> guaranteed to be different.</p>
+ <p>The most obvious use for this function is logging. The tuple can be used together with the function <seealso marker="stdlib:calendar#now_to_universal_time/1">calendar:now_to_universal_time/1</seealso>
+or <seealso marker="stdlib:calendar#now_to_local_time/1">calendar:now_to_local_time/1</seealso> to get calendar time. Using the calendar time together with the <c>MicroSecs</c> part of the return tuple from this function allows you to log timestamps in high resolution and consistent with the time in the rest of the operating system.</p>
+ <p>Example of code formatting a string in the format &quot;DD Mon YYYY HH:MM:SS.mmmmmm&quot;, where DD is the day of month, Mon is the textual month name, YYYY is the year, HH:MM:SS is the time and mmmmmm is the microseconds in six positions:</p>
+<code>
+-module(print_time).
+-export([format_utc_timestamp/0]).
+format_utc_timestamp() ->
+ TS = {_,_,Micro} = os:timestamp(),
+ {{Year,Month,Day},{Hour,Minute,Second}} =
+ calendar:now_to_universal_time(TS),
+ Mstr = element(Month,{"Jan","Feb","Mar","Apr","May","Jun","Jul",
+ "Aug","Sep","Oct","Nov","Dec"}),
+ io_lib:format("~2w ~s ~4w ~2w:~2..0w:~2..0w.~6..0w",
+ [Day,Mstr,Year,Hour,Minute,Second,Micro]).
+</code>
+
+ <p>The module above could be used in the following way:</p>
+<pre>
+1> <input>io:format("~s~n",[print_time:format_utc_timestamp()]).</input>
+29 Apr 2009 9:55:30.051711
+</pre>
+ </desc>
+ </func>
+ <func>
+ <name>type() -> {Osfamily, Osname} | Osfamily</name>
+ <fsummary>Return the OS family and, in some cases, OS name of the current operating system</fsummary>
+ <type>
+ <v>Osfamily = win32 | unix | vxworks</v>
+ <v>Osname = atom()</v>
+ </type>
+ <desc>
+ <p>Returns the <c>Osfamily</c> and, in some cases, <c>Osname</c>
+ of the current operating system.</p>
+ <p>On Unix, <c>Osname</c> will have same value as
+ <c>uname -s</c> returns, but in lower case. For example, on
+ Solaris 1 and 2, it will be <c>sunos</c>.</p>
+ <p>In Windows, <c>Osname</c> will be either <c>nt</c> (on
+ Windows NT), or <c>windows</c> (on Windows 95).</p>
+ <p>On VxWorks the OS family alone is returned, that is
+ <c>vxworks</c>.</p>
+ <note>
+ <p>Think twice before using this function. Use the
+ <c>filename</c> module if you want to inspect or build
+ file names in a portable way.
+ Avoid matching on the <c>Osname</c> atom.</p>
+ </note>
+ </desc>
+ </func>
+ <func>
+ <name>version() -> {Major, Minor, Release} | VersionString</name>
+ <fsummary>Return the Operating System version</fsummary>
+ <type>
+ <v>Major = Minor = Release = integer()</v>
+ <v>VersionString = string()</v>
+ </type>
+ <desc>
+ <p>Returns the operating system version.
+ On most systems, this function returns a tuple, but a string
+ will be returned instead if the system has versions which
+ cannot be expressed as three numbers.</p>
+ <note>
+ <p>Think twice before using this function. If you still need
+ to use it, always <c>call os:type()</c> first.</p>
+ </note>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
diff --git a/lib/kernel/doc/src/packages.xml b/lib/kernel/doc/src/packages.xml
new file mode 100644
index 0000000000..80de2e05fc
--- /dev/null
+++ b/lib/kernel/doc/src/packages.xml
@@ -0,0 +1,214 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2004</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>packages</title>
+ <prepared>Kenneth Lundin</prepared>
+ <responsible>Kenneth Lundin</responsible>
+ <docno>1</docno>
+ <approved>Kenneth Lundin</approved>
+ <checked></checked>
+ <date>2004-09-07</date>
+ <rev>A</rev>
+ <file>packages.sgml</file>
+ </header>
+ <module>packages</module>
+ <modulesummary>Packages in Erlang</modulesummary>
+ <description>
+ <warning><p>
+ Packages has since it was introduced more than 5 years ago been an
+ experimental feature. Use it at your own risk, we do not
+ actively maintain and develop this feature. It might however be
+ supported some
+ day.
+ </p>
+ <p>
+ In spite of this packages work quite well, but there are some
+ known issues in tools and other parts where packages don't work well.
+ </p>
+ </warning>
+ <p><em>Introduction</em></p>
+ <p>Packages are simply namespaces for modules.
+ All old Erlang modules automatically belong to the top level
+ ("empty-string") namespace, and do not need any changes.</p>
+ <p>The full name of a packaged module is written as e.g.
+ "<c>fee.fie.foe.foo</c>",
+ i.e., as atoms separated by periods,
+ where the package name is the part up to
+ but not including the last period;
+ in this case "<c>fee.fie.foe</c>".
+ A more concrete example is the module <c>erl.lang.term</c>,
+ which is in the
+ package <c>erl.lang</c>.
+ Package names can have any number of segments, as in
+ <c>erl.lang.list.sort</c>.
+ The atoms in the name can be quoted, as in <c>foo.'Bar'.baz</c>,
+ or even the
+ whole name, as in <c>'foo.bar.baz'</c> but the concatenation of
+ atoms and
+ periods must not contain two consecutive period characters or
+ end with a period,
+ as in <c>'foo..bar'</c>, <c>foo.'.bar'</c>, or <c>foo.'bar.'</c>.
+ The periods must not be followed by whitespace.</p>
+ <p>The code loader maps module names onto the file system directory
+ structure.
+ E.g., the module <c>erl.lang.term</c> corresponds to a file
+ <c>.../erl/lang/term.beam</c>
+ in the search path.
+ Note that the name of the actual object file corresponds to
+ the last part only of the full module name.
+ (Thus, old existing modules such as <c>lists</c>
+ simply map to <c>.../lists.beam</c>, exactly as before.)</p>
+ <p>A packaged module in a file "<c>foo/bar/fred.erl</c>" is declared
+ as:</p>
+ <code type="none">
+-module(foo.bar.fred).</code>
+ <p>This can be compiled and loaded from the Erlang shell using
+ <c>c(fred)</c>, if
+ your current directory is the same as that of the file.
+ The object file will be named <c>fred.beam</c>.</p>
+ <p>The Erlang search path works exactly as before,
+ except that the package segments will be appended to each
+ directory in the path in order to find the
+ file. E.g., assume the path is <c>["/usr/lib/erl", "/usr/local/lib/otp/legacy/ebin", "/home/barney/erl"]</c>.
+ Then, the code for a module named <c>foo.bar.fred</c> will be
+ searched for
+ first as <c>"/usr/lib/erl/foo/bar/fred.beam"</c>, then
+ <c>"/usr/local/lib/otp/legacy/ebin/foo/bar/fred.beam"</c>
+ and lastly <c>"/home/barney/erl/foo/bar/fred.beam"</c>.
+ A module
+ like <c>lists</c>, which is in the top-level package,
+ will be looked for as <c>"/usr/lib/erl/lists.beam"</c>,
+ <c>"/usr/local/lib/otp/legacy/ebin/lists.beam"</c> and
+ <c>"/home/barney/erl/lists.beam"</c>.</p>
+ <p><em>Programming</em></p>
+ <p>Normally, if a call is made from one module to another,
+ it is assumed that the
+ called module belongs to the same package as the source module.
+ The compiler
+ automatically expands such calls. E.g., in:</p>
+ <code type="none">
+-module(foo.bar.m1).
+-export([f/1]).
+
+f(X) -> m2:g(X).</code>
+ <p><c>m2:g(X)</c> becomes a call to <c>foo.bar.m2</c>
+ If this is not what was intended, the call can be written
+ explicitly, as in</p>
+ <code type="none">
+-module(foo.bar.m1).
+-export([f/1]).
+
+f(X) -> fee.fie.foe.m2:g(X).</code>
+ <p>Because the called module is given with an explicit package name,
+ no expansion is done in this case.</p>
+ <p>If a module from another package is used repeatedly in a module,
+ an import declaration can make life easier:</p>
+ <code type="none">
+-module(foo.bar.m1).
+-export([f/1, g/1]).
+-import(fee.fie.foe.m2).
+
+f(X) -> m2:g(X).
+g(X) -> m2:h(X).</code>
+ <p>will make the calls to <c>m2</c> refer to <c>fee.fie.foe.m2</c>.
+ More generally, a declaration <c>-import(Package.Module).</c>
+ will cause calls to <c>Module</c>
+ to be expanded to <c>Package.Module</c>.</p>
+ <p>Old-style function imports work as normal (but full module
+ names must be
+ used); e.g.:</p>
+ <code type="none">
+-import(fee.fie.foe.m2, [g/1, h/1]).</code>
+ <p>however, it is probably better to avoid this form of import
+ altogether in new
+ code, since it makes it hard to see what calls are really "remote".</p>
+ <p>If it is necessary to call a module in the top-level package
+ from within a
+ named package, the module name can be written either with an
+ initial period as
+ in e.g. "<c>.lists</c>", or with an empty initial atom, as in
+ "<c>''.lists</c>".
+ However, the best way is to use an import declaration -
+ this is most obvious to
+ the eye, and makes sure we don't forget adding a period somewhere:</p>
+ <code type="none">
+-module(foo.bar.fred).
+-export([f/1]).
+-import(lists).
+
+f(X) -> lists:reverse(X).</code>
+ <p>The dot-syntax for module names can be used in any expression.
+ All segments must
+ be constant atoms, and the result must be a well-formed
+ package/module name.
+ E.g.:</p>
+ <code type="none">
+spawn(foo.bar.fred, f, [X])</code>
+ <p>is equivalent to <c>spawn('foo.bar.fred', f, [X])</c>.</p>
+ <p><em>The Erlang Shell</em></p>
+ <p>The shell also automatically expands remote calls,
+ however currently no
+ expansions are made by default.
+ The user can change the behaviour by using the <c>import/1</c>
+ shell command (or its abbreviation <c>use/1</c>). E.g.:</p>
+ <pre>
+1> <input>import(foo.bar.m).</input>
+ok
+2> <input>m:f().</input></pre>
+ <p>will evaluate <c>foo.bar.m:f()</c>.
+ If a new import is made of the same name,
+ this overrides any previous import.
+ (It is likely that in the future, some
+ system packages will be pre-imported.)</p>
+ <p>In addition, the shell command <c>import_all/1</c>
+ (and its alias <c>use_all/1</c>)
+ imports all modules currently found in the path for a given
+ package name. E.g.,
+ assuming the files "<c>.../foo/bar/fred.beam</c>",
+ "<c>.../foo/bar/barney.beam</c>"
+ and "<c>.../foo/bar/bambam.beam</c>" can be found from our current
+ path,</p>
+ <pre>
+1> <input>import_all(foo.bar).</input></pre>
+ <p>will make <c>fred</c>, <c>barney</c> and <c>bambam</c>
+ expand to <c>foo.bar.fred</c>,
+ <c>foo.bar.barney</c> and <c>foo.bar.bambam</c>, respectively.</p>
+ <p>Note: The compiler does not have an "import all" directive, for the
+ reason that Erlang has no compile time type checking.
+ E.g. if the wrong search
+ path is used at compile time, a call <c>m:f(...)</c>
+ could be expanded to <c>foo.bar.m:f(...)</c>
+ without any warning, instead of the intended
+ <c>frob.ozz.m:f(...)</c>, if
+ package <c>foo.bar</c> happens to be found first in the path.
+ Explicitly
+ declaring each use of a module makes for safe code.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>no functions exported</name>
+ <fsummary>x</fsummary>
+ </func>
+ </funcs>
+</erlref>
+
diff --git a/lib/kernel/doc/src/part_notes.xml b/lib/kernel/doc/src/part_notes.xml
new file mode 100644
index 0000000000..ff43b9e007
--- /dev/null
+++ b/lib/kernel/doc/src/part_notes.xml
@@ -0,0 +1,39 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE part SYSTEM "part.dtd">
+
+<part xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>2004</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>Kernel Release Notes</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <description>
+ <p>The <em>Kernel</em> application has all the code necessary to run
+ the Erlang runtime system itself; File servers and code servers
+ etc.</p>
+ <p>For information about older versions, see
+ <url href="part_notes_history_frame.html">Release Notes History</url>.</p>
+ </description>
+ <xi:include href="notes.xml"/>
+</part>
+
diff --git a/lib/kernel/doc/src/part_notes_history.xml b/lib/kernel/doc/src/part_notes_history.xml
new file mode 100644
index 0000000000..07c7e4abea
--- /dev/null
+++ b/lib/kernel/doc/src/part_notes_history.xml
@@ -0,0 +1,39 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE part SYSTEM "part.dtd">
+
+<part>
+ <header>
+ <copyright>
+ <year>2006</year>
+ <year>2007</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>Kernel Release Notes History</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <description>
+ <p>The <em>Kernel</em> application has all the code necessary to run
+ the Erlang runtime system itself; File servers and code servers
+ etc.</p>
+ </description>
+ <include file="notes_history"></include>
+</part>
+
diff --git a/lib/kernel/doc/src/pg2.xml b/lib/kernel/doc/src/pg2.xml
new file mode 100644
index 0000000000..7463fd10f5
--- /dev/null
+++ b/lib/kernel/doc/src/pg2.xml
@@ -0,0 +1,199 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>pg2</title>
+ <prepared>[email protected]</prepared>
+ <responsible>[email protected]</responsible>
+ <docno></docno>
+ <approved>Bjarne D&auml;cker</approved>
+ <checked>[email protected]</checked>
+ <date>1997-08-18</date>
+ <rev>A2</rev>
+ <file>pg2.sgml</file>
+ </header>
+ <module>pg2</module>
+ <modulesummary>Distributed Named Process Groups</modulesummary>
+ <description>
+ <p>This module implements process groups. The groups in this
+ module differ from the groups in the module <c>pg</c> in several
+ ways. In <c>pg</c>, each message is sent to all members in the
+ group. In this module, each message may be sent to one, some, or
+ all members.
+ </p>
+ <p>A group of processes can be accessed by a common name. For
+ example, if there is a group named <c>foobar</c>, there can be a
+ set of processes (which can be located on different nodes) which
+ are all members of the group <c>foobar</c>. There are no special
+ functions for sending a message to the group. Instead, client
+ functions should be written with the functions
+ <c>get_members/1</c> and <c>get_local_members/1</c> to find out
+ which processes are members of the group. Then the message can be
+ sent to one or more members of the group.
+ </p>
+ <p>If a member terminates, it is automatically removed from the
+ group.
+ </p>
+ <warning>
+ <p>This module is used by the <c>disk_log</c> module for
+ managing distributed disk logs. The disk log names are used as
+ group names, which means that some action may need to be taken
+ to avoid name clashes.</p>
+ </warning>
+ </description>
+ <funcs>
+ <func>
+ <name>create(Name) -> void()</name>
+ <fsummary>Create a new, empty process group</fsummary>
+ <type>
+ <v>Name = term()</v>
+ </type>
+ <desc>
+ <p>Creates a new, empty process group. The group is globally
+ visible on all nodes. If the group exists, nothing happens.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>delete(Name) -> void()</name>
+ <fsummary>Delete a process group</fsummary>
+ <type>
+ <v>Name = term()</v>
+ </type>
+ <desc>
+ <p>Deletes a process group.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>get_closest_pid(Name) -> Pid | {error, Reason}</name>
+ <fsummary>Common dispatch function</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = {no_process, Name} | {no_such_group, Name}</v>
+ </type>
+ <desc>
+ <p>This is a useful dispatch function which can be used from
+ client functions. It returns a process on the local node, if
+ such a process exist. Otherwise, it chooses one randomly.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>get_members(Name) -> [Pid] | {error, Reason}</name>
+ <fsummary>Return all processes in a group</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = {no_such_group, Name}</v>
+ </type>
+ <desc>
+ <p>Returns all processes in the group <c>Name</c>. This
+ function should be used from within a client function that
+ accesses the group. It is therefore optimized for speed.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>get_local_members(Name) -> [Pid] | {error, Reason}</name>
+ <fsummary>Return all local processes in a group</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = {no_such_group, Name}</v>
+ </type>
+ <desc>
+ <p>Returns all processes running on the local node in the
+ group <c>Name</c>. This function should to be used from
+ within a client function that accesses the group. It is therefore
+ optimized for speed.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>join(Name, Pid) -> ok | {error, Reason}</name>
+ <fsummary>Join a process to a group</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = {no_such_group, Name}</v>
+ </type>
+ <desc>
+ <p>Joins the process <c>Pid</c> to the group <c>Name</c>.
+ A process can join a group several times; it must then
+ leave the group the same number of times.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>leave(Name, Pid) -> ok | {error, Reason}</name>
+ <fsummary>Make a process leave a group</fsummary>
+ <type>
+ <v>Name = term()</v>
+ <v>Pid = pid()</v>
+ <v>Reason = {no_such_group, Name}</v>
+ </type>
+ <desc>
+ <p>Makes the process <c>Pid</c> leave the group <c>Name</c>.
+ If the process is not a member of the group, <c>ok</c> is
+ returned.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>which_groups() -> [Name]</name>
+ <fsummary>Return a list of all known groups</fsummary>
+ <type>
+ <v>Name = term()</v>
+ </type>
+ <desc>
+ <p>Returns a list of all known groups.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>start()</name>
+ <name>start_link() -> {ok, Pid} | {error, Reason}</name>
+ <fsummary>Start the pg2 server</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Starts the pg2 server. Normally, the server does not need
+ to be started explicitly, as it is started dynamically if it
+ is needed. This is useful during development, but in a
+ target system the server should be started explicitly. Use
+ configuration parameters for <c>kernel</c> for this.
+ </p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>See Also</title>
+ <p><seealso marker="kernel_app">kernel(6)</seealso>,
+ <seealso marker="stdlib:pg">pg(3)</seealso></p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/ref_man.xml b/lib/kernel/doc/src/ref_man.xml
new file mode 100644
index 0000000000..9ef0959271
--- /dev/null
+++ b/lib/kernel/doc/src/ref_man.xml
@@ -0,0 +1,69 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE application SYSTEM "application.dtd">
+
+<application xmlns:xi="http://www.w3.org/2001/XInclude">
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>Kernel Reference Manual</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <description>
+ <p>The <em>Kernel</em> application has all the code necessary to run
+ the Erlang runtime system itself: file servers and code servers
+ and so on.</p>
+ </description>
+ <xi:include href="kernel_app.xml"/>
+ <xi:include href="application.xml"/>
+ <xi:include href="auth.xml"/>
+ <xi:include href="code.xml"/>
+ <xi:include href="disk_log.xml"/>
+ <xi:include href="erl_boot_server.xml"/>
+ <xi:include href="erl_ddll.xml"/>
+ <xi:include href="erl_prim_loader_stub.xml"/>
+ <xi:include href="erlang_stub.xml"/>
+ <xi:include href="error_handler.xml"/>
+ <xi:include href="error_logger.xml"/>
+ <xi:include href="file.xml"/>
+ <xi:include href="gen_tcp.xml"/>
+ <xi:include href="gen_udp.xml"/>
+ <xi:include href="gen_sctp.xml"/>
+ <xi:include href="global.xml"/>
+ <xi:include href="global_group.xml"/>
+ <xi:include href="heart.xml"/>
+ <xi:include href="inet.xml"/>
+ <xi:include href="inet_res.xml"/>
+ <xi:include href="init_stub.xml"/>
+ <xi:include href="net_adm.xml"/>
+ <xi:include href="net_kernel.xml"/>
+ <xi:include href="os.xml"/>
+ <xi:include href="pg2.xml"/>
+ <xi:include href="rpc.xml"/>
+ <xi:include href="seq_trace.xml"/>
+ <xi:include href="user.xml"/>
+ <xi:include href="wrap_log_reader.xml"/>
+ <xi:include href="zlib_stub.xml"/>
+ <xi:include href="app.xml"/>
+ <xi:include href="config.xml"/>
+ <xi:include href="packages.xml"/>
+</application>
+
diff --git a/lib/kernel/doc/src/rpc.xml b/lib/kernel/doc/src/rpc.xml
new file mode 100644
index 0000000000..86c6ea9178
--- /dev/null
+++ b/lib/kernel/doc/src/rpc.xml
@@ -0,0 +1,499 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>rpc</title>
+ <prepared>Claes Wikstrom</prepared>
+ <docno>1</docno>
+ <date>96-09-10</date>
+ <rev>A</rev>
+ </header>
+ <module>rpc</module>
+ <modulesummary>Remote Procedure Call Services</modulesummary>
+ <description>
+ <p>This module contains services which are similar to remote
+ procedure calls. It also contains broadcast facilities and
+ parallel evaluators. A remote procedure call is a method to call
+ a function on a remote node and collect the answer. It is used
+ for collecting information on a remote node, or for running a
+ function with some specific side effects on the remote node.</p>
+ </description>
+ <funcs>
+ <func>
+ <name>call(Node, Module, Function, Args) -> Res | {badrpc, Reason}</name>
+ <fsummary>Evaluate a function call on a node</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>Res = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Evaluates <c>apply(Module, Function, Args)</c> on the node
+ <c>Node</c> and returns the corresponding value <c>Res</c>, or
+ <c>{badrpc, Reason}</c> if the call fails.</p>
+ </desc>
+ </func>
+ <func>
+ <name>call(Node, Module, Function, Args, Timeout) -> Res | {badrpc, Reason}</name>
+ <fsummary>Evaluate a function call on a node</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>Res = term()</v>
+ <v>Reason = timeout | term()</v>
+ <v>Timeout = int() | infinity</v>
+ </type>
+ <desc>
+ <p>Evaluates <c>apply(Module, Function, Args)</c> on the node
+ <c>Node</c> and returns the corresponding value <c>Res</c>, or
+ <c>{badrpc, Reason}</c> if the call fails. <c>Timeout</c> is
+ a timeout value in milliseconds. If the call times out,
+ <c>Reason</c> is <c>timeout</c>.</p>
+ <p>If the reply arrives after the call times out, no message
+ will contaminate the caller's message queue, since this
+ function spawns off a middleman process to act as (a void)
+ destination for such an orphan reply. This feature also makes
+ this function more expensive than <c>call/4</c> at
+ the caller's end.</p>
+ </desc>
+ </func>
+ <func>
+ <name>block_call(Node, Module, Function, Args) -> Res | {badrpc, Reason}</name>
+ <fsummary>Evaluate a function call on a node in the RPC server's context</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>Res = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Like <c>call/4</c>, but the RPC server at <c>Node</c> does
+ not create a separate process to handle the call. Thus,
+ this function can be used if the intention of the call is to
+ block the RPC server from any other incoming requests until
+ the request has been handled. The function can also be used
+ for efficiency reasons when very small fast functions are
+ evaluated, for example BIFs that are guaranteed not to
+ suspend.</p>
+ </desc>
+ </func>
+ <func>
+ <name>block_call(Node, Module, Function, Args, Timeout) -> Res | {badrpc, Reason}</name>
+ <fsummary>Evaluate a function call on a node in the RPC server's context</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>Timeout = int() | infinity</v>
+ <v>Res = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Like <c>block_call/4</c>, but with a timeout value in
+ the same manner as <c>call/5</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>async_call(Node, Module, Function, Args) -> Key</name>
+ <fsummary>Evaluate a function call on a node, asynchronous version</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>Key -- see below</v>
+ </type>
+ <desc>
+ <p>Implements <em>call streams with promises</em>, a type of
+ RPC which does not suspend the caller until the result is
+ finished. Instead, a key is returned which can be used at a
+ later stage to collect the value. The key can be viewed as a
+ promise to deliver the answer.</p>
+ <p>In this case, the key <c>Key</c> is returned, which can be
+ used in a subsequent call to <c>yield/1</c> or
+ <c>nb_yield/1,2</c> to retrieve the value of evaluating
+ <c>apply(Module, Function, Args)</c> on the node <c>Node</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>yield(Key) -> Res | {badrpc, Reason}</name>
+ <fsummary>Deliver the result of evaluating a function call on a node (blocking)</fsummary>
+ <type>
+ <v>Key -- see async_call/4</v>
+ <v>Res = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>Returns the promised answer from a previous
+ <c>async_call/4</c>. If the answer is available, it is
+ returned immediately. Otherwise, the calling process is
+ suspended until the answer arrives from <c>Node</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>nb_yield(Key) -> {value, Val} | timeout</name>
+ <fsummary>Deliver the result of evaluating a function call on a node (non-blocking)</fsummary>
+ <type>
+ <v>Key -- see async_call/4</v>
+ <v>Val = Res | {badrpc, Reason}</v>
+ <v>&nbsp;Res = term()</v>
+ <v>&nbsp;Reason = term()</v>
+ </type>
+ <desc>
+ <p>Equivalent to <c>nb_yield(Key, 0)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>nb_yield(Key, Timeout) -> {value, Val} | timeout</name>
+ <fsummary>Deliver the result of evaluating a function call on a node (non-blocking)</fsummary>
+ <type>
+ <v>Key -- see async_call/4</v>
+ <v>Timeout = int() | infinity</v>
+ <v>Val = Res | {badrpc, Reason}</v>
+ <v>&nbsp;Res = term()</v>
+ <v>&nbsp;Reason = term()</v>
+ </type>
+ <desc>
+ <p>This is a non-blocking version of <c>yield/1</c>. It returns
+ the tuple <c>{value, Val}</c> when the computation has
+ finished, or <c>timeout</c> when <c>Timeout</c> milliseconds
+ has elapsed.</p>
+ </desc>
+ </func>
+ <func>
+ <name>multicall(Module, Function, Args) -> {ResL, BadNodes}</name>
+ <fsummary>Evaluate a function call on a number of nodes</fsummary>
+ <type>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>ResL = [term()]</v>
+ <v>BadNodes = [node()]</v>
+ </type>
+ <desc>
+ <p>Equivalent to <c>multicall([node()|nodes()], Module, Function, Args, infinity)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>multicall(Nodes, Module, Function, Args) -> {ResL, BadNodes}</name>
+ <fsummary>Evaluate a function call on a number of nodes</fsummary>
+ <type>
+ <v>Nodes = [node()]</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>ResL = [term()]</v>
+ <v>BadNodes = [node()]</v>
+ </type>
+ <desc>
+ <p>Equivalent to <c>multicall(Nodes, Module, Function, Args, infinity)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>multicall(Module, Function, Args, Timeout) -> {ResL, BadNodes}</name>
+ <fsummary>Evaluate a function call on a number of nodes</fsummary>
+ <type>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>Timeout = int() | infinity</v>
+ <v>ResL = [term()]</v>
+ <v>BadNodes = [node()]</v>
+ </type>
+ <desc>
+ <p>Equivalent to <c>multicall([node()|nodes()], Module, Function, Args, Timeout)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>multicall(Nodes, Module, Function, Args, Timeout) -> {ResL, BadNodes}</name>
+ <fsummary>Evaluate a function call on a number of nodes</fsummary>
+ <type>
+ <v>Nodes = [node()]</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ <v>Timeout = int() | infinity</v>
+ <v>ResL = [term()]</v>
+ <v>BadNodes = [node()]</v>
+ </type>
+ <desc>
+ <p>In contrast to an RPC, a multicall is an RPC which is sent
+ concurrently from one client to multiple servers. This is
+ useful for collecting some information from a set of nodes,
+ or for calling a function on a set of nodes to achieve some
+ side effects. It is semantically the same as iteratively
+ making a series of RPCs on all the nodes, but the multicall
+ is faster as all the requests are sent at the same time
+ and are collected one by one as they come back.</p>
+ <p>The function evaluates <c>apply(Module, Function, Args)</c>
+ on the specified nodes and collects the answers. It returns
+ <c>{ResL, Badnodes}</c>, where <c>Badnodes</c> is a list
+ of the nodes that terminated or timed out during computation,
+ and <c>ResL</c> is a list of the return values.
+ <c>Timeout</c> is a time (integer) in milliseconds, or
+ <c>infinity</c>.</p>
+ <p>The following example is useful when new object code is to
+ be loaded on all nodes in the network, and also indicates
+ some side effects RPCs may produce:</p>
+ <code type="none">
+%% Find object code for module Mod
+{Mod, Bin, File} = code:get_object_code(Mod),
+
+%% and load it on all nodes including this one
+{ResL, _} = rpc:multicall(code, load_binary, [Mod, Bin, File,]),
+
+%% and then maybe check the ResL list.</code>
+ </desc>
+ </func>
+ <func>
+ <name>cast(Node, Module, Function, Args) -> void()</name>
+ <fsummary>Run a function on a node ignoring the result</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ </type>
+ <desc>
+ <p>Evaluates <c>apply(Module, Function, Args)</c> on the node
+ <c>Node</c>. No response is delivered and the calling
+ process is not suspended until the evaluation is complete, as
+ is the case with <c>call/4,5</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>eval_everywhere(Module, Funtion, Args) -> void()</name>
+ <fsummary>Run a function on all nodes, ignoring the result</fsummary>
+ <type>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ </type>
+ <desc>
+ <p>Equivalent to <c>eval_everywhere([node()|nodes()], Module, Function, Args)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>eval_everywhere(Nodes, Module, Function, Args) -> void()</name>
+ <fsummary>Run a function on specific nodes, ignoring the result</fsummary>
+ <type>
+ <v>Nodes = [node()]</v>
+ <v>Module = Function = atom()</v>
+ <v>Args = [term()]</v>
+ </type>
+ <desc>
+ <p>Evaluates <c>apply(Module, Function, Args)</c> on
+ the specified nodes. No answers are collected.</p>
+ </desc>
+ </func>
+ <func>
+ <name>abcast(Name, Msg) -> void()</name>
+ <fsummary>Broadcast a message asynchronously to a registered process on all nodes</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>Msg = term()</v>
+ </type>
+ <desc>
+ <p>Equivalent to <c>abcast([node()|nodes()], Name, Msg)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>abcast(Nodes, Name, Msg) -> void()</name>
+ <fsummary>Broadcast a message asynchronously to a registered process on specific nodes</fsummary>
+ <type>
+ <v>Nodes = [node()]</v>
+ <v>Name = atom()</v>
+ <v>Msg = term()</v>
+ </type>
+ <desc>
+ <p>Broadcasts the message <c>Msg</c> asynchronously to
+ the registered process <c>Name</c> on the specified nodes.</p>
+ </desc>
+ </func>
+ <func>
+ <name>sbcast(Name, Msg) -> {GoodNodes, BadNodes}</name>
+ <fsummary>Broadcast a message synchronously to a registered process on all nodes</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>Msg = term()</v>
+ <v>GoodNodes = BadNodes = [node()]</v>
+ </type>
+ <desc>
+ <p>Equivalent to <c>sbcast([node()|nodes()], Name, Msg)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>sbcast(Nodes, Name, Msg) -> {GoodNodes, BadNodes}</name>
+ <fsummary>Broadcast a message synchronously to a registered process on specific nodes</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>Msg = term()</v>
+ <v>Nodes = GoodNodes = BadNodes = [node()]</v>
+ </type>
+ <desc>
+ <p>Broadcasts the message <c>Msg</c> synchronously to
+ the registered process <c>Name</c> on the specified nodes.</p>
+ <p>Returns <c>{GoodNodes, BadNodes}</c>, where <c>GoodNodes</c>
+ is the list of nodes which have <c>Name</c> as a registered
+ process.</p>
+ <p>The function is synchronous in the sense that it is known
+ that all servers have received the message when the call
+ returns. It is not possible to know that the servers have
+ actually processed the message.</p>
+ <p>Any further messages sent to the servers, after this
+ function has returned, will be received by all servers after
+ this message.</p>
+ </desc>
+ </func>
+ <func>
+ <name>server_call(Node, Name, ReplyWrapper, Msg) -> Reply | {error, Reason}</name>
+ <fsummary>Interact with a server on a node</fsummary>
+ <type>
+ <v>Node = node()</v>
+ <v>Name = atom()</v>
+ <v>ReplyWrapper = Msg = Reply = term()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc>
+ <p>This function can be used when interacting with a server
+ called <c>Name</c> at node <c>Node</c>. It is assumed that
+ the server receives messages in the format
+ <c>{From, Msg}</c> and replies using <c>From ! {ReplyWrapper, Node, Reply}</c>. This function makes such
+ a server call and ensures that the entire call is packed into
+ an atomic transaction which either succeeds or fails. It
+ never hangs, unless the server itself hangs.</p>
+ <p>The function returns the answer <c>Reply</c> as produced by
+ the server <c>Name</c>, or <c>{error, Reason}</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>multi_server_call(Name, Msg) -> {Replies, BadNodes}</name>
+ <fsummary>Interact with the servers on a number of nodes</fsummary>
+ <type>
+ <v>Name = atom()</v>
+ <v>Msg = term()</v>
+ <v>Replies = [Reply]</v>
+ <v>&nbsp;Reply = term()</v>
+ <v>BadNodes = [node()]</v>
+ </type>
+ <desc>
+ <p>Equivalent to <c>multi_server_call([node()|nodes()], Name, Msg)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>multi_server_call(Nodes, Name, Msg) -> {Replies, BadNodes}</name>
+ <fsummary>Interact with the servers on a number of nodes</fsummary>
+ <type>
+ <v>Nodes = [node()]</v>
+ <v>Name = atom()</v>
+ <v>Msg = term()</v>
+ <v>Replies = [Reply]</v>
+ <v>&nbsp;Reply = term()</v>
+ <v>BadNodes = [node()]</v>
+ </type>
+ <desc>
+ <p>This function can be used when interacting with servers
+ called <c>Name</c> on the specified nodes. It is assumed that
+ the servers receive messages in the format <c>{From, Msg}</c>
+ and reply using <c>From ! {Name, Node, Reply}</c>, where
+ <c>Node</c> is the name of the node where the server is
+ located. The function returns <c>{Replies, Badnodes}</c>,
+ where <c>Replies</c> is a list of all <c>Reply</c> values and
+ <c>BadNodes</c> is a list of the nodes which did not exist, or
+ where the server did not exist, or where the server terminated
+ before sending any reply.</p>
+ </desc>
+ </func>
+ <func>
+ <name>safe_multi_server_call(Name, Msg) -> {Replies, BadNodes}</name>
+ <name>safe_multi_server_call(Nodes, Name, Msg) -> {Replies, BadNodes}</name>
+ <fsummary>Interact with the servers on a number of nodes (deprecated)</fsummary>
+ <desc>
+ <warning>
+ <p>This function is deprecated. Use
+ <c>multi_server_call/2,3</c> instead.</p>
+ </warning>
+ <p>In Erlang/OTP R6B and earlier releases,
+ <c>multi_server_call/2,3</c> could not handle the case
+ where the remote node exists, but there is no server called
+ <c>Name</c>. Instead this function had to be used. In
+ Erlang/OTP R7B and later releases, however, the functions are
+ equivalent, except for this function being slightly slower.</p>
+ </desc>
+ </func>
+ <func>
+ <name>parallel_eval(FuncCalls) -> ResL</name>
+ <fsummary>Evaluate several function calls on all nodes in parallel</fsummary>
+ <type>
+ <v>FuncCalls = [{Module, Function, Args}]</v>
+ <v>&nbsp;Module = Function = atom()</v>
+ <v>&nbsp;Args = [term()]</v>
+ <v>ResL = [term()]</v>
+ </type>
+ <desc>
+ <p>For every tuple in <c>FuncCalls</c>, evaluates
+ <c>apply(Module, Function, Args)</c> on some node in
+ the network. Returns the list of return values, in the same
+ order as in <c>FuncCalls</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>pmap({Module, Function}, ExtraArgs, List2) -> List1</name>
+ <fsummary>Parallell evaluation of mapping a function over a list </fsummary>
+ <type>
+ <v>Module = Function = atom()</v>
+ <v>ExtraArgs = [term()]</v>
+ <v>List1 = [Elem]</v>
+ <v>&nbsp;Elem = term()</v>
+ <v>List2 = [term()]</v>
+ </type>
+ <desc>
+ <p>Evaluates <c>apply(Module, Function, [Elem|ExtraArgs])</c>,
+ for every element <c>Elem</c> in <c>List1</c>, in parallel.
+ Returns the list of return values, in the same order as in
+ <c>List1</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>pinfo(Pid) -> [{Item, Info}] | undefined</name>
+ <fsummary>Information about a process</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Item, Info -- see erlang:process_info/1</v>
+ </type>
+ <desc>
+ <p>Location transparent version of the BIF
+ <c>process_info/1</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>pinfo(Pid, Item) -> {Item, Info} | undefined | []</name>
+ <fsummary>Information about a process</fsummary>
+ <type>
+ <v>Pid = pid()</v>
+ <v>Item, Info -- see erlang:process_info/1</v>
+ </type>
+ <desc>
+ <p>Location transparent version of the BIF
+ <c>process_info/2</c>.</p>
+ </desc>
+ </func>
+ </funcs>
+</erlref>
+
diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml
new file mode 100644
index 0000000000..6c043dd767
--- /dev/null
+++ b/lib/kernel/doc/src/seq_trace.xml
@@ -0,0 +1,506 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1998</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>seq_trace</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>1998-04-16</date>
+ <rev>A</rev>
+ </header>
+ <module>seq_trace</module>
+ <modulesummary>Sequential Tracing of Messages</modulesummary>
+ <description>
+ <p>Sequential tracing makes it possible to trace all messages
+ resulting from one initial message. Sequential tracing is
+ completely independent of the ordinary tracing in Erlang, which
+ is controlled by the <c>erlang:trace/3</c> BIF. See the chapter
+ <seealso marker="#whatis">What is Sequential Tracing</seealso>
+ below for more information about what sequential tracing is and
+ how it can be used.</p>
+ <p><c>seq_trace</c> provides functions which control all aspects of
+ sequential tracing. There are functions for activation,
+ deactivation, inspection and for collection of the trace output.</p>
+ <note>
+ <p>The implementation of sequential tracing is in beta status.
+ This means that the programming interface still might undergo
+ minor adjustments (possibly incompatible) based on feedback
+ from users.</p>
+ </note>
+ </description>
+ <funcs>
+ <func>
+ <name>set_token(Token) -> PreviousToken</name>
+ <fsummary>Set the trace token</fsummary>
+ <type>
+ <v>Token = PreviousToken = term() | []</v>
+ </type>
+ <desc>
+ <p>Sets the trace token for the calling process to <c>Token</c>.
+ If <c>Token == []</c> then tracing is disabled, otherwise
+ <c>Token</c> should be an Erlang term returned from
+ <c>get_token/0</c> or <c>set_token/1</c>. <c>set_token/1</c>
+ can be used to temporarily exclude message passing from
+ the trace by setting the trace token to empty like this:</p>
+ <code type="none">
+OldToken = seq_trace:set_token([]), % set to empty and save
+ % old value
+% do something that should not be part of the trace
+io:format("Exclude the signalling caused by this~n"),
+seq_trace:set_token(OldToken), % activate the trace token again
+... </code>
+ <p>Returns the previous value of the trace token.</p>
+ </desc>
+ </func>
+ <func>
+ <name>set_token(Component, Val) -> {Component, OldVal}</name>
+ <fsummary>Set a component of the trace token</fsummary>
+ <type>
+ <v>Component = label | serial | Flag</v>
+ <v>&nbsp;Flag = send | 'receive' | print | timestamp </v>
+ <v>Val = OldVal -- see below</v>
+ </type>
+ <desc>
+ <p>Sets the individual <c>Component</c> of the trace token to
+ <c>Val</c>. Returns the previous value of the component.</p>
+ <taglist>
+ <tag><c>set_token(label, Int)</c></tag>
+ <item>
+ <p>The <c>label</c> component is an integer which
+ identifies all events belonging to the same sequential
+ trace. If several sequential traces can be active
+ simultaneously, <c>label</c> is used to identify
+ the separate traces. Default is 0.</p>
+ </item>
+ <tag><c>set_token(serial, SerialValue)</c></tag>
+ <item>
+ <p><c>SerialValue = {Previous, Current}</c>.
+ The <c>serial</c> component contains counters which
+ enables the traced messages to be sorted, should never be
+ set explicitly by the user as these counters are updated
+ automatically. Default is <c>{0, 0}</c>.</p>
+ </item>
+ <tag><c>set_token(send, Bool)</c></tag>
+ <item>
+ <p>A trace token flag (<c>true | false</c>) which
+ enables/disables tracing on message sending. Default is
+ <c>false</c>.</p>
+ </item>
+ <tag><c>set_token('receive', Bool)</c></tag>
+ <item>
+ <p>A trace token flag (<c>true | false</c>) which
+ enables/disables tracing on message reception. Default is
+ <c>false</c>.</p>
+ </item>
+ <tag><c>set_token(print, Bool)</c></tag>
+ <item>
+ <p>A trace token flag (<c>true | false</c>) which
+ enables/disables tracing on explicit calls to
+ <c>seq_trace:print/1</c>. Default is <c>false</c>.</p>
+ </item>
+ <tag><c>set_token(timestamp, Bool)</c></tag>
+ <item>
+ <p>A trace token flag (<c>true | false</c>) which
+ enables/disables a timestamp to be generated for each
+ traced event. Default is <c>false</c>.</p>
+ </item>
+ </taglist>
+ </desc>
+ </func>
+ <func>
+ <name>get_token() -> TraceToken</name>
+ <fsummary>Return the value of the trace token</fsummary>
+ <type>
+ <v>TraceToken = term() | []</v>
+ </type>
+ <desc>
+ <p>Returns the value of the trace token for the calling process.
+ If <c>[]</c> is returned, it means that tracing is not active.
+ Any other value returned is the value of an active trace
+ token. The value returned can be used as input to
+ the <c>set_token/1</c> function.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_token(Component) -> {Component, Val}</name>
+ <fsummary>Return the value of a trace token component</fsummary>
+ <type>
+ <v>Component = label | serial | Flag</v>
+ <v>&nbsp;Flag = send | 'receive' | print | timestamp </v>
+ <v>Val -- see set_token/2</v>
+ </type>
+ <desc>
+ <p>Returns the value of the trace token component
+ <c>Component</c>. See
+ <seealso marker="#set_token/2">set_token/2</seealso> for
+ possible values of <c>Component</c> and <c>Val</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name>print(TraceInfo) -> void()</name>
+ <fsummary>Put the Erlang term <c>TraceInfo</c>into the sequential trace output</fsummary>
+ <type>
+ <v>TraceInfo = term()</v>
+ </type>
+ <desc>
+ <p>Puts the Erlang term <c>TraceInfo</c> into the sequential
+ trace output if the calling process currently is executing
+ within a sequential trace and the <c>print</c> flag of
+ the trace token is set.</p>
+ </desc>
+ </func>
+ <func>
+ <name>print(Label, TraceInfo) -> void()</name>
+ <fsummary>Put the Erlang term <c>TraceInfo</c>into the sequential trace output</fsummary>
+ <type>
+ <v>Label = int()</v>
+ <v>TraceInfo = term()</v>
+ </type>
+ <desc>
+ <p>Same as <c>print/1</c> with the additional condition that
+ <c>TraceInfo</c> is output only if <c>Label</c> is equal to
+ the label component of the trace token.</p>
+ </desc>
+ </func>
+ <func>
+ <name>reset_trace() -> void()</name>
+ <fsummary>Stop all sequential tracing on the local node</fsummary>
+ <desc>
+ <p>Sets the trace token to empty for all processes on the
+ local node. The process internal counters used to create
+ the serial of the trace token is set to 0. The trace token is
+ set to empty for all messages in message queues. Together
+ this will effectively stop all ongoing sequential tracing in
+ the local node.</p>
+ </desc>
+ </func>
+ <func>
+ <name>set_system_tracer(Tracer) -> OldTracer</name>
+ <fsummary>Set the system tracer</fsummary>
+ <type>
+ <v>Tracer = OldTracer = pid() | port() | false</v>
+ </type>
+ <desc>
+ <p>Sets the system tracer. The system tracer can be either a
+ process or port denoted by <c>Tracer</c>. Returns the previous
+ value (which can be <c>false</c> if no system tracer is
+ active).</p>
+ <p>Failure: <c>{badarg, Info}}</c> if <c>Pid</c> is not an
+ existing local pid.</p>
+ </desc>
+ </func>
+ <func>
+ <name>get_system_tracer() -> Tracer</name>
+ <fsummary>Return the pid() or port() of the current system tracer.</fsummary>
+ <type>
+ <v>Tracer = pid() | port() | false</v>
+ </type>
+ <desc>
+ <p>Returns the pid or port identifier of the current system
+ tracer or <c>false</c> if no system tracer is activated.</p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>Trace Messages Sent To the System Tracer</title>
+ <p>The format of the messages are:</p>
+ <code type="none">
+{seq_trace, Label, SeqTraceInfo, TimeStamp}</code>
+ <p>or</p>
+ <code type="none">
+{seq_trace, Label, SeqTraceInfo}</code>
+ <p>depending on whether the <c>timestamp</c> flag of the trace
+ token is set to <c>true</c> or <c>false</c>. Where:</p>
+ <code type="none">
+Label = int()
+TimeStamp = {Seconds, Milliseconds, Microseconds}
+ Seconds = Milliseconds = Microseconds = int()</code>
+ <p>The <c>SeqTraceInfo</c> can have the following formats:</p>
+ <taglist>
+ <tag><c>{send, Serial, From, To, Message}</c></tag>
+ <item>
+ <p>Used when a process <c>From</c> with its trace token flag
+ <c>print</c> set to <c>true</c> has sent a message.</p>
+ </item>
+ <tag><c>{'receive', Serial, From, To, Message}</c></tag>
+ <item>
+ <p>Used when a process <c>To</c> receives a message with a
+ trace token that has the <c>'receive'</c> flag set to
+ <c>true</c>.</p>
+ </item>
+ <tag><c>{print, Serial, From, _, Info}</c></tag>
+ <item>
+ <p>Used when a process <c>From</c> has called
+ <c>seq_trace:print(Label, TraceInfo)</c> and has a trace
+ token with the <c>print</c> flag set to <c>true</c> and
+ <c>label</c> set to <c>Label</c>.</p>
+ </item>
+ </taglist>
+ <p><c>Serial</c> is a tuple <c>{PreviousSerial, ThisSerial}</c>,
+ where the first integer <c>PreviousSerial</c> denotes the serial
+ counter passed in the last received message which carried a trace
+ token. If the process is the first one in a new sequential trace,
+ <c>PreviousSerial</c> is set to the value of the process internal
+ "trace clock". The second integer <c>ThisSerial</c> is the serial
+ counter that a process sets on outgoing messages and it is based
+ on the process internal "trace clock" which is incremented by one
+ before it is attached to the trace token in the message.</p>
+ </section>
+
+ <section>
+ <marker id="whatis"></marker>
+ <title>What is Sequential Tracing</title>
+ <p>Sequential tracing is a way to trace a sequence of messages sent
+ between different local or remote processes, where the sequence
+ is initiated by one single message. In short it works like this:</p>
+ <p>Each process has a <em>trace token</em>, which can be empty or
+ not empty. When not empty the trace token can be seen as
+ the tuple <c>{Label, Flags, Serial, From}</c>. The trace token is
+ passed invisibly with each message.</p>
+ <p>In order to start a sequential trace the user must explicitly set
+ the trace token in the process that will send the first message
+ in a sequence.</p>
+ <p>The trace token of a process is set each time the process
+ matches a message in a receive statement, according to the trace
+ token carried by the received message, empty or not.</p>
+ <p>On each Erlang node a process can be set as the <em>system tracer</em>. This process will receive trace messages each time
+ a message with a trace token is sent or received (if the trace
+ token flag <c>send</c> or <c>'receive'</c> is set). The system
+ tracer can then print each trace event, write it to a file or
+ whatever suitable.</p>
+ <note>
+ <p>The system tracer will only receive those trace events that
+ occur locally within the Erlang node. To get the whole picture
+ of a sequential trace that involves processes on several Erlang
+ nodes, the output from the system tracer on each involved node
+ must be merged (off line).</p>
+ </note>
+ <p>In the following sections Sequential Tracing and its most
+ fundamental concepts are described.</p>
+ </section>
+
+ <section>
+ <title>Trace Token</title>
+ <p>Each process has a current trace token. Initially the token is
+ empty. When the process sends a message to another process, a
+ copy of the current token will be sent "invisibly" along with
+ the message.</p>
+ <p>The current token of a process is set in two ways, either</p>
+ <list type="ordered">
+ <item>
+ <p>explicitly by the process itself, through a call to
+ <c>seq_trace:set_token</c>, or</p>
+ </item>
+ <item>
+ <p>when a message is received.</p>
+ </item>
+ </list>
+ <p>In both cases the current token will be set. In particular, if
+ the token of a message received is empty, the current token of
+ the process is set to empty.</p>
+ <p>A trace token contains a label, and a set of flags. Both
+ the label and the flags are set in 1 and 2 above.</p>
+ </section>
+
+ <section>
+ <title>Serial</title>
+ <p>The trace token contains a component which is called
+ <c>serial</c>. It consists of two integers <c>Previous</c> and
+ <c>Current</c>. The purpose is to uniquely identify each traced
+ event within a trace sequence and to order the messages
+ chronologically and in the different branches if any.</p>
+ <p>The algorithm for updating <c>Serial</c> can be described as
+ follows:</p>
+ <p>Let each process have two counters <c>prev_cnt</c> and
+ <c>curr_cnt</c> which both are set to 0 when a process is created.
+ The counters are updated at the following occasions:</p>
+ <list type="bulleted">
+ <item>
+ <p><em>When the process is about to send a message and the trace token is not empty.</em></p>
+ <p>Let the serial of the trace token be <c>tprev</c> and
+ <c>tcurr</c>. <br></br>
+<c>curr_cnt := curr_cnt + 1</c> <br></br>
+<c>tprev := prev_cnt</c> <br></br>
+<c>tcurr := curr_cnt</c></p>
+ <p>The trace token with <c>tprev</c> and <c>tcurr</c> is then
+ passed along with the message.</p>
+ </item>
+ <item>
+ <p><em>When the process calls</em><c>seq_trace:print(Label, Info)</c>, <em>Label matches the label part of the trace token and the trace token print flag is true.</em></p>
+ <p>The same algorithm as for send above.</p>
+ </item>
+ <item>
+ <p><em>When a message is received and contains a nonempty trace token.</em></p>
+ <p>The process trace token is set to the trace token from
+ the message.</p>
+ <p>Let the serial of the trace token be <c>tprev</c> and
+ <c>tcurr</c>. <br></br>
+<c><![CDATA[if (curr_cnt < tcurr )]]></c> <br></br>
+
+ &nbsp; &nbsp; &nbsp; &nbsp;<c>curr_cnt := tcurr</c> <br></br>
+<c>prev_cnt := tcurr</c></p>
+ </item>
+ </list>
+ <p>The <c>curr_cnt</c> of a process is incremented each time
+ the process is involved in a sequential trace. The counter can
+ reach its limit (27 bits) if a process is very long-lived and is
+ involved in much sequential tracing. If the counter overflows it
+ will not be possible to use the serial for ordering of the trace
+ events. To prevent the counter from overflowing in the middle of
+ a sequential trace the function <c>seq_trace:reset_trace/0</c>
+ can be called to reset the <c>prev_cnt</c> and <c>curr_cnt</c> of
+ all processes in the Erlang node. This function will also set all
+ trace tokens in processes and their message queues to empty and
+ will thus stop all ongoing sequential tracing.</p>
+ </section>
+
+ <section>
+ <title>Performance considerations</title>
+ <p>The performance degradation for a system which is enabled for
+ Sequential Tracing is negligible as long as no tracing is
+ activated. When tracing is activated there will of course be an
+ extra cost for each traced message but all other messages will be
+ unaffected.</p>
+ </section>
+
+ <section>
+ <title>Ports</title>
+ <p>Sequential tracing is not performed across ports.</p>
+ <p>If the user for some reason wants to pass the trace token to a
+ port this has to be done manually in the code of the port
+ controlling process. The port controlling processes have to check
+ the appropriate sequential trace settings (as obtained from
+ <c>seq_trace:get_token/1</c> and include trace information in
+ the message data sent to their respective ports.</p>
+ <p>Similarly, for messages received from a port, a port controller
+ has to retrieve trace specific information, and set appropriate
+ sequential trace flags through calls to
+ <c>seq_trace:set_token/2</c>.</p>
+ </section>
+
+ <section>
+ <title>Distribution</title>
+ <p>Sequential tracing between nodes is performed transparently.
+ This applies to C-nodes built with Erl_Interface too. A C-node
+ built with Erl_Interface only maintains one trace token, which
+ means that the C-node will appear as one process from
+ the sequential tracing point of view.</p>
+ <p>In order to be able to perform sequential tracing between
+ distributed Erlang nodes, the distribution protocol has been
+ extended (in a backward compatible way). An Erlang node which
+ supports sequential tracing can communicate with an older
+ (OTP R3B) node but messages passed within that node can of course
+ not be traced.</p>
+ </section>
+
+ <section>
+ <title>Example of Usage</title>
+ <p>The example shown here will give rough idea of how the new
+ primitives can be used and what kind of output it will produce.</p>
+ <p>Assume that we have an initiating process with
+ <c><![CDATA[Pid == <0.30.0>]]></c> like this:</p>
+ <code type="none">
+-module(seqex).
+-compile(export_all).
+
+loop(Port) ->
+ receive
+ {Port,Message} ->
+ seq_trace:set_token(label,17),
+ seq_trace:set_token('receive',true),
+ seq_trace:set_token(print,true),
+ seq_trace:print(17,"**** Trace Started ****"),
+ call_server ! {self(),the_message};
+ {ack,Ack} ->
+ ok
+ end,
+ loop(Port).</code>
+ <p>And a registered process <c>call_server</c> with
+ <c><![CDATA[Pid == <0.31.0>]]></c> like this:</p>
+ <code type="none">
+loop() ->
+ receive
+ {PortController,Message} ->
+ Ack = {received, Message},
+ seq_trace:print(17,"We are here now"),
+ PortController ! {ack,Ack}
+ end,
+ loop().</code>
+ <p>A possible output from the system's sequential_tracer (inspired
+ by AXE-10 and MD-110) could look like:</p>
+ <pre>
+17:&lt;0.30.0> Info {0,1} WITH
+"**** Trace Started ****"
+17:&lt;0.31.0> Received {0,2} FROM &lt;0.30.0> WITH
+{&lt;0.30.0>,the_message}
+17:&lt;0.31.0> Info {2,3} WITH
+"We are here now"
+17:&lt;0.30.0> Received {2,4} FROM &lt;0.31.0> WITH
+{ack,{received,the_message}}</pre>
+ <p>The implementation of a system tracer process that produces
+ the printout above could look like this:</p>
+ <code type="none">
+tracer() ->
+ receive
+ {seq_trace,Label,TraceInfo} ->
+ print_trace(Label,TraceInfo,false);
+ {seq_trace,Label,TraceInfo,Ts} ->
+ print_trace(Label,TraceInfo,Ts);
+ Other -> ignore
+ end,
+ tracer().
+
+print_trace(Label,TraceInfo,false) ->
+ io:format("~p:",[Label]),
+ print_trace(TraceInfo);
+print_trace(Label,TraceInfo,Ts) ->
+ io:format("~p ~p:",[Label,Ts]),
+ print_trace(TraceInfo).
+
+print_trace({print,Serial,From,_,Info}) ->
+ io:format("~p Info ~p WITH~n~p~n", [From,Serial,Info]);
+print_trace({'receive',Serial,From,To,Message}) ->
+ io:format("~p Received ~p FROM ~p WITH~n~p~n",
+ [To,Serial,From,Message]);
+print_trace({send,Serial,From,To,Message}) ->
+ io:format("~p Sent ~p TO ~p WITH~n~p~n",
+ [From,Serial,To,Message]).</code>
+ <p>The code that creates a process that runs the tracer function
+ above and sets that process as the system tracer could look like
+ this:</p>
+ <code type="none">
+start() ->
+ Pid = spawn(?MODULE,tracer,[]),
+ seq_trace:set_system_tracer(Pid), % set Pid as the system tracer
+ ok.</code>
+ <p>With a function like <c>test/0</c> below the whole example can be
+ started.</p>
+ <code type="none">
+test() ->
+ P = spawn(?MODULE, loop, [port]),
+ register(call_server, spawn(?MODULE, loop, [])),
+ start(),
+ P ! {port,message}.</code>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/user.xml b/lib/kernel/doc/src/user.xml
new file mode 100644
index 0000000000..d9de2f4b04
--- /dev/null
+++ b/lib/kernel/doc/src/user.xml
@@ -0,0 +1,40 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1996</year>
+ <year>2007</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>user</title>
+ <prepared>Robert Virding</prepared>
+ <docno>1</docno>
+ <date>96-10-10</date>
+ <rev>A</rev>
+ </header>
+ <module>user</module>
+ <modulesummary>Standard I/O Server</modulesummary>
+ <description>
+ <p><c>user</c> is a server which responds to all the messages
+ defined in the I/O interface. The code in <c>user.erl</c> can be
+ used as a model for building alternative I/O servers.</p>
+ </description>
+</erlref>
+
diff --git a/lib/kernel/doc/src/user_guide.gif b/lib/kernel/doc/src/user_guide.gif
new file mode 100644
index 0000000000..e6275a803d
--- /dev/null
+++ b/lib/kernel/doc/src/user_guide.gif
Binary files differ
diff --git a/lib/kernel/doc/src/wrap_log_reader.xml b/lib/kernel/doc/src/wrap_log_reader.xml
new file mode 100644
index 0000000000..18664a029f
--- /dev/null
+++ b/lib/kernel/doc/src/wrap_log_reader.xml
@@ -0,0 +1,157 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1998</year><year>2009</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>wrap_log_reader</title>
+ <prepared>Esko Vierum&auml;ki</prepared>
+ <responsible>Esko Vierum&auml;ki</responsible>
+ <docno></docno>
+ <approved>nobody</approved>
+ <checked>no</checked>
+ <date>98-09-21</date>
+ <rev>A</rev>
+ <file>wrap_log_reader.sgml</file>
+ </header>
+ <module>wrap_log_reader</module>
+ <modulesummary>A function to read internally formatted wrap disk logs</modulesummary>
+ <description>
+ <p><c>wrap_log_reader</c> is a function to read internally formatted
+ wrap disk logs, refer to disk_log(3). <c>wrap_log_reader</c> does not
+ interfere with disk_log activities; there is however a known bug in this
+ version of the <c>wrap_log_reader</c>, see chapter <c>bugs</c> below.
+ </p>
+ <p>A wrap disk log file consists of several files, called index files.
+ A log file can be opened and closed. It is also possible to open just one index file
+ separately. If an non-existent or a non-internally formatted file is opened,
+ an error message is returned. If the file is corrupt, no attempt to repair it
+ will be done but an error message is returned.
+ </p>
+ <p>If a log is configured to be distributed, there is a possibility that all items
+ are not loggen on all nodes. <c>wrap_log_reader</c> does only read the log on
+ the called node, it is entirely up to the user to be sure that all items are read.
+ </p>
+ </description>
+ <funcs>
+ <func>
+ <name>chunk(Continuation)</name>
+ <name>chunk(Continuation, N) -> {Continuation2, Terms} | {Continuation2, Terms, Badbytes} | {Continuation2, eof} | {error, Reason}</name>
+ <fsummary>Read a chunk of objects written to a wrap log.</fsummary>
+ <type>
+ <v>Continuation = continuation()</v>
+ <v>N = int() > 0 | infinity</v>
+ <v>Continuation2 = continuation()</v>
+ <v>Terms= [term()]</v>
+ <v>Badbytes = integer()</v>
+ </type>
+ <desc>
+ <p>This function makes it possible to efficiently read the
+ terms which have been appended to a log. It minimises disk
+ I/O by reading large 8K chunks from the file.
+ </p>
+ <p>The first time <c>chunk</c> is called an initial
+ continuation returned from the <c>open/1</c>, <c>open/2</c> must be provided.
+ </p>
+ <p>When <c>chunk/3</c> is called, <c>N</c> controls the
+ maximum number of terms that are read from the log in each
+ chunk. Default is <c>infinity</c>, which means that all the
+ terms contained in the 8K chunk are read. If less than
+ <c>N</c> terms are returned, this does not necessarily mean
+ that end of file is reached.
+ </p>
+ <p>The <c>chunk</c> function returns a tuple
+ <c>{Continuation2, Terms}</c>, where <c>Terms</c> is a list
+ of terms found in the log. <c>Continuation2</c> is yet
+ another continuation which must be passed on into any
+ subsequent calls to <c>chunk</c>. With a series of calls to
+ <c>chunk</c> it is then possible to extract all terms from a
+ log.
+ </p>
+ <p>The <c>chunk</c> function returns a tuple
+ <c>{Continuation2, Terms, Badbytes}</c> if the log is opened
+ in read only mode and the read chunk is corrupt. <c>Badbytes</c>
+ indicates the number of non-Erlang terms found in the chunk.
+ Note also that the log is not repaired.
+ </p>
+ <p><c>chunk</c> returns <c>{Continuation2, eof}</c> when the end of the log is
+ reached, and <c>{error, Reason}</c> if an error occurs.
+ </p>
+ <p>The returned continuation may or may not be valid in the next call to
+ <c>chunk</c>. This is because the log may wrap and delete
+ the file into which the continuation points. To make sure
+ this does not happen, the log can be blocked during the
+ search.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>close(Continuation) -> ok </name>
+ <fsummary>Close a log</fsummary>
+ <type>
+ <v>Continuation = continuation()</v>
+ </type>
+ <desc>
+ <p>This function closes a log file properly.
+ </p>
+ </desc>
+ </func>
+ <func>
+ <name>open(Filename) -> OpenRet</name>
+ <name>open(Filename, N) -> OpenRet</name>
+ <fsummary>Open a log file</fsummary>
+ <type>
+ <v>File = string() | atom()</v>
+ <v>N = integer()</v>
+ <v>OpenRet = {ok, Continuation} | {error, Reason} </v>
+ <v>Continuation = continuation()</v>
+ </type>
+ <desc>
+ <p><c>Filename</c> specifies the name of the file which is to be read. </p>
+ <p><c>N</c> specifies the index of the file which is to be read.
+ If <c>N</c> is omitted the whole wrap log file will be read; if it
+ is specified only the specified index file will be read.
+ </p>
+ <p>The <c>open</c> function returns <c>{ok, Continuation}</c> if the
+ log/index file was successfully opened. The <c>Continuation</c>
+ is to be used when chunking or closing the file.
+ </p>
+ <p>The function returns <c>{error, Reason}</c> for all errors.
+ </p>
+ </desc>
+ </func>
+ </funcs>
+
+ <section>
+ <title>Bugs</title>
+ <p>This version of the <c>wrap_log_reader</c> does not detect if the <c>disk_log</c>
+ wraps to a new index file between a <c>wrap_log_reader:open</c> and the first
+ <c>wrap_log_reader:chunk</c>.
+ In this case the chuck will actually read the last logged items in the log file,
+ because the opened index file was truncated by the <c>disk_log</c>.
+ </p>
+ </section>
+
+ <section>
+ <title>See Also</title>
+ <p><seealso marker="disk_log">disk_log(3)</seealso></p>
+ </section>
+</erlref>
+
diff --git a/lib/kernel/doc/src/zlib_stub.xml b/lib/kernel/doc/src/zlib_stub.xml
new file mode 100644
index 0000000000..fa14262181
--- /dev/null
+++ b/lib/kernel/doc/src/zlib_stub.xml
@@ -0,0 +1,42 @@
+<?xml version="1.0" encoding="latin1" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>1997</year>
+ <year>2009</year>
+ <holder>Ericsson AB, All Rights Reserved</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ The Initial Developer of the Original Code is Ericsson AB.
+ </legalnotice>
+
+ <title>zlib</title>
+ <prepared>[email protected]</prepared>
+ <docno></docno>
+ <date>2008-12-16</date>
+ <rev>A</rev>
+ </header>
+ <module>zlib</module>
+ <modulesummary>Zlib Compression interface.</modulesummary>
+ <description><p>
+
+ The module zlib is moved to the runtime system
+ application. Please see <seealso
+ marker="erts:zlib">zlib(3)</seealso> in the
+ erts reference manual instead.
+
+ </p></description>
+</erlref>
diff --git a/lib/kernel/ebin/.gitignore b/lib/kernel/ebin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/ebin/.gitignore
diff --git a/lib/kernel/examples/Makefile b/lib/kernel/examples/Makefile
new file mode 100644
index 0000000000..fb27f8d438
--- /dev/null
+++ b/lib/kernel/examples/Makefile
@@ -0,0 +1,54 @@
+# ``The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved via the world wide web at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+# AB. All Rights Reserved.''
+#
+# $Id$
+#
+include $(ERL_TOP)/make/target.mk
+
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Common Macros
+# ----------------------------------------------------
+include ../vsn.mk
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt:
+
+clean:
+
+docs:
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+RELSYSDIR = $(RELEASE_PATH)/lib/kernel-$(KERNEL_VSN)/examples
+
+# Pack and install the complete directory structure from
+# here (CWD) and down, for all examples.
+
+EXAMPLES = uds_dist
+
+release_spec:
+ $(INSTALL_DIR) $(RELSYSDIR)
+ tar cf - $(EXAMPLES) | \
+ (cd $(RELSYSDIR); tar xf - ; chmod -R ug+w $(EXAMPLES) )
+
+release_docs_spec:
diff --git a/lib/kernel/examples/uds_dist/c_src/Makefile b/lib/kernel/examples/uds_dist/c_src/Makefile
new file mode 100644
index 0000000000..de3a3730c9
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/c_src/Makefile
@@ -0,0 +1,32 @@
+# Example makefile, Solaris only
+CC = gcc
+CFLAGS=-O3 -g -fPIC -pedantic -Wall -I$(ERL_INCLUDE)
+LD=ld
+RM_RF=rm -rf
+INSTALL_DIR=/usr/ucb/install -d
+LIBRARIES=-lc -ltermlib -lresolv -ldl -lm -lsocket -lnsl
+TARGET_DIR=../priv/lib
+OBJECT_DIR=../priv/obj
+SHLIB_EXT=.so
+OBJ_EXT=.o
+TARGET_NAME=uds_drv$(SHLIB_EXT)
+TARGET=$(TARGET_DIR)/$(TARGET_NAME)
+OBJECTS=$(OBJECT_DIR)/uds_drv$(OBJ_EXT)
+
+LDFLAGS=-G -h $(TARGET_NAME)
+
+# Works if building in open source source tree
+ERL_INCLUDE=$(ERL_TOP)/erts/emulator/beam
+
+opt: setup $(OBJECTS)
+ $(LD) $(LDFLAGS) $(OBJECTS) -o $(TARGET) $(LIBRARIES)
+
+setup:
+ $(INSTALL_DIR) $(TARGET_DIR)
+ $(INSTALL_DIR) $(OBJECT_DIR)
+
+$(OBJECT_DIR)/%.o: %.c
+ $(CC) $(CFLAGS) -c -o $@ $<
+
+clean:
+ $(RM_RF) $(TARGET_DIR) $(OBJECT_DIR)
diff --git a/lib/kernel/examples/uds_dist/c_src/uds_drv.c b/lib/kernel/examples/uds_dist/c_src/uds_drv.c
new file mode 100644
index 0000000000..fb10a375f4
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/c_src/uds_drv.c
@@ -0,0 +1,1065 @@
+/* ``The contents of this file are subject to the Erlang Public License,
+ * Version 1.1, (the "License"); you may not use this file except in
+ * compliance with the License. You should have received a copy of the
+ * Erlang Public License along with this software. If not, it can be
+ * retrieved via the world wide web at http://www.erlang.org/.
+ *
+ * Software distributed under the License is distributed on an "AS IS"
+ * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ * the License for the specific language governing rights and limitations
+ * under the License.
+ *
+ * The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+ * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+ * AB. All Rights Reserved.''
+ *
+ * $Id$
+ */
+
+/*
+ * Purpose: Special purpouse Unix domain socket driver for distribution.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <sys/socket.h>
+#include <sys/un.h>
+#include <fcntl.h>
+
+#define HAVE_UIO_H
+#include "erl_driver.h"
+
+#define DEBUG
+/*#define HARDDEBUG 1*/
+/*
+** Some constants/macros
+*/
+
+#ifdef HARDDEBUG
+#define DEBUGF(P) debugf P
+#include <stdarg.h>
+static void debugf(char *str, ...)
+{
+ va_list ap;
+ va_start(ap,str);
+ fprintf(stderr,"Uds_drv debug: ");
+ vfprintf(stderr,str, ap);
+ fprintf(stderr,"\r\n");
+ va_end(ap);
+}
+#ifndef DEBUG
+#define DEBUG 1
+#endif
+#else
+#define DEBUGF(P)
+#endif
+
+
+#ifdef DEBUG
+#define ASSERT(X) \
+do { \
+ if (!(X)) { \
+ fprintf(stderr,"Assertion (%s) failed at line %d file %s\r\n", #X, \
+ __LINE__, __FILE__); \
+ exit(1); \
+ } \
+} while(0)
+#define ASSERT_NONBLOCK(FD) ASSERT(fcntl((FD), F_GETFL, 0) & O_NONBLOCK)
+#else
+#define ASSERT(X)
+#define ASSERT_NONBLOCK(FD)
+#endif
+
+
+
+#define SET_NONBLOCKING(FD) \
+ fcntl((FD), F_SETFL, \
+ fcntl((FD), F_GETFL, 0) | O_NONBLOCK)
+
+#define ALLOC(X) my_malloc(X)
+#define REALLOC(P,X) my_realloc(P,X)
+#define FREE(X) driver_free(X)
+
+#define CHUNK_SIZE 256
+
+#define DIST_MAGIC_RECV_TAG 100
+
+/*
+** The max length of an I/O vector seams to be impossible to find
+** out (?), so this is just a value known to work on solaris.
+*/
+#define IO_VECTOR_MAX 16
+
+#define SOCKET_PATH "/tmp/erlang"
+#define LOCK_SUFFIX ".lock"
+
+#define NORMAL_READ_FAILURE -1
+#define SEVERE_READ_FAILURE -2
+#define EOF_READ_FAILURE -3
+
+/*
+** Internal structures
+*/
+
+#define HEADER_LENGTH 4
+
+typedef enum {
+ portTypeUnknown, /* An uninitialized port */
+ portTypeListener, /* A listening port/socket */
+ portTypeAcceptor, /* An intermidiate stage when accepting
+ on a listen port */
+ portTypeConnector, /* An intermediate stage when connecting */
+ portTypeCommand, /* A connected open port in command mode */
+ portTypeIntermediate, /* A connected open port in special half
+ active mode */
+ portTypeData /* A connectec open port in data mode */
+} PortType;
+
+typedef unsigned char Byte;
+typedef unsigned int Word;
+
+typedef struct uds_data {
+ int fd; /* File descriptor */
+ ErlDrvPort port; /* The port identifier */
+ int lockfd; /* The file descriptor for a lock file in
+ case of listen sockets */
+ Byte creation; /* The creation serial derived from the
+ lockfile */
+ PortType type; /* Type of port */
+ char *name; /* Short name of socket for unlink */
+ Word sent; /* Messages sent */
+ Word received; /* Messages received */
+ struct uds_data *partner; /* The partner in an accept/listen pair */
+ struct uds_data *next; /* Next structure in list */
+
+ /* The input buffer and it's data */
+ int buffer_size; /* The allocated size of the input buffer */
+ int buffer_pos; /* Current position in input buffer */
+ int header_pos; /* Where the current header is in the
+ input buffer */
+ Byte *buffer; /* The actual input buffer */
+} UdsData;
+
+/*
+** Interface routines
+*/
+static ErlDrvData uds_start(ErlDrvPort port, char *buff);
+static void uds_stop(ErlDrvData handle);
+static void uds_command(ErlDrvData handle, char *buff, int bufflen);
+static void uds_input(ErlDrvData handle, ErlDrvEvent event);
+static void uds_output(ErlDrvData handle, ErlDrvEvent event);
+static void uds_finish(void);
+static int uds_control(ErlDrvData handle, unsigned int command,
+ char* buf, int count, char** res, int res_size);
+static void uds_stop_select(ErlDrvEvent event, void*);
+
+/*
+** Local helpers forward declarations
+*/
+
+static void uds_command_listen(UdsData *ud, char *buff, int bufflen);
+static void uds_command_accept(UdsData *ud, char *buff, int bufflen);
+static void uds_command_connect(UdsData *ud, char *buff, int bufflen);
+
+static void do_stop(UdsData *ud, int shutting_down);
+static void do_send(UdsData *ud, char *buff, int bufflen);
+static void do_recv(UdsData *ud);
+
+static int report_control_error(char **buffer, int buff_len,
+ char *error_message);
+static int send_out_queue(UdsData *ud);
+static int buffered_read_package(UdsData *ud, char **result);
+static int read_at_least(UdsData *ud, int num);
+static int get_packet_length(char *b);
+static void put_packet_length(char *b, int len);
+static void *my_malloc(size_t size);
+static void *my_realloc(void *optr, size_t size);
+static int try_lock(char *sockname, Byte *p_creation);
+static int ensure_dir(char *path);
+static void do_unlink(char *name);
+
+/*
+** Global data
+*/
+
+/* The driver entry */
+ErlDrvEntry uds_driver_entry = {
+ NULL, /* init, N/A */
+ uds_start, /* start, called when port is opened */
+ uds_stop, /* stop, called when port is closed */
+ uds_command, /* output, called when erlang has sent */
+ uds_input, /* ready_input, called when input descriptor
+ ready */
+ uds_output, /* ready_output, called when output
+ descriptor ready */
+ "uds_drv", /* char *driver_name, the argument to open_port */
+ uds_finish, /* finish, called when unloaded */
+ NULL, /* void * that is not used (BC) */
+ uds_control, /* control, port_control callback */
+ NULL, /* timeout, called on timeouts */
+ NULL, /* outputv, vector output interface */
+ NULL, /* ready_async */
+ NULL, /* flush */
+ NULL, /* call */
+ NULL, /* event */
+ ERL_DRV_EXTENDED_MARKER,
+ ERL_DRV_EXTENDED_MAJOR_VERSION,
+ ERL_DRV_EXTENDED_MINOR_VERSION,
+ 0, /* ERL_DRV_FLAGs */
+ NULL,
+ NULL, /* process_exit */
+ uds_stop_select
+};
+
+/* Beginning of linked list of ports */
+static UdsData *first_data;
+
+/*
+**
+** Driver interface routines
+**
+*/
+
+/*
+** Driver initialization routine
+*/
+DRIVER_INIT(uds_drv)
+{
+ first_data = NULL;
+ return &uds_driver_entry;
+}
+
+/*
+** A port is opened, we need no information whatsoever about the socket
+** at this stage.
+*/
+static ErlDrvData uds_start(ErlDrvPort port, char *buff)
+{
+ UdsData *ud;
+
+ ud = ALLOC(sizeof(UdsData));
+ ud->fd = -1;
+ ud->lockfd = -1;
+ ud->creation = 0;
+ ud->port = port;
+ ud->type = portTypeUnknown;
+ ud->name = NULL;
+ ud->buffer_size = 0;
+ ud->buffer_pos = 0;
+ ud->header_pos = 0;
+ ud->buffer = NULL;
+ ud->sent = 0;
+ ud->received = 0;
+ ud->partner = NULL;
+ ud->next = first_data;
+ first_data = ud;
+
+ return((ErlDrvData) ud);
+}
+
+/*
+** Close the socket/port and free up
+*/
+static void uds_stop(ErlDrvData handle)
+{
+ do_stop((UdsData *) handle, 0);
+}
+
+/*
+** Command interface, operates in two modes, Command mode and data mode.
+** Mode is shifted with the port_control function.
+** Command mode protocol:
+** 'L'<socketname>: Lock and listen on socket.
+** 'A'<listennumber as 32 bit bigendian>: Accept from the port referenced by the
+** "listennumber"
+** 'C'<socketname>: Connect to the socket named <socketname>
+** 'S'<data>: Send the data <data>
+** 'R': Receive one packet of data
+** Data mode protocol:
+** Send anything that arrives (no opcodes/skip opcodes).
+*/
+
+static void uds_command(ErlDrvData handle, char *buff, int bufflen)
+{
+ UdsData *ud = (UdsData *) handle;
+
+ if (ud->type == portTypeData || ud->type == portTypeIntermediate) {
+ DEBUGF(("Passive do_send %d",bufflen));
+ do_send(ud, buff + 1, bufflen - 1); /* XXX */
+ return;
+ }
+ if (bufflen == 0) {
+ return;
+ }
+ switch (*buff) {
+ case 'L':
+ if (ud->type != portTypeUnknown) {
+ driver_failure_posix(ud->port, ENOTSUP);
+ return;
+ }
+ uds_command_listen(ud,buff,bufflen);
+ return;
+ case 'A':
+ if (ud->type != portTypeUnknown) {
+ driver_failure_posix(ud->port, ENOTSUP);
+ return;
+ }
+ uds_command_accept(ud,buff,bufflen);
+ return;
+ case 'C':
+ if (ud->type != portTypeUnknown) {
+ driver_failure_posix(ud->port, ENOTSUP);
+ return;
+ }
+ uds_command_connect(ud,buff,bufflen);
+ return;
+ case 'S':
+ if (ud->type != portTypeCommand) {
+ driver_failure_posix(ud->port, ENOTSUP);
+ return;
+ }
+ do_send(ud, buff + 1, bufflen - 1);
+ return;
+ case 'R':
+ if (ud->type != portTypeCommand) {
+ driver_failure_posix(ud->port, ENOTSUP);
+ return;
+ }
+ do_recv(ud);
+ return;
+ default:
+ ASSERT(0);
+ return;
+ }
+}
+
+static void uds_input(ErlDrvData handle, ErlDrvEvent event)
+{
+ UdsData *ud = (UdsData *) handle;
+
+ DEBUGF(("In uds_input type = %d",ud->type));
+ if (ud->type == portTypeListener) {
+ UdsData *ad = ud->partner;
+ struct sockaddr_un peer;
+ int pl = sizeof(struct sockaddr_un);
+ int fd;
+
+ ASSERT(ad != NULL);
+ if ((fd = accept(ud->fd, (struct sockaddr *) &peer, &pl)) < 0) {
+ if (errno != EWOULDBLOCK) {
+ DEBUGF(("Accept failed."));
+ driver_failure_posix(ud->port, errno);
+ return;
+ }
+ DEBUGF(("Accept would block."));
+ return;
+ }
+ SET_NONBLOCKING(fd);
+ ad->fd = fd;
+ ad->partner = NULL;
+ ad->type = portTypeCommand;
+ ud->partner = NULL;
+ DEBUGF(("Accept successful."));
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_READ, 0);
+ driver_output(ad->port, "Aok",3);
+ return;
+ }
+ /* OK, normal data or command port */
+ ASSERT(ud->type >= portTypeCommand);
+#ifdef HARDDEBUG
+ if (ud->type == portTypeData)
+ DEBUGF(("Passive do_recv"));
+#endif
+ do_recv(ud);
+}
+
+static void uds_output(ErlDrvData handle, ErlDrvEvent event)
+{
+ UdsData *ud = (UdsData *) handle;
+ if (ud->type == portTypeConnector) {
+ ud->type = portTypeCommand;
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_WRITE, 0);
+ driver_output(ud->port, "Cok",3);
+ return;
+ }
+ ASSERT(ud->type == portTypeCommand || ud->type == portTypeData);
+ send_out_queue(ud);
+}
+
+static void uds_finish(void)
+{
+ while (first_data != NULL) {
+ do_stop(first_data, 1);
+ }
+}
+
+/*
+** Protocol to control:
+** 'C': Set port in command mode.
+** 'I': Set port in intermidiate mode
+** 'D': Set port in data mode
+** 'N': Get identification number for listen port
+** 'S': Get statistics
+** 'T': Send a tick message
+** 'R': Get creation number of listen socket
+** Answer is one byte status (0 == ok, Other is followed by error as string)
+** followed by data if applicable
+*/
+static int uds_control(ErlDrvData handle, unsigned int command,
+ char* buf, int count, char** res, int res_size)
+{
+/* Local macro to ensure large enough buffer. */
+#define ENSURE(N) \
+ do { \
+ if (res_size < N) { \
+ *res = ALLOC(N); \
+ } \
+ } while(0)
+
+ UdsData *ud = (UdsData *) handle;
+
+ DEBUGF(("Control, type = %d, fd = %d, command = %c", ud->type, ud->fd,
+ (char) command));
+ switch (command) {
+ case 'S':
+ {
+ ENSURE(13);
+ **res = 0;
+ put_packet_length((*res) + 1, ud->received);
+ put_packet_length((*res) + 5, ud->sent);
+ put_packet_length((*res) + 9, driver_sizeq(ud->port));
+ return 13;
+ }
+ case 'C':
+ if (ud->type < portTypeCommand) {
+ return report_control_error(res, res_size, "einval");
+ }
+ ud->type = portTypeCommand;
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_READ, 0);
+ ENSURE(1);
+ **res = 0;
+ return 1;
+ case 'I':
+ if (ud->type < portTypeCommand) {
+ return report_control_error(res, res_size, "einval");
+ }
+ ud->type = portTypeIntermediate;
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_READ, 0);
+ ENSURE(1);
+ **res = 0;
+ return 1;
+ case 'D':
+ if (ud->type < portTypeCommand) {
+ return report_control_error(res, res_size, "einval");
+ }
+ ud->type = portTypeData;
+ do_recv(ud);
+ ENSURE(1);
+ **res = 0;
+ return 1;
+ case 'N':
+ if (ud->type != portTypeListener) {
+ return report_control_error(res, res_size, "einval");
+ }
+ ENSURE(5);
+ (*res)[0] = 0;
+ put_packet_length((*res) + 1, ud->fd);
+ return 5;
+ case 'T': /* tick */
+ if (ud->type != portTypeData) {
+ return report_control_error(res, res_size, "einval");
+ }
+ do_send(ud,"",0);
+ ENSURE(1);
+ **res = 0;
+ return 1;
+ case 'R':
+ if (ud->type != portTypeListener) {
+ return report_control_error(res, res_size, "einval");
+ }
+ ENSURE(2);
+ (*res)[0] = 0;
+ (*res)[1] = ud->creation;
+ return 2;
+ default:
+ return report_control_error(res, res_size, "einval");
+ }
+#undef ENSURE
+}
+
+static void uds_stop_select(ErlDrvEvent event, void* _)
+{
+ close((int)(long)event);
+}
+
+/*
+**
+** Local helpers
+**
+*/
+
+/*
+** Command implementations
+*/
+static void uds_command_connect(UdsData *ud, char *buff, int bufflen)
+{
+ char *str;
+ int fd;
+ struct sockaddr_un s_un;
+ int length;
+ int res;
+
+ str = ALLOC(25);
+ sprintf(str, "erl%d", (int) getpid()); /* A temporary sufficiently
+ unique name */
+ do_unlink(str);
+ s_un.sun_family = AF_UNIX;
+ strcpy(s_un.sun_path, SOCKET_PATH "/");
+ strcat(s_un.sun_path, str);
+ DEBUGF(("Connect own filename: %s", s_un.sun_path));
+ length = sizeof(s_un.sun_family) + strlen(s_un.sun_path);
+ ud->name = str;
+ ud->type = portTypeCommand;
+ if ((fd = socket(AF_UNIX, SOCK_STREAM, 0)) < 0) {
+ DEBUGF(("socket call failed, errno = %d"));
+ driver_failure_posix(ud->port, errno);
+ return;
+ }
+ ud->fd = fd;
+ if ((res = bind(fd, (struct sockaddr *) &s_un, length)) < 0) {
+ DEBUGF(("bind call failed, errno = %d",errno));
+ driver_failure_posix(ud->port, errno);
+ return;
+ }
+ str = ALLOC(bufflen);
+ memcpy(str, buff + 1, bufflen - 1);
+ str[bufflen - 1] = '\0';
+ strcpy(s_un.sun_path, SOCKET_PATH "/");
+ strcat(s_un.sun_path, str);
+ length = sizeof(s_un.sun_family) + strlen(s_un.sun_path);
+ DEBUGF(("Connect peer filename: %s", s_un.sun_path));
+ SET_NONBLOCKING(fd);
+ if (connect(fd, (struct sockaddr *) &s_un, length) < 0) {
+ if (errno != EINPROGRESS) {
+ driver_failure_posix(ud->port, errno);
+ } else {
+ DEBUGF(("Connect pending"));
+ ud->type = portTypeConnector;
+ driver_select(ud->port, (ErlDrvEvent) ud->fd,
+ ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ }
+ } else {
+ DEBUGF(("Connect done"));
+ driver_output(ud->port, "Cok", 3);
+ }
+ FREE(str);
+}
+
+static void uds_command_accept(UdsData *ud, char *buff, int bufflen)
+{
+ int listen_no;
+ UdsData *lp;
+
+ if (bufflen < 5) {
+ driver_failure_posix(ud->port, EINVAL);
+ return;
+ }
+
+ listen_no = get_packet_length(buff + 1); /* Same format as
+ packet headers */
+ DEBUGF(("Accept listen_no = %d",listen_no));
+ for (lp = first_data; lp != NULL && lp->fd != listen_no; lp = lp->next)
+ ;
+ if (lp == NULL) {
+ DEBUGF(("Could not find listen port"));
+ driver_failure_posix(ud->port, EINVAL);
+ return;
+ }
+ if (lp->partner != NULL) {
+ DEBUGF(("Listen port busy"));
+ driver_failure_posix(ud->port, EADDRINUSE);
+ return;
+ }
+ lp->partner = ud;
+ ud->partner = lp;
+ ud->type = portTypeAcceptor;
+ driver_select(lp->port,(ErlDrvEvent) lp->fd, ERL_DRV_READ|ERL_DRV_USE, 1);
+ /* Silent, answer will be sent in input routine */
+}
+
+static void uds_command_listen(UdsData *ud, char *buff, int bufflen)
+{
+ char *str;
+ int fd;
+ struct sockaddr_un s_un;
+ int length;
+ int res;
+ UdsData *tmp;
+ Byte creation;
+
+ str = ALLOC(bufflen);
+ memcpy(str, buff + 1,bufflen - 1);
+ str[bufflen - 1] = '\0';
+
+ /*
+ ** Before trying lockfiles etc, we need to assure that our own process is
+ ** not using the filename. Advisory locks can be recursive in one process.
+ */
+ for(tmp = first_data; tmp != NULL; tmp = tmp->next) {
+ if (tmp->name != NULL && strcmp(str, tmp->name) == 0) {
+ driver_failure_posix(ud->port, EADDRINUSE);
+ FREE(str);
+ return;
+ }
+ }
+
+ if ((fd = try_lock(str, &creation)) < 0) {
+ driver_failure_posix(ud->port, EADDRINUSE);
+ FREE(str);
+ return;
+ }
+ s_un.sun_family = AF_UNIX;
+ strcpy(s_un.sun_path, SOCKET_PATH "/");
+ strcat(s_un.sun_path, str);
+ length = sizeof(s_un.sun_family) + strlen(s_un.sun_path);
+ ud->name = str;
+ ud->type = portTypeListener;
+ ud->lockfd = fd;
+ ud->creation = creation;
+ if ((fd = socket(AF_UNIX, SOCK_STREAM, 0)) < 0) {
+ DEBUGF(("socket call failed, errno = %d"));
+ driver_failure_posix(ud->port, errno);
+ return;
+ }
+ SET_NONBLOCKING(fd);
+ ud->fd = fd;
+ do_unlink(str);
+ DEBUGF(("Listen filename: %s", s_un.sun_path));
+ if ((res = bind(fd, (struct sockaddr *) &s_un, length)) < 0) {
+ DEBUGF(("bind call failed, errno = %d",errno));
+ driver_failure_posix(ud->port, errno);
+ return;
+ }
+
+ if ((res = listen(fd, 5)) < 0) {
+ DEBUGF(("listen call failed, errno = %d"));
+ driver_failure_posix(ud->port, errno);
+ return;
+ }
+ driver_output(ud->port, "Lok", 3);
+}
+
+/*
+** Input/output/stop helpers
+*/
+static void do_stop(UdsData *ud, int shutting_down)
+{
+ UdsData **tmp;
+
+ DEBUGF(("Cleaning up, type = %d, fd = %d, lockfd = %d", ud->type,
+ ud->fd, ud->lockfd));
+ for (tmp = &first_data; *tmp != NULL && *tmp != ud; tmp = &((*tmp)->next))
+ ;
+ ASSERT(*tmp != NULL);
+ *tmp = (*tmp)->next;
+ if (ud->buffer != NULL) {
+ FREE(ud->buffer);
+ }
+ if (ud->fd >= 0) {
+ driver_select(ud->port, (ErlDrvEvent) ud->fd,
+ ERL_DRV_READ|ERL_DRV_WRITE|ERL_DRV_USE, 0);
+ }
+ if (ud->name) {
+ do_unlink(ud->name);
+ FREE(ud->name);
+ }
+ if (ud->lockfd >= 0) {
+ ASSERT(ud->type == portTypeListener);
+ close(ud->lockfd); /* the lock will be released */
+ /* But leave the file there for the creation counter... */
+ }
+ if (!shutting_down) { /* Dont bother if the driver is shutting down. */
+ if (ud->partner != NULL) {
+ if (ud->type == portTypeAcceptor) {
+ UdsData *listener = ud->partner;
+ listener->partner = NULL;
+ driver_select(listener->port, (ErlDrvEvent) listener->fd,
+ ERL_DRV_READ, 0);
+ } else {
+ UdsData *acceptor = ud->partner;
+ ASSERT(ud->type == portTypeListener);
+ acceptor->partner = NULL;
+ driver_failure_eof(acceptor->port);
+ }
+ }
+ }
+ FREE(ud);
+}
+
+/*
+** Actually send the data
+*/
+static void do_send(UdsData *ud, char *buff, int bufflen)
+{
+ char header[4];
+ int written;
+ SysIOVec iov[2];
+ ErlIOVec eio;
+ ErlDrvBinary *binv[] = {NULL,NULL};
+
+ put_packet_length(header, bufflen);
+ DEBUGF(("Write packet header %u,%u,%u,%u.", (Word) header[0],
+ (Word) header[1], (Word) header[2],(Word) header[3]));
+ iov[0].iov_base = (char *) header;
+ iov[0].iov_len = 4;
+ iov[1].iov_base = buff;
+ iov[1].iov_len = bufflen;
+ eio.iov = iov;
+ eio.binv = binv;
+ eio.vsize = 2;
+ eio.size = bufflen + 4;
+ written = 0;
+ if (driver_sizeq(ud->port) == 0) {
+ if ((written = writev(ud->fd, iov, 2)) == eio.size) {
+ ud->sent += written;
+ if (ud->type == portTypeCommand) {
+ driver_output(ud->port, "Sok", 3);
+ }
+ DEBUGF(("Wrote all %d bytes immediately.",written));
+ return;
+ } else if (written < 0) {
+ if (errno != EWOULDBLOCK) {
+ driver_failure_eof(ud->port);
+ return;
+ } else {
+ written = 0;
+ }
+ } else {
+ ud->sent += written;
+ }
+ DEBUGF(("Wrote %d bytes immediately.",written));
+ /* Enqueue remaining */
+ }
+ driver_enqv(ud->port, &eio, written);
+ DEBUGF(("Sending output queue."));
+ send_out_queue(ud);
+}
+
+static void do_recv(UdsData *ud)
+{
+ int res;
+ char *ibuf;
+ ASSERT_NONBLOCK(ud->fd);
+ DEBUGF(("do_recv called, type = %d", ud->type));
+ for(;;) {
+ if ((res = buffered_read_package(ud,&ibuf)) < 0) {
+ if (res == NORMAL_READ_FAILURE) {
+ DEBUGF(("do_recv normal read failed"));
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_READ|ERL_DRV_USE, 1);
+ } else {
+ DEBUGF(("do_recv fatal read failed (%d) (%d)",errno, res));
+ driver_failure_eof(ud->port);
+ }
+ return;
+ }
+ DEBUGF(("do_recv got package, port type = %d", ud->type));
+ /* Got a package */
+ if (ud->type == portTypeCommand) {
+ ibuf[-1] = 'R'; /* There is always room for a single byte opcode
+ before the actual buffer (where the packet
+ header was) */
+ driver_output(ud->port,ibuf - 1, res + 1);
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_READ, 0);
+ return;
+ } else {
+ ibuf[-1] = DIST_MAGIC_RECV_TAG; /* XXX */
+ driver_output(ud->port,ibuf - 1, res + 1);
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_READ|ERL_DRV_USE, 1);
+ }
+ }
+}
+
+
+/*
+** Report control error, helper for error messages from control
+*/
+static int report_control_error(char **buffer, int buff_len,
+ char *error_message)
+{
+ int elen = strlen(error_message);
+ if (elen + 1 < buff_len) {
+ *buffer = ALLOC(elen + 1);
+ }
+ **buffer = 1;
+ memcpy((*buffer) + 1, error_message, elen);
+ return elen + 1;
+}
+
+/*
+** Lower level I/O helpers
+*/
+static int send_out_queue(UdsData *ud)
+{
+ ASSERT_NONBLOCK(ud->fd);
+ for(;;) {
+ int vlen;
+ SysIOVec *tmp = driver_peekq(ud->port, &vlen);
+ int wrote;
+ if (tmp == NULL) {
+ DEBUGF(("Write queue empty."));
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_WRITE, 0);
+ if (ud->type == portTypeCommand) {
+ driver_output(ud->port, "Sok", 3);
+ }
+ return 0;
+ }
+ if (vlen > IO_VECTOR_MAX) {
+ vlen = IO_VECTOR_MAX;
+ }
+ DEBUGF(("Trying to writev %d vectors", vlen));
+#ifdef HARDDEBUG
+ {
+ int i;
+ for (i = 0; i < vlen; ++i) {
+ DEBUGF(("Buffer %d: length %d", i, tmp[i].iov_len));
+ }
+ }
+#endif
+ if ((wrote = writev(ud->fd, tmp, vlen)) < 0) {
+ if (errno == EWOULDBLOCK) {
+ DEBUGF(("Write failed normal."));
+ driver_select(ud->port, (ErlDrvEvent) ud->fd, ERL_DRV_WRITE|ERL_DRV_USE, 1);
+ return 0;
+ } else {
+ DEBUGF(("Write failed fatal (%d).", errno));
+ driver_failure_eof(ud->port);
+ return -1;
+ }
+ }
+ driver_deq(ud->port, wrote);
+ ud->sent += wrote;
+ DEBUGF(("Wrote %d bytes of data.",wrote));
+ }
+}
+
+static int buffered_read_package(UdsData *ud, char **result)
+{
+ int res;
+ int data_size;
+
+ if (ud->buffer_pos < ud->header_pos + HEADER_LENGTH) {
+ /* The header is not read yet */
+ DEBUGF(("Header not read yet"));
+ if ((res = read_at_least(ud, ud->header_pos + HEADER_LENGTH -
+ ud->buffer_pos)) < 0) {
+ DEBUGF(("Header read failed"));
+ return res;
+ }
+ }
+ DEBUGF(("Header is read"));
+ /* We have at least the header read */
+ data_size = get_packet_length((char *) ud->buffer + ud->header_pos);
+ DEBUGF(("Input packet size = %d", data_size));
+ if (ud->buffer_pos < ud->header_pos + HEADER_LENGTH + data_size) {
+ /* We need to read more */
+ DEBUGF(("Need to read more (bufferpos %d, want %d)", ud->buffer_pos,
+ ud->header_pos + HEADER_LENGTH + data_size));
+ if ((res = read_at_least(ud,
+ ud->header_pos + HEADER_LENGTH +
+ data_size - ud->buffer_pos)) < 0) {
+ DEBUGF(("Data read failed"));
+ return res;
+ }
+ }
+ DEBUGF(("Data is completely read"));
+ *result = (char *) ud->buffer + ud->header_pos + HEADER_LENGTH;
+ ud->header_pos += HEADER_LENGTH + data_size;
+ return data_size;
+}
+
+static int read_at_least(UdsData *ud, int num)
+{
+ int got;
+ if (ud->buffer_pos + num > ud->buffer_size) {
+ /* No place in the buffer, try to pack it */
+ if (ud->header_pos > 0) {
+ int offset = ud->header_pos;
+ DEBUGF(("Packing buffer, buffer_pos was %d, buffer_size was %d "
+ "offset %d num %d header_pos %d.",
+ ud->buffer_pos, ud->buffer_size,
+ offset, num, ud->header_pos));
+ memmove(ud->buffer, ud->buffer + ud->header_pos,
+ ud->buffer_pos - ud->header_pos);
+ ud->buffer_pos -= offset;
+ ud->header_pos -= offset;
+ }
+ /* The buffer is packed, look for space again and reallocate if
+ needed */
+ if (ud->buffer_pos + num > ud->buffer_size) {
+ /* Let's grow in chunks of 256 */
+ ud->buffer_size = (((ud->buffer_pos + num) /
+ CHUNK_SIZE) + 1) * CHUNK_SIZE;
+ DEBUGF(("New buffer size %d.",ud->buffer_size));
+ /* We will always keep one extra byte before the buffer to
+ allow insertion of an opcode */
+ if (!ud->buffer) {
+ ud->buffer = ALLOC(ud->buffer_size);
+ } else {
+ ud->buffer = REALLOC(ud->buffer, ud->buffer_size);
+ }
+ }
+ }
+ /* OK, now we have a large enough buffer, try to read into it */
+ if ((got = read(ud->fd, ud->buffer + ud->buffer_pos,
+ ud->buffer_size - ud->buffer_pos)) < 0) {
+ /* It failed, the question is why... */
+ if (errno == EAGAIN) {
+ return NORMAL_READ_FAILURE;
+ }
+ return SEVERE_READ_FAILURE;
+ } else if (got == 0) {
+ return EOF_READ_FAILURE;
+ }
+ DEBUGF(("Got %d bytes.", got));
+ ud->received += got;
+ ud->buffer_pos += got;
+ /* So, we got some bytes, but enough ? */
+ if (got < num) {
+ return NORMAL_READ_FAILURE;
+ }
+ return 0;
+}
+
+static int get_packet_length(char *b)
+{
+ Byte *u = (Byte *) b;
+ int x = (((Word) u[0]) << 24) | (((Word) u[1]) << 16) |
+ (((Word) u[2]) << 8) | ((Word) u[3]);
+ DEBUGF(("Packet length %d.", x));
+ return x;
+}
+
+static void put_packet_length(char *b, int len)
+{
+ Byte *p = (Byte *) b;
+ Word n = (Word) len;
+ p[0] = (n >> 24) & 0xFF;
+ p[1] = (n >> 16) & 0xFF;
+ p[2] = (n >> 8) & 0xFF;
+ p[3] = n & 0xFF;
+}
+
+/*
+** Malloc wrappers
+** Note!
+** The function erl_exit is actually not a pert of the
+** driver interface, but it is very nice to use if one wants to halt
+** with a core and an erlang crash dump.
+*/
+static void *my_malloc(size_t size)
+{
+ void erl_exit(int, char *, ...);
+ void *ptr;
+
+ if ((ptr = driver_alloc(size)) == NULL) {
+ erl_exit(1,"Could not allocate %d bytes of memory",(int) size);
+ }
+ return ptr;
+}
+
+static void *my_realloc(void *ptr, size_t size)
+{
+ void erl_exit(int, char *, ...);
+ void *nptr;
+ if ((nptr = driver_realloc(ptr, size)) == NULL) {
+ erl_exit(1,"Could not reallocate %d bytes of memory",(int) size);
+ }
+ return nptr;
+}
+
+
+/*
+** Socket file handling helpers
+*/
+
+/*
+** Check that directory exists, create if not (only works for one level)
+*/
+static int ensure_dir(char *path)
+{
+ if (mkdir(path,0777) != 0 && errno != EEXIST) {
+ return -1;
+ }
+ return 0;
+}
+
+/*
+** Try to open a lock file and lock the first byte write-only (advisory)
+** return the file descriptor if succesful, otherwise -1 (<0).
+*/
+static int try_lock(char *sockname, Byte *p_creation)
+{
+ char *lockname;
+ int lockfd;
+ struct flock fl;
+ Byte creation;
+
+ lockname = ALLOC(strlen(SOCKET_PATH)+1+strlen(sockname)+
+ strlen(LOCK_SUFFIX)+1);
+ sprintf(lockname,SOCKET_PATH "/%s" LOCK_SUFFIX, sockname);
+ DEBUGF(("lockname = %s", lockname));
+ if (ensure_dir(SOCKET_PATH) != 0) {
+ DEBUGF(("ensure_dir failed, errno = %d", errno));
+ FREE(lockname);
+ return -1;
+ }
+ if ((lockfd = open(lockname, O_RDWR | O_CREAT, 0666)) < 0) {
+ DEBUGF(("open failed, errno = %d", errno));
+ FREE(lockname);
+ return -1;
+ }
+ FREE(lockname);
+ memset(&fl,0,sizeof(fl));
+ fl.l_type = F_WRLCK;
+ fl.l_whence = SEEK_SET;
+ fl.l_start = 0;
+ fl.l_len = 1;
+ if (fcntl(lockfd, F_SETLK, &fl) < 0) {
+ DEBUGF(("fcntl failed, errno = %d", errno));
+ close(lockfd);
+ return -1;
+ }
+ /* OK, check for creation and update */
+ if (read(lockfd, &creation, 1) < 1) {
+ creation = 0;
+ } else {
+ creation = (creation + 1) % 4;
+ }
+ lseek(lockfd, 0, SEEK_SET);
+ write(lockfd, &creation, 1);
+ fsync(lockfd); /* This could be concidered dangerous (blocking) */
+ *p_creation = creation;
+ return lockfd;
+}
+
+static void do_unlink(char *name)
+{
+ char buff[100];
+ char *str = buff;
+ int len = strlen(SOCKET_PATH) + 1 + strlen(name) + 1;
+
+ if (len > 100) {
+ str = ALLOC(len);
+ }
+ sprintf(str,SOCKET_PATH "/%s",name);
+ unlink(str);
+ if (str != buff) {
+ FREE(str);
+ }
+}
+
diff --git a/lib/kernel/examples/uds_dist/ebin/.gitignore b/lib/kernel/examples/uds_dist/ebin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/ebin/.gitignore
diff --git a/lib/kernel/examples/uds_dist/priv/.gitignore b/lib/kernel/examples/uds_dist/priv/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/priv/.gitignore
diff --git a/lib/kernel/examples/uds_dist/src/Makefile b/lib/kernel/examples/uds_dist/src/Makefile
new file mode 100644
index 0000000000..338d29b23d
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/Makefile
@@ -0,0 +1,27 @@
+# Example makefile
+
+RM=rm -f
+CP=cp
+EBIN=../ebin
+EMULATOR=beam
+ERLC=erlc
+# Works if building in open source source tree
+KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/src
+ERLCFLAGS+= -W -b$(EMULATOR) -I$(KERNEL_INCLUDE)
+APP=uds_dist.app
+
+MODULES=uds_server uds uds_dist
+
+TARGET_FILES=$(MODULES:%=$(EBIN)/%.$(EMULATOR))
+
+opt: $(TARGET_FILES) $(EBIN)/$(APP)
+
+$(EBIN)/%.$(EMULATOR): %.erl
+ $(ERLC) $(ERLCFLAGS) -o$(EBIN) $<
+
+$(EBIN)/$(APP): $(APP)
+ $(CP) $(APP) $(EBIN)/$(APP)
+
+clean:
+ $(RM) $(TARGET_FILES) $(EBIN)/$(APP)
+
diff --git a/lib/kernel/examples/uds_dist/src/uds.erl b/lib/kernel/examples/uds_dist/src/uds.erl
new file mode 100644
index 0000000000..ae1a78c44b
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/uds.erl
@@ -0,0 +1,166 @@
+-module(uds).
+
+-export([listen/1, connect/1, accept/1, send/2, recv/1, close/1,
+ get_port/1, get_status_counters/1, set_mode/2, controlling_process/2,
+ tick/1, get_creation/1]).
+
+-define(decode(A,B,C,D), (((A) bsl 24) bor
+ ((B) bsl 16) bor ((C) bsl 8) bor (D))).
+-define(encode(N), [(((N) bsr 24) band 16#FF), (((N) bsr 16) band 16#FF),
+ (((N) bsr 8) band 16#FF), ((N) band 16#FF)]).
+-define(check_server(), case whereis(uds_server) of
+ undefined ->
+ exit(uds_server_not_started);
+ _ ->
+ ok
+ end).
+
+listen(Name) ->
+ ?check_server(),
+ command(port(),$L,Name).
+
+
+connect(Name) ->
+ ?check_server(),
+ command(port(),$C,Name).
+
+accept(Port) ->
+ ?check_server(),
+ case control(Port,$N) of
+ {ok, N} ->
+ command(port(),$A,N);
+ Else ->
+ Else
+ end.
+
+send(Port,Data) ->
+ ?check_server(),
+ command(Port, $S, Data).
+
+recv(Port) ->
+ ?check_server(),
+ command(Port, $R, []).
+
+close(Port) ->
+ ?check_server(),
+ (catch unlink(Port)), %% Avoids problem with trap exits.
+ case (catch erlang:port_close(Port)) of
+ {'EXIT', Reason} ->
+ {error, closed};
+ _ ->
+ ok
+ end.
+
+get_port(Port) ->
+ ?check_server(),
+ {ok,Port}.
+
+get_status_counters(Port) ->
+ ?check_server(),
+ case control(Port, $S) of
+ {ok, {C0, C1, C2}} ->
+ {ok, C0, C1, C2};
+ Other ->
+ Other
+ end.
+
+get_creation(Port) ->
+ ?check_server(),
+ case control(Port, $R) of
+ {ok, [A]} ->
+ A;
+ Else ->
+ Else
+ end.
+
+
+set_mode(Port, command) ->
+ ?check_server(),
+ control(Port,$C);
+set_mode(Port,intermediate) ->
+ ?check_server(),
+ control(Port,$I);
+set_mode(Port,data) ->
+ ?check_server(),
+ control(Port,$D).
+
+tick(Port) ->
+ ?check_server(),
+ control(Port,$T).
+
+controlling_process(Port, Pid) ->
+ ?check_server(),
+ case (catch erlang:port_connect(Port, Pid)) of
+ true ->
+ (catch unlink(Port)),
+ ok;
+ {'EXIT', {badarg, _}} ->
+ {error, closed};
+ Else ->
+ exit({unexpected_driver_response, Else})
+ end.
+
+
+control(Port, Command) ->
+ case (catch erlang:port_control(Port, Command, [])) of
+ [0] ->
+ ok;
+ [0,A] ->
+ {ok, [A]};
+ [0,A,B,C,D] ->
+ {ok, [A,B,C,D]};
+ [0,A1,B1,C1,D1,A2,B2,C2,D2,A3,B3,C3,D3] ->
+ {ok, {?decode(A1,B1,C1,D1),?decode(A2,B2,C2,D2),
+ ?decode(A3,B3,C3,D3)}};
+ [1|Error] ->
+ exit({error, list_to_atom(Error)});
+ {'EXIT', {badarg, _}} ->
+ {error, closed};
+ Else ->
+ exit({unexpected_driver_response, Else})
+ end.
+
+
+command(Port, Command, Parameters) ->
+ SavedTrapExit = process_flag(trap_exit,true),
+ case (catch erlang:port_command(Port,[Command | Parameters])) of
+ true ->
+ receive
+ {Port, {data, [Command, $o, $k]}} ->
+ process_flag(trap_exit,SavedTrapExit),
+ {ok, Port};
+ {Port, {data, [Command |T]}} ->
+ process_flag(trap_exit,SavedTrapExit),
+ {ok, T};
+ {Port, Else} ->
+ process_flag(trap_exit,SavedTrapExit),
+ exit({unexpected_driver_response, Else});
+ {'EXIT', Port, normal} ->
+ process_flag(trap_exit,SavedTrapExit),
+ {error, closed};
+ {'EXIT', Port, Error} ->
+ process_flag(trap_exit,SavedTrapExit),
+ exit(Error)
+ end;
+ {'EXIT', {badarg, _}} ->
+ process_flag(trap_exit,SavedTrapExit),
+ {error, closed};
+ Unexpected ->
+ process_flag(trap_exit,SavedTrapExit),
+ exit({unexpected_driver_response, Unexpected})
+ end.
+
+port() ->
+ SavedTrapExit = process_flag(trap_exit,true),
+ case open_port({spawn, "uds_drv"},[]) of
+ P when port(P) ->
+ process_flag(trap_exit,SavedTrapExit),
+ P;
+ {'EXIT',Error} ->
+ process_flag(trap_exit,SavedTrapExit),
+ exit(Error);
+ Else ->
+ process_flag(trap_exit,SavedTrapExit),
+ exit({unexpected_driver_response, Else})
+ end.
+
diff --git a/lib/kernel/examples/uds_dist/src/uds_dist.app b/lib/kernel/examples/uds_dist/src/uds_dist.app
new file mode 100644
index 0000000000..2a58694c94
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/uds_dist.app
@@ -0,0 +1,7 @@
+{application, uds_dist,
+ [{description, "SSL socket version 2"},
+ {vsn, "1.0"},
+ {modules, [uds_server]},
+ {registered, [uds_server]},
+ {applications, [kernel, stdlib]},
+ {env, []}]}.
diff --git a/lib/kernel/examples/uds_dist/src/uds_dist.erl b/lib/kernel/examples/uds_dist/src/uds_dist.erl
new file mode 100644
index 0000000000..7a9c15a3c8
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/uds_dist.erl
@@ -0,0 +1,304 @@
+%% ``The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved via the world wide web at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
+%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
+%% AB. All Rights Reserved.''
+%%
+%% $Id$
+%%
+-module(uds_dist).
+
+%% Handles the connection setup phase with other Erlang nodes.
+
+-export([childspecs/0, listen/1, accept/1, accept_connection/5,
+ setup/4, close/1, select/1, is_node_name/1]).
+
+%% internal exports
+
+-export([accept_loop/2,do_accept/6,do_setup/5, getstat/1,tick/1]).
+
+-import(error_logger,[error_msg/2]).
+
+-include("net_address.hrl").
+
+
+
+-define(to_port(Socket, Data),
+ case uds:send(Socket, Data) of
+ {error, closed} ->
+ self() ! {uds_closed, Socket},
+ {error, closed};
+ R ->
+ R
+ end).
+
+
+-include("dist.hrl").
+-include("dist_util.hrl").
+-record(tick, {read = 0,
+ write = 0,
+ tick = 0,
+ ticked = 0
+ }).
+
+
+%% -------------------------------------------------------------
+%% This function should return a valid childspec, so that
+%% the primitive ssl_server gets supervised
+%% -------------------------------------------------------------
+childspecs() ->
+ {ok, [{uds_server,{uds_server, start_link, []},
+ permanent, 2000, worker, [uds_server]}]}.
+
+
+%% ------------------------------------------------------------
+%% Select this protocol based on node name
+%% select(Node) => Bool
+%% ------------------------------------------------------------
+
+select(Node) ->
+ {ok, MyHost} = inet:gethostname(),
+ case split_node(atom_to_list(Node), $@, []) of
+ [_, MyHost] ->
+ true;
+ _ ->
+ false
+ end.
+
+%% ------------------------------------------------------------
+%% Create the listen socket, i.e. the port that this erlang
+%% node is accessible through.
+%% ------------------------------------------------------------
+
+listen(Name) ->
+ case uds:listen(atom_to_list(Name)) of
+ {ok, Socket} ->
+ {ok, {Socket,
+ #net_address{address = [],
+ host = inet:gethostname(),
+ protocol = uds,
+ family = uds},
+ uds:get_creation(Socket)}};
+ Error ->
+ Error
+ end.
+
+%% ------------------------------------------------------------
+%% Accepts new connection attempts from other Erlang nodes.
+%% ------------------------------------------------------------
+
+accept(Listen) ->
+ spawn_link(?MODULE, accept_loop, [self(), Listen]).
+
+accept_loop(Kernel, Listen) ->
+ process_flag(priority, max),
+ case uds:accept(Listen) of
+ {ok, Socket} ->
+ Kernel ! {accept,self(),Socket,uds,uds},
+ controller(Kernel, Socket),
+ accept_loop(Kernel, Listen);
+ Error ->
+ exit(Error)
+ end.
+
+controller(Kernel, Socket) ->
+ receive
+ {Kernel, controller, Pid} ->
+ uds:controlling_process(Socket, Pid),
+ Pid ! {self(), controller};
+ {Kernel, unsupported_protocol} ->
+ exit(unsupported_protocol)
+ end.
+
+%% ------------------------------------------------------------
+%% Accepts a new connection attempt from another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+ spawn_link(?MODULE, do_accept,
+ [self(), AcceptPid, Socket, MyNode,
+ Allowed, SetupTime]).
+
+do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+ process_flag(priority, max),
+ receive
+ {AcceptPid, controller} ->
+ Timer = dist_util:start_timer(SetupTime),
+ HSData = #hs_data{
+ kernel_pid = Kernel,
+ this_node = MyNode,
+ socket = Socket,
+ timer = Timer,
+ this_flags = ?DFLAG_PUBLISHED bor
+ ?DFLAG_ATOM_CACHE bor
+ ?DFLAG_EXTENDED_REFERENCES bor
+ ?DFLAG_DIST_MONITOR bor
+ ?DFLAG_FUN_TAGS,
+ allowed = Allowed,
+ f_send = fun(S,D) -> uds:send(S,D) end,
+ f_recv = fun(S,N,T) -> uds:recv(S)
+ end,
+ f_setopts_pre_nodeup =
+ fun(S) ->
+ uds:set_mode(S, intermediate)
+ end,
+ f_setopts_post_nodeup =
+ fun(S) ->
+ uds:set_mode(S, data)
+ end,
+ f_getll = fun(S) ->
+ uds:get_port(S)
+ end,
+ f_address = fun get_remote_id/2,
+ mf_tick = {?MODULE, tick},
+ mf_getstat = {?MODULE,getstat}
+ },
+ dist_util:handshake_other_started(HSData)
+ end.
+
+%% ------------------------------------------------------------
+%% Get remote information about a Socket.
+%% ------------------------------------------------------------
+
+get_remote_id(Socket, Node) ->
+ [_, Host] = split_node(atom_to_list(Node), $@, []),
+ #net_address {
+ address = [],
+ host = Host,
+ protocol = uds,
+ family = uds }.
+
+%% ------------------------------------------------------------
+%% Setup a new connection to another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+setup(Node, MyNode, LongOrShortNames,SetupTime) ->
+ spawn_link(?MODULE, do_setup, [self(),
+ Node,
+ MyNode,
+ LongOrShortNames,
+ SetupTime]).
+
+do_setup(Kernel, Node, MyNode, LongOrShortNames,SetupTime) ->
+ process_flag(priority, max),
+ ?trace("~p~n",[{uds_dist,self(),setup,Node}]),
+ [Name, Address] = splitnode(Node, LongOrShortNames),
+ {ok, MyName} = inet:gethostname(),
+ case Address of
+ MyName ->
+ Timer = dist_util:start_timer(SetupTime),
+ case uds:connect(Name) of
+ {ok, Socket} ->
+ HSData = #hs_data{
+ kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = Socket,
+ timer = Timer,
+ this_flags = ?DFLAG_PUBLISHED bor
+ ?DFLAG_ATOM_CACHE bor
+ ?DFLAG_EXTENDED_REFERENCES bor
+ ?DFLAG_DIST_MONITOR bor
+ ?DFLAG_FUN_TAGS,
+ other_version = 1,
+ f_send = fun(S,D) ->
+ uds:send(S,D)
+ end,
+ f_recv = fun(S,N,T) ->
+ uds:recv(S)
+ end,
+ f_setopts_pre_nodeup =
+ fun(S) ->
+ uds:set_mode(S, intermediate)
+ end,
+ f_setopts_post_nodeup =
+ fun(S) ->
+ uds:set_mode(S, data)
+ end,
+ f_getll = fun(S) ->
+ uds:get_port(S)
+ end,
+ f_address =
+ fun(_,_) ->
+ #net_address{
+ address = [],
+ host = Address,
+ protocol = uds,
+ family = uds}
+ end,
+ mf_tick = {?MODULE, tick},
+ mf_getstat = {?MODULE,getstat}
+ },
+ dist_util:handshake_we_started(HSData);
+ _ ->
+ ?shutdown(Node)
+ end;
+ Other ->
+ ?shutdown(Node)
+ end.
+
+%%
+%% Close a socket.
+%%
+close(Socket) ->
+ uds:close(Socket).
+
+
+%% If Node is illegal terminate the connection setup!!
+splitnode(Node, LongOrShortNames) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [Name|Tail] when Tail /= [] ->
+ Host = lists:append(Tail),
+ case split_node(Host, $., []) of
+ [_] when LongOrShortNames == longnames ->
+ error_msg("** System running to use "
+ "fully qualified "
+ "hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown(Node);
+ L when length(L) > 1, LongOrShortNames == shortnames ->
+ error_msg("** System NOT running to use fully qualified "
+ "hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown(Node);
+ _ ->
+ [Name, Host]
+ end;
+ [_] ->
+ error_msg("** Nodename ~p illegal, no '@' character **~n",
+ [Node]),
+ ?shutdown(Node);
+ _ ->
+ error_msg("** Nodename ~p illegal **~n", [Node]),
+ ?shutdown(Node)
+ end.
+
+split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])];
+split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]);
+split_node([], _, Ack) -> [lists:reverse(Ack)].
+
+is_node_name(Node) when atom(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_, Host] -> true;
+ _ -> false
+ end;
+is_node_name(Node) ->
+ false.
+
+tick(Sock) ->
+ uds:tick(Sock).
+getstat(Socket) ->
+ uds:get_status_counters(Socket).
diff --git a/lib/kernel/examples/uds_dist/src/uds_server.erl b/lib/kernel/examples/uds_dist/src/uds_server.erl
new file mode 100644
index 0000000000..c060130f9d
--- /dev/null
+++ b/lib/kernel/examples/uds_dist/src/uds_server.erl
@@ -0,0 +1,156 @@
+%%%----------------------------------------------------------------------
+%%% File : uds_server.erl
+%%% Purpose : Holder for the uds_drv ddll driver.
+%%% Created : 15 Mar 2000
+%%%----------------------------------------------------------------------
+
+-module(uds_server).
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]).
+
+-define(DRIVER_NAME,"uds_drv").
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+start_link() ->
+ gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from gen_server
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%%----------------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit,true),
+ case load_driver() of
+ ok ->
+ {ok, []};
+ {error, already_loaded} ->
+ {ok, []};
+ Error ->
+ exit(Error)
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Func: handle_call/3
+%% Returns: {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} | (terminate/2 is called)
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_call(Request, From, State) ->
+ Reply = ok,
+ {reply, Reply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_cast/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_cast(Msg, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_info/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_info(Info, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: terminate/2
+%% Purpose: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%----------------------------------------------------------------------
+terminate(Reason, State) ->
+ erl_ddll:unload_driver(?DRIVER_NAME),
+ ok.
+
+%%----------------------------------------------------------------------
+%% Func: code_change/3
+%% Purpose: Convert process state when code is changed
+%% Returns: {ok, NewState}
+%%----------------------------------------------------------------------
+code_change(OldVsn, State, Extra) ->
+ {ok, State}.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+%%
+%% Actually load the driver.
+%%
+load_driver() ->
+ Dir = find_priv_lib(),
+ erl_ddll:load_driver(Dir,?DRIVER_NAME).
+
+%%
+%% As this server may be started by the distribution, it is not safe to assume
+%% a working code server, neither a working file server.
+%% I try to utilize the most primitive interfaces available to determine
+%% the directory of the port_program.
+%%
+find_priv_lib() ->
+ PrivDir = case (catch code:priv_dir(uds_dist)) of
+ {'EXIT', _} ->
+ %% Code server probably not startet yet
+ {ok, P} = erl_prim_loader:get_path(),
+ ModuleFile = atom_to_list(?MODULE) ++ extension(),
+ Pd = (catch lists:foldl
+ (fun(X,Acc) ->
+ M = filename:join([X, ModuleFile]),
+ %% The file server probably not started
+ %% either, has to use raw interface.
+ case file:raw_read_file_info(M) of
+ {ok,_} ->
+ %% Found our own module in the
+ %% path, lets bail out with
+ %% the priv_dir of this directory
+ Y = filename:split(X),
+ throw(filename:join
+ (lists:sublist
+ (Y,length(Y) - 1)
+ ++ ["priv"]));
+ _ ->
+ Acc
+ end
+ end,
+ false,P)),
+ case Pd of
+ false ->
+ exit(uds_dist_priv_lib_indeterminate);
+ _ ->
+ Pd
+ end;
+ Dir ->
+ Dir
+ end,
+ filename:join([PrivDir, "lib"]).
+
+extension() ->
+ %% erlang:info(machine) returns machine name as text in all uppercase
+ "." ++ lists:map(fun(X) ->
+ X + $a - $A
+ end,
+ erlang:info(machine)).
+
diff --git a/lib/kernel/include/file.hrl b/lib/kernel/include/file.hrl
new file mode 100644
index 0000000000..c1de4d764d
--- /dev/null
+++ b/lib/kernel/include/file.hrl
@@ -0,0 +1,70 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifndef(FILE_HRL_).
+-define(FILE_HRL_, 1).
+%%--------------------------------------------------------------------------
+
+%%-type namelist() :: [char() | atom() | namelist()].
+-type namelist() :: [_]. %% XXX: GROSS OVERAPPROXIMATION -- FIX ME
+-type name() :: string() | atom() | namelist().
+-type posix() :: atom().
+
+-type date() :: {pos_integer(), pos_integer(), pos_integer()}.
+-type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}.
+-type date_time() :: {date(), time()}.
+
+%%--------------------------------------------------------------------------
+
+-record(file_info,
+ {size :: non_neg_integer(), % Size of file in bytes.
+ type :: 'device' | 'directory' | 'other' | 'regular' | 'symlink',
+ access :: 'read' | 'write' | 'read_write' | 'none',
+ atime :: date_time(), % The local time the file was last read:
+ % {{Year, Mon, Day}, {Hour, Min, Sec}}.
+ mtime :: date_time(), % The local time the file was last written.
+ ctime :: date_time(), % The interpretation of this time field
+ % is dependent on operating system.
+ % On Unix it is the last time the file or
+ % or the inode was changed. On Windows,
+ % it is the creation time.
+ mode :: integer(), % File permissions. On Windows,
+ % the owner permissions will be
+ % duplicated for group and user.
+ links :: non_neg_integer(), % Number of links to the file (1 if the
+ % filesystem doesn't support links).
+ major_device :: integer(), % Identifies the file system (Unix),
+ % or the drive number (A: = 0, B: = 1)
+ % (Windows).
+ %% The following are Unix specific.
+ %% They are set to zero on other operating systems.
+ minor_device :: integer(), % Only valid for devices.
+ inode :: integer(), % Inode number for file.
+ uid :: integer(), % User id for owner.
+ gid :: integer()}). % Group id for owner.
+
+
+-record(file_descriptor,
+ {module :: module(), % Module that handles this kind of file
+ data :: term()}). % Module dependent data
+
+-type fd() :: pid() | #file_descriptor{}.
+
+%%--------------------------------------------------------------------------
+-endif.
diff --git a/lib/kernel/include/inet.hrl b/lib/kernel/include/inet.hrl
new file mode 100644
index 0000000000..929b2ee294
--- /dev/null
+++ b/lib/kernel/include/inet.hrl
@@ -0,0 +1,36 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% This record is returned by inet:gethostbyaddr/2 and inet:gethostbyname/2.
+
+
+-type hostname() :: atom() | string().
+-type ip4_address() :: {0..255,0..255,0..255,0..255}.
+-type ip6_address() :: {0..65535,0..65535,0..65535,0..65535,
+ 0..65535,0..65535,0..65535,0..65535}.
+-type ip_address() :: ip4_address() | ip6_address().
+-type ip_port() :: 0..65535.
+
+-record(hostent,
+ {
+ h_name :: hostname(), %% offical name of host
+ h_aliases = [] :: [hostname()], %% alias list
+ h_addrtype :: 'inet' | 'inet6', %% host address type
+ h_length :: non_neg_integer(), %% length of address
+ h_addr_list = [] :: [ip_address()] %% list of addresses from name server
+ }).
diff --git a/lib/kernel/include/inet_sctp.hrl b/lib/kernel/include/inet_sctp.hrl
new file mode 100644
index 0000000000..169ba013aa
--- /dev/null
+++ b/lib/kernel/include/inet_sctp.hrl
@@ -0,0 +1,247 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% SCTP protocol contribution by Leonid Timochouk and Serge Aleynikov.
+%% See also: $ERL_TOP/lib/kernel/AUTHORS
+%%
+
+%%
+%% SCTP-related records.
+%%
+
+%% sctp_initmsg: For creating a new association (send*) and
+%% SCTP_OPT_INITMSG setsockopt:
+-record(sctp_initmsg,
+ {
+ num_ostreams, % 0 Use endpoint default
+ max_instreams, % 0 Use endpoint default
+ max_attempts, % 0 Use endpoint default
+ max_init_timeo % 0 Use endpoint default
+ }).
+
+%% sctp_sndrcvinfo: Possible "flags": Atoms, as below. Used
+%% in "send*" and SCTP_OPT_DEFAULT_SEND_PARAM setsockopt:
+-record(sctp_sndrcvinfo,
+ {
+ stream, % 0 Streams numbered from 0 (XXX?)
+ ssn, % 0, Ignored for send
+ flags, % [unordered,
+ %% addr_over,
+ %% abort,
+ %% eof]
+ ppid, % 0, Passed to the remote end
+ context, % 0, Passed to the user on error
+ timetolive, % 0, In msec; 0 -> no expiration
+ tsn, % 0, Recv only: TSN of one of the chunks
+ cumtsn, % 0, Only for unordered recv
+ assoc_id % 0 IMPORTANT!
+ }).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% SCTP Notification Events:
+%%
+
+%% sctp_assoc_change: Possible valid "state" values include:
+%% comm_up, comm_lost, restart,
+%% shutdown_comp, cant_assoc
+-record(sctp_assoc_change,
+ {
+ state = cant_assoc,
+ error = 0,
+ outbound_streams = 0,
+ inbound_streams = 0,
+ assoc_id = 0
+ }).
+
+%% sctp_paddr_change: Peer address is a list. Possible "state" values:
+%% addr_available, addr_unreachable,
+%% addr_removed, addr_added,
+%% addr_made_prim
+-record(sctp_paddr_change,
+ {
+ addr = [0,0,0,0],
+ state = addr_available,
+ error = 0,
+ assoc_id = 0
+ }).
+
+%% sctp_remote_error: Possible "data" elements are Error Causes (Atoms
+%% (extending the info provided by "error" field).
+-record(sctp_remote_error,
+ {
+ error = 0,
+ assoc_id = 0,
+ data = []
+ }).
+
+%% sctp_send_failed: The "flags" is a Boolean specifying whether the
+%% data have actually been transmitted over the wire.
+%% "error" is similar to in #sctp_remote_error{} above.
+%% "info" is the orig "*sndrcvinfo", and "data" is
+%% the whole orig data chunk we attempted to send:
+-record(sctp_send_failed,
+ {
+ flags = false,
+ error = 0,
+ info = #sctp_sndrcvinfo{},
+ assoc_id = 0,
+ data = <<>>
+ }).
+
+%% sctp_shutdown_event: In this case, shut-down occurs on a particular
+%% association, not on the whole socket.
+-record(sctp_shutdown_event,
+ {
+ assoc_id = 0
+ }).
+
+%% sctp_adaptation_event: "adaptation_ind" is opaque user-specified data:
+-record(sctp_adaptation_event,
+ {
+ adaptation_ind = 0,
+ assoc_id = 0
+ }).
+
+%% sctp_partial_delivery_event: XXX: Not clear whether it is delivered to
+%% the Sender or to the Recepient (probably the
+%% former). Currently, there is only 1 possible
+%% value for "indication":
+-record(sctp_pdapi_event,
+ {
+ indication = partial_delivery_aborted,
+ assoc_id = 0
+ }).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% SCTP Socket Options:
+%%
+
+-record(sctp_rtoinfo, % For SCTP_OPT_RTOINFO
+ {
+ assoc_id,
+ initial, % 0
+ max, % 0
+ min % 0
+ }).
+
+-record(sctp_assocparams, % For SCTP_OPT_ASSOCINFO
+ {
+ assoc_id,
+ asocmaxrxt, % 0
+ number_peer_destinations, % 0
+ peer_rwnd, % 0
+ local_rwnd, % 0
+ cookie_life % 0
+ }).
+
+% #sctp_initmsg{} and #sctp_sndrcvinfo{}, declared above, can also be options.
+
+-record(sctp_prim, % For SCTP_OPT_SET_PRIMARY_ADDR and
+ {
+ assoc_id,
+ addr % When set: {IP, Port}
+ }).
+
+-record(sctp_setpeerprim, % For SCTP_OPT_SET_PEER_PRIMARY_ADDR
+ {
+ assoc_id,
+ addr % When set: { IP, Port}
+ }).
+
+-record(sctp_setadaptation, % For SCTP_OPT_ADAPTATION_LAYER
+ {
+ adaptation_ind % 0
+ }).
+
+-record(sctp_paddrparams, % For SCTP_OPT_PEER_ADDR_PARAMS
+ {
+ assoc_id,
+ address, % When set: {IP, Port}
+ hbinterval, % 0
+ pathmaxrxt, % 0
+ pathmtu, % 0
+ sackdelay, % 0
+ flags % [hb_enable,
+ %% hb_disable
+ %% hb_demand,
+ %% pmtud_enable,
+ %% pmtud_disable,
+ %% sackdelay_enable,
+ %% sackdelay_disable]
+ }).
+
+
+% SCTP events which will be subscribed by default upon opening the socket.
+% NB: "data_io_event" controls delivery of #sctp_sndrcvinfo{} ancilary
+% data, not events (which are normal data) in fact; it may be needed in
+% order to get the AssocID of data just received:
+%
+-record(sctp_event_subscribe,
+ {
+ data_io_event, % true, % Used by gen_sctp
+ association_event, % true, % Used by gen_sctp
+ address_event, % true, % Unlikely to happen...
+ send_failure_event, % true, % Delivered as an ERROR
+ peer_error_event, % true, % Delivered as an ERROR
+ shutdown_event, % true, % Used by gen_sctp
+ partial_delivery_event, % true, % Unlikely to happen...
+ adaptation_layer_event, % false % Probably not needed...
+ authentication_event % false % Not implemented yet...
+ }).
+
+-record(sctp_assoc_value, % For SCTP_OPT_DELAYED_ACK_TIME
+ {
+ assoc_id,
+ assoc_value % 0
+ }).
+
+
+
+% sctp_paddrinfo and sctp_status are records for read-only options:
+-record(sctp_paddrinfo,
+ {
+ assoc_id,
+ address, % When set: {IP, Port}
+ state, % 'inactive', Or 'active'
+ cwnd, % 0
+ srtt, % 0,
+ rto, % 0
+ mtu % 0
+ }).
+
+-record(sctp_status,
+ {
+ assoc_id,
+ state, % empty,
+ % Other possible states:
+ % closed, cookie_wait,
+ % cookie_echoed, established,
+ % shutdown_pending, shutdow_sent,
+ % shutdown_received, shutdown_ack_sent;
+ % NOT YET IMPLEMENTED:
+ % bound, listen
+ rwnd, % 0
+ unackdata, % 0,
+ penddata, % 0,
+ instrms, % 0,
+ outstrms, % 0,
+ fragmentation_point, % 0,
+ primary % When set: an #sctp_paddrinfo{} record
+ }).
diff --git a/lib/kernel/info b/lib/kernel/info
new file mode 100644
index 0000000000..c7c1a89750
--- /dev/null
+++ b/lib/kernel/info
@@ -0,0 +1,2 @@
+group: basic Basic Applications
+short: Functionality necessary to run the Erlang System itself
diff --git a/lib/kernel/internal_doc/distribution_handshake.txt b/lib/kernel/internal_doc/distribution_handshake.txt
new file mode 100644
index 0000000000..f64ebe0302
--- /dev/null
+++ b/lib/kernel/internal_doc/distribution_handshake.txt
@@ -0,0 +1,215 @@
+HOW THE DISTRIBUTION HANDSHAKE WORKS
+------------------------------------
+
+This document describes the distribution handshake introduced in
+the R6 release of Erlang/OTP.
+
+GENERAL
+-------
+
+The TCP/IP distribution uses a handshake which expects a
+connection based protocol, i.e. the protocol does not include
+any authentication after the handshake procedure.
+
+This is not entirelly safe, as it is vulnerable against takeover
+attacks, but it is a tradeoff between fair safety and performance.
+
+The cookies are never sent in cleartext and the handshake procedure
+expects the client (called A) to be the first one to prove that it can
+generate a sufficient digest. The digest is generated with the
+MD5 message digest algorithm and the challenges are expected to be very
+random numbers.
+
+DEFINITIONS
+-----------
+
+A challenge is a 32 bit integer number in big endian. Below the function
+gen_challenge() returns a random 32 bit integer used as a challenge.
+
+A digest is a (16 bytes) MD5 hash of [the Challenge (as text) concatenated
+with the cookie (as text)]. Below, the function gen_digest(Challenge, Cookie)
+generates a digest as described above.
+
+An out_cookie is the cookie used in outgoing communication to a certain node,
+so that A's out_cookie for B should correspond with B's in_cookie for A and
+the other way around. A's out_cookie for B and A's in_cookie for B need *NOT*
+be the same. Below the function out_cookie(Node) returns the current
+node's out_cookie for Node.
+
+An in_cookie is the cookie expected to be used by another node when
+communicating with us, so that A's in_cookie for B corresponds with B's
+out_cookie for A. Below the function in_cookie(Node) returns the current
+node's in_cookie for Node.
+
+The cookies are text strings that can be viewed as passwords.
+
+Every message in the handshake starts with a 16 bit big endian integer
+which contains the length of the message (not counting the two initial bytes).
+In erlang this corresponds to the gen_tcp option {packet, 2}. Note that after
+the handshake, the distribution switches to 4 byte backet headers.
+
+THE HANDSHAKE IN DETAIL
+-----------------------
+
+Imagine two nodes, node A, which initiates the handshake and node B, whitch
+accepts the connection.
+
+1) connect/accept: A connects to B via TCP/IP and B accepts the connection.
+
+2) send_name/receive_name: A sends an initial identification to B.
+B receives the message. The message looks
+like this (every "square" beeing one byte and the packet header removed):
+
++---+--------+--------+-----+-----+-----+-----+-----+-----+-...-+-----+
+|'n'|Version0|Version1|Flag0|Flag1|Flag2|Flag3|Name0|Name1| ... |NameN|
++---+--------+--------+-----+-----+-----+-----+-----+-----+-... +-----+
+
+The 'n' is just a message tag,
+Version0 & Version1 is the distribution version selected by node A,
+ based on information from EPMD. (16 bit big endian)
+Flag0 ... Flag3 is capability flags, the capabilities defined in dist.hrl.
+ (32 bit big endian)
+Name0 ... NameN is the full nodename of A, as a string of bytes (the
+ packet length denotes how long it is).
+
+3) recv_status/send_status: B sends a status message to A, which indicates
+if the connection is allowed. Four different status codes are defined:
+ok: The handshake will continue.
+ok_simultaneous: The handshake will continue, but A is informed that B
+ has another ongoing connection attempt that will be
+ shut down (simultaneous connect where A's name is
+ greater than B's name, compared literally),
+nok: The handshake will not continue, as B already has an ongoing handshake
+ which it itself has initiated. (simultaneous connect where B's name is
+ greater than A's)
+not_allowed: The connection is disallowed for some (unspecified) security
+ reason.
+alive: A connection to the node is already active, which either means
+ that node A is confused or that the TCP connection breakdown
+ of a previous node with this name has not yet reached node B.
+ See 3B below.
+
+This is the format of the status message:
+
++---+-------+-------+ ... +-------+
+|'s'|Status0|Status1| ... |StatusN|
++---+-------+-------+ ... +-------+
+
+'s' is the message tag
+Status0 ... StatusN is the status as a string (not terminated)
+
+3B) send_status/recv_status: If status was 'alive', node A will answer with
+another status message containing either 'true' which means that the
+connection should continue (The old connection from this node is broken), or
+'false', which simply means that the connection should be closed, the
+connection attempt was a mistake.
+
+4) recv_challenge/send_challenge: If the status was 'ok' or 'ok_simultaneous',
+The handshake continues with B sending A another message, the challenge.
+The challenge contains the same type of information as the "name" message
+initially sent from A to B, with the addition of a 32 bit challenge:
+
++---+--------+--------+-----+-----+-----+-----+-----+-----+-----+-----+---
+|'n'|Version0|Version1|Flag0|Flag1|Flag2|Flag3|Chal0|Chal1|Chal2|Chal3|
++---+--------+--------+-----+-----+-----+-----+-----+-----+---- +-----+---
+ ------+-----+-...-+-----+
+ Name0|Name1| ... |NameN|
+ ------+-----+-... +-----+
+
+Where Chal0 ... Chal3 is the challenge as a 32 bit biog endian integer
+and the other fields are B's version, flags and full nodename.
+
+5) send_challenge_reply/recv_challenge_reply: Now A has generated
+a digest and it's own challenge. Those are sent together in a package
+to B:
+
++---+-----+-----+-----+-----+-----+-----+-----+-----+
+|'r'|Chal0|Chal1|Chal2|Chal3|Dige0|Dige1|Dige2|Dige3|
++---+-----+-----+-----+-----+-----+-----+---- +-----+
+
+Where 'r' is the tag, Chal0 ... Chal3 is A's challenge for B to handle and
+Dige0 ... Dige3 is the digest that A constructed from the challenge B sent
+in the previous step.
+
+6) recv_challenge_ack/send_challenge_ack: B checks that the digest received
+from A is correct and generates a digest from the challenge received from
+A. The digest is then sent to A. The message looks like this:
+
++---+-----+-----+-----+-----+
+|'a'|Dige0|Dige1|Dige2|Dige3|
++---+-----+-----+---- +-----+
+
+Where 'a' is the tag and Dige0 ... Dige3 is the digest calculated by B
+for A's challenge.
+
+7) A checks the digest from B and the connection is up.
+
+SEMIGRAPHIC VIEW
+----------------
+
+A (initiator) B (acceptor)
+
+TCP connect ----------------------------------------->
+ TCP accept
+
+send_name ----------------------------------------->
+ recv_name
+
+ <---------------------------------------- send_status
+recv_status
+(if status was 'alive'
+ send_status - - - - - - - - - - - - - - - - - - - ->
+ recv_status)
+ ChB = gen_challenge()
+ (ChB)
+ <---------------------------------------- send_challenge
+recv_challenge
+
+ChA = gen_challenge(),
+OCA = out_cookie(B),
+DiA = gen_digest(ChB,OCA)
+ (ChA, DiA)
+send_challenge_reply -------------------------------->
+ recv_challenge_reply
+ ICB = in_cookie(A),
+ check:
+ DiA == gen_digest
+ (ChB, ICB) ?
+ - if OK:
+ OCB = out_cookie(A),
+ DiB = gen_digest
+ (DiB) (ChA, OCB)
+ <----------------------------------------- send_challenge_ack
+recv_challenge_ack DONE
+ICA = in_cookie(B), - else
+check: CLOSE
+DiB == gen_digest(ChA,ICA) ?
+- if OK
+ DONE
+- else
+ CLOSE
+
+
+THE CURRENTLY DEFINED FLAGS
+---------------------------
+Currently the following capability flags are defined:
+
+%% The node should be published and part of the global namespace
+-define(DFLAG_PUBLISHED,1).
+
+%% The node implements an atom cache
+-define(DFLAG_ATOM_CACHE,2).
+
+%% The node implements extended (3 * 32 bits) references
+-define(DFLAG_EXTENDED_REFERENCES,4).
+
+%% The node implements distributed process monitoring.
+-define(DFLAG_DIST_MONITOR,8).
+
+%% The node uses separate tag for fun's (labmdas) in the distribution protocol.
+-define(DFLAG_FUN_TAGS,16).
+
+An R6 erlang node implements all of the above, while a C or Java node only
+implements DFLAG_EXTENDED_REFERENCES.
+
+Last modified 1999-11-08 -- Patrik Nyblom, OTP
diff --git a/lib/kernel/priv/.gitignore b/lib/kernel/priv/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/priv/.gitignore
diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile
new file mode 100644
index 0000000000..ef280058fb
--- /dev/null
+++ b/lib/kernel/src/Makefile
@@ -0,0 +1,243 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1996-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+
+ifdef BOOTSTRAP
+EGEN=$(BOOTSTRAP_TOP)/lib/kernel/egen
+EBIN=$(BOOTSTRAP_TOP)/lib/kernel/ebin
+endif
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Application version
+# ----------------------------------------------------
+
+# Include erts/system/vsn.mk to port number for EPMD -- we will
+# get an unwanted definition for VSN too. Therefore,
+# we'll use KERNEL_VSN directly instead of assigning it to
+# VSN which is done in other Makefiles. Same with HIPE_VSN.
+
+include ../vsn.mk
+include $(ERL_TOP)/erts/vsn.mk
+include $(ERL_TOP)/lib/hipe/vsn.mk
+
+include $(ERL_TOP)/erts/epmd/epmd.mk
+
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/lib/kernel-$(KERNEL_VSN)
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+
+MODULES = \
+ application \
+ application_controller \
+ application_master \
+ application_starter \
+ auth \
+ code \
+ code_server \
+ disk_log \
+ disk_log_1 \
+ disk_log_server \
+ disk_log_sup \
+ dist_ac \
+ dist_util \
+ erl_boot_server \
+ erl_ddll \
+ erl_distribution \
+ erl_epmd \
+ erl_reply \
+ erts_debug \
+ error_handler \
+ error_logger \
+ file \
+ file_io_server \
+ file_server \
+ gen_tcp \
+ gen_udp \
+ gen_sctp \
+ global \
+ global_group \
+ global_search \
+ group \
+ heart \
+ hipe_unified_loader \
+ inet \
+ inet6_tcp \
+ inet6_tcp_dist \
+ inet6_udp \
+ inet6_sctp \
+ inet_config \
+ inet_db \
+ inet_dns \
+ inet_gethost_native \
+ inet_hosts \
+ inet_parse \
+ inet_res \
+ inet_tcp \
+ inet_tcp_dist \
+ inet_udp \
+ inet_sctp \
+ kernel \
+ kernel_config \
+ net \
+ net_adm \
+ net_kernel \
+ os \
+ packages \
+ pg2 \
+ ram_file \
+ rpc \
+ seq_trace \
+ standard_error \
+ user \
+ user_drv \
+ user_sup \
+ wrap_log_reader
+
+HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl
+INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \
+ net_address.hrl inet_dns.hrl inet_res.hrl \
+ inet_boot.hrl inet_config.hrl inet_int.hrl \
+ dist.hrl dist_util.hrl inet_dns_record_adts.hrl
+
+ERL_FILES= $(MODULES:%=%.erl)
+
+TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \
+ $(APP_TARGET) $(APPUP_TARGET)
+
+APP_FILE= kernel.app
+
+APP_SRC= $(APP_FILE).src
+APP_TARGET= $(EBIN)/$(APP_FILE)
+
+APPUP_FILE= kernel.appup
+
+APPUP_SRC= $(APPUP_FILE).src
+APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+ERL_COMPILE_FLAGS += -I../include
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+debug opt: $(TARGET_FILES)
+
+# Note: In the open-source build clean must not destroyed the preloaded
+# beam files.
+clean:
+ rm -f $(NON_PRECIOUS_TARGETS)
+ rm -f core
+
+
+docs:
+
+# ----------------------------------------------------
+# Special Build Targets
+# ----------------------------------------------------
+
+../../hipe/main/hipe.hrl: ../../hipe/vsn.mk ../../hipe/main/hipe.hrl.src
+ sed -e "s;%VSN%;$(HIPE_VSN);" ../../hipe/main/hipe.hrl.src > ../../hipe/main/hipe.hrl
+
+$(APP_TARGET): $(APP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(KERNEL_VSN);' $< > $@
+
+$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk
+ sed -e 's;%VSN%;$(KERNEL_VSN);' $< > $@
+
+
+EPMD_FLAGS = -Depmd_port_no=$(EPMD_PORT_NO) \
+ -Depmd_node_type=$(EPMD_NODE_TYPE) \
+ -Depmd_dist_low=$(EPMD_DIST_LOW) \
+ -Depmd_dist_high=$(EPMD_DIST_HIGH) \
+ -Derlang_daemon_port=$(EPMD_PORT_NO)
+
+$(ESRC)/inet_dns_record_adts.hrl: $(ESRC)/inet_dns_record_adts.pl
+ LANG=C $(PERL) $< > $@
+
+$(EBIN)/erl_epmd.beam: $(ESRC)/erl_epmd.erl
+ $(ERLC) $(ERL_COMPILE_FLAGS) $(EPMD_FLAGS) -o$(EBIN) $<
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/include
+ $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+
+# Include dependencies -- list below added by Kostis Sagonas
+$(EBIN)/application_controller.beam: application_master.hrl
+$(EBIN)/application_master.beam: application_master.hrl
+$(EBIN)/auth.beam: ../include/file.hrl
+$(EBIN)/code.beam: ../include/file.hrl
+$(EBIN)/code_server.beam: ../include/file.hrl
+$(EBIN)/disk_log.beam: disk_log.hrl
+$(EBIN)/disk_log_1.beam: disk_log.hrl ../include/file.hrl
+$(EBIN)/disk_log_server.beam: disk_log.hrl
+$(EBIN)/dist_util.beam: dist_util.hrl dist.hrl
+$(EBIN)/erl_boot_server.beam: inet_boot.hrl
+$(EBIN)/erl_epmd.beam: inet_int.hrl erl_epmd.hrl
+$(EBIN)/file.beam: ../include/file.hrl
+$(EBIN)/gen_tcp.beam: inet_int.hrl
+$(EBIN)/gen_udp.beam: inet_int.hrl
+$(EBIN)/gen_sctp.beam: ../include/inet_sctp.hrl
+$(EBIN)/global.beam: ../../stdlib/include/ms_transform.hrl
+$(EBIN)/hipe_unified_loader.beam: ../../hipe/main/hipe.hrl hipe_ext_format.hrl
+$(EBIN)/inet.beam: ../include/inet.hrl inet_int.hrl ../include/inet_sctp.hrl
+$(EBIN)/inet6_tcp.beam: inet_int.hrl
+$(EBIN)/inet6_tcp_dist.beam: net_address.hrl dist.hrl dist_util.hrl
+$(EBIN)/inet6_udp.beam: inet_int.hrl
+$(EBIN)/inet6_sctp.beam: inet_int.hrl
+$(EBIN)/inet_config.beam: inet_config.hrl ../include/inet.hrl
+$(EBIN)/inet_db.beam: ../include/inet.hrl inet_int.hrl inet_res.hrl inet_dns.hrl inet_config.hrl
+$(EBIN)/inet_dns.beam: inet_int.hrl inet_dns.hrl inet_dns_record_adts.hrl
+$(EBIN)/inet_gethost_native.beam: ../include/inet.hrl
+$(EBIN)/inet_hosts.beam: ../include/inet.hrl
+$(EBIN)/inet_parse.beam: ../include/file.hrl
+$(EBIN)/inet_res.beam: ../include/inet.hrl inet_res.hrl inet_dns.hrl inet_int.hrl
+$(EBIN)/inet_tcp.beam: inet_int.hrl
+$(EBIN)/inet_udp_dist.beam: net_address.hrl dist.hrl dist_util.hrl
+$(EBIN)/inet_udp.beam: inet_int.hrl
+$(EBIN)/inet_sctp.beam: inet_int.hrl ../include/inet_sctp.hrl
+$(EBIN)/net_kernel.beam: net_address.hrl
+$(EBIN)/os.beam: ../include/file.hrl
+$(EBIN)/ram_file.beam: ../include/file.hrl
+$(EBIN)/wrap_log_reader.beam: disk_log.hrl ../include/file.hrl
diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl
new file mode 100644
index 0000000000..d9db23d652
--- /dev/null
+++ b/lib/kernel/src/application.erl
@@ -0,0 +1,263 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(application).
+
+-export([start/1, start/2, start_boot/1, start_boot/2, stop/1,
+ load/1, load/2, unload/1, takeover/2,
+ which_applications/0, which_applications/1,
+ loaded_applications/0, permit/2]).
+-export([set_env/3, set_env/4, unset_env/2, unset_env/3]).
+-export([get_env/1, get_env/2, 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]).
+-export([start_type/0]).
+
+-export([behaviour_info/1]).
+
+%%%-----------------------------------------------------------------
+
+-type restart_type() :: 'permanent' | 'transient' | 'temporary'.
+-type application_opt() :: {'description', string()}
+ | {'vsn', string()}
+ | {'id', string()}
+ | {'modules', [atom() | {atom(), any()}]}
+ | {'registered', [atom()]}
+ | {'applications', [atom()]}
+ | {'included_applications', [atom()]}
+ | {'env', [{atom(), any()}]}
+ | {'start_phases', [{atom(), any()}] | 'undefined'}
+ | {'maxT', timeout()} % max timeout
+ | {'maxP', integer() | 'infinity'} % max processes
+ | {'mod', {atom(), any()}}.
+-type application_spec() :: {'application', atom(), [application_opt()]}.
+
+%%------------------------------------------------------------------
+
+-spec behaviour_info(atom()) -> 'undefined' | [{atom(), byte()}].
+
+behaviour_info(callbacks) ->
+ [{start,2},{stop,1}];
+behaviour_info(_Other) ->
+ undefined.
+
+%%%-----------------------------------------------------------------
+%%% This module is API towards application_controller and
+%%% application_master.
+%%%-----------------------------------------------------------------
+
+-spec load(Application :: atom() | application_spec()) ->
+ 'ok' | {'error', term()}.
+
+load(Application) ->
+ load(Application, []).
+
+-spec load(Application :: atom() | application_spec(),
+ Distributed :: any()) -> 'ok' | {'error', term()}.
+
+load(Application, DistNodes) ->
+ case application_controller:load_application(Application) of
+ ok when DistNodes =/= [] ->
+ AppName = get_appl_name(Application),
+ case dist_ac:load_application(AppName, DistNodes) of
+ ok ->
+ ok;
+ {error, R} ->
+ application_controller:unload_application(AppName),
+ {error, R}
+ end;
+ Else ->
+ Else
+ end.
+
+-spec unload(Application :: atom()) -> 'ok' | {'error', term()}.
+
+unload(Application) ->
+ application_controller:unload_application(Application).
+
+-spec start(Application :: atom()) -> 'ok' | {'error', term()}.
+
+start(Application) ->
+ start(Application, temporary).
+
+-spec start(Application :: atom() | application_spec(),
+ RestartType :: restart_type()) -> any().
+
+start(Application, RestartType) ->
+ case load(Application) of
+ ok ->
+ Name = get_appl_name(Application),
+ application_controller:start_application(Name, RestartType);
+ {error, {already_loaded, Name}} ->
+ application_controller:start_application(Name, RestartType);
+ Error ->
+ Error
+ end.
+
+-spec start_boot(Application :: atom()) -> 'ok' | {'error', term()}.
+
+start_boot(Application) ->
+ start_boot(Application, temporary).
+
+-spec start_boot(Application :: atom(), RestartType :: restart_type()) ->
+ 'ok' | {'error', term()}.
+
+start_boot(Application, RestartType) ->
+ application_controller:start_boot_application(Application, RestartType).
+
+-spec takeover(Application :: atom(), RestartType :: restart_type()) -> any().
+
+takeover(Application, RestartType) ->
+ dist_ac:takeover_application(Application, RestartType).
+
+-spec permit(Application :: atom(), Bool :: boolean()) -> 'ok' | {'error', term()}.
+
+permit(Application, Bool) ->
+ case Bool of
+ true -> ok;
+ false -> ok;
+ Bad -> exit({badarg, {?MODULE, permit, [Application, Bad]}})
+ end,
+ case application_controller:permit_application(Application, Bool) of
+ distributed_application ->
+ dist_ac:permit_application(Application, Bool);
+ {distributed_application, only_loaded} ->
+ dist_ac:permit_only_loaded_application(Application, Bool);
+ LocalResult ->
+ LocalResult
+ end.
+
+-spec stop(Application :: atom()) -> 'ok' | {'error', term()}.
+
+stop(Application) ->
+ application_controller:stop_application(Application).
+
+-spec which_applications() -> [{atom(), string(), string()}].
+
+which_applications() ->
+ application_controller:which_applications().
+
+-spec which_applications(timeout()) -> [{atom(), string(), string()}].
+
+which_applications(infinity) ->
+ application_controller:which_applications(infinity);
+which_applications(Timeout) when is_integer(Timeout), Timeout>=0 ->
+ application_controller:which_applications(Timeout).
+
+-spec loaded_applications() -> [{atom(), string(), string()}].
+
+loaded_applications() ->
+ application_controller:loaded_applications().
+
+-spec info() -> any().
+
+info() ->
+ application_controller:info().
+
+-spec set_env(Application :: atom(), Key :: atom(), Value :: any()) -> 'ok'.
+
+set_env(Application, Key, Val) ->
+ application_controller:set_env(Application, Key, Val).
+
+-spec set_env(Application :: atom(), Key :: atom(),
+ Value :: any(), Timeout :: timeout()) -> 'ok'.
+
+set_env(Application, Key, Val, infinity) ->
+ application_controller:set_env(Application, Key, Val, infinity);
+set_env(Application, Key, Val, Timeout) when is_integer(Timeout), Timeout>=0 ->
+ application_controller:set_env(Application, Key, Val, Timeout).
+
+-spec unset_env(atom(), atom()) -> 'ok'.
+
+unset_env(Application, Key) ->
+ application_controller:unset_env(Application, Key).
+
+-spec unset_env(atom(), atom(), timeout()) -> 'ok'.
+
+unset_env(Application, Key, infinity) ->
+ application_controller:unset_env(Application, Key, infinity);
+unset_env(Application, Key, Timeout) when is_integer(Timeout), Timeout>=0 ->
+ application_controller:unset_env(Application, Key, Timeout).
+
+-spec get_env(atom()) -> 'undefined' | {'ok', term()}.
+
+get_env(Key) ->
+ application_controller:get_pid_env(group_leader(), Key).
+
+-spec get_env(atom(), atom()) -> 'undefined' | {'ok', term()}.
+
+get_env(Application, Key) ->
+ application_controller:get_env(Application, Key).
+
+-spec get_all_env() -> [] | [{atom(), any()}].
+
+get_all_env() ->
+ application_controller:get_pid_all_env(group_leader()).
+
+-spec get_all_env(atom()) -> [] | [{atom(), any()}].
+
+get_all_env(Application) ->
+ application_controller:get_all_env(Application).
+
+-spec get_key(atom()) -> 'undefined' | {'ok', term()}.
+
+get_key(Key) ->
+ application_controller:get_pid_key(group_leader(), Key).
+
+-spec get_key(atom(), atom()) -> 'undefined' | {'ok', term()}.
+
+get_key(Application, Key) ->
+ application_controller:get_key(Application, Key).
+
+-spec get_all_key() -> 'undefined' | [] | {'ok', [{atom(),any()},...]}.
+
+get_all_key() ->
+ application_controller:get_pid_all_key(group_leader()).
+
+-spec get_all_key(atom()) -> 'undefined' | {'ok', [{atom(),any()},...]}.
+
+get_all_key(Application) ->
+ application_controller:get_all_key(Application).
+
+-spec get_application() -> 'undefined' | {'ok', atom()}.
+
+get_application() ->
+ application_controller:get_application(group_leader()).
+
+-spec get_application(Pid :: pid()) -> 'undefined' | {'ok', atom()}
+ ; (Module :: atom()) -> 'undefined' | {'ok', atom()}.
+
+get_application(Pid) when is_pid(Pid) ->
+ case process_info(Pid, group_leader) of
+ {group_leader, Gl} ->
+ application_controller:get_application(Gl);
+ undefined ->
+ undefined
+ end;
+get_application(Module) when is_atom(Module) ->
+ application_controller:get_application_module(Module).
+
+-spec start_type() -> 'undefined' | 'local' | 'normal'
+ | {'takeover', node()} | {'failover', node()}.
+
+start_type() ->
+ application_controller:start_type(group_leader()).
+
+%% Internal
+get_appl_name(Name) when is_atom(Name) -> Name;
+get_appl_name({application, Name, _}) when is_atom(Name) -> Name.
diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl
new file mode 100644
index 0000000000..7c1f059875
--- /dev/null
+++ b/lib/kernel/src/application_controller.erl
@@ -0,0 +1,1946 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(application_controller).
+
+%% External exports
+-export([start/1,
+ load_application/1, unload_application/1,
+ start_application/2, start_boot_application/2, stop_application/1,
+ 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,
+ 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,
+ start_type/1, permit_application/2, do_config_diff/2,
+ set_env/3, set_env/4, unset_env/2, unset_env/3]).
+
+%% Internal exports
+-export([handle_call/3, handle_cast/2, handle_info/2, terminate/2,
+ code_change/3, init_starter/4, get_loaded/1]).
+
+%% Test exports, only to be used from the test suites
+-export([test_change_apps/2]).
+
+-import(lists, [zf/2, map/2, foreach/2, foldl/3,
+ keysearch/3, keydelete/3, keyreplace/4]).
+
+-include("application_master.hrl").
+
+-define(AC, ?MODULE). % Name of process
+
+%%%-----------------------------------------------------------------
+%%% The application_controller controls local applications only. A
+%%% local application can be loaded/started/stopped/unloaded and
+%%% changed. The control of distributed applications is taken care of
+%%% by another process (default is dist_ac).
+%%%
+%%% When an application has been started (by a call to application:start)
+%%% it can be running or not running (on this node). For example,
+%%% a distributed application must be started on all nodes, but
+%%% may be running on one node at the time.
+%%%
+%%% The external API to this module is in the module 'application'.
+%%%
+%%% The process that controls distributed applications (called dist
+%%% ac). calls application_controller:control_application(Name) to
+%%% take responsibility for an application. The interface between AC
+%%% and the dist_ac process is message-based:
+%%%
+%%% AC DIST AC
+%%% == =======
+%%% --> {ac_load_application_req, Name}
+%%% <-- {ac_load_application_reply, Name, LoadReply}
+%%% --> {ac_start_application_req, Name} (*)
+%%% <-- {ac_start_application_reply, Name, StartReply}
+%%% --> {ac_application_run, Name, Res}
+%%% --> {ac_application_not_run, Name, Res}
+%%% --> {ac_application_stopped, Name}
+%%% --> {ac_application_unloaded, Name}
+%%% <-- {ac_change_application_req, Name, Req} (**)
+%%%
+%%% Where LoadReply =
+%%% ok - App is loaded
+%%% {error, R} - An error occurred
+%%% And StartReply =
+%%% start_it - DIST AC decided that AC should start the app
+%%% {started, Node} - The app is started distributed at Node
+%%% not_started - The app should not be running at this time
+%%% {takeover, Node}- The app should takeover from Node
+%%% {error, R} - an error occurred
+%%% And Req =
+%%% start_it - DIST AC wants AC to start the app locally
+%%% stop_it - AC should stop the app.
+%%% {takeover, Node, RestartType}
+%%% - AC should start the app as a takeover
+%%% {failover, Node, RestartType}
+%%% - AC should start the app as a failover
+%%% {started, Node} - The app is started at Node
+%%% NOTE: The app must have been started at this node
+%%% before this request is sent!
+%%% And Res =
+%%% ok - Application is started locally
+%%% {error, R} - Start of application failed
+%%%
+%%% (*)
+%%% The call to application:start() doesn't return until the
+%%% ac_start_application_reply has been received by AC. AC
+%%% itself is not blocked however.
+%%% (**)
+%%% DIST AC gets ACK to its ac_change_application_req, but not as a
+%%% separate messgage. Instead the normal messages are used as:
+%%% start_it generates an ac_application_run
+%%% stop_it generates an ac_application_not_run
+%%% takeover generates an ac_application_run
+%%% started doesn't generate anything
+%%%
+%%% There is a distinction between application:stop and stop_it
+%%% from a dist ac process. The first one stops the application,
+%%% and resets the internal structures as they were before start was
+%%% called. stop_it stops the application, but just marks it as
+%%% not being running.
+%%%
+%%% When a dist ac process has taken control of an application, no
+%%% other process can take the control.
+%%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Naming conventions:
+%% App = appl_descr()
+%% Appl = #appl
+%% AppName = atom()
+%% Application = App | AppName
+%%-----------------------------------------------------------------
+-record(state, {loading = [], starting = [], start_p_false = [], running = [],
+ control = [], started = [], start_req = [], conf_data}).
+%%-----------------------------------------------------------------
+%% loading = [{AppName, From}] - Load not yet finished
+%% starting = [{AppName, RestartType, Type, From}] - Start not
+%% yet finished
+%% start_p_false = [{AppName, RestartType, Type, From}] - Start not
+%% executed because permit == false
+%% running = [{AppName, Pid}] - running locally (Pid == application_master)
+%% [{AppName, {distributed, Node}}] - running on Node
+%% control = [{AppName, Controller}]
+%% started = [{AppName, RestartType}] - Names of all apps that
+%% have been started (but may not run because
+%% permission = false)
+%% conf_data = [{AppName, Env}]
+%% start_req = [{AppName, From}] - list of all start requests
+%% Id = AMPid | undefined | {distributed, Node}
+%% Env = [{Key, Value}]
+%%-----------------------------------------------------------------
+
+-record(appl, {name, appl_data, descr, id, vsn, restart_type, inc_apps, apps}).
+
+%%-----------------------------------------------------------------
+%% Func: start/1
+%% Args: KernelApp = appl_descr()
+%% appl_descr() = [{application, Name, [appl_opt()]}]
+%% appl_opt() = {description, string()} |
+%% {vsn, string()} |
+%% {id, string()}, |
+%% {modules, [Module|{Module,Vsn}]} |
+%% {registered, [atom()]} |
+%% {applications, [atom()]} |
+%% {included_applications, [atom()]} |
+%% {env, [{atom(), term()}]} |
+%% {start_phases, [{atom(), term()}]}|
+%% {maxT, integer()|infinity} |
+%% {maxP, integer()|infinity} |
+%% {mod, {Module, term()}}
+%% Module = atom()
+%% Vsn = term()
+%% Purpose: Starts the application_controller. This process starts all
+%% application masters for the applications.
+%% The kernel application is the only application that is
+%% treated specially. The reason for this is that the kernel
+%% starts user. This process is special because it should
+%% be group_leader for this process.
+%% Pre: All modules are loaded, or will be loaded on demand.
+%% Returns: {ok, Pid} | ReasonStr
+%%-----------------------------------------------------------------
+start(KernelApp) ->
+ %% OTP-5811 Don't start as a gen_server to prevent crash report
+ %% when (if) the process terminates
+ Init = self(),
+ AC = spawn_link(fun() -> init(Init, KernelApp) end),
+ receive
+ {ack, AC, ok} ->
+ {ok, AC};
+ {ack, AC, {error, Reason}} ->
+ to_string(Reason); % init doesn't want error tuple, only a reason
+ {'EXIT', _Pid, Reason} ->
+ to_string(Reason)
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: load_application/1
+%% Args: Application = appl_descr() | atom()
+%% Purpose: Loads an application. Currently just inserts the
+%% application's env.
+%% Returns: ok | {error, Reason}
+%%-----------------------------------------------------------------
+load_application(Application) ->
+ gen_server:call(?AC, {load_application, Application}, infinity).
+
+unload_application(AppName) ->
+ gen_server:call(?AC, {unload_application, AppName}, infinity).
+
+%%-----------------------------------------------------------------
+%% Func: start_application/2
+%% Args: Application = atom()
+%% RestartType = permanent | transient | temporary
+%% Purpose: Starts a new application.
+%% The RestartType specifies what should happen if the
+%% application dies:
+%% If it is permanent, all other applications are terminated,
+%% and the application_controller dies.
+%% If it is transient, and the application dies normally,
+%% this is reported and no other applications are terminated.
+%% If the application dies abnormally, all other applications
+%% are terminated, and the application_controller dies.
+%% If it is temporary and the application dies this is reported
+%% and no other applications are terminated. In this way,
+%% an application can run in test mode, without disturbing
+%% the other applications.
+%% The caller of this function is suspended until the application
+%% is started, either locally or distributed.
+%% Returns: ok | {error, Reason}
+%%-----------------------------------------------------------------
+start_application(AppName, RestartType) ->
+ gen_server:call(?AC, {start_application, AppName, RestartType}, infinity).
+
+%%-----------------------------------------------------------------
+%% Func: start_boot_application/2
+%% The same as start_application/2 expect that this function is
+%% called from the boot script file. It mustnot be used by the operator.
+%% This function will cause a node crash if a permanent application
+%% fails to boot start
+%%-----------------------------------------------------------------
+start_boot_application(Application, RestartType) ->
+ case {application:load(Application), RestartType} of
+ {ok, _} ->
+ AppName = get_appl_name(Application),
+ gen_server:call(?AC, {start_application, AppName, RestartType}, infinity);
+ {{error, {already_loaded, AppName}}, _} ->
+ gen_server:call(?AC, {start_application, AppName, RestartType}, infinity);
+ {{error,{bad_environment_value,Env}}, permanent} ->
+ Txt = io_lib:format("Bad environment variable: ~p Application: ~p",
+ [Env, Application]),
+ exit({error, list_to_atom(lists:flatten(Txt))});
+ {Error, _} ->
+ Error
+ end.
+
+stop_application(AppName) ->
+ gen_server:call(?AC, {stop_application, AppName}, infinity).
+
+%%-----------------------------------------------------------------
+%% Returns: [{Name, Descr, Vsn}]
+%%-----------------------------------------------------------------
+which_applications() ->
+ gen_server:call(?AC, which_applications).
+which_applications(Timeout) ->
+ gen_server:call(?AC, which_applications, Timeout).
+
+loaded_applications() ->
+ ets:filter(ac_tab,
+ fun([{{loaded, AppName}, #appl{descr = Descr, vsn = Vsn}}]) ->
+ {true, {AppName, Descr, Vsn}};
+ (_) ->
+ false
+ end,
+ []).
+
+%% Returns some debug info
+info() ->
+ gen_server:call(?AC, info).
+
+control_application(AppName) ->
+ gen_server:call(?AC, {control_application, AppName}, infinity).
+
+%%-----------------------------------------------------------------
+%% Func: change_application_data/2
+%% Args: Applications = [appl_descr()]
+%% Config = [{AppName, [{Par,Val}]}]
+%% Purpose: Change all applications and their parameters on this node.
+%% This function should be used from a release handler, at
+%% the same time as the .app or start.boot file is
+%% introduced. Note that during some time the ACs may have
+%% different view of e.g. the distributed applications.
+%% This is solved by syncing the release installation.
+%% However, strange things may happen if a node crashes
+%% and two other nodes have different opinons about who's
+%% gonna start the applications. The release handler must
+%% shutdown each involved node in this case.
+%% Note that this function is used to change existing apps,
+%% adding new/deleting old isn't handled by this function.
+%% Changes an application's vsn, descr and env.
+%% Returns: ok | {error, Reason}
+%% If an error occurred, the situation may be inconsistent,
+%% so the release handler must restart the node. E.g. if
+%% some applicatation may have got new config data.
+%%-----------------------------------------------------------------
+change_application_data(Applications, Config) ->
+ gen_server:call(?AC,
+ {change_application_data, Applications, Config},
+ infinity).
+
+prep_config_change() ->
+ gen_server:call(?AC,
+ prep_config_change,
+ infinity).
+
+
+config_change(EnvPrev) ->
+ gen_server:call(?AC,
+ {config_change, EnvPrev},
+ infinity).
+
+
+
+get_pid_env(Master, Key) ->
+ case ets:match(ac_tab, {{application_master, '$1'}, Master}) of
+ [[AppName]] -> get_env(AppName, Key);
+ _ -> undefined
+ end.
+
+get_env(AppName, Key) ->
+ case ets:lookup(ac_tab, {env, AppName, Key}) of
+ [{_, Val}] -> {ok, Val};
+ _ -> undefined
+ end.
+
+get_pid_all_env(Master) ->
+ case ets:match(ac_tab, {{application_master, '$1'}, Master}) of
+ [[AppName]] -> get_all_env(AppName);
+ _ -> []
+ end.
+
+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);
+ _ -> undefined
+ end.
+
+get_key(AppName, Key) ->
+ case ets:lookup(ac_tab, {loaded, AppName}) of
+ [{_, Appl}] ->
+ case Key of
+ description ->
+ {ok, Appl#appl.descr};
+ id ->
+ {ok, Appl#appl.id};
+ vsn ->
+ {ok, Appl#appl.vsn};
+ modules ->
+ {ok, (Appl#appl.appl_data)#appl_data.mods};
+ maxP ->
+ {ok, (Appl#appl.appl_data)#appl_data.maxP};
+ maxT ->
+ {ok, (Appl#appl.appl_data)#appl_data.maxT};
+ registered ->
+ {ok, (Appl#appl.appl_data)#appl_data.regs};
+ included_applications ->
+ {ok, Appl#appl.inc_apps};
+ applications ->
+ {ok, Appl#appl.apps};
+ env ->
+ {ok, get_all_env(AppName)};
+ mod ->
+ {ok, (Appl#appl.appl_data)#appl_data.mod};
+ start_phases ->
+ {ok, (Appl#appl.appl_data)#appl_data.phases};
+ _ -> undefined
+ end;
+ _ ->
+ undefined
+ end.
+
+get_pid_all_key(Master) ->
+ case ets:match(ac_tab, {{application_master, '$1'}, Master}) of
+ [[AppName]] -> get_all_key(AppName);
+ _ -> []
+ end.
+
+get_all_key(AppName) ->
+ case ets:lookup(ac_tab, {loaded, AppName}) of
+ [{_, Appl}] ->
+ {ok, [{description, Appl#appl.descr},
+ {id, Appl#appl.id},
+ {vsn, Appl#appl.vsn},
+ {modules, (Appl#appl.appl_data)#appl_data.mods},
+ {maxP, (Appl#appl.appl_data)#appl_data.maxP},
+ {maxT, (Appl#appl.appl_data)#appl_data.maxT},
+ {registered, (Appl#appl.appl_data)#appl_data.regs},
+ {included_applications, Appl#appl.inc_apps},
+ {applications, Appl#appl.apps},
+ {env, get_all_env(AppName)},
+ {mod, (Appl#appl.appl_data)#appl_data.mod},
+ {start_phases, (Appl#appl.appl_data)#appl_data.phases}
+ ]};
+ _ ->
+ undefined
+ end.
+
+
+start_type(Master) ->
+ case ets:match(ac_tab, {{application_master, '$1'}, Master}) of
+ [[AppName]] ->
+ gen_server:call(?AC, {start_type, AppName}, infinity);
+ _X ->
+ undefined
+ end.
+
+
+
+
+
+
+get_master(AppName) ->
+ case ets:lookup(ac_tab, {application_master, AppName}) of
+ [{_, Pid}] -> Pid;
+ _ -> undefined
+ end.
+
+get_application(Master) ->
+ case ets:match(ac_tab, {{application_master, '$1'}, Master}) of
+ [[AppName]] -> {ok, AppName};
+ _ -> undefined
+ end.
+
+get_application_module(Module) ->
+ ApplDataPattern = #appl_data{mods='$2', _='_'},
+ ApplPattern = #appl{appl_data=ApplDataPattern, _='_'},
+ AppModules = ets:match(ac_tab, {{loaded, '$1'}, ApplPattern}),
+ get_application_module(Module, AppModules).
+
+get_application_module(Module, [[AppName, Modules]|AppModules]) ->
+ case in_modules(Module, Modules) of
+ true ->
+ {ok, AppName};
+ false ->
+ get_application_module(Module, AppModules)
+ end;
+get_application_module(_Module, []) ->
+ undefined.
+
+%% 'modules' key in .app is a list of Module or {Module,Vsn}
+in_modules(Module, [Module|_Modules]) ->
+ true;
+in_modules(Module, [{Module, _Vsn}|_Modules]) ->
+ true;
+in_modules(Module, [_Module|Modules]) ->
+ in_modules(Module, Modules);
+in_modules(_Module, []) ->
+ false.
+
+permit_application(ApplName, Flag) ->
+ gen_server:call(?AC,
+ {permit_application, ApplName, Flag},
+ infinity).
+
+
+set_env(AppName, Key, Val) ->
+ gen_server:call(?AC, {set_env, AppName, Key, Val}).
+set_env(AppName, Key, Val, Timeout) ->
+ gen_server:call(?AC, {set_env, AppName, Key, Val}, Timeout).
+
+unset_env(AppName, Key) ->
+ gen_server:call(?AC, {unset_env, AppName, Key}).
+unset_env(AppName, Key, Timeout) ->
+ gen_server:call(?AC, {unset_env, AppName, Key}, Timeout).
+
+%%%-----------------------------------------------------------------
+%%% call-back functions from gen_server
+%%%-----------------------------------------------------------------
+init(Init, Kernel) ->
+ register(?AC, self()),
+ process_flag(trap_exit, true),
+ put('$ancestors', [Init]), % OTP-5811, for gen_server compatibility
+ put('$initial_call', {application_controller, start, 1}),
+
+ case catch check_conf() of
+ {ok, ConfData} ->
+ %% Actually, we don't need this info in an ets table anymore.
+ %% This table was introduced because starting applications
+ %% should be able to get som info from AC (e.g. loaded_apps).
+ %% The new implementation makes sure the AC process can be
+ %% called during start-up of any app.
+ case check_conf_data(ConfData) of
+ ok ->
+ ets:new(ac_tab, [set, public, named_table]),
+ S = #state{conf_data = ConfData},
+ {ok, KAppl} = make_appl(Kernel),
+ case catch load(S, KAppl) of
+ {'EXIT', LoadError} ->
+ Reason = {'load error', LoadError},
+ Init ! {ack, self(), {error, to_string(Reason)}};
+ {ok, NewS} ->
+ Init ! {ack, self(), ok},
+ gen_server:enter_loop(?MODULE, [], NewS,
+ {local, ?AC})
+ end;
+ {error, ErrorStr} ->
+ Str = lists:flatten(io_lib:format("invalid config data: ~s", [ErrorStr])),
+ Init ! {ack, self(), {error, to_string(Str)}}
+ end;
+ {error, {File, Line, Str}} ->
+ ReasonStr =
+ lists:flatten(io_lib:format("error in config file "
+ "~p (~w): ~s",
+ [File, Line, Str])),
+ Init ! {ack, self(), {error, to_string(ReasonStr)}}
+ end.
+
+
+%% Check the syntax of the .config file [{ApplicationName, [{Parameter, Value}]}].
+check_conf_data([]) ->
+ ok;
+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
+ end;
+ {AppName, List} when is_list(List) ->
+ ErrMsg = "application: "
+ ++ lists:flatten(io_lib:format("~p",[AppName]))
+ ++ "; application name must be an atom",
+ {error, ErrMsg};
+ {AppName, _List} ->
+ ErrMsg = "application: "
+ ++ lists:flatten(io_lib:format("~p",[AppName]))
+ ++ "; parameters must be a list",
+ {error, ErrMsg};
+ Else ->
+ ErrMsg = "invalid application name: " ++
+ lists:flatten(io_lib:format(" ~p",[Else])),
+ {error, ErrMsg}
+ end;
+check_conf_data(_ConfData) ->
+ {error, 'configuration must be a list ended by <dot><whitespace>'}.
+
+
+%% Special check of distributed parameter for kernel
+check_para_kernel([]) ->
+ ok;
+check_para_kernel([{distributed, Apps} | ParaList]) when is_list(Apps) ->
+ case check_distributed(Apps) of
+ {error, ErrorMsg} ->
+ {error, ErrorMsg};
+ _ ->
+ check_para_kernel(ParaList)
+ 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: " ++
+ lists:flatten(io_lib:format("~p",[Para]))};
+check_para_kernel(Else) ->
+ {error, "application: kernel; invalid parameter list: " ++
+ lists:flatten(io_lib:format("~p",[Else]))}.
+
+
+check_distributed([]) ->
+ ok;
+check_distributed([{App, List} | Apps]) when is_atom(App), is_list(List) ->
+ check_distributed(Apps);
+check_distributed([{App, infinity, List} | Apps]) when is_atom(App), is_list(List) ->
+ check_distributed(Apps);
+check_distributed([{App, Time, List} | Apps]) when is_atom(App), is_integer(Time), is_list(List) ->
+ check_distributed(Apps);
+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("~p",[Para]))};
+check_para([Else | _ParaList], AppName) ->
+ {error, "application: " ++ AppName ++ "; invalid parameter: " ++
+ lists:flatten(io_lib:format("~p",[Else]))}.
+
+
+handle_call({load_application, Application}, From, S) ->
+ case catch do_load_application(Application, S) of
+ {ok, NewS} ->
+ AppName = get_appl_name(Application),
+ case cntrl(AppName, S, {ac_load_application_req, AppName}) of
+ true ->
+ {noreply, S#state{loading = [{AppName, From} |
+ S#state.loading]}};
+ false ->
+ {reply, ok, NewS}
+ end;
+ {error, Error} ->
+ {reply, {error, Error}, S};
+ {'EXIT',R} ->
+ {reply, {error, R}, S}
+ end;
+
+handle_call({unload_application, AppName}, _From, S) ->
+ case lists:keymember(AppName, 1, S#state.running) of
+ true -> {reply, {error, {running, AppName}}, S};
+ false ->
+ case get_loaded(AppName) of
+ {true, _} ->
+ NewS = unload(AppName, S),
+ cntrl(AppName, S, {ac_application_unloaded, AppName}),
+ {reply, ok, NewS};
+ false ->
+ {reply, {error, {not_loaded, AppName}}, S}
+ end
+ end;
+
+handle_call({start_application, AppName, RestartType}, From, S) ->
+ #state{running = Running, starting = Starting, start_p_false = SPF,
+ started = Started, start_req = Start_req} = S,
+ %% Check if the commandline environment variables are OK.
+ %% Incase of erroneous variables do not start the application,
+ %% if the application is permanent crash the node.
+ %% Check if the application is already starting.
+ case lists:keysearch(AppName, 1, Start_req) of
+ false ->
+ case catch check_start_cond(AppName, RestartType, Started, Running) of
+ {ok, Appl} ->
+ Cntrl = cntrl(AppName, S, {ac_start_application_req, AppName}),
+ Perm = application:get_env(kernel, permissions),
+ case {Cntrl, Perm} of
+ {true, _} ->
+ {noreply, S#state{starting = [{AppName, RestartType, normal, From} |
+ Starting],
+ start_req = [{AppName, From} | Start_req]}};
+ {false, undefined} ->
+ spawn_starter(From, Appl, S, normal),
+ {noreply, S#state{starting = [{AppName, RestartType, normal, From} |
+ Starting],
+ start_req = [{AppName, From} | Start_req]}};
+ {false, {ok, Perms}} ->
+ case lists:member({AppName, false}, Perms) of
+ false ->
+ spawn_starter(From, Appl, S, normal),
+ {noreply, S#state{starting = [{AppName, RestartType, normal, From} |
+ Starting],
+ start_req = [{AppName, From} | Start_req]}};
+ true ->
+ SS = S#state{start_p_false = [{AppName, RestartType, normal, From} |
+ SPF]},
+ {reply, ok, SS}
+ end
+ end;
+ {error, R} ->
+ {reply, {error, R}, S}
+ end;
+ {value, {AppName, _FromX}} ->
+ SS = S#state{start_req = [{AppName, From} | Start_req]},
+ {noreply, SS}
+
+ end;
+
+handle_call({permit_application, AppName, Bool}, From, S) ->
+ Control = S#state.control,
+ Starting = S#state.starting,
+ SPF = S#state.start_p_false,
+ Started = S#state.started,
+ Running = S#state.running,
+ Start_req = S#state.start_req,
+ IsLoaded = get_loaded(AppName),
+ IsStarting = lists:keysearch(AppName, 1, Starting),
+ IsSPF = lists:keysearch(AppName, 1, SPF),
+ IsStarted = lists:keysearch(AppName, 1, Started),
+ IsRunning = lists:keysearch(AppName, 1, Running),
+
+ case lists:keymember(AppName, 1, Control) of
+ %%========================
+ %% distributed application
+ %%========================
+ true ->
+ case {IsLoaded, IsStarting, IsStarted} of
+ %% not loaded
+ {false, _, _} ->
+ {reply, {error, {not_loaded, AppName}}, S};
+ %% only loaded
+ {{true, _Appl}, false, false} ->
+ update_permissions(AppName, Bool),
+ {reply, {distributed_application, only_loaded}, S};
+ _ ->
+ update_permissions(AppName, Bool),
+ {reply, distributed_application, S}
+ end;
+ %%========================
+ %% local application
+ %%========================
+ false ->
+ case {Bool, IsLoaded, IsStarting, IsSPF, IsStarted, IsRunning} of
+ %%------------------------
+ %% permit the applicaition
+ %%------------------------
+ %% already running
+ {true, _, _, _, _, {value, _Tuple}} ->
+ {reply, ok, S};
+ %% not loaded
+ {true, false, _, _, _, _} ->
+ {reply, {error, {not_loaded, AppName}}, S};
+ %% only loaded
+ {true, {true, _Appl}, false, false, false, false} ->
+ update_permissions(AppName, Bool),
+ {reply, ok, S};
+ %% starting
+ {true, {true, _Appl}, {value, _Tuple}, false, false, false} ->
+ update_permissions(AppName, Bool),
+ {reply, ok, S}; %% check the permission after then app is started
+ %% start requested but not started because permit was false
+ {true, {true, Appl}, false, {value, Tuple}, false, false} ->
+ update_permissions(AppName, Bool),
+ {_AppName2, RestartType, normal, _From} = Tuple,
+ spawn_starter(From, Appl, S, normal),
+ SS = S#state{starting = [{AppName, RestartType, normal, From} | Starting],
+ start_p_false = keydelete(AppName, 1, SPF),
+ start_req = [{AppName, From} | Start_req]},
+ {noreply, SS};
+ %% started but not running
+ {true, {true, Appl}, _, _, {value, {AppName, RestartType}}, false} ->
+ update_permissions(AppName, Bool),
+ spawn_starter(From, Appl, S, normal),
+ SS = S#state{starting = [{AppName, RestartType, normal, From} | Starting],
+ started = keydelete(AppName, 1, Started),
+ start_req = [{AppName, From} | Start_req]},
+ {noreply, SS};
+
+ %%==========================
+ %% unpermit the applicaition
+ %%==========================
+ %% running
+ {false, _, _, _, _, {value, {_AppName, Id}}} ->
+ {value, {_AppName2, Type}} = keysearch(AppName, 1, Started),
+ stop_appl(AppName, Id, Type),
+ NRunning = keydelete(AppName, 1, Running),
+ {reply, ok, S#state{running = NRunning}};
+ %% not loaded
+ {false, false, _, _, _, _} ->
+ {reply, {error, {not_loaded, AppName}}, S};
+ %% only loaded
+ {false, {true, _Appl}, false, false, false, false} ->
+ update_permissions(AppName, Bool),
+ {reply, ok, S};
+ %% starting
+ {false, {true, _Appl}, {value, _Tuple}, false, false, false} ->
+ update_permissions(AppName, Bool),
+ {reply, ok, S};
+ %% start requested but not started because permit was false
+ {false, {true, _Appl}, false, {value, _Tuple}, false, false} ->
+ update_permissions(AppName, Bool),
+ SS = S#state{start_p_false = keydelete(AppName, 1, SPF)},
+ {reply, ok, SS};
+ %% started but not running
+ {false, {true, _Appl}, _, _, {value, _Tuple}, false} ->
+ update_permissions(AppName, Bool),
+ {reply, ok, S}
+
+ end
+ end;
+
+handle_call({stop_application, AppName}, _From, S) ->
+ #state{running = Running, started = Started} = S,
+ case keysearch(AppName, 1, Running) of
+ {value, {_AppName, Id}} ->
+ {value, {_AppName2, Type}} = keysearch(AppName, 1, Started),
+ stop_appl(AppName, Id, Type),
+ NRunning = keydelete(AppName, 1, Running),
+ NStarted = keydelete(AppName, 1, Started),
+ cntrl(AppName, S, {ac_application_stopped, AppName}),
+ {reply, ok, S#state{running = NRunning, started = NStarted}};
+ false ->
+ case lists:keymember(AppName, 1, Started) of
+ true ->
+ NStarted = keydelete(AppName, 1, Started),
+ cntrl(AppName, S, {ac_application_stopped, AppName}),
+ {reply, ok, S#state{started = NStarted}};
+ false ->
+ {reply, {error, {not_started, AppName}}, S}
+ end
+ end;
+
+handle_call({change_application_data, Applications, Config}, _From, S) ->
+ OldAppls = ets:filter(ac_tab,
+ fun([{{loaded, _AppName}, Appl}]) ->
+ {true, Appl};
+ (_) ->
+ false
+ end,
+ []),
+ case catch do_change_apps(Applications, Config, OldAppls) of
+ {error, R} ->
+ {reply, {error, R}, S};
+ {'EXIT', R} ->
+ {reply, {error, R}, S};
+ NewAppls ->
+ lists:foreach(fun(Appl) ->
+ ets:insert(ac_tab, {{loaded, Appl#appl.name},
+ Appl})
+ end, NewAppls),
+ {reply, ok, S#state{conf_data = Config}}
+ end;
+
+handle_call(prep_config_change, _From, S) ->
+ RunningApps = S#state.running,
+ EnvBefore = lists:reverse(do_prep_config_change(RunningApps)),
+ {reply, EnvBefore, S};
+
+handle_call({config_change, EnvBefore}, _From, S) ->
+ RunningApps = S#state.running,
+ R = do_config_change(RunningApps, EnvBefore),
+ {reply, R, S};
+
+handle_call(which_applications, _From, S) ->
+ Reply = zf(fun({Name, Id}) ->
+ case Id of
+ {distributed, _Node} ->
+ false;
+ _ ->
+ {true, #appl{descr = Descr, vsn = Vsn}} =
+ get_loaded(Name),
+ {true, {Name, Descr, Vsn}}
+ end
+ end, S#state.running),
+ {reply, Reply, S};
+
+handle_call({set_env, AppName, Key, Val}, _From, S) ->
+ ets:insert(ac_tab, {{env, AppName, Key}, Val}),
+ {reply, ok, S};
+
+handle_call({unset_env, AppName, Key}, _From, S) ->
+ ets:delete(ac_tab, {env, AppName, Key}),
+ {reply, ok, S};
+
+handle_call({control_application, AppName}, {Pid, _Tag}, S) ->
+ Control = S#state.control,
+ case lists:keymember(AppName, 1, Control) of
+ false ->
+ link(Pid),
+ {reply, true, S#state{control = [{AppName, Pid} | Control]}};
+ true ->
+ {reply, false, S}
+ end;
+
+handle_call({start_type, AppName}, _From, S) ->
+ Starting = S#state.starting,
+ StartType = case keysearch(AppName, 1, Starting) of
+ false ->
+ local;
+ {value, {_AppName, _RestartType, Type, _F}} ->
+ Type
+ end,
+ {reply, StartType, S};
+
+handle_call(info, _From, S) ->
+ Reply = [{loaded, loaded_applications()},
+ {loading, S#state.loading},
+ {started, S#state.started},
+ {start_p_false, S#state.start_p_false},
+ {running, S#state.running},
+ {starting, S#state.starting}],
+ {reply, Reply, S}.
+
+handle_cast({application_started, AppName, Res}, S) ->
+ handle_application_started(AppName, Res, S).
+
+handle_application_started(AppName, Res, S) ->
+ #state{starting = Starting, running = Running, started = Started,
+ start_req = Start_req} = S,
+ Start_reqN = reply_to_requester(AppName, Start_req, Res),
+ {value, {_AppName, RestartType, _Type, _From}} = keysearch(AppName, 1, Starting),
+ case Res of
+ {ok, Id} ->
+ case AppName of
+ kernel -> check_user();
+ _ -> ok
+ end,
+ info_started(AppName, nd(Id)),
+ notify_cntrl_started(AppName, Id, S, ok),
+ NRunning = keyreplaceadd(AppName, 1, Running,{AppName,Id}),
+ NStarted = keyreplaceadd(AppName, 1, Started,{AppName,RestartType}),
+ NewS = S#state{starting = keydelete(AppName, 1, Starting),
+ running = NRunning,
+ started = NStarted,
+ start_req = Start_reqN},
+
+ %% The permission may have been changed during start
+ Perm = application:get_env(kernel, permissions),
+ case {Perm, Id} of
+ {undefined, _} ->
+ {noreply, NewS};
+ %% Check only if the application is started on the own node
+ {{ok, Perms}, {distributed, StartNode}} when StartNode =:= node() ->
+ case lists:member({AppName, false}, Perms) of
+ true ->
+ #state{running = StopRunning, started = StopStarted} = NewS,
+ case keysearch(AppName, 1, StopRunning) of
+ {value, {_AppName, Id}} ->
+ {value, {_AppName2, Type}} =
+ keysearch(AppName, 1, StopStarted),
+ stop_appl(AppName, Id, Type),
+ NStopRunning = keydelete(AppName, 1, StopRunning),
+ cntrl(AppName, NewS, {ac_application_stopped, AppName}),
+ {noreply, NewS#state{running = NStopRunning,
+ started = StopStarted}};
+ false ->
+ {noreply, NewS}
+ end;
+ false ->
+ {noreply, NewS}
+ end;
+ _ ->
+ {noreply, NewS}
+ end;
+
+
+
+
+ {error, R} when RestartType =:= temporary ->
+ notify_cntrl_started(AppName, undefined, S, {error, R}),
+ info_exited(AppName, R, RestartType),
+ {noreply, S#state{starting = keydelete(AppName, 1, Starting),
+ start_req = Start_reqN}};
+ {info, R} when RestartType =:= temporary ->
+ notify_cntrl_started(AppName, undefined, S, {error, R}),
+ {noreply, S#state{starting = keydelete(AppName, 1, Starting),
+ start_req = Start_reqN}};
+ {ErrInf, R} when RestartType =:= transient, ErrInf =:= error;
+ RestartType =:= transient, ErrInf =:= info ->
+ notify_cntrl_started(AppName, undefined, S, {error, R}),
+ case ErrInf of
+ error ->
+ info_exited(AppName, R, RestartType);
+ info ->
+ ok
+ end,
+ case R of
+ {{'EXIT',normal},_Call} ->
+ {noreply, S#state{starting = keydelete(AppName, 1, Starting),
+ start_req = Start_reqN}};
+ _ ->
+ Reason = {application_start_failure, AppName, R},
+ {stop, to_string(Reason), S}
+ end;
+ {error, R} -> %% permanent
+ notify_cntrl_started(AppName, undefined, S, {error, R}),
+ info_exited(AppName, R, RestartType),
+ Reason = {application_start_failure, AppName, R},
+ {stop, to_string(Reason), S};
+ {info, R} -> %% permanent
+ notify_cntrl_started(AppName, undefined, S, {error, R}),
+ Reason = {application_start_failure, AppName, R},
+ {stop, to_string(Reason), S}
+ end.
+
+handle_info({ac_load_application_reply, AppName, Res}, S) ->
+ case keysearchdelete(AppName, 1, S#state.loading) of
+ {value, {_AppName, From}, Loading} ->
+ gen_server:reply(From, Res),
+ case Res of
+ ok ->
+ {noreply, S#state{loading = Loading}};
+ {error, _R} ->
+ NewS = unload(AppName, S),
+ {noreply, NewS#state{loading = Loading}}
+ end;
+ false ->
+ {noreply, S}
+ end;
+
+handle_info({ac_start_application_reply, AppName, Res}, S) ->
+ Start_req = S#state.start_req,
+ case keysearch(AppName, 1, Starting = S#state.starting) of
+ {value, {_AppName, RestartType, Type, From}} ->
+ case Res of
+ start_it ->
+ {true, Appl} = get_loaded(AppName),
+ spawn_starter(From, Appl, S, Type),
+ {noreply, S};
+ {started, Node} ->
+ handle_application_started(AppName,
+ {ok, {distributed, Node}},
+ S);
+ not_started ->
+ Started = S#state.started,
+ Start_reqN =
+ reply_to_requester(AppName, Start_req, ok),
+ {noreply,
+ S#state{starting = keydelete(AppName, 1, Starting),
+ started = [{AppName, RestartType} | Started],
+ start_req = Start_reqN}};
+ {takeover, Node} ->
+ {true, Appl} = get_loaded(AppName),
+ spawn_starter(From, Appl, S, {takeover, Node}),
+ NewStarting1 = keydelete(AppName, 1, Starting),
+ NewStarting = [{AppName, RestartType, {takeover, Node}, From} | NewStarting1],
+ {noreply, S#state{starting = NewStarting}};
+ {error, Reason} when RestartType =:= permanent ->
+ Start_reqN =
+ reply_to_requester(AppName, Start_req,
+ {error, Reason}),
+ {stop, to_string(Reason), S#state{start_req = Start_reqN}};
+ {error, Reason} ->
+ Start_reqN =
+ reply_to_requester(AppName, Start_req,
+ {error, Reason}),
+ {noreply, S#state{starting =
+ keydelete(AppName, 1, Starting),
+ start_req = Start_reqN}}
+ end;
+ false ->
+ {noreply, S} % someone called stop before control got that
+ end;
+
+handle_info({ac_change_application_req, AppName, Msg}, S) ->
+ Running = S#state.running,
+ Started = S#state.started,
+ Starting = S#state.starting,
+ case {keysearch(AppName, 1, Running), keysearch(AppName, 1, Started)} of
+ {{value, {AppName, Id}}, {value, {_AppName2, Type}}} ->
+ case Msg of
+ {started, Node} ->
+ stop_appl(AppName, Id, Type),
+ NRunning = [{AppName, {distributed, Node}} |
+ keydelete(AppName, 1, Running)],
+ {noreply, S#state{running = NRunning}};
+ {takeover, _Node, _RT} when is_pid(Id) -> % it is running already
+ notify_cntrl_started(AppName, Id, S, ok),
+ {noreply, S};
+ {takeover, Node, RT} ->
+ NewS = do_start(AppName, RT, {takeover, Node}, undefined, S),
+ {noreply, NewS};
+ {failover, _Node, _RT} when is_pid(Id) -> % it is running already
+ notify_cntrl_started(AppName, Id, S, ok),
+ {noreply, S};
+ {failover, Node, RT} ->
+ case application:get_key(AppName, start_phases) of
+ {ok, undefined} ->
+ %% to be backwards compatible the application
+ %% is not started as failover if start_phases
+ %% is not defined in the .app file
+ NewS = do_start(AppName, RT, normal, undefined, S),
+ {noreply, NewS};
+ {ok, _StartPhases} ->
+ NewS = do_start(AppName, RT, {failover, Node}, undefined, S),
+ {noreply, NewS}
+ end;
+ stop_it ->
+ stop_appl(AppName, Id, Type),
+ cntrl(AppName, S, {ac_application_not_run, AppName}),
+ NRunning = keyreplace(AppName, 1, Running,
+ {AppName, {distributed, []}}),
+ {noreply, S#state{running = NRunning}};
+ %% We should not try to start a running application!
+ start_it when is_pid(Id) ->
+ notify_cntrl_started(AppName, Id, S, ok),
+ {noreply, S};
+ start_it ->
+ NewS = do_start(AppName, undefined, normal, undefined, S),
+ {noreply, NewS};
+ not_running ->
+ NRunning = keydelete(AppName, 1, Running),
+ {noreply, S#state{running = NRunning}};
+ _ ->
+ {noreply, S}
+ end;
+ _ ->
+ IsLoaded = get_loaded(AppName),
+ IsStarting = lists:keysearch(AppName, 1, Starting),
+ IsStarted = lists:keysearch(AppName, 1, Started),
+ IsRunning = lists:keysearch(AppName, 1, Running),
+
+ case Msg of
+ start_it ->
+ case {IsLoaded, IsStarting, IsStarted, IsRunning} of
+ %% already running
+ {_, _, _, {value, _Tuple}} ->
+ {noreply, S};
+ %% not loaded
+ {false, _, _, _} ->
+ {noreply, S};
+ %% only loaded
+ {{true, _Appl}, false, false, false} ->
+ {noreply, S};
+ %% starting
+ {{true, _Appl}, {value, Tuple}, false, false} ->
+ {_AppName, _RStype, _Type, From} = Tuple,
+ NewS = do_start(AppName, undefined, normal, From, S),
+ {noreply, NewS};
+ %% started but not running
+ {{true, _Appl}, _, {value, {AppName, _RestartType}}, false} ->
+ NewS = do_start(AppName, undefined, normal, undefined, S),
+ SS = NewS#state{started = keydelete(AppName, 1, Started)},
+ {noreply, SS}
+ end;
+ {started, Node} ->
+ NRunning = [{AppName, {distributed, Node}} |
+ keydelete(AppName, 1, Running)],
+ {noreply, S#state{running = NRunning}};
+ _ ->
+ {noreply, S} % someone called stop before control got that
+ end
+ end;
+
+%%-----------------------------------------------------------------
+%% An application died. Check its restart_type. Maybe terminate
+%% all other applications.
+%%-----------------------------------------------------------------
+handle_info({'EXIT', Pid, Reason}, S) ->
+ ets:match_delete(ac_tab, {{application_master, '_'}, Pid}),
+ NRunning = keydelete(Pid, 2, S#state.running),
+ NewS = S#state{running = NRunning},
+ case keysearch(Pid, 2, S#state.running) of
+ {value, {AppName, _AmPid}} ->
+ cntrl(AppName, S, {ac_application_stopped, AppName}),
+ case keysearch(AppName, 1, S#state.started) of
+ {value, {_AppName, temporary}} ->
+ info_exited(AppName, Reason, temporary),
+ {noreply, NewS};
+ {value, {_AppName, transient}} when Reason =:= normal ->
+ info_exited(AppName, Reason, transient),
+ {noreply, NewS};
+ {value, {_AppName, Type}} ->
+ info_exited(AppName, Reason, Type),
+ {stop, to_string({application_terminated, AppName, Reason}), NewS}
+ end;
+ false ->
+ {noreply, S#state{control = del_cntrl(S#state.control, Pid)}}
+ end;
+
+handle_info(_, S) ->
+ {noreply, S}.
+
+terminate(Reason, S) ->
+ case application:get_env(kernel, shutdown_func) of
+ {ok, {M, F}} ->
+ catch M:F(Reason);
+ _ ->
+ ok
+ end,
+ foreach(fun({_AppName, Id}) when is_pid(Id) ->
+ exit(Id, shutdown),
+ receive
+ {'EXIT', Id, _} -> ok
+ end;
+ (_) -> ok
+ end,
+ S#state.running),
+ ets:delete(ac_tab).
+
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+
+%%%-----------------------------------------------------------------
+%%% Internal functions
+%%%-----------------------------------------------------------------
+cntrl(AppName, #state{control = Control}, Msg) ->
+ case keysearch(AppName, 1, Control) of
+ {value, {_AppName, Pid}} ->
+ Pid ! Msg,
+ true;
+ false ->
+ false
+ end.
+
+notify_cntrl_started(_AppName, {distributed, _Node}, _S, _Res) ->
+ ok;
+notify_cntrl_started(AppName, _Id, S, Res) ->
+ cntrl(AppName, S, {ac_application_run, AppName, Res}).
+
+del_cntrl([{_, Pid}|T], Pid) ->
+ del_cntrl(T, Pid);
+del_cntrl([H|T], Pid) ->
+ [H|del_cntrl(T, Pid)];
+del_cntrl([], _Pid) ->
+ [].
+
+get_loaded(App) ->
+ AppName = get_appl_name(App),
+ case ets:lookup(ac_tab, {loaded, AppName}) of
+ [{_Key, Appl}] -> {true, Appl};
+ _ -> false
+ end.
+
+do_load_application(Application, S) ->
+ case get_loaded(Application) of
+ {true, _} ->
+ throw({error, {already_loaded, Application}});
+ false ->
+ case make_appl(Application) of
+ {ok, Appl} -> load(S, Appl);
+ Error -> Error
+ end
+ end.
+
+%% Recursively load the application and its included apps.
+%load(S, {ApplData, ApplEnv, IncApps, Descr, Vsn, Apps}) ->
+load(S, {ApplData, ApplEnv, IncApps, Descr, Id, Vsn, Apps}) ->
+ Name = ApplData#appl_data.name,
+ ConfEnv = get_env_i(Name, S),
+ NewEnv = merge_app_env(ApplEnv, ConfEnv),
+ CmdLineEnv = get_cmd_env(Name),
+ NewEnv2 = merge_app_env(NewEnv, CmdLineEnv),
+ NewEnv3 = keyreplaceadd(included_applications, 1, NewEnv2,
+ {included_applications, IncApps}),
+ add_env(Name, NewEnv3),
+ Appl = #appl{name = Name, descr = Descr, id = Id, vsn = Vsn,
+ appl_data = ApplData, inc_apps = IncApps, apps = Apps},
+ ets:insert(ac_tab, {{loaded, Name}, Appl}),
+ NewS =
+ foldl(fun(App, S1) ->
+ case get_loaded(App) of
+ {true, _} -> S1;
+ false ->
+ case do_load_application(App, S1) of
+ {ok, S2} -> S2;
+ Error -> throw(Error)
+ end
+ end
+ end, S, IncApps),
+ {ok, NewS}.
+
+unload(AppName, S) ->
+ {ok, IncApps} = get_env(AppName, included_applications),
+ del_env(AppName),
+ ets:delete(ac_tab, {loaded, AppName}),
+ foldl(fun(App, S1) ->
+ case get_loaded(App) of
+ false -> S1;
+ {true, _} -> unload(App, S1)
+ end
+ end, S, IncApps).
+
+check_start_cond(AppName, RestartType, Started, Running) ->
+ validRestartType(RestartType),
+ case get_loaded(AppName) of
+ {true, Appl} ->
+ %% Check Running; not Started. An exited app is not running,
+ %% but started. It must be possible to start an exited app!
+ case lists:keymember(AppName, 1, Running) of
+ true ->
+ {error, {already_started, AppName}};
+ false ->
+ foreach(
+ fun(AppName2) ->
+ case lists:keymember(AppName2, 1, Started) of
+ true -> ok;
+ false ->
+ throw({error, {not_started, AppName2}})
+ end
+ end, Appl#appl.apps),
+ {ok, Appl}
+ end;
+ false ->
+ {error, {not_loaded, AppName}}
+ end.
+
+do_start(AppName, RT, Type, From, S) ->
+ RestartType = case keysearch(AppName, 1, S#state.started) of
+ {value, {_AppName2, OldRT}} ->
+ get_restart_type(RT, OldRT);
+ false ->
+ RT
+ end,
+ %% UW 990913: We check start_req instead of starting, because starting
+ %% has already been checked.
+ case lists:keymember(AppName, 1, S#state.start_req) of
+ false ->
+ {true, Appl} = get_loaded(AppName),
+ Start_req = S#state.start_req,
+ spawn_starter(undefined, Appl, S, Type),
+ Starting = case keysearch(AppName, 1, S#state.starting) of
+ false ->
+ %% UW: don't know if this is necessary
+ [{AppName, RestartType, Type, From} |
+ S#state.starting];
+ _ ->
+ S#state.starting
+ end,
+ S#state{starting = Starting,
+ start_req = [{AppName, From} | Start_req]};
+ true -> % otherwise we're already starting the app...
+ S
+ end.
+
+spawn_starter(From, Appl, S, Type) ->
+ spawn_link(?MODULE, init_starter, [From, Appl, S, Type]).
+
+init_starter(_From, Appl, S, Type) ->
+ process_flag(trap_exit, true),
+ AppName = Appl#appl.name,
+ gen_server:cast(?AC, {application_started, AppName,
+ catch start_appl(Appl, S, Type)}).
+
+reply(undefined, _Reply) ->
+ ok;
+reply(From, Reply) -> gen_server:reply(From, Reply).
+
+start_appl(Appl, S, Type) ->
+ ApplData = Appl#appl.appl_data,
+ case ApplData#appl_data.mod of
+ [] ->
+ {ok, undefined};
+ _ ->
+ %% Name = ApplData#appl_data.name,
+ Running = S#state.running,
+ foreach(
+ fun(AppName) ->
+ case lists:keymember(AppName, 1, Running) of
+ true ->
+ ok;
+ false ->
+ throw({info, {not_running, AppName}})
+ end
+ end, Appl#appl.apps),
+ case application_master:start_link(ApplData, Type) of
+ {ok, Pid} ->
+ {ok, Pid};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Stop application locally.
+%%-----------------------------------------------------------------
+stop_appl(AppName, Id, Type) when is_pid(Id) ->
+ unlink(Id),
+ application_master:stop(Id),
+ info_exited(AppName, stopped, Type),
+ ets:delete(ac_tab, {application_master, AppName});
+stop_appl(AppName, undefined, Type) ->
+ %% Code-only application stopped
+ info_exited(AppName, stopped, Type);
+stop_appl(_AppName, _Id, _Type) ->
+ %% Distributed application stopped
+ ok.
+
+keysearchdelete(Key, Pos, List) ->
+ ksd(Key, Pos, List, []).
+
+ksd(Key, Pos, [H | T], Rest) when element(Pos, H) =:= Key ->
+ {value, H, Rest ++ T};
+ksd(Key, Pos, [H | T], Rest) ->
+ ksd(Key, Pos, T, [H | Rest]);
+ksd(_Key, _Pos, [], _Rest) ->
+ false.
+
+keyreplaceadd(Key, Pos, List, New) ->
+ %% Maintains the order!
+ case lists:keymember(Key, Pos, List) of
+ true -> keyreplace(Key, Pos, List, New);
+ false -> [New | List]
+ end.
+
+validRestartType(permanent) -> true;
+validRestartType(temporary) -> true;
+validRestartType(transient) -> true;
+validRestartType(RestartType) ->
+ throw({error, {invalid_restart_type, RestartType}}).
+
+nd({distributed, Node}) -> Node;
+nd(_) -> node().
+
+get_restart_type(undefined, OldRT) ->
+ OldRT;
+get_restart_type(RT, _OldRT) ->
+ RT.
+
+get_appl_name(Name) when is_atom(Name) -> Name;
+get_appl_name({application, Name, _}) when is_atom(Name) -> Name;
+get_appl_name(Appl) -> throw({error, {bad_application, Appl}}).
+
+make_appl(Name) when is_atom(Name) ->
+ FName = atom_to_list(Name) ++ ".app",
+ case code:where_is_file(FName) of
+ non_existing ->
+ {error, {file:format_error(enoent), FName}};
+ FullName ->
+ case prim_consult(FullName) of
+ {ok, [Application]} ->
+ {ok, make_appl_i(Application)};
+ {error, Reason} ->
+ {error, {file:format_error(Reason), FName}}
+ end
+ end;
+make_appl(Application) ->
+ {ok, make_appl_i(Application)}.
+
+prim_consult(FullName) ->
+ case erl_prim_loader:get_file(FullName) of
+ {ok, Bin, _} ->
+ case erl_scan:string(binary_to_list(Bin)) of
+ {ok, Tokens, _EndLine} ->
+ prim_parse(Tokens, []);
+ {error, Reason, _EndLine} ->
+ {error, Reason}
+ end;
+ error ->
+ {error, enoent}
+ end.
+
+prim_parse(Tokens, Acc) ->
+ case lists:splitwith(fun(T) -> element(1,T) =/= dot end, Tokens) of
+ {[], []} ->
+ {ok, lists:reverse(Acc)};
+ {Tokens2, [{dot,_} = Dot | Rest]} ->
+ case erl_parse:parse_term(Tokens2 ++ [Dot]) of
+ {ok, Term} ->
+ prim_parse(Rest, [Term | Acc]);
+ {error, Reason} ->
+ {error, Reason}
+ end;
+ {Tokens2, []} ->
+ case erl_parse:parse_term(Tokens2) of
+ {ok, Term} ->
+ {ok, lists:reverse([Term | Acc])};
+ {error, Reason} ->
+ {error, Reason}
+ end
+ end.
+
+make_appl_i({application, Name, Opts}) when is_atom(Name), is_list(Opts) ->
+ Descr = get_opt(description, Opts, ""),
+ Id = get_opt(id, Opts, ""),
+ Vsn = get_opt(vsn, Opts, ""),
+ Mods = get_opt(modules, Opts, []),
+ Regs = get_opt(registered, Opts, []),
+ Apps = get_opt(applications, Opts, []),
+ Mod =
+ case get_opt(mod, Opts, []) of
+ {M,A} when is_atom(M) -> {M,A};
+ [] -> [];
+ Other -> throw({error, {badstartspec, Other}})
+ end,
+ Phases = get_opt(start_phases, Opts, undefined),
+ Env = get_opt(env, Opts, []),
+ MaxP = get_opt(maxP, Opts, infinity),
+ MaxT = get_opt(maxT, Opts, infinity),
+ IncApps = get_opt(included_applications, Opts, []),
+ {#appl_data{name = Name, regs = Regs, mod = Mod, phases = Phases, mods = Mods,
+ inc_apps = IncApps, maxP = MaxP, maxT = MaxT},
+ Env, IncApps, Descr, Id, Vsn, Apps};
+make_appl_i({application, Name, Opts}) when is_list(Opts) ->
+ throw({error,{invalid_name,Name}});
+make_appl_i({application, _Name, Opts}) ->
+ throw({error,{invalid_options, Opts}});
+make_appl_i(Appl) -> throw({error, {bad_application, Appl}}).
+
+
+%%-----------------------------------------------------------------
+%% Merge current applications with changes.
+%%-----------------------------------------------------------------
+
+%% do_change_apps(Applications, Config, OldAppls) -> NewAppls
+%% Applications = [{application, AppName, [{Key,Value}]}]
+%% Config = [{AppName,[{Par,Value}]} | File]
+%% OldAppls = NewAppls = [#appl{}]
+do_change_apps(Applications, Config, OldAppls) ->
+
+ %% OTP-4867
+ %% Config = contents of sys.config file
+ %% May now contain names of other .config files as well as
+ %% configuration parameters.
+ %% Therefore read and merge contents.
+ {ok, SysConfig, Errors} = check_conf_sys(Config),
+
+ %% Report errors, but do not terminate
+ %% (backwards compatible behaviour)
+ lists:foreach(fun({error, {SysFName, Line, Str}}) ->
+ Str2 = lists:flatten(io_lib:format("~p: ~w: ~s~n",
+ [SysFName, Line, Str])),
+ error_logger:format(Str2, [])
+ end,
+ Errors),
+
+ map(fun(Appl) ->
+ AppName = Appl#appl.name,
+ case is_loaded_app(AppName, Applications) of
+ {true, Application} ->
+ do_change_appl(make_appl(Application),
+ Appl, SysConfig);
+
+ %% ignored removed apps - handled elsewhere
+ false ->
+ Appl
+ end
+ end, OldAppls).
+
+is_loaded_app(AppName, [{application, AppName, App} | _]) ->
+ {true, {application, AppName, App}};
+is_loaded_app(AppName, [_ | T]) -> is_loaded_app(AppName, T);
+is_loaded_app(_AppName, []) -> false.
+
+do_change_appl({ok, {ApplData, Env, IncApps, Descr, Id, Vsn, Apps}},
+ OldAppl, Config) ->
+ AppName = OldAppl#appl.name,
+
+ %% Merge application env with env from sys.config, if any
+ ConfEnv = get_opt(AppName, Config, []),
+ NewEnv1 = merge_app_env(Env, ConfEnv),
+
+ %% Merge application env with command line arguments, if any
+ CmdLineEnv = get_cmd_env(AppName),
+ NewEnv2 = merge_app_env(NewEnv1, CmdLineEnv),
+
+ %% included_apps is made into an env parameter as well
+ NewEnv3 = keyreplaceadd(included_applications, 1, NewEnv2,
+ {included_applications, IncApps}),
+
+ %% Update ets table with new application env
+ del_env(AppName),
+ add_env(AppName, NewEnv3),
+
+ OldAppl#appl{appl_data=ApplData,
+ descr=Descr,
+ id=Id,
+ vsn=Vsn,
+ inc_apps=IncApps,
+ apps=Apps};
+do_change_appl({error, R}, _Appl, _ConfData) ->
+ throw({error, R}).
+
+get_opt(Key, List, Default) ->
+ case keysearch(Key, 1, List) of
+ {value, {_Key, Val}} -> Val;
+ _ -> Default
+ end.
+
+get_cmd_env(Name) ->
+ case init:get_argument(Name) of
+ {ok, Args} ->
+ foldl(fun(List, Res) -> conv(List) ++ Res end, [], Args);
+ _ -> []
+ end.
+
+conv([Key, Val | T]) ->
+ [{make_term(Key), make_term(Val)} | conv(T)];
+conv(_) -> [].
+
+%%% Fix some day: eliminate the duplicated code here
+make_term(Str) ->
+ case erl_scan:string(Str) of
+ {ok, Tokens, _} ->
+ case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
+ {ok, Term} ->
+ Term;
+ {error, {_,M,Reason}} ->
+ error_logger:format("application_controller: ~s: ~s~n",
+ [M:format_error(Reason), Str]),
+ throw({error, {bad_environment_value, Str}})
+ end;
+ {error, {_,M,Reason}, _} ->
+ error_logger:format("application_controller: ~s: ~s~n",
+ [M:format_error(Reason), Str]),
+ throw({error, {bad_environment_value, Str}})
+ end.
+
+get_env_i(Name, #state{conf_data = ConfData}) when is_list(ConfData) ->
+ case keysearch(Name, 1, ConfData) of
+ {value, {_Name, Env}} -> Env;
+ _ -> []
+ end;
+get_env_i(_Name, _) -> [].
+
+%% Merges envs for all apps. Env2 overrides Env1
+merge_env(Env1, Env2) ->
+ merge_env(Env1, Env2, []).
+
+merge_env([{App, AppEnv1} | T], Env2, Res) ->
+ case get_env_key(App, Env2) of
+ {value, AppEnv2, RestEnv2} ->
+ NewAppEnv = merge_app_env(AppEnv1, AppEnv2),
+ merge_env(T, RestEnv2, [{App, NewAppEnv} | Res]);
+ _ ->
+ merge_env(T, Env2, [{App, AppEnv1} | Res])
+ end;
+merge_env([], Env2, Res) ->
+ Env2 ++ Res.
+
+
+
+
+%% Merges envs for an application. Env2 overrides Env1
+merge_app_env(Env1, Env2) ->
+ merge_app_env(Env1, Env2, []).
+
+merge_app_env([{Key, Val} | T], Env2, Res) ->
+ case get_env_key(Key, Env2) of
+ {value, NewVal, RestEnv} ->
+ merge_app_env(T, RestEnv, [{Key, NewVal}|Res]);
+ _ ->
+ merge_app_env(T, Env2, [{Key, Val} | Res])
+ end;
+merge_app_env([], Env2, Res) ->
+ Env2 ++ Res.
+
+get_env_key(Key, Env) -> get_env_key(Env, Key, []).
+get_env_key([{Key, Val} | T], Key, Res) ->
+ {value, Val, T ++ Res};
+get_env_key([H | T], Key, Res) ->
+ get_env_key(T, Key, [H | Res]);
+get_env_key([], _Key, Res) -> Res.
+
+add_env(Name, Env) ->
+ foreach(fun({Key, Value}) ->
+ ets:insert(ac_tab, {{env, Name, Key}, Value})
+ end,
+ Env).
+
+del_env(Name) ->
+ ets:match_delete(ac_tab, {{env, Name, '_'}, '_'}).
+
+check_user() ->
+ case whereis(user) of
+ User when is_pid(User) -> group_leader(User, self());
+ _ -> ok
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Prepare for a release upgrade by reading all the evironment variables.
+%%-----------------------------------------------------------------
+do_prep_config_change(Apps) ->
+ do_prep_config_change(Apps, []).
+
+do_prep_config_change([], EnvBefore) ->
+ EnvBefore;
+do_prep_config_change([{App, _Id} | Apps], EnvBefore) ->
+ Env = application:get_all_env(App),
+ do_prep_config_change(Apps, [{App, Env} | EnvBefore]).
+
+
+
+%%-----------------------------------------------------------------
+%% Inform all running applications about the changed configuration.
+%%-----------------------------------------------------------------
+do_config_change(Apps, EnvBefore) ->
+ do_config_change(Apps, EnvBefore, []).
+
+do_config_change([], _EnvBefore, []) ->
+ ok;
+do_config_change([], _EnvBefore, Errors) ->
+ {error, Errors};
+do_config_change([{App, _Id} | Apps], EnvBefore, Errors) ->
+ AppEnvNow = lists:sort(application:get_all_env(App)),
+ AppEnvBefore = case lists:keysearch(App, 1, EnvBefore) of
+ false ->
+ [];
+ {value, {App, AppEnvBeforeT}} ->
+ lists:sort(AppEnvBeforeT)
+ end,
+
+ Res =
+ case AppEnvNow of
+ AppEnvBefore ->
+ ok;
+ _ ->
+ case do_config_diff(AppEnvNow, AppEnvBefore) of
+ {[], [], []} ->
+ ok;
+ {Changed, New, Removed} ->
+ case application:get_key(App, mod) of
+ {ok, {Mod, _Para}} ->
+ case catch Mod:config_change(Changed, New,
+ Removed) of
+ ok ->
+ ok;
+ %% It is not considered as an error
+ %% if the cb-function is not defined
+ {'EXIT', {undef, _}} ->
+ ok;
+ {error, Error} ->
+ {error, Error};
+ Else ->
+ {error, Else}
+ end;
+ {ok,[]} ->
+ {error, {module_not_defined, App}};
+ undefined ->
+ {error, {application_not_found, App}}
+ end
+ end
+ end,
+
+ case Res of
+ ok ->
+ do_config_change(Apps, EnvBefore, Errors);
+ {error, NewError} ->
+ do_config_change(Apps, EnvBefore,[NewError | Errors])
+ end.
+
+
+
+
+%%-----------------------------------------------------------------
+%% Check if the configuration is changed in anyway.
+%%-----------------------------------------------------------------
+do_config_diff(AppEnvNow, AppEnvBefore) ->
+ do_config_diff(AppEnvNow, AppEnvBefore, {[], []}).
+
+do_config_diff([], AppEnvBefore, {Changed, New}) ->
+ Removed = lists:foldl(fun({Env, _Value}, Acc) -> [Env | Acc] end, [], AppEnvBefore),
+ {Changed, New, Removed};
+do_config_diff(AppEnvNow, [], {Changed, New}) ->
+ {Changed, AppEnvNow++New, []};
+do_config_diff([{Env, Value} | AppEnvNow], AppEnvBefore, {Changed, New}) ->
+ case lists:keysearch(Env, 1, AppEnvBefore) of
+ {value, {Env, Value}} ->
+ do_config_diff(AppEnvNow, lists:keydelete(Env,1,AppEnvBefore), {Changed, New});
+ {value, {Env, _OtherValue}} ->
+ do_config_diff(AppEnvNow, lists:keydelete(Env,1,AppEnvBefore),
+ {[{Env, Value} | Changed], New});
+ false ->
+ do_config_diff(AppEnvNow, AppEnvBefore, {Changed, [{Env, Value}|New]})
+ end.
+
+
+
+
+
+
+%%-----------------------------------------------------------------
+%% Read the .config files.
+%%-----------------------------------------------------------------
+check_conf() ->
+ case init:get_argument(config) of
+ {ok, Files} ->
+ {ok, lists:foldl(
+ fun([File], Env) ->
+ BFName = filename:basename(File,".config"),
+ FName = filename:join(filename:dirname(File),
+ BFName ++ ".config"),
+ case load_file(FName) of
+ {ok, NewEnv} ->
+ %% OTP-4867
+ %% sys.config may now contain names of
+ %% other .config files as well as
+ %% configuration parameters.
+ %% Therefore read and merge contents.
+ if
+ BFName =:= "sys" ->
+ {ok, SysEnv, Errors} =
+ check_conf_sys(NewEnv),
+
+ %% Report first error, if any, and
+ %% terminate
+ %% (backwards compatible behaviour)
+ case Errors of
+ [] ->
+ merge_env(Env, SysEnv);
+ [{error, {SysFName, Line, Str}}|_] ->
+ throw({error, {SysFName, Line, Str}})
+ end;
+ true ->
+ merge_env(Env, NewEnv)
+ end;
+ {error, {Line, _Mod, Str}} ->
+ throw({error, {FName, Line, Str}})
+ end
+ end, [], Files)};
+ _ -> {ok, []}
+ end.
+
+check_conf_sys(Env) ->
+ check_conf_sys(Env, [], []).
+
+check_conf_sys([File|T], SysEnv, Errors) when is_list(File) ->
+ BFName = filename:basename(File, ".config"),
+ FName = filename:join(filename:dirname(File), BFName ++ ".config"),
+ case load_file(FName) of
+ {ok, NewEnv} ->
+ check_conf_sys(T, merge_env(SysEnv, NewEnv), Errors);
+ {error, {Line, _Mod, Str}} ->
+ check_conf_sys(T, SysEnv, [{error, {FName, Line, Str}}|Errors])
+ end;
+check_conf_sys([Tuple|T], SysEnv, Errors) ->
+ check_conf_sys(T, merge_env(SysEnv, [Tuple]), Errors);
+check_conf_sys([], SysEnv, Errors) ->
+ {ok, SysEnv, lists:reverse(Errors)}.
+
+load_file(File) ->
+ %% We can't use file:consult/1 here. Too bad.
+ case erl_prim_loader:get_file(File) of
+ {ok, Bin, _FileName} ->
+ %% Make sure that there is some whitespace at the end of the string
+ %% (so that reading a file with no NL following the "." will work).
+ Str = binary_to_list(Bin) ++ " ",
+ scan_file(Str);
+ error ->
+ {error, {none, open_file, "configuration file not found"}}
+ end.
+
+scan_file(Str) ->
+ case erl_scan:tokens([], Str, 1) of
+ {done, {ok, Tokens, _}, Left} ->
+ case erl_parse:parse_term(Tokens) of
+ {ok,L}=Res when is_list(L) ->
+ case only_ws(Left) of
+ true ->
+ Res;
+ false ->
+ %% There was trailing garbage found after the list.
+ config_error()
+ end;
+ {ok,_} ->
+ %% Parsing succeeded but the result is not a list.
+ config_error();
+ Error ->
+ Error
+ end;
+ {done, Result, _} ->
+ {error, {none, parse_file, tuple_to_list(Result)}};
+ {more, _} ->
+ {error, {none, load_file, "no ending <dot> found"}}
+ end.
+
+only_ws([C|Cs]) when C =< $\s -> only_ws(Cs);
+only_ws([$%|Cs]) -> only_ws(strip_comment(Cs)); % handle comment
+only_ws([_|_]) -> false;
+only_ws([]) -> true.
+
+strip_comment([$\n|Cs]) -> Cs;
+strip_comment([_|Cs]) -> strip_comment(Cs);
+strip_comment([]) -> [].
+
+config_error() ->
+ {error,
+ {none, load_file,
+ "configuration file must contain ONE list ended by <dot>"}}.
+
+%%-----------------------------------------------------------------
+%% Info messages sent to error_logger
+%%-----------------------------------------------------------------
+info_started(Name, Node) ->
+ Rep = [{application, Name},
+ {started_at, Node}],
+ error_logger:info_report(progress, Rep).
+
+info_exited(Name, Reason, Type) ->
+ Rep = [{application, Name},
+ {exited, Reason},
+ {type, Type}],
+ error_logger:info_report(Rep).
+
+
+%%-----------------------------------------------------------------
+%% Reply to all processes waiting this application to be started.
+%%-----------------------------------------------------------------
+reply_to_requester(AppName, Start_req, Res) ->
+ R = case Res of
+ {ok, _Id} ->
+ ok;
+ {info, Reason} ->
+ {error, Reason};
+ Error ->
+ Error
+ end,
+
+ lists:foldl(fun(Sp, AccIn) ->
+ case Sp of
+ {AppName, From} ->
+ reply(From, R),
+ AccIn;
+ _ ->
+ [Sp | AccIn]
+ end
+ end,
+ [],
+ Start_req).
+
+
+%%-----------------------------------------------------------------
+%% Update the environment variable permission for an application.
+%%-----------------------------------------------------------------
+update_permissions(AppName, Bool) ->
+ case ets:lookup(ac_tab, {env, kernel, permissions}) of
+ [] ->
+ ets:insert(ac_tab, {{env, kernel, permissions},
+ [{AppName, Bool}]});
+ [{_, Perm}] ->
+ Perm2 = lists:keydelete(AppName, 1, Perm),
+ ets:insert(ac_tab, {{env, kernel, permissions},
+ [{AppName, Bool}| Perm2]})
+ end.
+
+%%-----------------------------------------------------------------
+%% These functions are only to be used from testsuites.
+%%-----------------------------------------------------------------
+test_change_apps(Apps, Conf) ->
+ Res = test_make_apps(Apps, []),
+ test_do_change_appl(Apps, Conf, Res).
+
+test_do_change_appl([], _, _) ->
+ ok;
+test_do_change_appl([A|Apps], [], [R|Res]) ->
+ do_change_appl(R, #appl{name = A}, []),
+ test_do_change_appl(Apps, [], Res);
+test_do_change_appl([A|Apps], [C|Conf], [R|Res]) ->
+ do_change_appl(R, #appl{name = A}, C),
+ test_do_change_appl(Apps, Conf, Res).
+
+test_make_apps([], Res) ->
+ lists:reverse(Res);
+test_make_apps([A|Apps], Res) ->
+ test_make_apps(Apps, [make_appl(A) | Res]).
+
+%%-----------------------------------------------------------------
+%% String conversion
+%% Exit reason needs to be a printable string
+%% (and of length <200, but init now does the chopping).
+%%-----------------------------------------------------------------
+to_string(Term) ->
+ case io_lib:printable_list(Term) of
+ true ->
+ Term;
+ false ->
+ lists:flatten(io_lib:write(Term))
+ end.
diff --git a/lib/kernel/src/application_master.erl b/lib/kernel/src/application_master.erl
new file mode 100644
index 0000000000..679fefaed9
--- /dev/null
+++ b/lib/kernel/src/application_master.erl
@@ -0,0 +1,426 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(application_master).
+
+%% External exports
+-export([start_link/2, start_type/0, stop/1]).
+-export([get_child/1]).
+
+%% Internal exports
+-export([init/4, start_it/4]).
+
+-include("application_master.hrl").
+
+-record(state, {child, appl_data, children = [], procs = 0, gleader}).
+
+%%-----------------------------------------------------------------
+%% Func: start_link/1
+%% Args: ApplData = record(appl_data)
+%% Purpose: Starts an application master for the application.
+%% Called from application_controller. (The application is
+%% also started).
+%% Returns: {ok, Pid} | {error, Reason} (Pid is unregistered)
+%%-----------------------------------------------------------------
+start_link(ApplData, Type) ->
+ Parent = whereis(application_controller),
+ proc_lib:start_link(application_master, init,
+ [Parent, self(), ApplData, Type]).
+
+start_type() ->
+ group_leader() ! {start_type, self()},
+ receive
+ {start_type, Type} ->
+ Type
+ after 5000 ->
+ {error, timeout}
+ end.
+
+%%-----------------------------------------------------------------
+%% Func: stop/1
+%% Purpose: Stops the application. This function makes sure
+%% that all processes belonging to the applicication is
+%% stopped (shutdown or killed). The application master
+%% is also stopped.
+%% Returns: ok
+%%-----------------------------------------------------------------
+stop(AppMaster) -> call(AppMaster, stop).
+
+%%-----------------------------------------------------------------
+%% Func: get_child/1
+%% Purpose: Get the topmost supervisor of an application.
+%% Returns: {pid(), App}
+%%-----------------------------------------------------------------
+get_child(AppMaster) -> call(AppMaster, get_child).
+
+call(AppMaster, Req) ->
+ Tag = make_ref(),
+ Ref = erlang:monitor(process, AppMaster),
+ AppMaster ! {Req, Tag, self()},
+ receive
+ {'DOWN', Ref, process, _, _Info} ->
+ ok;
+ {Tag, Res} ->
+ erlang:demonitor(Ref),
+ receive
+ {'DOWN', Ref, process, _, _Info} ->
+ Res
+ after 0 ->
+ Res
+ end
+ end.
+
+%%%-----------------------------------------------------------------
+%%% The logical and physical process structrure is as follows:
+%%%
+%%% logical physical
+%%%
+%%% -------- --------
+%%% |AM(GL)| |AM(GL)|
+%%% -------- --------
+%%% | |
+%%% -------- --------
+%%% |Appl P| | X |
+%%% -------- --------
+%%% |
+%%% --------
+%%% |Appl P|
+%%% --------
+%%%
+%%% Where AM(GL) == Application Master (Group Leader)
+%%% Appl P == The application specific root process (child to AM)
+%%% X == A special 'invisible' process
+%%% The reason for not using the logical structrure is that
+%%% the application start function is synchronous, and
+%%% that the AM is GL. This means that if AM executed the start
+%%% function, and this function uses spawn_request/1
+%%% or io, deadlock would occur. Therefore, this function is
+%%% executed by the process X. Also, AM needs three loops;
+%%% init_loop (waiting for the start function to return)
+%%% main_loop
+%%% terminate_loop (waiting for the process to die)
+%%% In each of these loops, io and other requests are handled.
+%%%-----------------------------------------------------------------
+%%% Internal functions
+%%%-----------------------------------------------------------------
+init(Parent, Starter, ApplData, Type) ->
+ link(Parent),
+ process_flag(trap_exit, true),
+ OldGleader = group_leader(),
+ group_leader(self(), self()),
+ %% Insert ourselves as master for the process. This ensures that
+ %% the processes in the application can use get_env/1 at startup.
+ Name = ApplData#appl_data.name,
+ ets:insert(ac_tab, {{application_master, Name}, self()}),
+ State = #state{appl_data = ApplData, gleader = OldGleader},
+ case start_it(State, Type) of
+ {ok, Pid} -> % apply(M,F,A) returned ok
+ set_timer(ApplData#appl_data.maxT),
+ unlink(Starter),
+ proc_lib:init_ack(Starter, {ok,self()}),
+ main_loop(Parent, State#state{child = Pid});
+ {error, Reason} -> % apply(M,F,A) returned error
+ exit(Reason);
+ Else -> % apply(M,F,A) returned erroneous
+ exit(Else)
+ end.
+
+%%-----------------------------------------------------------------
+%% We want to start the new application synchronously, but we still
+%% want to handle io requests. So we spawn off a new process that
+%% performs the apply, and we wait for a start ack.
+%%-----------------------------------------------------------------
+start_it(State, Type) ->
+ Tag = make_ref(),
+ Pid = spawn_link(application_master, start_it, [Tag, State, self(), Type]),
+ init_loop(Pid, Tag, State, Type).
+
+
+%%-----------------------------------------------------------------
+%% These are the three different loops executed by the application_
+%% master
+%%-----------------------------------------------------------------
+init_loop(Pid, Tag, State, Type) ->
+ receive
+ IoReq when element(1, IoReq) =:= io_request ->
+ State#state.gleader ! IoReq,
+ init_loop(Pid, Tag, State, Type);
+ {Tag, Res} ->
+ Res;
+ {'EXIT', Pid, Reason} ->
+ {error, Reason};
+ {start_type, From} ->
+ From ! {start_type, Type},
+ init_loop(Pid, Tag, State, Type);
+ Other ->
+ NewState = handle_msg(Other, State),
+ init_loop(Pid, Tag, NewState, Type)
+ end.
+
+main_loop(Parent, State) ->
+ receive
+ IoReq when element(1, IoReq) =:= io_request ->
+ State#state.gleader ! IoReq,
+ main_loop(Parent, State);
+ {'EXIT', Parent, Reason} ->
+ terminate(Reason, State);
+ {'EXIT', Child, Reason} when State#state.child =:= Child ->
+ terminate(Reason, State#state{child=undefined});
+ {'EXIT', _, timeout} ->
+ terminate(normal, State);
+ {'EXIT', Pid, _Reason} ->
+ Children = lists:delete(Pid, State#state.children),
+ Procs = State#state.procs - 1,
+ main_loop(Parent, State#state{children=Children, procs=Procs});
+ {start_type, From} ->
+ From ! {start_type, local},
+ main_loop(Parent, State);
+ Other ->
+ NewState = handle_msg(Other, State),
+ main_loop(Parent, NewState)
+ end.
+
+terminate_loop(Child, State) ->
+ receive
+ IoReq when element(1, IoReq) =:= io_request ->
+ State#state.gleader ! IoReq,
+ terminate_loop(Child, State);
+ {'EXIT', Child, _} ->
+ ok;
+ Other ->
+ NewState = handle_msg(Other, State),
+ terminate_loop(Child, NewState)
+ end.
+
+
+%%-----------------------------------------------------------------
+%% The Application Master is linked to *all* processes in the group
+%% (application).
+%%-----------------------------------------------------------------
+handle_msg({get_child, Tag, From}, State) ->
+ From ! {Tag, get_child_i(State#state.child)},
+ State;
+handle_msg({stop, Tag, From}, State) ->
+ catch terminate(normal, State),
+ From ! {Tag, ok},
+ exit(normal);
+handle_msg(_, State) ->
+ State.
+
+
+terminate(Reason, State) ->
+ terminate_child(State#state.child, State),
+ kill_children(State#state.children),
+ exit(Reason).
+
+
+
+
+%%======================================================================
+%%======================================================================
+%%======================================================================
+%% This is the process X above...
+%%======================================================================
+%%======================================================================
+%%======================================================================
+
+%%======================================================================
+%% Start an application.
+%% If the start_phases is defined in the .app file, the application is
+%% to be started in one or several start phases.
+%% If the Module in the mod-key is set to application_starter then
+%% the generic help module application_starter is used to control
+%% the start.
+%%======================================================================
+
+start_it(Tag, State, From, Type) ->
+ process_flag(trap_exit, true),
+ ApplData = State#state.appl_data,
+ case {ApplData#appl_data.phases, ApplData#appl_data.mod} of
+ {undefined, _} ->
+ start_it_old(Tag, From, Type, ApplData);
+ {Phases, {application_starter, [M, A]}} ->
+ start_it_new(Tag, From, Type, M, A, Phases,
+ [ApplData#appl_data.name]);
+ {Phases, {M, A}} ->
+ start_it_new(Tag, From, Type, M, A, Phases,
+ [ApplData#appl_data.name]);
+ {OtherP, OtherM} ->
+ From ! {Tag, {error, {bad_keys, {{mod, OtherM},
+ {start_phases, OtherP}}}}}
+ end.
+
+
+%%%-----------------------------------------------------
+%%% No start phases are defined
+%%%-----------------------------------------------------
+start_it_old(Tag, From, Type, ApplData) ->
+ {M,A} = ApplData#appl_data.mod,
+ case catch M:start(Type, A) of
+ {ok, Pid} ->
+ link(Pid),
+ From ! {Tag, {ok, self()}},
+ loop_it(From, Pid, M, []);
+ {ok, Pid, AppState} ->
+ link(Pid),
+ From ! {Tag, {ok, self()}},
+ loop_it(From, Pid, M, AppState);
+ {'EXIT', normal} ->
+ From ! {Tag, {error, {{'EXIT',normal},{M,start,[Type,A]}}}};
+ {error, Reason} ->
+ From ! {Tag, {error, {Reason, {M,start,[Type,A]}}}};
+ Other ->
+ From ! {Tag, {error, {bad_return,{{M,start,[Type,A]},Other}}}}
+ end.
+
+
+%%%-----------------------------------------------------
+%%% Start phases are defined
+%%%-----------------------------------------------------
+start_it_new(Tag, From, Type, M, A, Phases, Apps) ->
+ case catch start_the_app(Type, M, A, Phases, Apps) of
+ {ok, Pid, AppState} ->
+ From ! {Tag, {ok, self()}},
+ loop_it(From, Pid, M, AppState);
+ Error ->
+ From ! {Tag, Error}
+ end.
+
+
+%%%=====================================================
+%%% Start the application in the defined phases,
+%%% but first the supervisors are starter.
+%%%=====================================================
+start_the_app(Type, M, A, Phases, Apps) ->
+ case start_supervisor(Type, M, A) of
+ {ok, Pid, AppState} ->
+ link(Pid),
+ case application_starter:start(Phases, Type, Apps) of
+ ok ->
+ {ok, Pid, AppState};
+ Error2 ->
+ unlink(Pid),
+ Error2
+ end;
+ Error ->
+ Error
+ end.
+
+%%%-------------------------------------------------------------
+%%% Start the supervisors
+%%%-------------------------------------------------------------
+start_supervisor(Type, M, A) ->
+ case catch M:start(Type, A) of
+ {ok, Pid} ->
+ {ok, Pid, []};
+ {ok, Pid, AppState} ->
+ {ok, Pid, AppState};
+ {error, Reason} ->
+ {error, {Reason, {M, start, [Type, A]}}};
+ {'EXIT', normal} ->
+ {error, {{'EXIT', normal}, {M, start, [Type, A]}}};
+ Other ->
+ {error, {bad_return, {{M, start, [Type, A]}, Other}}}
+ end.
+
+
+
+
+%%======================================================================
+%%
+%%======================================================================
+
+loop_it(Parent, Child, Mod, AppState) ->
+ receive
+ {Parent, get_child} ->
+ Parent ! {self(), Child, Mod},
+ loop_it(Parent, Child, Mod, AppState);
+ {Parent, terminate} ->
+ NewAppState = prep_stop(Mod, AppState),
+ exit(Child, shutdown),
+ receive
+ {'EXIT', Child, _} -> ok
+ end,
+ catch Mod:stop(NewAppState),
+ exit(normal);
+ {'EXIT', Parent, Reason} ->
+ NewAppState = prep_stop(Mod, AppState),
+ exit(Child, Reason),
+ receive
+ {'EXIT', Child, Reason2} ->
+ exit(Reason2)
+ end,
+ catch Mod:stop(NewAppState);
+ {'EXIT', Child, Reason} -> % forward *all* exit reasons (inc. normal)
+ NewAppState = prep_stop(Mod, AppState),
+ catch Mod:stop(NewAppState),
+ exit(Reason);
+ _ ->
+ loop_it(Parent, Child, Mod, AppState)
+ end.
+
+prep_stop(Mod, AppState) ->
+ case catch Mod:prep_stop(AppState) of
+ {'EXIT', {undef, _}} ->
+ AppState;
+ {'EXIT', Reason} ->
+ error_logger:error_report([{?MODULE, shutdown_error},
+ {Mod, {prep_stop, [AppState]}},
+ {error_info, Reason}]),
+ AppState;
+ NewAppState ->
+ NewAppState
+ end.
+
+get_child_i(Child) ->
+ Child ! {self(), get_child},
+ receive
+ {Child, GrandChild, Mod} -> {GrandChild, Mod}
+ end.
+
+terminate_child_i(Child, State) ->
+ Child ! {self(), terminate},
+ terminate_loop(Child, State).
+
+%% Try to shutdown the child gently
+terminate_child(undefined, _) -> ok;
+terminate_child(Child, State) ->
+ terminate_child_i(Child, State).
+
+kill_children(Children) ->
+ lists:foreach(fun(Pid) -> exit(Pid, kill) end, Children),
+ kill_all_procs().
+
+kill_all_procs() ->
+ kill_all_procs_1(processes(), self(), 0).
+
+kill_all_procs_1([Self|Ps], Self, N) ->
+ kill_all_procs_1(Ps, Self, N);
+kill_all_procs_1([P|Ps], Self, N) ->
+ case process_info(P, group_leader) of
+ {group_leader,Self} ->
+ exit(P, kill),
+ kill_all_procs_1(Ps, Self, N+1);
+ _ ->
+ kill_all_procs_1(Ps, Self, N)
+ end;
+kill_all_procs_1([], _, 0) -> ok;
+kill_all_procs_1([], _, _) -> kill_all_procs().
+
+set_timer(infinity) -> ok;
+set_timer(Time) -> timer:exit_after(Time, timeout).
diff --git a/lib/kernel/src/application_master.hrl b/lib/kernel/src/application_master.hrl
new file mode 100644
index 0000000000..cd6d12c33c
--- /dev/null
+++ b/lib/kernel/src/application_master.hrl
@@ -0,0 +1,20 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-record(appl_data, {name, regs = [], phases, mod, mods = [],
+ inc_apps, maxP = infinity, maxT = infinity}).
diff --git a/lib/kernel/src/application_starter.erl b/lib/kernel/src/application_starter.erl
new file mode 100644
index 0000000000..8d839e4662
--- /dev/null
+++ b/lib/kernel/src/application_starter.erl
@@ -0,0 +1,111 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% ----------------------------------------------------------------------
+%% Purpose : Starts applications in the phases defined in the .app file's
+%% start_phases key. If the application includes other applications
+%% these are also started according to their mod and
+%% start_phases-keys in their .app file.
+%% ----------------------------------------------------------------------
+
+-module(application_starter).
+
+-export([start/3]).
+
+%%%=============================================================================
+%%%=============================================================================
+%%%=============================================================================
+%%% start(Phases, Type, Applications) -> ok | {error, ErrorMessage}
+%%%
+%%% The applications are started by calling Module:start_phase(Phase, Type, Args)
+%%% where Module and is defined in the mod-key, Phase and Args are defined in
+%%% the start_phases-key.
+%%%=============================================================================
+%%%=============================================================================
+%%%=============================================================================
+start([], _Type, _Apps) ->
+ ok;
+start([{Phase,_PhaseArgs}|Phases], Type, Apps) ->
+ case start_apps(Phase, Type, Apps) of
+ {error, Error} ->
+ {error, Error};
+ _ ->
+ start(Phases, Type, Apps)
+ end.
+
+
+%%%=============================================================================
+%%% Start each application in the phase Phase.
+%%%=============================================================================
+start_apps(_Phase, _Type, []) ->
+ ok;
+start_apps(Phase, Type, [App | Apps]) ->
+ case catch run_start_phase(Phase, Type, App) of
+ {error, Error} ->
+ {error, Error};
+ _ ->
+ start_apps(Phase, Type, Apps)
+ end.
+
+
+%%%=============================================================================
+%%% If application_starter is used recursively, start also all the included
+%%% applications in the phase Phase.
+%%%=============================================================================
+run_start_phase(Phase, Type, App) ->
+ {ok,{Mod,Arg}} = application:get_key(App, mod),
+ case Mod of
+ application_starter ->
+ [StartMod, _StartArgs] = Arg,
+ run_the_phase(Phase, Type, App, StartMod),
+ {ok, IncApps} = application:get_key(App, included_applications),
+ start_apps(Phase, Type, IncApps);
+ _ ->
+ run_the_phase(Phase, Type, App, Mod)
+ end.
+
+
+%%%=============================================================================
+%%% Start the application only if the start phase is defined in the
+%%% start_phases-key.
+%%%=============================================================================
+run_the_phase(Phase, Type, App, Mod) ->
+ Start_phases = case application_controller:get_key(App, start_phases) of
+ {ok, undefined} ->
+ throw({error, {start_phases_undefined, App}});
+ {ok, Sp} ->
+ Sp
+ end,
+ case lists:keysearch(Phase, 1, Start_phases) of
+ false ->
+ ok;
+ {value, {Phase, PhaseArgs}} ->
+ case catch Mod:start_phase(Phase, Type, PhaseArgs) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ throw({error, {Reason,
+ {Mod, start_phase,
+ [Phase, Type, PhaseArgs]}}});
+ Other ->
+ throw({error, {bad_return_value,
+ {{Mod, start_phase,
+ [Phase, Type, PhaseArgs]},
+ Other}}})
+ end
+ end.
diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl
new file mode 100644
index 0000000000..62c0bef0cc
--- /dev/null
+++ b/lib/kernel/src/auth.erl
@@ -0,0 +1,391 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(auth).
+-behaviour(gen_server).
+
+-export([start_link/0]).
+
+%% Old documented interface - deprecated
+-export([is_auth/1, cookie/0, cookie/1, node_cookie/1, node_cookie/2]).
+-deprecated([{is_auth,1}, {cookie,'_'}, {node_cookie, '_'}]).
+
+%% New interface - meant for internal use within kernel only
+-export([get_cookie/0, get_cookie/1,
+ set_cookie/1, set_cookie/2,
+ sync_cookie/0,
+ print/3]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-define(COOKIE_ETS_PROTECTION, protected).
+
+-record(state, {
+ our_cookie, %% Our own cookie
+ other_cookies %% The send-cookies of other nodes
+ }).
+
+-include("../include/file.hrl").
+
+%%----------------------------------------------------------------------
+%% Exported functions
+%%----------------------------------------------------------------------
+
+start_link() ->
+ gen_server:start_link({local, auth}, auth, [], []).
+
+%%--Deprecated interface------------------------------------------------
+
+-spec is_auth(Node :: node()) -> 'yes' | 'no'.
+
+is_auth(Node) ->
+ case net_adm:ping(Node) of
+ pong -> yes;
+ pang -> no
+ end.
+
+-spec cookie() -> atom().
+
+cookie() ->
+ get_cookie().
+
+-spec cookie(Cookies :: [atom(),...] | atom()) -> 'true'.
+
+cookie([Cookie]) ->
+ set_cookie(Cookie);
+cookie(Cookie) ->
+ set_cookie(Cookie).
+
+-spec node_cookie(Cookies :: [atom(),...]) -> 'yes' | 'no'.
+
+node_cookie([Node, Cookie]) ->
+ node_cookie(Node, Cookie).
+
+-spec node_cookie(Node :: node(), Cookie :: atom()) -> 'yes' | 'no'.
+
+node_cookie(Node, Cookie) ->
+ set_cookie(Node, Cookie),
+ is_auth(Node).
+
+%%--"New" interface-----------------------------------------------------
+
+-spec get_cookie() -> atom().
+
+get_cookie() ->
+ get_cookie(node()).
+
+-spec get_cookie(Node :: node()) -> atom().
+
+get_cookie(_Node) when node() =:= nonode@nohost ->
+ nocookie;
+get_cookie(Node) ->
+ gen_server:call(auth, {get_cookie, Node}).
+
+-spec set_cookie(Cookie :: atom()) -> 'true'.
+
+set_cookie(Cookie) ->
+ set_cookie(node(), Cookie).
+
+-spec set_cookie(Node :: node(), Cookie :: atom()) -> 'true'.
+
+set_cookie(_Node, _Cookie) when node() =:= nonode@nohost ->
+ erlang:error(distribution_not_started);
+set_cookie(Node, Cookie) ->
+ gen_server:call(auth, {set_cookie, Node, Cookie}).
+
+-spec sync_cookie() -> any().
+
+sync_cookie() ->
+ gen_server:call(auth, sync_cookie).
+
+-spec print(Node :: node(), Format :: string(), Args :: [_]) -> 'ok'.
+
+print(Node,Format,Args) ->
+ (catch gen_server:cast({auth,Node},{print,Format,Args})).
+
+%%--gen_server callbacks------------------------------------------------
+
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok, init_cookie()}.
+
+%% Opened is a list of servers we have opened up
+%% The net kernel will let all message to the auth server
+%% through as is
+
+handle_call({get_cookie, Node}, {_From,_Tag}, State) when Node =:= node() ->
+ {reply, State#state.our_cookie, State};
+handle_call({get_cookie, Node}, {_From,_Tag}, State) ->
+ case ets:lookup(State#state.other_cookies, Node) of
+ [{Node, Cookie}] ->
+ {reply, Cookie, State};
+ [] ->
+ {reply, State#state.our_cookie, State}
+ end;
+handle_call({set_cookie, Node, Cookie}, {_From,_Tag}, State)
+ when Node =:= node() ->
+ {reply, true, State#state{our_cookie = Cookie}};
+
+%%
+%% Happens when the distribution is brought up and
+%% Someone wight have set up the cookie for our new nodename.
+%%
+
+handle_call({set_cookie, Node, Cookie}, {_From,_Tag}, State) ->
+ ets:insert(State#state.other_cookies, {Node, Cookie}),
+ {reply, true, State};
+
+handle_call(sync_cookie, _From, State) ->
+ case ets:lookup(State#state.other_cookies,node()) of
+ [{_N,C}] ->
+ ets:delete(State#state.other_cookies,node()),
+ {reply, true, State#state{our_cookie = C}};
+ [] ->
+ {reply, true, State}
+ end;
+
+handle_call(echo, _From, O) ->
+ {reply, hello, O}.
+
+handle_cast({print,What,Args}, O) ->
+ %% always allow print outs
+ error_logger:error_msg(What,Args),
+ {noreply, O}.
+
+%% A series of bad messages that may come (from older distribution versions).
+
+handle_info({From,badcookie,net_kernel,{From,spawn,_M,_F,_A,_Gleader}}, O) ->
+ auth:print(node(From) ,"~n** Unauthorized spawn attempt to ~w **~n",
+ [node()]),
+ erlang:disconnect_node(node(From)),
+ {noreply, O};
+handle_info({From,badcookie,net_kernel,{From,spawn_link,_M,_F,_A,_Gleader}}, O) ->
+ auth:print(node(From),
+ "~n** Unauthorized spawn_link attempt to ~w **~n",
+ [node()]),
+ erlang:disconnect_node(node(From)),
+ {noreply, O};
+handle_info({_From,badcookie,ddd_server,_Mess}, O) ->
+ %% Ignore bad messages to the ddd server, they will be resent
+ %% If the authentication is succesful
+ {noreply, O};
+handle_info({From,badcookie,rex,_Msg}, O) ->
+ auth:print(getnode(From),
+ "~n** Unauthorized rpc attempt to ~w **~n",[node()]),
+ disconnect_node(node(From)),
+ {noreply, O};
+%% These two messages has to do with the old auth:is_auth() call (net_adm:ping)
+handle_info({From,badcookie,net_kernel,{'$gen_call',{From,Tag},{is_auth,_Node}}}, O) -> %% ho ho
+ From ! {Tag, no},
+ {noreply, O};
+handle_info({_From,badcookie,To,{{auth_reply,N},R}}, O) ->%% Let auth replys through
+ catch To ! {{auth_reply,N},R},
+ {noreply, O};
+handle_info({From,badcookie,Name,Mess}, Opened) ->
+ %% This may be registered send as well as pid send.
+ case lists:member(Name, Opened) of
+ true ->
+ catch Name ! Mess;
+ false ->
+ case catch lists:member(element(1, Mess), Opened) of
+ true ->
+ catch Name ! Mess; %% Might be a pid as well
+ _ ->
+ auth:print(getnode(From),
+ "~n** Unauthorized send attempt ~w to ~w **~n",
+ [Mess,node()]),
+ erlang:disconnect_node(getnode(From))
+ end
+ end,
+ {noreply, Opened};
+handle_info(_, O)-> % Ignore anything else especially EXIT signals
+ {noreply, O}.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+getnode(P) when is_pid(P) -> node(P);
+getnode(P) -> P.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%%
+%%% Cookie functions
+%%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Read cookie from $HOME/.erlang.cookie and set it.
+init_cookie() ->
+ case init:get_argument(nocookie) of
+ error ->
+ case init:get_argument(setcookie) of
+ {ok, [[C0]]} ->
+ C = list_to_atom(C0),
+ #state{our_cookie = C,
+ other_cookies = ets:new(cookies,
+ [?COOKIE_ETS_PROTECTION])};
+ _ ->
+ %% Here is the default
+ case read_cookie() of
+ {error, Error} ->
+ error_logger:error_msg(Error, []),
+ %% Is this really this serious?
+ erlang:error(Error);
+ {ok, Co} ->
+ #state{our_cookie = list_to_atom(Co),
+ other_cookies = ets:new(
+ cookies,
+ [?COOKIE_ETS_PROTECTION])}
+ end
+ end;
+ _Other ->
+ #state{our_cookie = nocookie,
+ other_cookies = ets:new(cookies,[?COOKIE_ETS_PROTECTION])}
+ end.
+
+read_cookie() ->
+ case init:get_argument(home) of
+ {ok, [[Home]]} ->
+ read_cookie(filename:join(Home, ".erlang.cookie"));
+ _ ->
+ {error, "No home for cookie file"}
+ end.
+
+read_cookie(Name) ->
+ case file:raw_read_file_info(Name) of
+ {ok, #file_info {type=Type, mode=Mode, size=Size}} ->
+ case check_attributes(Name, Type, Mode, os:type()) of
+ ok -> read_cookie(Name, Size);
+ Error -> Error
+ end;
+ {error, enoent} ->
+ case create_cookie(Name) of
+ ok -> read_cookie(Name);
+ Error -> Error
+ end;
+ {error, Reason} ->
+ {error, make_error(Name, Reason)}
+ end.
+
+read_cookie(Name, Size) ->
+ case file:open(Name, [raw, read]) of
+ {ok, File} ->
+ case file:read(File, Size) of
+ {ok, List} ->
+ file:close(File),
+ check_cookie(List, []);
+ {error, Reason} ->
+ make_error(Name, Reason)
+ end;
+ {error, Reason} ->
+ make_error(Name, Reason)
+ end.
+
+make_error(Name, Reason) ->
+ {error, "Error when reading " ++ Name ++ ": " ++ atom_to_list(Reason)}.
+
+%% Verifies that only the owner can access the cookie file.
+
+check_attributes(Name, Type, _Mode, _Os) when Type =/= regular ->
+ {error, "Cookie file " ++ Name ++ " is of type " ++ Type};
+check_attributes(Name, _Type, Mode, {unix, _}) when (Mode band 8#077) =/= 0 ->
+ {error, "Cookie file " ++ Name ++ " must be accessible by owner only"};
+check_attributes(_Name, _Type, _Mode, _Os) ->
+ ok.
+
+%% Checks that the cookie has the correct format.
+
+check_cookie([Letter|Rest], Result) when $\s =< Letter, Letter =< $~ ->
+ check_cookie(Rest, [Letter|Result]);
+check_cookie([X|Rest], Result) ->
+ check_cookie1([X|Rest], Result);
+check_cookie([], Result) ->
+ check_cookie1([], Result).
+
+check_cookie1([$\n|Rest], Result) ->
+ check_cookie1(Rest, Result);
+check_cookie1([$\r|Rest], Result) ->
+ check_cookie1(Rest, Result);
+check_cookie1([$\s|Rest], Result) ->
+ check_cookie1(Rest, Result);
+check_cookie1([_|_], _Result) ->
+ {error, "Bad characters in cookie"};
+check_cookie1([], []) ->
+ {error, "Too short cookie string"};
+check_cookie1([], Result) ->
+ {ok, lists:reverse(Result)}.
+
+%% Creates a new, random cookie.
+
+create_cookie(Name) ->
+ {_, S1, S2} = now(),
+ Seed = S2*10000+S1,
+ Cookie = random_cookie(20, Seed, []),
+ case file:open(Name, [write, raw]) of
+ {ok, File} ->
+ R1 = file:write(File, Cookie),
+ file:close(File),
+ R2 = file:raw_write_file_info(Name, make_info(Name)),
+ case {R1, R2} of
+ {ok, ok} ->
+ ok;
+ {{error,_Reason}, _} ->
+ {error, "Failed to create cookie file"};
+ {ok, {error, Reason}} ->
+ {error, "Failed to change mode: " ++ atom_to_list(Reason)}
+ end;
+ {error,_Reason} ->
+ {error, "Failed to create cookie file"}
+ end.
+
+random_cookie(0, _, Result) ->
+ Result;
+random_cookie(Count, X0, Result) ->
+ X = next_random(X0),
+ Letter = X*($Z-$A+1) div 16#1000000000 + $A,
+ random_cookie(Count-1, X, [Letter|Result]).
+
+%% Returns suitable information for a new cookie.
+%%
+%% Note: Since the generated cookie depends on the time the file was
+%% created, and the time can be seen plainly in the file, we will
+%% round down the file creation times to the nearest midnight to
+%% give crackers some more work.
+
+make_info(Name) ->
+ Midnight =
+ case file:raw_read_file_info(Name) of
+ {ok, #file_info{atime={Date, _}}} ->
+ {Date, {0, 0, 0}};
+ _ ->
+ {{1990, 1, 1}, {0, 0, 0}}
+ end,
+ #file_info{mode=8#400, atime=Midnight, mtime=Midnight, ctime=Midnight}.
+
+%% This RNG is from line 21 on page 102 in Knuth: The Art of Computer Programming,
+%% Volume II, Seminumerical Algorithms.
+%%
+%% Returns an integer in the range 0..(2^35-1).
+
+next_random(X) ->
+ (X*17059465+1) band 16#fffffffff.
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
new file mode 100644
index 0000000000..fef11d7e6e
--- /dev/null
+++ b/lib/kernel/src/code.erl
@@ -0,0 +1,491 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code).
+
+%% This is the interface module to the code server. It also contains
+%% some implementation details. See also related modules: code_*.erl
+%% in this directory.
+
+-export([objfile_extension/0,
+ set_path/1,
+ get_path/0,
+ load_file/1,
+ ensure_loaded/1,
+ load_abs/1,
+ load_abs/2,
+ load_binary/3,
+ load_native_partial/2,
+ load_native_sticky/3,
+ delete/1,
+ purge/1,
+ soft_purge/1,
+ is_loaded/1,
+ all_loaded/0,
+ stop/0,
+ root_dir/0,
+ lib_dir/0,
+ lib_dir/1,
+ lib_dir/2,
+ compiler_dir/0,
+ priv_dir/1,
+ stick_dir/1,
+ unstick_dir/1,
+ stick_mod/1,
+ unstick_mod/1,
+ is_sticky/1,
+ get_object_code/1,
+ add_path/1,
+ add_pathsz/1,
+ add_paths/1,
+ add_pathsa/1,
+ add_patha/1,
+ add_pathz/1,
+ del_path/1,
+ replace_path/2,
+ rehash/0,
+ start_link/0, start_link/1,
+ which/1,
+ where_is_file/1,
+ where_is_file/2,
+ set_primary_archive/2,
+ clash/0]).
+
+-include_lib("kernel/include/file.hrl").
+
+%% User interface.
+%%
+%% objfile_extension() -> ".beam"
+%% set_path(Dir*) -> true
+%% get_path() -> Dir*
+%% add_path(Dir) -> true | {error, What}
+%% add_patha(Dir) -> true | {error, What}
+%% add_pathz(Dir) -> true | {error, What}
+%% add_paths(DirList) -> true | {error, What}
+%% add_pathsa(DirList) -> true | {error, What}
+%% add_pathsz(DirList) -> true | {error, What}
+%% del_path(Dir) -> true | {error, What}
+%% replace_path(Name,Dir) -> true | {error, What}
+%% load_file(File) -> {error,What} | {module, Mod}
+%% load_abs(File) -> {error,What} | {module, Mod}
+%% load_abs(File,Mod) -> {error,What} | {module, Mod}
+%% load_binary(Mod,File,Bin) -> {error,What} | {module,Mod}
+%% ensure_loaded(Module) -> {error,What} | {module, Mod}
+%% delete(Module)
+%% purge(Module) kills all procs running old code
+%% soft_purge(Module) -> true | false
+%% is_loaded(Module) -> {file, File} | false
+%% all_loaded() -> {Module, File}*
+%% get_object_code(Mod) -> error | {Mod, Bin, Filename}
+%% stop() -> true
+%% root_dir()
+%% compiler_dir()
+%% lib_dir()
+%% priv_dir(Name)
+%% stick_dir(Dir) -> ok | error
+%% unstick_dir(Dir) -> ok | error
+%% is_sticky(Module) -> true | false
+%% which(Module) -> Filename
+%% set_primary_archive((FileName, Bin) -> ok | {error, Reason}
+%% clash() -> -> print out
+
+%%----------------------------------------------------------------------------
+%% Some types for basic exported functions of this module
+%%----------------------------------------------------------------------------
+
+-type load_error_rsn() :: 'badfile' | 'native_code' | 'nofile' | 'not_purged'
+ | 'sticky_directory'. % for some functions only
+-type load_ret() :: {'error', load_error_rsn()} | {'module', atom()}.
+-type loaded_ret_atoms() :: 'cover_compiled' | 'preloaded'.
+-type loaded_filename() :: file:filename() | loaded_ret_atoms().
+
+%%----------------------------------------------------------------------------
+%% User interface
+%%----------------------------------------------------------------------------
+
+-spec objfile_extension() -> file:filename().
+objfile_extension() ->
+ init:objfile_extension().
+
+-spec load_file(Module :: atom()) -> load_ret().
+load_file(Mod) when is_atom(Mod) ->
+ call({load_file,Mod}).
+
+-spec ensure_loaded(Module :: atom()) -> load_ret().
+ensure_loaded(Mod) when is_atom(Mod) ->
+ call({ensure_loaded,Mod}).
+
+%% XXX File as an atom is allowed only for backwards compatibility.
+-spec load_abs(Filename :: file:filename()) -> load_ret().
+load_abs(File) when is_list(File); is_atom(File) -> call({load_abs,File,[]}).
+
+%% XXX Filename is also an atom(), e.g. 'cover_compiled'
+-spec load_abs(Filename :: loaded_filename(), Module :: atom()) -> load_ret().
+load_abs(File,M) when (is_list(File) orelse is_atom(File)), is_atom(M) ->
+ call({load_abs,File,M}).
+
+%% XXX Filename is also an atom(), e.g. 'cover_compiled'
+-spec load_binary(Module :: atom(), Filename :: loaded_filename(), Binary :: binary()) -> load_ret().
+load_binary(Mod,File,Bin)
+ when is_atom(Mod), (is_list(File) orelse is_atom(File)), is_binary(Bin) ->
+ call({load_binary,Mod,File,Bin}).
+
+-spec load_native_partial(Module :: atom(), Binary :: binary()) -> load_ret().
+load_native_partial(Mod,Bin) when is_atom(Mod), is_binary(Bin) ->
+ call({load_native_partial,Mod,Bin}).
+
+-spec load_native_sticky(Module :: atom(), Binary :: binary(), WholeModule :: 'false' | binary()) -> load_ret().
+load_native_sticky(Mod,Bin,WholeModule)
+ when is_atom(Mod), is_binary(Bin),
+ (is_binary(WholeModule) orelse WholeModule =:= false) ->
+ call({load_native_sticky,Mod,Bin,WholeModule}).
+
+-spec delete(Module :: atom()) -> boolean().
+delete(Mod) when is_atom(Mod) -> call({delete,Mod}).
+
+-spec purge/1 :: (Module :: atom()) -> boolean().
+purge(Mod) when is_atom(Mod) -> call({purge,Mod}).
+
+-spec soft_purge(Module :: atom()) -> boolean().
+soft_purge(Mod) when is_atom(Mod) -> call({soft_purge,Mod}).
+
+-spec is_loaded(Module :: atom()) -> {'file', loaded_filename()} | 'false'.
+is_loaded(Mod) when is_atom(Mod) -> call({is_loaded,Mod}).
+
+-spec get_object_code(Module :: atom()) -> {atom(), binary(), file:filename()} | 'error'.
+get_object_code(Mod) when is_atom(Mod) -> call({get_object_code, Mod}).
+
+-spec all_loaded() -> [{atom(), loaded_filename()}].
+all_loaded() -> call(all_loaded).
+
+-spec stop() -> no_return().
+stop() -> call(stop).
+
+-spec root_dir() -> file:filename().
+root_dir() -> call({dir,root_dir}).
+
+-spec lib_dir() -> file:filename().
+lib_dir() -> call({dir,lib_dir}).
+
+%% XXX is_list() is for backwards compatibility -- take out in future version
+-spec lib_dir(App :: atom()) -> file:filename() | {'error', 'bad_name'}.
+lib_dir(App) when is_atom(App) ; is_list(App) -> call({dir,{lib_dir,App}}).
+
+-spec lib_dir(App :: atom(), SubDir :: atom()) -> file:filename() | {'error', 'bad_name'}.
+lib_dir(App, SubDir) when is_atom(App), is_atom(SubDir) -> call({dir,{lib_dir,App,SubDir}}).
+
+-spec compiler_dir() -> file:filename().
+compiler_dir() -> call({dir,compiler_dir}).
+
+%% XXX is_list() is for backwards compatibility -- take out in future version
+-spec priv_dir(Appl :: atom()) -> file:filename() | {'error', 'bad_name'}.
+priv_dir(App) when is_atom(App) ; is_list(App) -> call({dir,{priv_dir,App}}).
+
+-spec stick_dir(Directory :: file:filename()) -> 'ok' | 'error'.
+stick_dir(Dir) when is_list(Dir) -> call({stick_dir,Dir}).
+
+-spec unstick_dir(Directory :: file:filename()) -> 'ok' | 'error'.
+unstick_dir(Dir) when is_list(Dir) -> call({unstick_dir,Dir}).
+
+-spec stick_mod(Module :: atom()) -> 'true'.
+stick_mod(Mod) when is_atom(Mod) -> call({stick_mod,Mod}).
+
+-spec unstick_mod(Module :: atom()) -> 'true'.
+unstick_mod(Mod) when is_atom(Mod) -> call({unstick_mod,Mod}).
+
+-spec is_sticky(Module :: atom()) -> boolean().
+is_sticky(Mod) when is_atom(Mod) -> call({is_sticky,Mod}).
+
+-spec set_path(Directories :: [file:filename()]) -> 'true' | {'error', term()}.
+set_path(PathList) when is_list(PathList) -> call({set_path,PathList}).
+
+-spec get_path() -> [file:filename()].
+get_path() -> call(get_path).
+
+-spec add_path(Directory :: file:filename()) -> 'true' | {'error', term()}.
+add_path(Dir) when is_list(Dir) -> call({add_path,last,Dir}).
+
+-spec add_pathz(Directory :: file:filename()) -> 'true' | {'error', term()}.
+add_pathz(Dir) when is_list(Dir) -> call({add_path,last,Dir}).
+
+-spec add_patha(Directory :: file:filename()) -> 'true' | {'error', term()}.
+add_patha(Dir) when is_list(Dir) -> call({add_path,first,Dir}).
+
+-spec add_paths(Directories :: [file:filename()]) -> 'ok'.
+add_paths(Dirs) when is_list(Dirs) -> call({add_paths,last,Dirs}).
+
+-spec add_pathsz(Directories :: [file:filename()]) -> 'ok'.
+add_pathsz(Dirs) when is_list(Dirs) -> call({add_paths,last,Dirs}).
+
+-spec add_pathsa(Directories :: [file:filename()]) -> 'ok'.
+add_pathsa(Dirs) when is_list(Dirs) -> call({add_paths,first,Dirs}).
+
+%% XXX Contract's input argument differs from add_path/1 -- why?
+-spec del_path(Name :: file:filename() | atom()) -> boolean() | {'error', 'bad_name'}.
+del_path(Name) when is_list(Name) ; is_atom(Name) -> call({del_path,Name}).
+
+-type replace_path_error() :: {'error', 'bad_directory' | 'bad_name' | {'badarg',_}}.
+-spec replace_path(Name:: atom(), Dir :: file:filename()) -> 'true' | replace_path_error().
+replace_path(Name, Dir) when (is_atom(Name) or is_list(Name)) and
+ (is_atom(Dir) or is_list(Dir)) ->
+ call({replace_path,Name,Dir}).
+
+-spec rehash() -> 'ok'.
+rehash() -> call(rehash).
+
+%%-----------------------------------------------------------------
+
+call(Req) ->
+ code_server:call(code_server, Req).
+
+-spec start_link() -> {'ok', pid()} | {'error', 'crash'}.
+start_link() ->
+ start_link([stick]).
+
+-spec start_link(Flags :: [atom()]) -> {'ok', pid()} | {'error', 'crash'}.
+start_link(Flags) ->
+ do_start(Flags).
+
+%%-----------------------------------------------------------------
+%% In the init phase, code must not use any modules not yet loaded,
+%% either pre_loaded (e.g. init) or first in the script (e.g.
+%% erlang). Therefore, keep the modules used in init phase to a
+%% minimum, and make sure they are loaded before init is called.
+%% Try to call these modules from do_start instead.
+%% file is used in init - this is ok; file has been started before
+%% us, so the module is loaded.
+%%-----------------------------------------------------------------
+
+do_start(Flags) ->
+ %% The following module_info/1 calls are here to ensure
+ %% that the modules are loaded prior to their use elsewhere in
+ %% the code_server.
+ %% Otherwise a deadlock may occur when the code_server is starting.
+ code_server:module_info(module),
+ packages:module_info(module),
+ catch hipe_unified_loader:load_hipe_modules(),
+ gb_sets:module_info(module),
+ gb_trees:module_info(module),
+
+ ets:module_info(module),
+ os:module_info(module),
+ filename:module_info(module),
+ lists:module_info(module),
+
+ Mode = get_mode(Flags),
+ case init:get_argument(root) of
+ {ok,[[Root0]]} ->
+ Root = filename:join([Root0]), % Normalize. Use filename
+ case code_server:start_link([Root,Mode]) of
+ {ok,_Pid} = Ok2 ->
+ if
+ Mode =:= interactive ->
+ case lists:member(stick, Flags) of
+ true -> do_stick_dirs();
+ _ -> ok
+ end;
+ true ->
+ ok
+ end,
+ Ok2;
+ Other ->
+ Other
+ end;
+ Other ->
+ error_logger:error_msg("Can not start code server ~w ~n",[Other]),
+ {error, crash}
+ end.
+
+do_stick_dirs() ->
+ do_s(compiler),
+ do_s(stdlib),
+ do_s(kernel).
+
+do_s(Lib) ->
+ case lib_dir(Lib) of
+ {error, _} ->
+ ok;
+ Dir ->
+ %% The return value is intentionally ignored. Missing
+ %% directories is not a fatal error. (In embedded systems,
+ %% there is usually no compiler directory.)
+ stick_dir(filename:append(Dir, "ebin")),
+ ok
+ end.
+
+get_mode(Flags) ->
+ case lists:member(embedded, Flags) of
+ true ->
+ embedded;
+ _Otherwise ->
+ case init:get_argument(mode) of
+ {ok,[["embedded"]]} ->
+ embedded;
+ {ok,[["minimal"]]} ->
+ minimal;
+ _Else ->
+ interactive
+ end
+ end.
+
+%% Find out which version of a particular module we would
+%% load if we tried to load it, unless it's already loaded.
+%% In that case return the name of the file which contains
+%% the loaded object code
+
+-type which_ret_atoms() :: loaded_ret_atoms() | 'non_existing'.
+
+-spec which(Module :: atom()) -> file:filename() | which_ret_atoms().
+
+which(Module) when is_atom(Module) ->
+ case is_loaded(Module) of
+ false ->
+ which2(Module);
+ {file, File} ->
+ File
+ end.
+
+which2(Module) ->
+ Base = to_path(Module),
+ File = filename:basename(Base) ++ objfile_extension(),
+ Path = get_path(),
+ which(File, filename:dirname(Base), Path).
+
+-spec which(file:filename(), file:filename(), [file:filename()]) ->
+ 'non_existing' | file:filename().
+
+which(_, _, []) ->
+ non_existing;
+which(File, Base, [Directory|Tail]) ->
+ Path = if
+ Base =:= "." -> Directory;
+ true -> filename:join(Directory, Base)
+ end,
+ case erl_prim_loader:list_dir(Path) of
+ {ok,Files} ->
+ case lists:member(File,Files) of
+ true ->
+ filename:append(Path, File);
+ false ->
+ which(File, Base, Tail)
+ end;
+ _Error ->
+ which(File, Base, Tail)
+ end.
+
+%% Search the code path for a specific file. Try to locate
+%% it in the code path cache if possible.
+
+-spec where_is_file(Filename :: file:filename()) ->
+ 'non_existing' | file:filename().
+
+where_is_file(File) when is_list(File) ->
+ case call({is_cached,File}) of
+ no ->
+ Path = get_path(),
+ which(File, ".", Path);
+ Dir ->
+ filename:join(Dir, File)
+ end.
+
+-spec where_is_file(Path :: file:filename(), Filename :: file:filename()) ->
+ file:filename() | 'non_existing'.
+
+where_is_file(Path, File) when is_list(Path), is_list(File) ->
+ CodePath = get_path(),
+ if
+ Path =:= CodePath ->
+ case call({is_cached, File}) of
+ no ->
+ which(File, ".", Path);
+ Dir ->
+ filename:join(Dir, File)
+ end;
+ true ->
+ which(File, ".", Path)
+ end.
+
+-spec set_primary_archive(ArchiveFile :: file:filename(), ArchiveBin :: binary()) -> 'ok' | {'error', atom()}.
+
+set_primary_archive(ArchiveFile0, ArchiveBin) when is_list(ArchiveFile0), is_binary(ArchiveBin) ->
+ ArchiveFile = filename:absname(ArchiveFile0),
+ case call({set_primary_archive, ArchiveFile, ArchiveBin}) of
+ {ok, []} ->
+ ok;
+ {ok, _Mode, Ebins} ->
+ %% Prepend the code path with the ebins found in the archive
+ Ebins2 = [filename:join([ArchiveFile, E]) || E <- Ebins],
+ add_pathsa(Ebins2); % Returns ok
+ {error, _Reason} = Error ->
+ Error
+ end.
+
+%% Search the entire path system looking for name clashes
+
+-spec clash() -> 'ok'.
+
+clash() ->
+ Path = get_path(),
+ Struct = lists:flatten(build(Path)),
+ Len = length(search(Struct)),
+ io:format("** Found ~w name clashes in code paths ~n", [Len]).
+
+%% Internal for clash/0
+
+search([]) -> [];
+search([{Dir, File} | Tail]) ->
+ case lists:keyfind(File, 2, Tail) of
+ false ->
+ search(Tail);
+ {Dir2, File} ->
+ io:format("** ~s hides ~s~n",
+ [filename:join(Dir, File),
+ filename:join(Dir2, File)]),
+ [clash | search(Tail)]
+ end.
+
+build([]) -> [];
+build([Dir|Tail]) ->
+ Files = filter(objfile_extension(), Dir, file:list_dir(Dir)),
+ [decorate(Files, Dir) | build(Tail)].
+
+decorate([], _) -> [];
+decorate([File|Tail], Dir) ->
+ [{Dir, File} | decorate(Tail, Dir)].
+
+filter(_Ext, Dir, {error,_}) ->
+ io:format("** Bad path can't read ~s~n", [Dir]), [];
+filter(Ext, _, {ok,Files}) ->
+ filter2(Ext, length(Ext), Files).
+
+filter2(_Ext, _Extlen, []) -> [];
+filter2(Ext, Extlen,[File|Tail]) ->
+ case has_ext(Ext,Extlen, File) of
+ true -> [File | filter2(Ext, Extlen, Tail)];
+ false -> filter2(Ext, Extlen, Tail)
+ end.
+
+has_ext(Ext, Extlen,File) ->
+ L = length(File),
+ case catch lists:nthtail(L - Extlen, File) of
+ Ext -> true;
+ _ -> false
+ end.
+
+to_path(X) ->
+ filename:join(packages:split(X)).
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
new file mode 100644
index 0000000000..018f7f41d2
--- /dev/null
+++ b/lib/kernel/src/code_server.erl
@@ -0,0 +1,1539 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code_server).
+
+%% This file holds the server part of the code_server.
+
+-export([start_link/1,
+ call/2,
+ system_continue/3,
+ system_terminate/4,
+ system_code_change/4,
+ error_msg/2, info_msg/2
+ ]).
+
+-include_lib("kernel/include/file.hrl").
+
+-import(lists, [foreach/2]).
+
+-record(state,{supervisor,
+ root,
+ path,
+ moddb,
+ namedb,
+ cache = no_cache,
+ mode=interactive,
+ on_load = []}).
+
+start_link(Args) ->
+ Ref = make_ref(),
+ Parent = self(),
+ Init = fun() -> init(Ref, Parent, Args) end,
+ spawn_link(Init),
+ receive
+ {Ref,Res} -> Res
+ end.
+
+
+%% -----------------------------------------------------------
+%% Init the code_server process.
+%% -----------------------------------------------------------
+
+init(Ref, Parent, [Root,Mode0]) ->
+ register(?MODULE, self()),
+ process_flag(trap_exit, true),
+
+ Db = ets:new(code, [private]),
+ foreach(fun (M) -> ets:insert(Db, {M,preloaded}) end, erlang:pre_loaded()),
+ ets:insert(Db, init:fetch_loaded()),
+
+ Mode =
+ case Mode0 of
+ minimal -> interactive;
+ _ -> Mode0
+ end,
+
+ IPath =
+ case Mode of
+ interactive ->
+ LibDir = filename:append(Root, "lib"),
+ {ok,Dirs} = erl_prim_loader:list_dir(LibDir),
+ {Paths,_Libs} = make_path(LibDir,Dirs),
+ UserLibPaths = get_user_lib_dirs(),
+ ["."] ++ UserLibPaths ++ Paths;
+ _ ->
+ []
+ end,
+
+ Path = add_loader_path(IPath, Mode),
+ State0 = #state{root = Root,
+ path = Path,
+ moddb = Db,
+ namedb = init_namedb(Path),
+ mode = Mode},
+
+ State =
+ case init:get_argument(code_path_cache) of
+ {ok, _} ->
+ create_cache(State0);
+ error ->
+ State0
+ end,
+
+ Parent ! {Ref,{ok,self()}},
+ loop(State#state{supervisor=Parent}).
+
+get_user_lib_dirs() ->
+ case os:getenv("ERL_LIBS") of
+ LibDirs0 when is_list(LibDirs0) ->
+ Sep =
+ case os:type() of
+ {win32, _} -> $;;
+ _ -> $:
+ end,
+ LibDirs = split_paths(LibDirs0, Sep, [], []),
+ get_user_lib_dirs_1(LibDirs);
+ false ->
+ []
+ end.
+
+get_user_lib_dirs_1([Dir|DirList]) ->
+ case erl_prim_loader:list_dir(Dir) of
+ {ok, Dirs} ->
+ {Paths,_Libs} = make_path(Dir, Dirs),
+ %% Only add paths trailing with ./ebin.
+ [P || P <- Paths, filename:basename(P) =:= "ebin"] ++
+ get_user_lib_dirs_1(DirList);
+ error ->
+ get_user_lib_dirs_1(DirList)
+ end;
+get_user_lib_dirs_1([]) -> [].
+
+
+split_paths([S|T], S, Path, Paths) ->
+ split_paths(T, S, [], [lists:reverse(Path) | Paths]);
+split_paths([C|T], S, Path, Paths) ->
+ split_paths(T, S, [C|Path], Paths);
+split_paths([], _S, Path, Paths) ->
+ lists:reverse(Paths, [lists:reverse(Path)]).
+
+call(Name, Req) ->
+ Name ! {code_call, self(), Req},
+ receive
+ {?MODULE, Reply} ->
+ Reply
+ end.
+
+reply(Pid, Res) ->
+ Pid ! {?MODULE, Res}.
+
+loop(#state{supervisor=Supervisor}=State0) ->
+ receive
+ {code_call, Pid, Req} ->
+ case handle_call(Req, {Pid, call}, State0) of
+ {reply, Res, State} ->
+ reply(Pid, Res),
+ loop(State);
+ {noreply, State} ->
+ loop(State);
+ {stop, Why, stopped, State} ->
+ system_terminate(Why, Supervisor, [], State)
+ end;
+ {'EXIT', Supervisor, Reason} ->
+ system_terminate(Reason, Supervisor, [], State0);
+ {system, From, Msg} ->
+ handle_system_msg(running,Msg, From, Supervisor, State0);
+ {'DOWN',Ref,process,_,Res} ->
+ State = finish_on_load(Ref, Res, State0),
+ loop(State);
+ _Msg ->
+ loop(State0)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% System upgrade
+
+handle_system_msg(SysState,Msg,From,Parent,Misc) ->
+ case do_sys_cmd(SysState,Msg,Parent, Misc) of
+ {suspended, Reply, NMisc} ->
+ gen_reply(From, Reply),
+ suspend_loop(suspended, Parent, NMisc);
+ {running, Reply, NMisc} ->
+ gen_reply(From, Reply),
+ system_continue(Parent, [], NMisc)
+ end.
+
+gen_reply({To, Tag}, Reply) ->
+ catch To ! {Tag, Reply}.
+
+%%-----------------------------------------------------------------
+%% When a process is suspended, it can only respond to system
+%% messages.
+%%-----------------------------------------------------------------
+suspend_loop(SysState, Parent, Misc) ->
+ receive
+ {system, From, Msg} ->
+ handle_system_msg(SysState, Msg, From, Parent, Misc);
+ {'EXIT', Parent, Reason} ->
+ system_terminate(Reason, Parent, [], Misc)
+ end.
+
+do_sys_cmd(_, suspend, _Parent, Misc) ->
+ {suspended, ok, Misc};
+do_sys_cmd(_, resume, _Parent, Misc) ->
+ {running, ok, Misc};
+do_sys_cmd(SysState, get_status, Parent, Misc) ->
+ Status = {status, self(), {module, ?MODULE},
+ [get(), SysState, Parent, [], Misc]},
+ {SysState, Status, Misc};
+do_sys_cmd(SysState, {debug, _What}, _Parent, Misc) ->
+ {SysState,ok,Misc};
+do_sys_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, Misc0) ->
+ {Res, Misc} =
+ case catch ?MODULE:system_code_change(Misc0, Module, Vsn, Extra) of
+ {ok, Misc1} -> {ok, Misc1};
+ Else -> {{error, Else}, Misc0}
+ end,
+ {suspended, Res, Misc};
+do_sys_cmd(SysState, Other, _Parent, Misc) ->
+ {SysState, {error, {unknown_system_msg, Other}}, Misc}.
+
+system_continue(_Parent, _Debug, State) ->
+ loop(State).
+
+system_terminate(_Reason, _Parent, _Debug, _State) ->
+% error_msg("~p terminating: ~p~n ",[?MODULE,Reason]),
+ exit(shutdown).
+
+system_code_change(State, _Module, _OldVsn, _Extra) ->
+ {ok, State}.
+
+%%
+%% The gen_server call back functions.
+%%
+
+handle_call({stick_dir,Dir}, {_From,_Tag}, S) ->
+ {reply,stick_dir(Dir, true, S),S};
+
+handle_call({unstick_dir,Dir}, {_From,_Tag}, S) ->
+ {reply,stick_dir(Dir, false, S),S};
+
+handle_call({stick_mod,Mod}, {_From,_Tag}, S) ->
+ {reply,stick_mod(Mod, true, S),S};
+
+handle_call({unstick_mod,Mod}, {_From,_Tag}, S) ->
+ {reply,stick_mod(Mod, false, S),S};
+
+handle_call({dir,Dir},{_From,_Tag}, S) ->
+ Root = S#state.root,
+ Resp = do_dir(Root,Dir,S#state.namedb),
+ {reply,Resp,S};
+
+handle_call({load_file,Mod}, Caller, St) ->
+ case modp(Mod) of
+ false ->
+ {reply,{error,badarg},St};
+ true ->
+ load_file(Mod, Caller, St)
+ end;
+
+handle_call({add_path,Where,Dir0}, {_From,_Tag}, S=#state{cache=Cache0}) ->
+ case Cache0 of
+ no_cache ->
+ {Resp,Path} = add_path(Where, Dir0, S#state.path, S#state.namedb),
+ {reply,Resp,S#state{path=Path}};
+ _ ->
+ Dir = absname(Dir0), %% Cache always expands the path
+ {Resp,Path} = add_path(Where, Dir, S#state.path, S#state.namedb),
+ Cache=update_cache([Dir],Where,Cache0),
+ {reply,Resp,S#state{path=Path,cache=Cache}}
+ end;
+
+handle_call({add_paths,Where,Dirs0}, {_From,_Tag}, S=#state{cache=Cache0}) ->
+ case Cache0 of
+ no_cache ->
+ {Resp,Path} = add_paths(Where,Dirs0,S#state.path,S#state.namedb),
+ {reply,Resp, S#state{path=Path}};
+ _ ->
+ %% Cache always expands the path
+ Dirs = [absname(Dir) || Dir <- Dirs0],
+ {Resp,Path} = add_paths(Where, Dirs, S#state.path, S#state.namedb),
+ Cache=update_cache(Dirs,Where,Cache0),
+ {reply,Resp,S#state{cache=Cache,path=Path}}
+ end;
+
+handle_call({set_path,PathList}, {_From,_Tag}, S) ->
+ Path = S#state.path,
+ {Resp, NewPath,NewDb} = set_path(PathList, Path, S#state.namedb),
+ {reply,Resp,rehash_cache(S#state{path = NewPath, namedb=NewDb})};
+
+handle_call({del_path,Name}, {_From,_Tag}, S) ->
+ {Resp,Path} = del_path(Name,S#state.path,S#state.namedb),
+ {reply,Resp,rehash_cache(S#state{path = Path})};
+
+handle_call({replace_path,Name,Dir}, {_From,_Tag}, S) ->
+ {Resp,Path} = replace_path(Name,Dir,S#state.path,S#state.namedb),
+ {reply,Resp,rehash_cache(S#state{path = Path})};
+
+handle_call(rehash, {_From,_Tag}, S0) ->
+ S = create_cache(S0),
+ {reply,ok,S};
+
+handle_call(get_path, {_From,_Tag}, S) ->
+ {reply,S#state.path,S};
+
+%% Messages to load, delete and purge modules/files.
+handle_call({load_abs,File,Mod}, Caller, S) ->
+ case modp(File) of
+ false ->
+ {reply,{error,badarg},S};
+ true ->
+ load_abs(File, Mod, Caller, S)
+ end;
+
+handle_call({load_binary,Mod,File,Bin}, Caller, S) ->
+ do_load_binary(Mod, File, Bin, Caller, S);
+
+handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) ->
+ Result = (catch hipe_unified_loader:load(Mod,Bin)),
+ Status = hipe_result_to_status(Result),
+ {reply,Status,S};
+
+handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) ->
+ Result = (catch hipe_unified_loader:load_module(Mod,Bin,WholeModule)),
+ Status = hipe_result_to_status(Result),
+ {reply,Status,S};
+
+handle_call({ensure_loaded,Mod0}, Caller, St0) ->
+ Fun = fun (M, St) ->
+ case erlang:module_loaded(M) of
+ true ->
+ {reply,{module,M},St};
+ false when St#state.mode =:= interactive ->
+ load_file(M, Caller, St);
+ false ->
+ {reply,{error,embedded},St}
+ end
+ end,
+ do_mod_call(Fun, Mod0, {error,badarg}, St0);
+
+handle_call({delete,Mod0}, {_From,_Tag}, S) ->
+ Fun = fun (M, St) ->
+ case catch erlang:delete_module(M) of
+ true ->
+ ets:delete(St#state.moddb, M),
+ {reply,true,St};
+ _ ->
+ {reply,false,St}
+ end
+ end,
+ do_mod_call(Fun, Mod0, false, S);
+
+handle_call({purge,Mod0}, {_From,_Tag}, St0) ->
+ do_mod_call(fun (M, St) ->
+ {reply,do_purge(M),St}
+ end, Mod0, false, St0);
+
+handle_call({soft_purge,Mod0}, {_From,_Tag}, St0) ->
+ do_mod_call(fun (M, St) ->
+ {reply,do_soft_purge(M),St}
+ end, Mod0, true, St0);
+
+handle_call({is_loaded,Mod0}, {_From,_Tag}, St0) ->
+ do_mod_call(fun (M, St) ->
+ {reply,is_loaded(M, St#state.moddb),St}
+ end, Mod0, false, St0);
+
+handle_call(all_loaded, {_From,_Tag}, S) ->
+ Db = S#state.moddb,
+ {reply,all_loaded(Db),S};
+
+handle_call({get_object_code,Mod0}, {_From,_Tag}, St0) ->
+ Fun = fun(M, St) ->
+ Path = St#state.path,
+ case mod_to_bin(Path, atom_to_list(M)) of
+ {_,Bin,FName} -> {reply,{M,Bin,FName},St};
+ Error -> {reply,Error,St}
+ end
+ end,
+ do_mod_call(Fun, Mod0, error, St0);
+
+handle_call({is_sticky, Mod}, {_From,_Tag}, S) ->
+ Db = S#state.moddb,
+ {reply, is_sticky(Mod,Db), S};
+
+handle_call(stop,{_From,_Tag}, S) ->
+ {stop,normal,stopped,S};
+
+handle_call({is_cached,_File}, {_From,_Tag}, S=#state{cache=no_cache}) ->
+ {reply, no, S};
+
+handle_call({set_primary_archive, File, ArchiveBin}, {_From,_Tag}, S=#state{mode=Mode}) ->
+ case erl_prim_loader:set_primary_archive(File, ArchiveBin) of
+ {ok, Files} ->
+ {reply, {ok, Mode, Files}, S};
+ {error, Reason} ->
+ {reply, {error, Reason}, S}
+ end;
+
+handle_call({is_cached,File}, {_From,_Tag}, S=#state{cache=Cache}) ->
+ ObjExt = objfile_extension(),
+ Ext = filename:extension(File),
+ Type = case Ext of
+ ObjExt -> obj;
+ ".app" -> app;
+ _ -> undef
+ end,
+ if Type =:= undef ->
+ {reply, no, S};
+ true ->
+ Key = {Type,list_to_atom(filename:rootname(File, Ext))},
+ case ets:lookup(Cache, Key) of
+ [] ->
+ {reply, no, S};
+ [{Key,Dir}] ->
+ {reply, Dir, S}
+ end
+ end;
+
+handle_call(Other,{_From,_Tag}, S) ->
+ error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]),
+ {noreply,S}.
+
+do_mod_call(Action, Module, _Error, St) when is_atom(Module) ->
+ Action(Module, St);
+do_mod_call(Action, Module, Error, St) ->
+ try list_to_atom(Module) of
+ Atom when is_atom(Atom) ->
+ Action(Atom, St)
+ catch
+ error:badarg ->
+ {reply,Error,St}
+ end.
+
+%% --------------------------------------------------------------
+%% Cache functions
+%% --------------------------------------------------------------
+
+create_cache(St = #state{cache = no_cache}) ->
+ Cache = ets:new(code_cache, [protected]),
+ rehash_cache(Cache, St);
+create_cache(St) ->
+ rehash_cache(St).
+
+rehash_cache(St = #state{cache = no_cache}) ->
+ St;
+rehash_cache(St = #state{cache = OldCache}) ->
+ ets:delete(OldCache),
+ Cache = ets:new(code_cache, [protected]),
+ rehash_cache(Cache, St).
+
+rehash_cache(Cache, St = #state{path = Path}) ->
+ Exts = [{obj,objfile_extension()}, {app,".app"}],
+ {Cache,NewPath} = locate_mods(lists:reverse(Path), first, Exts, Cache, []),
+ St#state{cache = Cache, path=NewPath}.
+
+update_cache(Dirs, Where, Cache0) ->
+ Exts = [{obj,objfile_extension()}, {app,".app"}],
+ {Cache, _} = locate_mods(Dirs, Where, Exts, Cache0, []),
+ Cache.
+
+locate_mods([Dir0|Path], Where, Exts, Cache, Acc) ->
+ Dir = absname(Dir0), %% Cache always expands the path
+ case erl_prim_loader:list_dir(Dir) of
+ {ok, Files} ->
+ Cache = filter_mods(Files, Where, Exts, Dir, Cache),
+ locate_mods(Path, Where, Exts, Cache, [Dir|Acc]);
+ error ->
+ locate_mods(Path, Where, Exts, Cache, Acc)
+ end;
+locate_mods([], _, _, Cache, Path) ->
+ {Cache,Path}.
+
+filter_mods([File|Rest], Where, Exts, Dir, Cache) ->
+ Ext = filename:extension(File),
+ Root = list_to_atom(filename:rootname(File, Ext)),
+ case lists:keysearch(Ext, 2, Exts) of
+ {value,{Type,_}} ->
+ Key = {Type,Root},
+ case Where of
+ first ->
+ true = ets:insert(Cache, {Key,Dir});
+ last ->
+ case ets:lookup(Cache, Key) of
+ [] ->
+ true = ets:insert(Cache, {Key,Dir});
+ _ ->
+ ignore
+ end
+ end;
+ false ->
+ ok
+ end,
+ filter_mods(Rest, Where, Exts, Dir, Cache);
+
+filter_mods([], _, _, _, Cache) ->
+ Cache.
+
+%% --------------------------------------------------------------
+%% Path handling functions.
+%% --------------------------------------------------------------
+
+%%
+%% Create the initial path.
+%%
+make_path(BundleDir,Bundles0) ->
+ Bundles = choose_bundles(Bundles0),
+ make_path(BundleDir,Bundles,[],[]).
+
+choose_bundles(Bundles) ->
+ ArchiveExt = archive_extension(),
+ Bs = lists:sort([create_bundle(B,ArchiveExt) || B <- Bundles]),
+ [FullName || {_Name,_NumVsn,FullName} <-
+ choose(lists:reverse(Bs), [], ArchiveExt)].
+
+create_bundle(FullName,ArchiveExt) ->
+ BaseName = filename:basename(FullName,ArchiveExt),
+ case split(BaseName, "-") of
+ Toks when length(Toks) > 1 ->
+ VsnStr = lists:last(Toks),
+ case vsn_to_num(VsnStr) of
+ {ok, VsnNum} ->
+ Name = join(lists:sublist(Toks,length(Toks)-1),"-"),
+ {Name,VsnNum,FullName};
+ false ->
+ {FullName, [0], FullName}
+ end;
+ _ ->
+ {FullName,[0],FullName}
+ end.
+
+%% Convert "X.Y.Z. ..." to [K, L, M| ...]
+vsn_to_num(Vsn) ->
+ case is_vsn(Vsn) of
+ true ->
+ {ok, [list_to_integer(S) || S <- split(Vsn, ".")]};
+ _ ->
+ false
+ end.
+
+is_vsn(Str) when is_list(Str) ->
+ Vsns = split(Str, "."),
+ lists:all(fun is_numstr/1, Vsns).
+
+is_numstr(Cs) ->
+ lists:all(fun (C) when $0 =< C, C =< $9 -> true;
+ (_) -> false
+ end, Cs).
+
+split(Cs, S) ->
+ split1(Cs, S, []).
+
+split1([C|S], Seps, Toks) ->
+ case lists:member(C, Seps) of
+ true -> split1(S, Seps, Toks);
+ false -> split2(S, Seps, Toks, [C])
+ end;
+split1([], _Seps, Toks) ->
+ lists:reverse(Toks).
+
+split2([C|S], Seps, Toks, Cs) ->
+ case lists:member(C, Seps) of
+ true -> split1(S, Seps, [lists:reverse(Cs)|Toks]);
+ false -> split2(S, Seps, Toks, [C|Cs])
+ end;
+split2([], _Seps, Toks, Cs) ->
+ lists:reverse([lists:reverse(Cs)|Toks]).
+
+join([H1, H2| T], S) ->
+ H1 ++ S ++ join([H2| T], S);
+join([H], _) ->
+ H;
+join([], _) ->
+ [].
+
+choose([{Name,NumVsn,NewFullName}=New|Bs], Acc, ArchiveExt) ->
+ case lists:keysearch(Name,1,Acc) of
+ {value, {_, NV, OldFullName}} when NV =:= NumVsn ->
+ case filename:extension(OldFullName) =:= ArchiveExt of
+ false ->
+ choose(Bs,Acc, ArchiveExt);
+ true ->
+ Acc2 = lists:keystore(Name, 1, Acc, New),
+ choose(Bs,Acc2, ArchiveExt)
+ end;
+ {value, {_, _, _}} ->
+ choose(Bs,Acc, ArchiveExt);
+ false ->
+ choose(Bs,[{Name,NumVsn,NewFullName}|Acc], ArchiveExt)
+ end;
+choose([],Acc, _ArchiveExt) ->
+ Acc.
+
+make_path(_,[],Res,Bs) ->
+ {Res,Bs};
+make_path(BundleDir,[Bundle|Tail],Res,Bs) ->
+ Dir = filename:append(BundleDir,Bundle),
+ Ebin = filename:append(Dir,"ebin"),
+ %% First try with /ebin
+ case erl_prim_loader:read_file_info(Ebin) of
+ {ok,#file_info{type=directory}} ->
+ make_path(BundleDir,Tail,[Ebin|Res],[Bundle|Bs]);
+ _ ->
+ %% Second try with archive
+ Ext = archive_extension(),
+ Base = filename:basename(Dir, Ext),
+ Ebin2 = filename:join([filename:dirname(Dir), Base ++ Ext, Base, "ebin"]),
+ Ebins =
+ case split(Base, "-") of
+ Toks when length(Toks) > 1 ->
+ AppName = join(lists:sublist(Toks,length(Toks)-1),"-"),
+ Ebin3 = filename:join([filename:dirname(Dir), Base ++ Ext, AppName, "ebin"]),
+ [Ebin3, Ebin2, Dir];
+ _ ->
+ [Ebin2, Dir]
+ end,
+ try_ebin_dirs(Ebins,BundleDir,Tail,Res,Bundle, Bs)
+ end.
+
+try_ebin_dirs([Ebin | Ebins],BundleDir,Tail,Res,Bundle,Bs) ->
+ case erl_prim_loader:read_file_info(Ebin) of
+ {ok,#file_info{type=directory}} ->
+ make_path(BundleDir,Tail,[Ebin|Res],[Bundle|Bs]);
+ _ ->
+ try_ebin_dirs(Ebins,BundleDir,Tail,Res,Bundle,Bs)
+ end;
+try_ebin_dirs([],BundleDir,Tail,Res,_Bundle,Bs) ->
+ make_path(BundleDir,Tail,Res,Bs).
+
+
+%%
+%% Add the erl_prim_loader path.
+%%
+%%
+add_loader_path(IPath0,Mode) ->
+ {ok,PrimP0} = erl_prim_loader:get_path(),
+ case Mode of
+ embedded ->
+ strip_path(PrimP0, Mode); % i.e. only normalize
+ _ ->
+ Pa0 = get_arg(pa),
+ Pz0 = get_arg(pz),
+
+ Pa = patch_path(Pa0),
+ Pz = patch_path(Pz0),
+ PrimP = patch_path(PrimP0),
+ IPath = patch_path(IPath0),
+
+ P = exclude_pa_pz(PrimP,Pa,Pz),
+ Path0 = strip_path(P, Mode),
+ Path = add(Path0, IPath, []),
+ add_pa_pz(Path,Pa,Pz)
+ end.
+
+patch_path(Path) ->
+ case check_path(Path) of
+ {ok, NewPath} -> NewPath;
+ {error, _Reason} -> Path
+ end.
+
+%% As the erl_prim_loader path includes the -pa and -pz
+%% directories they have to be removed first !!
+exclude_pa_pz(P0,Pa,Pz) ->
+ P1 = excl(Pa, P0),
+ P = excl(Pz, lists:reverse(P1)),
+ lists:reverse(P).
+
+excl([], P) ->
+ P;
+excl([D|Ds], P) ->
+ excl(Ds, lists:delete(D, P)).
+
+%%
+%% Keep only 'valid' paths in code server.
+%% Only if mode is interactive, in an embedded
+%% system we can't rely on file.
+%%
+
+strip_path([P0|Ps], Mode) ->
+ P = filename:join([P0]), % Normalize
+ case check_path([P]) of
+ {ok, [NewP]} ->
+ [NewP|strip_path(Ps, Mode)];
+ _ when Mode =:= embedded ->
+ [P|strip_path(Ps, Mode)];
+ _ ->
+ strip_path(Ps, Mode)
+ end;
+strip_path(_, _) ->
+ [].
+
+%%
+%% Add only non-existing paths.
+%% Also delete other versions of directories,
+%% e.g. .../test-3.2/ebin should exclude .../test-*/ebin (and .../test/ebin).
+%% Put the Path directories first in resulting path.
+%%
+add(Path,["."|IPath],Acc) ->
+ RPath = add1(Path,IPath,Acc),
+ ["."|lists:delete(".",RPath)];
+add(Path,IPath,Acc) ->
+ add1(Path,IPath,Acc).
+
+add1([P|Path],IPath,Acc) ->
+ case lists:member(P,Acc) of
+ true ->
+ add1(Path,IPath,Acc); % Already added
+ false ->
+ IPath1 = exclude(P,IPath),
+ add1(Path,IPath1,[P|Acc])
+ end;
+add1(_,IPath,Acc) ->
+ lists:reverse(Acc) ++ IPath.
+
+add_pa_pz(Path0, Patha, Pathz) ->
+ {_,Path1} = add_paths(first,Patha,Path0,false),
+ {_,Path2} = add_paths(first,Pathz,lists:reverse(Path1),false),
+ lists:reverse(Path2).
+
+get_arg(Arg) ->
+ case init:get_argument(Arg) of
+ {ok, Values} ->
+ lists:append(Values);
+ _ ->
+ []
+ end.
+
+%%
+%% Exclude other versions of Dir or duplicates.
+%% Return a new Path.
+%%
+exclude(Dir,Path) ->
+ Name = get_name(Dir),
+ [D || D <- Path,
+ D =/= Dir,
+ get_name(D) =/= Name].
+
+%%
+%% Get the "Name" of a directory. A directory in the code server path
+%% have the following form: .../Name-Vsn or .../Name
+%% where Vsn is any sortable term (the newest directory is sorted as
+%% the greatest term).
+%%
+%%
+get_name(Dir) ->
+ get_name2(get_name1(Dir), []).
+
+get_name1(Dir) ->
+ case lists:reverse(filename:split(Dir)) of
+ ["ebin",DirName|_] -> DirName;
+ [DirName|_] -> DirName;
+ _ -> "" % No name !
+ end.
+
+get_name2([$-|_],Acc) -> lists:reverse(Acc);
+get_name2([H|T],Acc) -> get_name2(T,[H|Acc]);
+get_name2(_,Acc) -> lists:reverse(Acc).
+
+check_path(Path) ->
+ PathChoice = init:code_path_choice(),
+ ArchiveExt = archive_extension(),
+ do_check_path(Path, PathChoice, ArchiveExt, []).
+
+do_check_path([], _PathChoice, _ArchiveExt, Acc) ->
+ {ok, lists:reverse(Acc)};
+do_check_path([Dir | Tail], PathChoice, ArchiveExt, Acc) ->
+ case catch erl_prim_loader:read_file_info(Dir) of
+ {ok, #file_info{type=directory}} ->
+ do_check_path(Tail, PathChoice, ArchiveExt, [Dir | Acc]);
+ _ when PathChoice =:= strict ->
+ %% Be strict. Only use dir as explicitly stated
+ {error, bad_directory};
+ _ when PathChoice =:= relaxed ->
+ %% Be relaxed
+ case catch lists:reverse(filename:split(Dir)) of
+ {'EXIT', _} ->
+ {error, bad_directory};
+ ["ebin", App] ->
+ Dir2 = filename:join([App ++ ArchiveExt, App, "ebin"]),
+ case erl_prim_loader:read_file_info(Dir2) of
+ {ok, #file_info{type = directory}} ->
+ do_check_path(Tail, PathChoice, ArchiveExt, [Dir2 | Acc]);
+ _ ->
+ {error, bad_directory}
+ end;
+ ["ebin", App, OptArchive | RevTop] ->
+ Ext = filename:extension(OptArchive),
+ Base = filename:basename(OptArchive, Ext),
+ Dir2 =
+ if
+ Ext =:= ArchiveExt, Base =:= App ->
+ %% .../app-vsn.ez/app-vsn/ebin
+ Top = lists:reverse(RevTop),
+ filename:join(Top ++ [App, "ebin"]);
+ Ext =:= ArchiveExt ->
+ %% .../app-vsn.ez/xxx/ebin
+ {error, bad_directory};
+ true ->
+ %% .../app-vsn/ebin
+ Top = lists:reverse([OptArchive | RevTop]),
+ filename:join(Top ++ [App ++ ArchiveExt, App, "ebin"])
+ end,
+ case erl_prim_loader:read_file_info(Dir2) of
+ {ok, #file_info{type = directory}} ->
+ do_check_path(Tail, PathChoice, ArchiveExt, [Dir2 | Acc]);
+ _ ->
+ {error, bad_directory}
+ end;
+ _ ->
+ {error, bad_directory}
+ end
+ end.
+
+%%
+%% Add new path(s).
+%%
+add_path(Where,Dir,Path,NameDb) when is_atom(Dir) ->
+ add_path(Where,atom_to_list(Dir),Path,NameDb);
+add_path(Where,Dir0,Path,NameDb) when is_list(Dir0) ->
+ case int_list(Dir0) of
+ true ->
+ Dir = filename:join([Dir0]), % Normalize
+ case check_path([Dir]) of
+ {ok, [NewDir]} ->
+ {true, do_add(Where,NewDir,Path,NameDb)};
+ Error ->
+ {Error, Path}
+ end;
+ false ->
+ {{error, bad_directory}, Path}
+ end;
+add_path(_,_,Path,_) ->
+ {{error, bad_directory}, Path}.
+
+
+%%
+%% If the new directory is added first or if the directory didn't exist
+%% the name-directory table must be updated.
+%% If NameDb is false we should NOT update NameDb as it is done later
+%% then the table is created :-)
+%%
+do_add(first,Dir,Path,NameDb) ->
+ update(Dir,NameDb),
+ [Dir|lists:delete(Dir,Path)];
+do_add(last,Dir,Path,NameDb) ->
+ case lists:member(Dir,Path) of
+ true ->
+ Path;
+ false ->
+ maybe_update(Dir,NameDb),
+ Path ++ [Dir]
+ end.
+
+%% Do not update if the same name already exists !
+maybe_update(Dir,NameDb) ->
+ case lookup_name(get_name(Dir),NameDb) of
+ false -> update(Dir,NameDb);
+ _ -> false
+ end.
+
+update(_Dir, false) ->
+ ok;
+update(Dir,NameDb) ->
+ replace_name(Dir,NameDb).
+
+
+
+%%
+%% Set a completely new path.
+%%
+set_path(NewPath0, OldPath, NameDb) ->
+ NewPath = normalize(NewPath0),
+ case check_path(NewPath) of
+ {ok, NewPath2} ->
+ ets:delete(NameDb),
+ NewDb = init_namedb(NewPath2),
+ {true, NewPath2, NewDb};
+ Error ->
+ {Error, OldPath, NameDb}
+ end.
+
+%%
+%% Normalize the given path.
+%% The check_path function catches erroneous path,
+%% thus it is ignored here.
+%%
+normalize([P|Path]) when is_atom(P) ->
+ normalize([atom_to_list(P)|Path]);
+normalize([P|Path]) when is_list(P) ->
+ case int_list(P) of
+ true -> [filename:join([P])|normalize(Path)];
+ false -> [P|normalize(Path)]
+ end;
+normalize([P|Path]) ->
+ [P|normalize(Path)];
+normalize([]) ->
+ [];
+normalize(Other) ->
+ Other.
+
+%% Handle a table of name-directory pairs.
+%% The priv_dir/1 and lib_dir/1 functions will have
+%% an O(1) lookup.
+init_namedb(Path) ->
+ Db = ets:new(code_names,[private]),
+ init_namedb(lists:reverse(Path), Db),
+ Db.
+
+init_namedb([P|Path], Db) ->
+ insert_name(P, Db),
+ init_namedb(Path, Db);
+init_namedb([], _) ->
+ ok.
+
+-ifdef(NOTUSED).
+clear_namedb([P|Path], Db) ->
+ delete_name_dir(P, Db),
+ clear_namedb(Path, Db);
+clear_namedb([], _) ->
+ ok.
+-endif.
+
+insert_name(Dir, Db) ->
+ case get_name(Dir) of
+ Dir -> false;
+ Name -> insert_name(Name, Dir, Db)
+ end.
+
+insert_name(Name, Dir, Db) ->
+ AppDir = del_ebin(Dir),
+ {Base, SubDirs} = archive_subdirs(AppDir),
+ ets:insert(Db, {Name, AppDir, Base, SubDirs}),
+ true.
+
+archive_subdirs(AppDir) ->
+ IsDir =
+ fun(RelFile) ->
+ File = filename:join([AppDir, RelFile]),
+ case erl_prim_loader:read_file_info(File) of
+ {ok, #file_info{type = directory}} ->
+ false;
+ _ ->
+ true
+ end
+ end,
+ {Base, ArchiveDirs} = all_archive_subdirs(AppDir),
+ {Base, lists:filter(IsDir, ArchiveDirs)}.
+
+all_archive_subdirs(AppDir) ->
+ Ext = archive_extension(),
+ Base = filename:basename(AppDir),
+ Dirs =
+ case split(Base, "-") of
+ Toks when length(Toks) > 1 ->
+ Base2 = join(lists:sublist(Toks,length(Toks)-1),"-"),
+ [Base2, Base];
+ _ ->
+ [Base]
+ end,
+ try_archive_subdirs(AppDir ++ Ext, Base, Dirs).
+
+try_archive_subdirs(Archive, Base, [Dir | Dirs]) ->
+ ArchiveDir = filename:join([Archive, Dir]),
+ case erl_prim_loader:list_dir(ArchiveDir) of
+ {ok, Files} ->
+ IsDir =
+ fun(RelFile) ->
+ File = filename:join([ArchiveDir, RelFile]),
+ case erl_prim_loader:read_file_info(File) of
+ {ok, #file_info{type = directory}} ->
+ true;
+ _ ->
+ false
+ end
+ end,
+ {Dir, lists:filter(IsDir, Files)};
+ _ ->
+ try_archive_subdirs(Archive, Base, Dirs)
+ end;
+try_archive_subdirs(_Archive, Base, []) ->
+ {Base, []}.
+
+%%
+%% Delete a directory from Path.
+%% Name can be either the the name in .../Name[-*] or
+%% the complete directory name.
+%%
+del_path(Name0,Path,NameDb) ->
+ case catch to_list(Name0)of
+ {'EXIT',_} ->
+ {{error,bad_name},Path};
+ Name ->
+ case del_path1(Name,Path,NameDb) of
+ Path -> % Nothing has changed
+ {false,Path};
+ NewPath ->
+ {true,NewPath}
+ end
+ end.
+
+del_path1(Name,[P|Path],NameDb) ->
+ case get_name(P) of
+ Name ->
+ delete_name(Name, NameDb),
+ insert_old_shadowed(Name, Path, NameDb),
+ Path;
+ _ when Name =:= P ->
+ case delete_name_dir(Name, NameDb) of
+ true -> insert_old_shadowed(get_name(Name), Path, NameDb);
+ false -> ok
+ end,
+ Path;
+ _ ->
+ [P|del_path1(Name,Path,NameDb)]
+ end;
+del_path1(_,[],_) ->
+ [].
+
+insert_old_shadowed(Name, [P|Path], NameDb) ->
+ case get_name(P) of
+ Name -> insert_name(Name, P, NameDb);
+ _ -> insert_old_shadowed(Name, Path, NameDb)
+ end;
+insert_old_shadowed(_, [], _) ->
+ ok.
+
+%%
+%% Replace an old occurrence of an directory with name .../Name[-*].
+%% If it does not exist, put the new directory last in Path.
+%%
+replace_path(Name,Dir,Path,NameDb) ->
+ case catch check_pars(Name,Dir) of
+ {ok,N,D} ->
+ {true,replace_path1(N,D,Path,NameDb)};
+ {'EXIT',_} ->
+ {{error,{badarg,[Name,Dir]}},Path};
+ Error ->
+ {Error,Path}
+ end.
+
+replace_path1(Name,Dir,[P|Path],NameDb) ->
+ case get_name(P) of
+ Name ->
+ insert_name(Name, Dir, NameDb),
+ [Dir|Path];
+ _ ->
+ [P|replace_path1(Name,Dir,Path,NameDb)]
+ end;
+replace_path1(Name, Dir, [], NameDb) ->
+ insert_name(Name, Dir, NameDb),
+ [Dir].
+
+check_pars(Name,Dir) ->
+ N = to_list(Name),
+ D = filename:join([to_list(Dir)]), % Normalize
+ case get_name(Dir) of
+ N ->
+ case check_path([D]) of
+ {ok, [NewD]} ->
+ {ok,N,NewD};
+ Error ->
+ Error
+ end;
+ _ ->
+ {error,bad_name}
+ end.
+
+
+del_ebin(Dir) ->
+ case filename:basename(Dir) of
+ "ebin" ->
+ Dir2 = filename:dirname(Dir),
+ Dir3 = filename:dirname(Dir2),
+ Ext = archive_extension(),
+ case filename:extension(Dir3) of
+ E when E =:= Ext ->
+ %% Strip archive extension
+ filename:join([filename:dirname(Dir3),
+ filename:basename(Dir3, Ext)]);
+ _ ->
+ Dir2
+ end;
+ _ ->
+ Dir
+ end.
+
+
+
+replace_name(Dir, Db) ->
+ case get_name(Dir) of
+ Dir ->
+ false;
+ Name ->
+ delete_name(Name, Db),
+ insert_name(Name, Dir, Db)
+ end.
+
+delete_name(Name, Db) ->
+ ets:delete(Db, Name).
+
+delete_name_dir(Dir, Db) ->
+ case get_name(Dir) of
+ Dir -> false;
+ Name ->
+ Dir0 = del_ebin(Dir),
+ case lookup_name(Name, Db) of
+ {ok, Dir0, _Base, _SubDirs} ->
+ ets:delete(Db, Name),
+ true;
+ _ -> false
+ end
+ end.
+
+lookup_name(Name, Db) ->
+ case ets:lookup(Db, Name) of
+ [{Name, Dir, Base, SubDirs}] -> {ok, Dir, Base, SubDirs};
+ _ -> false
+ end.
+
+
+%%
+%% Fetch a directory.
+%%
+do_dir(Root,lib_dir,_) ->
+ filename:append(Root, "lib");
+do_dir(Root,root_dir,_) ->
+ Root;
+do_dir(_Root,compiler_dir,NameDb) ->
+ case lookup_name("compiler", NameDb) of
+ {ok, Dir, _Base, _SubDirs} -> Dir;
+ _ -> ""
+ end;
+do_dir(_Root,{lib_dir,Name},NameDb) ->
+ case catch lookup_name(to_list(Name), NameDb) of
+ {ok, Dir, _Base, _SubDirs} -> Dir;
+ _ -> {error, bad_name}
+ end;
+do_dir(_Root,{lib_dir,Name,SubDir0},NameDb) ->
+ SubDir = atom_to_list(SubDir0),
+ case catch lookup_name(to_list(Name), NameDb) of
+ {ok, Dir, Base, SubDirs} ->
+ case lists:member(SubDir, SubDirs) of
+ true ->
+ %% Subdir is in archive
+ filename:join([Dir ++ archive_extension(),
+ Base,
+ SubDir]);
+ false ->
+ %% Subdir is regular directory
+ filename:join([Dir, SubDir])
+ end;
+ _ ->
+ {error, bad_name}
+ end;
+do_dir(_Root,{priv_dir,Name},NameDb) ->
+ do_dir(_Root,{lib_dir,Name,priv},NameDb);
+do_dir(_, _, _) ->
+ 'bad request to code'.
+
+stick_dir(Dir, Stick, St) ->
+ case erl_prim_loader:list_dir(Dir) of
+ {ok,Listing} ->
+ Mods = get_mods(Listing, objfile_extension()),
+ Db = St#state.moddb,
+ case Stick of
+ true ->
+ foreach(fun (M) -> ets:insert(Db, {{sticky,M},true}) end, Mods);
+ false ->
+ foreach(fun (M) -> ets:delete(Db, {sticky,M}) end, Mods)
+ end;
+ Error ->
+ Error
+ end.
+
+stick_mod(M, Stick, St) ->
+ Db = St#state.moddb,
+ case Stick of
+ true ->
+ ets:insert(Db, {{sticky,M},true});
+ false ->
+ ets:delete(Db, {sticky,M})
+ end.
+
+get_mods([File|Tail], Extension) ->
+ case filename:extension(File) of
+ Extension ->
+ [list_to_atom(filename:basename(File, Extension)) |
+ get_mods(Tail, Extension)];
+ _ ->
+ get_mods(Tail, Extension)
+ end;
+get_mods([], _) -> [].
+
+is_sticky(Mod, Db) ->
+ case erlang:module_loaded(Mod) of
+ true ->
+ case ets:lookup(Db, {sticky,Mod}) of
+ [] -> false;
+ _ -> true
+ end;
+ false ->
+ false
+ end.
+
+add_paths(Where,[Dir|Tail],Path,NameDb) ->
+ {_,NPath} = add_path(Where,Dir,Path,NameDb),
+ add_paths(Where,Tail,NPath,NameDb);
+add_paths(_,_,Path,_) ->
+ {ok,Path}.
+
+
+do_load_binary(Module, File, Binary, Caller, St) ->
+ case modp(Module) andalso modp(File) andalso is_binary(Binary) of
+ true ->
+ case erlang:module_loaded(to_atom(Module)) of
+ true -> do_purge(Module);
+ false -> ok
+ end,
+ try_load_module(File, Module, Binary, Caller, St);
+ false ->
+ {reply,{error,badarg},St}
+ end.
+
+modp(Atom) when is_atom(Atom) -> true;
+modp(List) when is_list(List) -> int_list(List);
+modp(_) -> false.
+
+
+load_abs(File, Mod0, Caller, St) ->
+ Ext = objfile_extension(),
+ FileName0 = lists:concat([File, Ext]),
+ FileName = absname(FileName0),
+ Mod = if Mod0 =:= [] ->
+ list_to_atom(filename:basename(FileName0, Ext));
+ true ->
+ Mod0
+ end,
+ case erl_prim_loader:get_file(FileName) of
+ {ok,Bin,_} ->
+ try_load_module(FileName, Mod, Bin, Caller, St);
+ error ->
+ {reply,{error,nofile},St}
+ end.
+
+try_load_module(Mod, Dir, Caller, St) ->
+ File = filename:append(Dir, to_path(Mod) ++
+ objfile_extension()),
+ case erl_prim_loader:get_file(File) of
+ error ->
+ {reply,error,St};
+ {ok,Binary,FName} ->
+ try_load_module(absname(FName), Mod, Binary, Caller, St)
+ end.
+
+try_load_module(File, Mod, Bin, {From,_}=Caller, St0) ->
+ M = to_atom(Mod),
+ case pending_on_load(M, From, St0) of
+ no ->
+ try_load_module_1(File, M, Bin, Caller, St0);
+ {yes,St} ->
+ {noreply,St}
+ end.
+
+try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) ->
+ case is_sticky(Mod, Db) of
+ true -> %% Sticky file reject the load
+ error_msg("Can't load module that resides in sticky dir\n",[]),
+ {reply,{error,sticky_directory},St};
+ false ->
+ case catch load_native_code(Mod, Bin) of
+ {module,Mod} ->
+ ets:insert(Db, {Mod,File}),
+ {reply,{module,Mod},St};
+ no_native ->
+ case erlang:load_module(Mod, Bin) of
+ {module,Mod} ->
+ ets:insert(Db, {Mod,File}),
+ post_beam_load(Mod),
+ {reply,{module,Mod},St};
+ {error,on_load} ->
+ handle_on_load(Mod, File, Caller, St);
+ {error,What} ->
+ error_msg("Loading of ~s failed: ~p\n", [File, What]),
+ {reply,{error,What},St}
+ end;
+ Error ->
+ error_msg("Native loading of ~s failed: ~p\n",
+ [File,Error]),
+ {reply,ok,St}
+ end
+ end.
+
+load_native_code(Mod, Bin) ->
+ %% During bootstrapping of Open Source Erlang, we don't have any hipe
+ %% loader modules, but the Erlang emulator might be hipe enabled.
+ %% Therefore we must test for that the loader modules are available
+ %% before trying to to load native code.
+ case erlang:module_loaded(hipe_unified_loader) of
+ false -> no_native;
+ true -> hipe_unified_loader:load_native_code(Mod, Bin)
+ end.
+
+hipe_result_to_status(Result) ->
+ case Result of
+ {module,_} -> Result;
+ _ -> {error,Result}
+ end.
+
+post_beam_load(Mod) ->
+ case erlang:module_loaded(hipe_unified_loader) of
+ false -> ok;
+ true -> hipe_unified_loader:post_beam_load(Mod)
+ end.
+
+int_list([H|T]) when is_integer(H) -> int_list(T);
+int_list([_|_]) -> false;
+int_list([]) -> true.
+
+
+load_file(Mod, Caller, #state{path=Path,cache=no_cache}=St) ->
+ case mod_to_bin(Path, Mod) of
+ error ->
+ {reply,{error,nofile},St};
+ {Mod,Binary,File} ->
+ try_load_module(File, Mod, Binary, Caller, St)
+ end;
+load_file(Mod, Caller, #state{cache=Cache}=St0) ->
+ Key = {obj,Mod},
+ case ets:lookup(Cache, Key) of
+ [] ->
+ St = rehash_cache(St0),
+ case ets:lookup(St#state.cache, Key) of
+ [] ->
+ {reply,{error,nofile},St};
+ [{Key,Dir}] ->
+ try_load_module(Mod, Dir, Caller, St)
+ end;
+ [{Key,Dir}] ->
+ try_load_module(Mod, Dir, Caller, St0)
+ end.
+
+mod_to_bin([Dir|Tail], Mod) ->
+ File = filename:append(Dir, to_path(Mod) ++ objfile_extension()),
+ case erl_prim_loader:get_file(File) of
+ error ->
+ mod_to_bin(Tail, Mod);
+ {ok,Bin,FName} ->
+ {Mod,Bin,absname(FName)}
+ end;
+mod_to_bin([], Mod) ->
+ %% At last, try also erl_prim_loader's own method
+ File = to_path(Mod) ++ objfile_extension(),
+ case erl_prim_loader:get_file(File) of
+ error ->
+ error; % No more alternatives !
+ {ok,Bin,FName} ->
+ {Mod,Bin,absname(FName)}
+ end.
+
+absname(File) ->
+ case erl_prim_loader:get_cwd() of
+ {ok,Cwd} -> absname(File, Cwd);
+ _Error -> File
+ end.
+
+absname(Name, AbsBase) ->
+ case filename:pathtype(Name) of
+ relative ->
+ filename:absname_join(AbsBase, Name);
+ absolute ->
+ %% We must flatten the filename before passing it into join/1,
+ %% or we will get slashes inserted into the wrong places.
+ filename:join([filename:flatten(Name)]);
+ volumerelative ->
+ absname_vr(filename:split(Name), filename:split(AbsBase), AbsBase)
+ end.
+
+%% Handles volumerelative names (on Windows only).
+
+absname_vr(["/"|Rest1], [Volume|_], _AbsBase) ->
+ %% Absolute path on current drive.
+ filename:join([Volume|Rest1]);
+absname_vr([[X, $:]|Rest1], [[X|_]|_], AbsBase) ->
+ %% Relative to current directory on current drive.
+ absname(filename:join(Rest1), AbsBase);
+absname_vr([[X, $:]|Name], _, _AbsBase) ->
+ %% Relative to current directory on another drive.
+ Dcwd =
+ case erl_prim_loader:get_cwd([X, $:]) of
+ {ok, Dir} -> Dir;
+ error -> [X, $:, $/]
+ end,
+ absname(filename:join(Name), Dcwd).
+
+
+%% do_purge(Module)
+%% Kill all processes running code from *old* Module, and then purge the
+%% module. Return true if any processes killed, else false.
+
+do_purge(Mod) ->
+ do_purge(processes(), to_atom(Mod), false).
+
+do_purge([P|Ps], Mod, Purged) ->
+ case erlang:check_process_code(P, Mod) of
+ true ->
+ Ref = erlang:monitor(process, P),
+ exit(P, kill),
+ receive
+ {'DOWN',Ref,process,_Pid,_} -> ok
+ end,
+ do_purge(Ps, Mod, true);
+ false ->
+ do_purge(Ps, Mod, Purged)
+ end;
+do_purge([], Mod, Purged) ->
+ catch erlang:purge_module(Mod),
+ Purged.
+
+%% do_soft_purge(Module)
+%% Purge old code only if no procs remain that run old code
+%% Return true in that case, false if procs remain (in this
+%% case old code is not purged)
+
+do_soft_purge(Mod) ->
+ catch do_soft_purge(processes(), Mod).
+
+do_soft_purge([P|Ps], Mod) ->
+ case erlang:check_process_code(P, Mod) of
+ true -> throw(false);
+ false -> do_soft_purge(Ps, Mod)
+ end;
+do_soft_purge([], Mod) ->
+ catch erlang:purge_module(Mod),
+ true.
+
+is_loaded(M, Db) ->
+ case ets:lookup(Db, M) of
+ [{M,File}] -> {file,File};
+ [] -> false
+ end.
+
+%% -------------------------------------------------------
+%% The on_load functionality.
+%% -------------------------------------------------------
+
+handle_on_load(Mod, File, {From,_}, #state{on_load=OnLoad0}=St0) ->
+ Fun = fun() ->
+ Res = erlang:call_on_load_function(Mod),
+ exit(Res)
+ end,
+ {_,Ref} = spawn_monitor(Fun),
+ OnLoad = [{Ref,Mod,File,[From]}|OnLoad0],
+ St = St0#state{on_load=OnLoad},
+ {noreply,St}.
+
+pending_on_load(_, _, #state{on_load=[]}) ->
+ no;
+pending_on_load(Mod, From, #state{on_load=OnLoad0}=St) ->
+ case lists:keymember(Mod, 2, OnLoad0) of
+ false ->
+ no;
+ true ->
+ OnLoad = pending_on_load_1(Mod, From, OnLoad0),
+ {yes,St#state{on_load=OnLoad}}
+ end.
+
+pending_on_load_1(Mod, From, [{Ref,Mod,File,Pids}|T]) ->
+ [{Ref,Mod,File,[From|Pids]}|T];
+pending_on_load_1(Mod, From, [H|T]) ->
+ [H|pending_on_load_1(Mod, From, T)];
+pending_on_load_1(_, _, []) -> [].
+
+finish_on_load(Ref, OnLoadRes, #state{on_load=OnLoad0,moddb=Db}=State) ->
+ case lists:keyfind(Ref, 1, OnLoad0) of
+ false ->
+ %% Since this process in general silently ignores messages
+ %% it doesn't understand, it should also ignore a 'DOWN'
+ %% message with an unknown reference.
+ State;
+ {Ref,Mod,File,WaitingPids} ->
+ finish_on_load_1(Mod, File, OnLoadRes, WaitingPids, Db),
+ OnLoad = [E || {R,_,_,_}=E <- OnLoad0, R =/= Ref],
+ State#state{on_load=OnLoad}
+ end.
+
+finish_on_load_1(Mod, File, OnLoadRes, WaitingPids, Db) ->
+ Keep = if
+ is_boolean(OnLoadRes) -> OnLoadRes;
+ true -> false
+ end,
+ erlang:finish_after_on_load(Mod, Keep),
+ Res = case Keep of
+ false -> {error,on_load_failure};
+ true ->
+ ets:insert(Db, {Mod,File}),
+ {module,Mod}
+ end,
+ [reply(Pid, Res) || Pid <- WaitingPids],
+ ok.
+
+%% -------------------------------------------------------
+%% Internal functions.
+%% -------------------------------------------------------
+
+all_loaded(Db) ->
+ all_l(Db, ets:slot(Db, 0), 1, []).
+
+all_l(_Db, '$end_of_table', _, Acc) ->
+ Acc;
+all_l(Db, ModInfo, N, Acc) ->
+ NewAcc = strip_mod_info(ModInfo,Acc),
+ all_l(Db, ets:slot(Db, N), N + 1, NewAcc).
+
+
+strip_mod_info([{{sticky,_},_}|T], Acc) -> strip_mod_info(T, Acc);
+strip_mod_info([H|T], Acc) -> strip_mod_info(T, [H|Acc]);
+strip_mod_info([], Acc) -> Acc.
+
+% error_msg(Format) ->
+% error_msg(Format,[]).
+error_msg(Format, Args) ->
+ Msg = {notify,{error, group_leader(), {self(), Format, Args}}},
+ error_logger ! Msg,
+ ok.
+
+info_msg(Format, Args) ->
+ Msg = {notify,{info_msg, group_leader(), {self(), Format, Args}}},
+ error_logger ! Msg,
+ ok.
+
+objfile_extension() ->
+ init:objfile_extension().
+
+archive_extension() ->
+ init:archive_extension().
+
+to_list(X) when is_list(X) -> X;
+to_list(X) when is_atom(X) -> atom_to_list(X).
+
+to_atom(X) when is_atom(X) -> X;
+to_atom(X) when is_list(X) -> list_to_atom(X).
+
+to_path(X) ->
+ filename:join(packages:split(X)).
diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl
new file mode 100644
index 0000000000..7f1b5f9ec6
--- /dev/null
+++ b/lib/kernel/src/disk_log.erl
@@ -0,0 +1,1899 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(disk_log).
+
+%% Efficient file based log - process part
+
+-export([start/0, istart_link/1,
+ log/2, log_terms/2, blog/2, blog_terms/2,
+ alog/2, alog_terms/2, balog/2, balog_terms/2,
+ close/1, lclose/1, lclose/2, sync/1, open/1,
+ truncate/1, truncate/2, btruncate/2,
+ reopen/2, reopen/3, breopen/3, inc_wrap_file/1, change_size/2,
+ change_notify/3, change_header/2,
+ chunk/2, chunk/3, bchunk/2, bchunk/3, chunk_step/3, chunk_info/1,
+ block/1, block/2, unblock/1, info/1, format_error/1,
+ accessible_logs/0]).
+
+%% Internal exports
+-export([init/2, internal_open/2,
+ system_continue/3, system_terminate/4, system_code_change/4]).
+
+%% To be used by disk_log_h.erl (not (yet) in Erlang/OTP) only.
+-export([ll_open/1, ll_close/1, do_log/2, do_sync/1, do_info/2]).
+
+%% To be used by wrap_log_reader only.
+-export([ichunk_end/2]).
+
+%% To be used for debugging only:
+-export([pid2name/1]).
+
+-type dlog_state_error() :: 'ok' | {'error', term()}.
+
+-record(state, {queue = [],
+ messages = [],
+ parent,
+ server,
+ cnt = 0 :: non_neg_integer(),
+ args,
+ error_status = ok :: dlog_state_error(),
+ cache_error = ok %% cache write error after timeout
+ }).
+
+-include("disk_log.hrl").
+
+-define(failure(Error, Function, Arg),
+ {{failed, Error}, [{?MODULE, Function, Arg}]}).
+
+%%-define(PROFILE(C), C).
+-define(PROFILE(C), void).
+
+-compile({inline,[{log_loop,4},{log_end_sync,2},{replies,2},{rflat,1}]}).
+
+%%%----------------------------------------------------------------------
+%%% Contract type specifications
+%%%----------------------------------------------------------------------
+
+-type bytes() :: binary() | [byte()].
+
+-type log() :: term(). % XXX: refine
+-type file_error() :: term(). % XXX: refine
+-type invalid_header() :: term(). % XXX: refine
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% This module implements the API, and the processes for each log.
+%% There is one process per log.
+%%-----------------------------------------------------------------
+
+-type open_error_rsn() :: 'no_such_log'
+ | {'badarg', term()}
+ | {'size_mismatch', dlog_size(), dlog_size()}
+ | {'arg_mismatch', dlog_optattr(), term(), term()}
+ | {'name_already_open', log()}
+ | {'open_read_write', log()}
+ | {'open_read_only', log()}
+ | {'need_repair', log()}
+ | {'not_a_log_file', string()}
+ | {'invalid_index_file', string()}
+ | {'invalid_header', invalid_header()}
+ | {'file_error', file:filename(), file_error()}
+ | {'node_already_open', log()}.
+-type dist_error_rsn() :: 'nodedown' | open_error_rsn().
+-type ret() :: {'ok', log()}
+ | {'repaired', log(), {'recovered', non_neg_integer()},
+ {'badbytes', non_neg_integer()}}.
+-type open_ret() :: ret() | {'error', open_error_rsn()}.
+-type dist_open_ret() :: {[{node(), ret()}],
+ [{node(), {'error', dist_error_rsn()}}]}.
+-type all_open_ret() :: open_ret() | dist_open_ret().
+
+-spec open(Args :: dlog_options()) -> all_open_ret().
+open(A) ->
+ disk_log_server:open(check_arg(A, #arg{options = A})).
+
+-type log_error_rsn() :: 'no_such_log' | 'nonode' | {'read_only_mode', log()}
+ | {'format_external', log()} | {'blocked_log', log()}
+ | {'full', log()} | {'invalid_header', invalid_header()}
+ | {'file_error', file:filename(), file_error()}.
+
+-spec log(Log :: log(), Term :: term()) -> 'ok' | {'error', log_error_rsn()}.
+log(Log, Term) ->
+ req(Log, {log, term_to_binary(Term)}).
+
+-spec blog(Log :: log(), Bytes :: bytes()) -> 'ok' | {'error', log_error_rsn()}.
+blog(Log, Bytes) ->
+ req(Log, {blog, check_bytes(Bytes)}).
+
+-spec log_terms(Log :: log(), Terms :: [term()]) -> 'ok' | {'error', term()}.
+log_terms(Log, Terms) ->
+ Bs = terms2bins(Terms),
+ req(Log, {log, Bs}).
+
+-spec blog_terms(Log :: log(), Bytes :: [bytes()]) -> 'ok' | {'error', term()}.
+blog_terms(Log, Bytess) ->
+ Bs = check_bytes_list(Bytess, Bytess),
+ req(Log, {blog, Bs}).
+
+-type notify_ret() :: 'ok' | {'error', 'no_such_log'}.
+
+-spec alog(Log :: log(), Term :: term()) -> notify_ret().
+alog(Log, Term) ->
+ notify(Log, {alog, term_to_binary(Term)}).
+
+-spec alog_terms(Log :: log(), Terms :: [term()]) -> notify_ret().
+alog_terms(Log, Terms) ->
+ Bs = terms2bins(Terms),
+ notify(Log, {alog, Bs}).
+
+-spec balog(Log :: log(), Bytes :: bytes()) -> notify_ret().
+balog(Log, Bytes) ->
+ notify(Log, {balog, check_bytes(Bytes)}).
+
+-spec balog_terms(Log :: log(), Bytes :: [bytes()]) -> notify_ret().
+balog_terms(Log, Bytess) ->
+ Bs = check_bytes_list(Bytess, Bytess),
+ notify(Log, {balog, Bs}).
+
+-type close_error_rsn() ::'no_such_log' | 'nonode'
+ | {'file_error', file:filename(), file_error()}.
+
+-spec close(Log :: log()) -> 'ok' | {'error', close_error_rsn()}.
+close(Log) ->
+ req(Log, close).
+
+-type lclose_error_rsn() :: 'no_such_log'
+ | {'file_error', file:filename(), file_error()}.
+
+-spec lclose(Log :: log()) -> 'ok' | {'error', lclose_error_rsn()}.
+lclose(Log) ->
+ lclose(Log, node()).
+
+-spec lclose(Log :: log(), Node :: node()) -> 'ok' | {'error', lclose_error_rsn()}.
+lclose(Log, Node) ->
+ lreq(Log, close, Node).
+
+-type trunc_error_rsn() :: 'no_such_log' | 'nonode'
+ | {'read_only_mode', log()}
+ | {'blocked_log', log()}
+ | {'invalid_header', invalid_header()}
+ | {'file_error', file:filename(), file_error()}.
+
+-spec truncate(Log :: log()) -> 'ok' | {'error', trunc_error_rsn()}.
+truncate(Log) ->
+ req(Log, {truncate, none, truncate, 1}).
+
+-spec truncate(Log :: log(), Head :: term()) -> 'ok' | {'error', trunc_error_rsn()}.
+truncate(Log, Head) ->
+ req(Log, {truncate, {ok, term_to_binary(Head)}, truncate, 2}).
+
+-spec btruncate(Log :: log(), Head :: bytes()) -> 'ok' | {'error', trunc_error_rsn()}.
+btruncate(Log, Head) ->
+ req(Log, {truncate, {ok, check_bytes(Head)}, btruncate, 2}).
+
+-spec reopen(Log :: log(), Filename :: file:filename()) -> 'ok' | {'error', term()}.
+reopen(Log, NewFile) ->
+ req(Log, {reopen, NewFile, none, reopen, 2}).
+
+-spec reopen(Log :: log(), Filename :: file:filename(), Head :: term()) ->
+ 'ok' | {'error', term()}.
+reopen(Log, NewFile, NewHead) ->
+ req(Log, {reopen, NewFile, {ok, term_to_binary(NewHead)}, reopen, 3}).
+
+-spec breopen(Log :: log(), Filename :: file:filename(), Head :: bytes()) ->
+ 'ok' | {'error', term()}.
+breopen(Log, NewFile, NewHead) ->
+ req(Log, {reopen, NewFile, {ok, check_bytes(NewHead)}, breopen, 3}).
+
+-type inc_wrap_error_rsn() :: 'no_such_log' | 'nonode'
+ | {'read_only_mode', log()}
+ | {'blocked_log', log()} | {'halt_log', log()}
+ | {'invalid_header', invalid_header()}
+ | {'file_error', file:filename(), file_error()}.
+
+-spec inc_wrap_file(Log :: log()) -> 'ok' | {'error', inc_wrap_error_rsn()}.
+inc_wrap_file(Log) ->
+ req(Log, inc_wrap_file).
+
+-spec change_size(Log :: log(), Size :: dlog_size()) -> 'ok' | {'error', term()}.
+change_size(Log, NewSize) ->
+ req(Log, {change_size, NewSize}).
+
+-spec change_notify(Log :: log(), Pid :: pid(), Notify :: boolean()) ->
+ 'ok' | {'error', term()}.
+change_notify(Log, Pid, NewNotify) ->
+ req(Log, {change_notify, Pid, NewNotify}).
+
+-spec change_header(Log :: log(), Head :: {atom(), term()}) ->
+ 'ok' | {'error', term()}.
+change_header(Log, NewHead) ->
+ req(Log, {change_header, NewHead}).
+
+-type sync_error_rsn() :: 'no_such_log' | 'nonode' | {'read_only_mode', log()}
+ | {'blocked_log', log()}
+ | {'file_error', file:filename(), file_error()}.
+
+-spec sync(Log :: log()) -> 'ok' | {'error', sync_error_rsn()}.
+sync(Log) ->
+ req(Log, sync).
+
+-type block_error_rsn() :: 'no_such_log' | 'nonode' | {'blocked_log', log()}.
+
+-spec block(Log :: log()) -> 'ok' | {'error', block_error_rsn()}.
+block(Log) ->
+ block(Log, true).
+
+-spec block(Log :: log(), QueueLogRecords :: boolean()) -> 'ok' | {'error', term()}.
+block(Log, QueueLogRecords) ->
+ req(Log, {block, QueueLogRecords}).
+
+-type unblock_error_rsn() :: 'no_such_log' | 'nonode'
+ | {'not_blocked', log()}
+ | {'not_blocked_by_pid', log()}.
+
+-spec unblock(Log :: log()) -> 'ok' | {'error', unblock_error_rsn()}.
+unblock(Log) ->
+ req(Log, unblock).
+
+-spec format_error(Error :: term()) -> string().
+format_error(Error) ->
+ do_format_error(Error).
+
+-spec info(Log :: log()) -> [{atom(), any()}] | {'error', term()}.
+info(Log) ->
+ sreq(Log, info).
+
+-spec pid2name(Pid :: pid()) -> {'ok', log()} | 'undefined'.
+pid2name(Pid) ->
+ disk_log_server:start(),
+ case ets:lookup(?DISK_LOG_PID_TABLE, Pid) of
+ [] -> undefined;
+ [{_Pid, Log}] -> {ok, Log}
+ end.
+
+%% This function Takes 3 args, a Log, a Continuation and N.
+%% It retuns a {Cont2, ObjList} | eof | {error, Reason}
+%% The initial continuation is the atom 'start'
+
+-spec chunk(Log :: log(), Cont :: any()) ->
+ {'error', term()} | 'eof' | {any(), [any()]} | {any(), [any()], integer()}.
+chunk(Log, Cont) ->
+ chunk(Log, Cont, infinity).
+
+-spec chunk(Log :: log(), Cont :: any(), N :: pos_integer() | 'infinity') ->
+ {'error', term()} | 'eof' | {any(), [any()]} | {any(), [any()], integer()}.
+chunk(Log, Cont, infinity) ->
+ %% There cannot be more than ?MAX_CHUNK_SIZE terms in a chunk.
+ ichunk(Log, Cont, ?MAX_CHUNK_SIZE);
+chunk(Log, Cont, N) when is_integer(N), N > 0 ->
+ ichunk(Log, Cont, N).
+
+ichunk(Log, start, N) ->
+ R = sreq(Log, {chunk, 0, [], N}),
+ ichunk_end(R, Log);
+ichunk(Log, More, N) when is_record(More, continuation) ->
+ R = req2(More#continuation.pid,
+ {chunk, More#continuation.pos, More#continuation.b, N}),
+ ichunk_end(R, Log);
+ichunk(_Log, _, _) ->
+ {error, {badarg, continuation}}.
+
+ichunk_end({C, R}, Log) when is_record(C, continuation) ->
+ ichunk_end(R, read_write, Log, C, 0);
+ichunk_end({C, R, Bad}, Log) when is_record(C, continuation) ->
+ ichunk_end(R, read_only, Log, C, Bad);
+ichunk_end(R, _Log) ->
+ R.
+
+%% Create the terms on the client's heap, not the server's.
+%% The list of binaries is reversed.
+ichunk_end(R, Mode, Log, C, Bad) ->
+ case catch bins2terms(R, []) of
+ {'EXIT', _} ->
+ RR = lists:reverse(R),
+ ichunk_bad_end(RR, Mode, Log, C, Bad, []);
+ Ts when Bad > 0 ->
+ {C, Ts, Bad};
+ Ts when Bad =:= 0 ->
+ {C, Ts}
+ end.
+
+bins2terms([], L) ->
+ L;
+bins2terms([B | Bs], L) ->
+ bins2terms(Bs, [binary_to_term(B) | L]).
+
+ichunk_bad_end([B | Bs], Mode, Log, C, Bad, A) ->
+ case catch binary_to_term(B) of
+ {'EXIT', _} when read_write =:= Mode ->
+ InfoList = info(Log),
+ {value, {file, FileName}} = lists:keysearch(file, 1, InfoList),
+ File = case C#continuation.pos of
+ Pos when is_integer(Pos) -> FileName; % halt log
+ {FileNo, _} -> add_ext(FileName, FileNo) % wrap log
+ end,
+ {error, {corrupt_log_file, File}};
+ {'EXIT', _} when read_only =:= Mode ->
+ Reread = lists:foldl(fun(Bin, Sz) ->
+ Sz + byte_size(Bin) + ?HEADERSZ
+ end, 0, Bs),
+ NewPos = case C#continuation.pos of
+ Pos when is_integer(Pos) -> Pos-Reread;
+ {FileNo, Pos} -> {FileNo, Pos-Reread}
+ end,
+ NewBad = Bad + byte_size(B),
+ {C#continuation{pos = NewPos, b = []}, lists:reverse(A), NewBad};
+ T ->
+ ichunk_bad_end(Bs, Mode, Log, C, Bad, [T | A])
+ end.
+
+-spec bchunk(Log :: log(), Cont :: any()) ->
+ {'error', any()} | 'eof' | {any(), [binary()]} | {any(), [binary()], integer()}.
+bchunk(Log, Cont) ->
+ bchunk(Log, Cont, infinity).
+
+-spec bchunk(Log :: log(), Cont :: any(), N :: 'infinity' | pos_integer()) ->
+ {'error', any()} | 'eof' | {any(), [binary()]} | {any(), [binary()], integer()}.
+bchunk(Log, Cont, infinity) ->
+ %% There cannot be more than ?MAX_CHUNK_SIZE terms in a chunk.
+ bichunk(Log, Cont, ?MAX_CHUNK_SIZE);
+bchunk(Log, Cont, N) when is_integer(N), N > 0 ->
+ bichunk(Log, Cont, N).
+
+bichunk(Log, start, N) ->
+ R = sreq(Log, {chunk, 0, [], N}),
+ bichunk_end(R);
+bichunk(_Log, #continuation{pid = Pid, pos = Pos, b = B}, N) ->
+ R = req2(Pid, {chunk, Pos, B, N}),
+ bichunk_end(R);
+bichunk(_Log, _, _) ->
+ {error, {badarg, continuation}}.
+
+bichunk_end({C = #continuation{}, R}) ->
+ {C, lists:reverse(R)};
+bichunk_end({C = #continuation{}, R, Bad}) ->
+ {C, lists:reverse(R), Bad};
+bichunk_end(R) ->
+ R.
+
+-spec chunk_step(Log :: log(), Cont :: any(), N :: integer()) ->
+ {'ok', any()} | {'error', term()}.
+chunk_step(Log, Cont, N) when is_integer(N) ->
+ ichunk_step(Log, Cont, N).
+
+ichunk_step(Log, start, N) ->
+ sreq(Log, {chunk_step, 0, N});
+ichunk_step(_Log, More, N) when is_record(More, continuation) ->
+ req2(More#continuation.pid, {chunk_step, More#continuation.pos, N});
+ichunk_step(_Log, _, _) ->
+ {error, {badarg, continuation}}.
+
+-spec chunk_info(More :: any()) ->
+ [{'node', node()},...] | {'error', {'no_continuation', any()}}.
+chunk_info(More = #continuation{}) ->
+ [{node, node(More#continuation.pid)}];
+chunk_info(BadCont) ->
+ {error, {no_continuation, BadCont}}.
+
+-spec accessible_logs() -> {[_], [_]}.
+accessible_logs() ->
+ disk_log_server:accessible_logs().
+
+istart_link(Server) ->
+ {ok, proc_lib:spawn_link(disk_log, init, [self(), Server])}.
+
+%% Only for backwards compatibility, could probably be removed.
+-spec start() -> 'ok'.
+start() ->
+ disk_log_server:start().
+
+internal_open(Pid, A) ->
+ req2(Pid, {internal_open, A}).
+
+%%% ll_open() and ll_close() are used by disk_log_h.erl, a module not
+%%% (yet) in Erlang/OTP.
+
+%% -spec ll_open(dlog_options()) -> {'ok', Res :: _, #log{}, Cnt :: _} | Error.
+ll_open(A) ->
+ case check_arg(A, #arg{options = A}) of
+ {ok, L} -> do_open(L);
+ Error -> Error
+ end.
+
+%% -> closed | throw(Error)
+ll_close(Log) ->
+ close_disk_log2(Log).
+
+check_arg([], Res) ->
+ Ret = case Res#arg.head of
+ none ->
+ {ok, Res};
+ _ ->
+ case check_head(Res#arg.head, Res#arg.format) of
+ {ok, Head} ->
+ {ok, Res#arg{head = Head}};
+ Error ->
+ Error
+ end
+ end,
+
+ if %% check result
+ Res#arg.name =:= 0 ->
+ {error, {badarg, name}};
+ Res#arg.file =:= none ->
+ case catch lists:concat([Res#arg.name, ".LOG"]) of
+ {'EXIT',_} -> {error, {badarg, file}};
+ FName -> check_arg([], Res#arg{file = FName})
+ end;
+ Res#arg.repair =:= truncate, Res#arg.mode =:= read_only ->
+ {error, {badarg, repair_read_only}};
+ Res#arg.type =:= halt, is_tuple(Res#arg.size) ->
+ {error, {badarg, size}};
+ Res#arg.type =:= wrap ->
+ {OldSize, Version} =
+ disk_log_1:read_size_file_version(Res#arg.file),
+ check_wrap_arg(Ret, OldSize, Version);
+ true ->
+ Ret
+ end;
+check_arg([{file, F} | Tail], Res) when is_list(F) ->
+ check_arg(Tail, Res#arg{file = F});
+check_arg([{file, F} | Tail], Res) when is_atom(F) ->
+ check_arg(Tail, Res#arg{file = F});
+check_arg([{linkto, Pid} |Tail], Res) when is_pid(Pid) ->
+ check_arg(Tail, Res#arg{linkto = Pid});
+check_arg([{linkto, none} |Tail], Res) ->
+ check_arg(Tail, Res#arg{linkto = none});
+check_arg([{name, Name}|Tail], Res) ->
+ check_arg(Tail, Res#arg{name = Name});
+check_arg([{repair, true}|Tail], Res) ->
+ check_arg(Tail, Res#arg{repair = true});
+check_arg([{repair, false}|Tail], Res) ->
+ check_arg(Tail, Res#arg{repair = false});
+check_arg([{repair, truncate}|Tail], Res) ->
+ check_arg(Tail, Res#arg{repair = truncate});
+check_arg([{size, Int}|Tail], Res) when is_integer(Int), Int > 0 ->
+ check_arg(Tail, Res#arg{size = Int});
+check_arg([{size, infinity}|Tail], Res) ->
+ check_arg(Tail, Res#arg{size = infinity});
+check_arg([{size, {MaxB,MaxF}}|Tail], Res) when is_integer(MaxB),
+ is_integer(MaxF),
+ MaxB > 0, MaxB =< ?MAX_BYTES,
+ MaxF > 0, MaxF < ?MAX_FILES ->
+ check_arg(Tail, Res#arg{size = {MaxB, MaxF}});
+check_arg([{type, wrap}|Tail], Res) ->
+ check_arg(Tail, Res#arg{type = wrap});
+check_arg([{type, halt}|Tail], Res) ->
+ check_arg(Tail, Res#arg{type = halt});
+check_arg([{format, internal}|Tail], Res) ->
+ check_arg(Tail, Res#arg{format = internal});
+check_arg([{format, external}|Tail], Res) ->
+ check_arg(Tail, Res#arg{format = external});
+check_arg([{distributed, []}|Tail], Res) ->
+ check_arg(Tail, Res#arg{distributed = false});
+check_arg([{distributed, Nodes}|Tail], Res) when is_list(Nodes) ->
+ check_arg(Tail, Res#arg{distributed = {true, Nodes}});
+check_arg([{notify, true}|Tail], Res) ->
+ check_arg(Tail, Res#arg{notify = true});
+check_arg([{notify, false}|Tail], Res) ->
+ check_arg(Tail, Res#arg{notify = false});
+check_arg([{head_func, HeadFunc}|Tail], Res) ->
+ check_arg(Tail, Res#arg{head = {head_func, HeadFunc}});
+check_arg([{head, Term}|Tail], Res) ->
+ check_arg(Tail, Res#arg{head = {head, Term}});
+check_arg([{mode, read_only}|Tail], Res) ->
+ check_arg(Tail, Res#arg{mode = read_only});
+check_arg([{mode, read_write}|Tail], Res) ->
+ check_arg(Tail, Res#arg{mode = read_write});
+check_arg(Arg, _) ->
+ {error, {badarg, Arg}}.
+
+check_wrap_arg({ok, Res}, {0,0}, _Version) when Res#arg.size =:= infinity ->
+ {error, {badarg, size}};
+check_wrap_arg({ok, Res}, OldSize, Version) when Res#arg.size =:= infinity ->
+ NewRes = Res#arg{size = OldSize},
+ check_wrap_arg({ok, NewRes}, OldSize, Version);
+check_wrap_arg({ok, Res}, {0,0}, Version) ->
+ {ok, Res#arg{version = Version}};
+check_wrap_arg({ok, Res}, OldSize, Version) when OldSize =:= Res#arg.size ->
+ {ok, Res#arg{version = Version}};
+check_wrap_arg({ok, Res}, _OldSize, Version) when Res#arg.repair =:= truncate,
+ is_tuple(Res#arg.size) ->
+ {ok, Res#arg{version = Version}};
+check_wrap_arg({ok, Res}, OldSize, _Version) when is_tuple(Res#arg.size) ->
+ {error, {size_mismatch, OldSize, Res#arg.size}};
+check_wrap_arg({ok, _Res}, _OldSize, _Version) ->
+ {error, {badarg, size}};
+check_wrap_arg(Ret, _OldSize, _Version) ->
+ Ret.
+
+%%%-----------------------------------------------------------------
+%%% Server functions
+%%%-----------------------------------------------------------------
+init(Parent, Server) ->
+ ?PROFILE(ep:do()),
+ process_flag(trap_exit, true),
+ loop(#state{parent = Parent, server = Server}).
+
+loop(State) when State#state.messages =:= [] ->
+ receive
+ Message ->
+ handle(Message, State)
+ end;
+loop(State) ->
+ [M | Ms] = State#state.messages,
+ handle(M, State#state{messages = Ms}).
+
+handle({From, write_cache}, S) when From =:= self() ->
+ case catch do_write_cache(get(log)) of
+ ok ->
+ loop(S);
+ Error ->
+ loop(S#state{cache_error = Error})
+ end;
+handle({From, {log, B}}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ reply(From, {error, {read_only_mode, L#log.name}}, S);
+ L when L#log.status =:= ok, L#log.format =:= internal ->
+ log_loop(S, From, [B], []);
+ L when L#log.status =:= ok, L#log.format =:= external ->
+ reply(From, {error, {format_external, L#log.name}}, S);
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, {log, B}} | S#state.queue]})
+ end;
+handle({From, {blog, B}}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ reply(From, {error, {read_only_mode, L#log.name}}, S);
+ L when L#log.status =:= ok ->
+ log_loop(S, From, [B], []);
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, {blog, B}} | S#state.queue]})
+ end;
+handle({alog, B}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ notify_owners({read_only,B}),
+ loop(S);
+ L when L#log.status =:= ok, L#log.format =:= internal ->
+ log_loop(S, [], [B], []);
+ L when L#log.status =:= ok ->
+ notify_owners({format_external, B}),
+ loop(S);
+ L when L#log.status =:= {blocked, false} ->
+ notify_owners({blocked_log, B}),
+ loop(S);
+ _ ->
+ loop(S#state{queue = [{alog, B} | S#state.queue]})
+ end;
+handle({balog, B}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ notify_owners({read_only,B}),
+ loop(S);
+ L when L#log.status =:= ok ->
+ log_loop(S, [], [B], []);
+ L when L#log.status =:= {blocked, false} ->
+ notify_owners({blocked_log, B}),
+ loop(S);
+ _ ->
+ loop(S#state{queue = [{balog, B} | S#state.queue]})
+ end;
+handle({From, {block, QueueLogRecs}}, S) ->
+ case get(log) of
+ L when L#log.status =:= ok ->
+ do_block(From, QueueLogRecs, L),
+ reply(From, ok, S);
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, {block, QueueLogRecs}} |
+ S#state.queue]})
+ end;
+handle({From, unblock}, S) ->
+ case get(log) of
+ L when L#log.status =:= ok ->
+ reply(From, {error, {not_blocked, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ S2 = do_unblock(L, S),
+ reply(From, ok, S2);
+ L ->
+ reply(From, {error, {not_blocked_by_pid, L#log.name}}, S)
+ end;
+handle({From, sync}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ reply(From, {error, {read_only_mode, L#log.name}}, S);
+ L when L#log.status =:= ok ->
+ sync_loop([From], S);
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, sync} | S#state.queue]})
+ end;
+handle({From, {truncate, Head, F, A}}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ reply(From, {error, {read_only_mode, L#log.name}}, S);
+ L when L#log.status =:= ok, S#state.cache_error =/= ok ->
+ loop(cache_error(S, [From]));
+ L when L#log.status =:= ok ->
+ H = merge_head(Head, L#log.head),
+ case catch do_trunc(L, H) of
+ ok ->
+ erase(is_full),
+ notify_owners({truncated, S#state.cnt}),
+ N = if Head =:= none -> 0; true -> 1 end,
+ reply(From, ok, (state_ok(S))#state{cnt = N});
+ Error ->
+ do_exit(S, From, Error, ?failure(Error, F, A))
+ end;
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, {truncate, Head, F, A}}
+ | S#state.queue]})
+ end;
+handle({From, {chunk, Pos, B, N}}, S) ->
+ case get(log) of
+ L when L#log.status =:= ok, S#state.cache_error =/= ok ->
+ loop(cache_error(S, [From]));
+ L when L#log.status =:= ok ->
+ R = do_chunk(L, Pos, B, N),
+ reply(From, R, S);
+ L when L#log.blocked_by =:= From ->
+ R = do_chunk(L, Pos, B, N),
+ reply(From, R, S);
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _L ->
+ loop(S#state{queue = [{From, {chunk, Pos, B, N}} | S#state.queue]})
+ end;
+handle({From, {chunk_step, Pos, N}}, S) ->
+ case get(log) of
+ L when L#log.status =:= ok, S#state.cache_error =/= ok ->
+ loop(cache_error(S, [From]));
+ L when L#log.status =:= ok ->
+ R = do_chunk_step(L, Pos, N),
+ reply(From, R, S);
+ L when L#log.blocked_by =:= From ->
+ R = do_chunk_step(L, Pos, N),
+ reply(From, R, S);
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, {chunk_step, Pos, N}}
+ | S#state.queue]})
+ end;
+handle({From, {change_notify, Pid, NewNotify}}, S) ->
+ case get(log) of
+ L when L#log.status =:= ok ->
+ case do_change_notify(L, Pid, NewNotify) of
+ {ok, L1} ->
+ put(log, L1),
+ reply(From, ok, S);
+ Error ->
+ reply(From, Error, S)
+ end;
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, {change_notify, Pid, NewNotify}}
+ | S#state.queue]})
+ end;
+handle({From, {change_header, NewHead}}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ reply(From, {error, {read_only_mode, L#log.name}}, S);
+ L when L#log.status =:= ok ->
+ case check_head(NewHead, L#log.format) of
+ {ok, Head} ->
+ put(log, L#log{head = mk_head(Head, L#log.format)}),
+ reply(From, ok, S);
+ Error ->
+ reply(From, Error, S)
+ end;
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, {change_header, NewHead}}
+ | S#state.queue]})
+ end;
+handle({From, {change_size, NewSize}}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ reply(From, {error, {read_only_mode, L#log.name}}, S);
+ L when L#log.status =:= ok ->
+ case check_size(L#log.type, NewSize) of
+ ok ->
+ case catch do_change_size(L, NewSize) of % does the put
+ ok ->
+ reply(From, ok, S);
+ {big, CurSize} ->
+ reply(From,
+ {error,
+ {new_size_too_small, L#log.name, CurSize}},
+ S);
+ Else ->
+ reply(From, Else, state_err(S, Else))
+ end;
+ not_ok ->
+ reply(From, {error, {badarg, size}}, S)
+ end;
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, {change_size, NewSize}}
+ | S#state.queue]})
+ end;
+handle({From, inc_wrap_file}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ reply(From, {error, {read_only_mode, L#log.name}}, S);
+ L when L#log.type =:= halt ->
+ reply(From, {error, {halt_log, L#log.name}}, S);
+ L when L#log.status =:= ok, S#state.cache_error =/= ok ->
+ loop(cache_error(S, [From]));
+ L when L#log.status =:= ok ->
+ case catch do_inc_wrap_file(L) of
+ {ok, L2, Lost} ->
+ put(log, L2),
+ notify_owners({wrap, Lost}),
+ reply(From, ok, S#state{cnt = S#state.cnt-Lost});
+ {error, Error, L2} ->
+ put(log, L2),
+ reply(From, Error, state_err(S, Error))
+ end;
+ L when L#log.status =:= {blocked, false} ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ L when L#log.blocked_by =:= From ->
+ reply(From, {error, {blocked_log, L#log.name}}, S);
+ _ ->
+ loop(S#state{queue = [{From, inc_wrap_file} | S#state.queue]})
+ end;
+handle({From, {reopen, NewFile, Head, F, A}}, S) ->
+ case get(log) of
+ L when L#log.mode =:= read_only ->
+ reply(From, {error, {read_only_mode, L#log.name}}, S);
+ L when L#log.status =:= ok, S#state.cache_error =/= ok ->
+ loop(cache_error(S, [From]));
+ L when L#log.status =:= ok, L#log.filename =/= NewFile ->
+ case catch close_disk_log2(L) of
+ closed ->
+ File = L#log.filename,
+ case catch rename_file(File, NewFile, L#log.type) of
+ ok ->
+ H = merge_head(Head, L#log.head),
+ case do_open((S#state.args)#arg{name = L#log.name,
+ repair = truncate,
+ head = H,
+ file = File}) of
+ {ok, Res, L2, Cnt} ->
+ put(log, L2#log{owners = L#log.owners,
+ head = L#log.head,
+ users = L#log.users}),
+ notify_owners({truncated, S#state.cnt}),
+ erase(is_full),
+ case Res of
+ {error, _} ->
+ do_exit(S, From, Res,
+ ?failure(Res, F, A));
+ _ ->
+ reply(From, ok, S#state{cnt = Cnt})
+ end;
+ Res ->
+ do_exit(S, From, Res, ?failure(Res, F, A))
+ end;
+ Error ->
+ do_exit(S, From, Error, ?failure(Error, reopen, 2))
+ end;
+ Error ->
+ do_exit(S, From, Error, ?failure(Error, F, A))
+ end;
+ L when L#log.status =:= ok ->
+ reply(From, {error, {same_file_name, L#log.name}}, S);
+ L ->
+ reply(From, {error, {blocked_log, L#log.name}}, S)
+ end;
+handle({Server, {internal_open, A}}, S) ->
+ case get(log) of
+ undefined ->
+ case do_open(A) of % does the put
+ {ok, Res, L, Cnt} ->
+ put(log, opening_pid(A#arg.linkto, A#arg.notify, L)),
+ reply(Server, Res, S#state{args=A, cnt=Cnt});
+ Res ->
+ do_fast_exit(S, Server, Res)
+ end;
+ L ->
+ TestH = mk_head(A#arg.head, A#arg.format),
+ case compare_arg(A#arg.options, S#state.args, TestH, L#log.head) of
+ ok ->
+ case add_pid(A#arg.linkto, A#arg.notify, L) of
+ {ok, L1} ->
+ put(log, L1),
+ reply(Server, {ok, L#log.name}, S);
+ Error ->
+ reply(Server, Error, S)
+ end;
+ Error ->
+ reply(Server, Error, S)
+ end
+ end;
+handle({From, close}, S) ->
+ case do_close(From, S) of
+ {stop, S1} ->
+ do_exit(S1, From, ok, normal);
+ {continue, S1} ->
+ reply(From, ok, S1)
+ end;
+handle({From, info}, S) ->
+ reply(From, do_info(get(log), S#state.cnt), S);
+handle({'EXIT', From, Reason}, S) when From =:= S#state.parent ->
+ %% Parent orders shutdown.
+ _ = do_stop(S),
+ exit(Reason);
+handle({'EXIT', From, Reason}, S) when From =:= S#state.server ->
+ %% The server is gone.
+ _ = do_stop(S),
+ exit(Reason);
+handle({'EXIT', From, _Reason}, S) ->
+ L = get(log),
+ case is_owner(From, L) of
+ {true, _Notify} ->
+ case close_owner(From, L, S) of
+ {stop, S1} ->
+ _ = do_stop(S1),
+ exit(normal);
+ {continue, S1} ->
+ loop(S1)
+ end;
+ false ->
+ %% 'users' is not decremented.
+ S1 = do_unblock(From, get(log), S),
+ loop(S1)
+ end;
+handle({system, From, Req}, S) ->
+ sys:handle_system_msg(Req, From, S#state.parent, ?MODULE, [], S);
+handle(_, S) ->
+ loop(S).
+
+sync_loop(From, S) ->
+ log_loop(S, [], [], From).
+
+%% Inlined.
+log_loop(S, Pids, _Bins, _Sync) when S#state.cache_error =/= ok ->
+ loop(cache_error(S, Pids));
+log_loop(S, Pids, Bins, Sync) when S#state.messages =:= [] ->
+ receive
+ Message ->
+ log_loop(Message, Pids, Bins, Sync, S, get(log))
+ after 0 ->
+ loop(log_end(S, Pids, Bins, Sync))
+ end;
+log_loop(S, Pids, Bins, Sync) ->
+ [M | Ms] = S#state.messages,
+ S1 = S#state{messages = Ms},
+ log_loop(M, Pids, Bins, Sync, S1, get(log)).
+
+%% Items logged after the last sync request found are sync:ed as well.
+log_loop({alog,B}, Pids, Bins, Sync, S, L) when L#log.format =:= internal ->
+ %% {alog, _} allowed for the internal format only.
+ log_loop(S, Pids, [B | Bins], Sync);
+log_loop({balog, B}, Pids, Bins, Sync, S, _L) ->
+ log_loop(S, Pids, [B | Bins], Sync);
+log_loop({From, {log, B}}, Pids, Bins, Sync, S, L)
+ when L#log.format =:= internal ->
+ %% {log, _} allowed for the internal format only.
+ log_loop(S, [From | Pids], [B | Bins], Sync);
+log_loop({From, {blog, B}}, Pids, Bins, Sync, S, _L) ->
+ log_loop(S, [From | Pids], [B | Bins], Sync);
+log_loop({From, sync}, Pids, Bins, Sync, S, _L) ->
+ log_loop(S, Pids, Bins, [From | Sync]);
+log_loop(Message, Pids, Bins, Sync, S, _L) ->
+ NS = log_end(S, Pids, Bins, Sync),
+ handle(Message, NS).
+
+log_end(S, [], [], Sync) ->
+ log_end_sync(S, Sync);
+log_end(S, Pids, Bins, Sync) ->
+ case do_log(get(log), rflat(Bins)) of
+ N when is_integer(N) ->
+ replies(Pids, ok),
+ S1 = (state_ok(S))#state{cnt = S#state.cnt+N},
+ log_end_sync(S1, Sync);
+ {error, {error, {full, _Name}}, N} when Pids =:= [] ->
+ log_end_sync(state_ok(S#state{cnt = S#state.cnt + N}), Sync);
+ {error, Error, N} ->
+ replies(Pids, Error),
+ state_err(S#state{cnt = S#state.cnt + N}, Error)
+ end.
+
+%% Inlined.
+log_end_sync(S, []) ->
+ S;
+log_end_sync(S, Sync) ->
+ Res = do_sync(get(log)),
+ replies(Sync, Res),
+ state_err(S, Res).
+
+%% Inlined.
+rflat([B]=L) when is_binary(B) -> L;
+rflat([B]) -> B;
+rflat(B) -> rflat(B, []).
+
+rflat([B | Bs], L) when is_binary(B) ->
+ rflat(Bs, [B | L]);
+rflat([B | Bs], L) ->
+ rflat(Bs, B ++ L);
+rflat([], L) -> L.
+
+%% -> {ok, Log} | {error, Error}
+do_change_notify(L, Pid, Notify) ->
+ case is_owner(Pid, L) of
+ {true, Notify} ->
+ {ok, L};
+ {true, _OldNotify} when Notify =/= true, Notify =/= false ->
+ {error, {badarg, notify}};
+ {true, _OldNotify} ->
+ Owners = lists:keydelete(Pid, 1, L#log.owners),
+ L1 = L#log{owners = [{Pid, Notify} | Owners]},
+ {ok, L1};
+ false ->
+ {error, {not_owner, Pid}}
+ end.
+
+%% -> {stop, S} | {continue, S}
+do_close(Pid, S) ->
+ L = get(log),
+ case is_owner(Pid, L) of
+ {true, _Notify} ->
+ close_owner(Pid, L, S);
+ false ->
+ close_user(Pid, L, S)
+ end.
+
+%% -> {stop, S} | {continue, S}
+close_owner(Pid, L, S) ->
+ L1 = L#log{owners = lists:keydelete(Pid, 1, L#log.owners)},
+ put(log, L1),
+ S2 = do_unblock(Pid, get(log), S),
+ unlink(Pid),
+ do_close2(L1, S2).
+
+%% -> {stop, S} | {continue, S}
+close_user(Pid, L, S) when L#log.users > 0 ->
+ L1 = L#log{users = L#log.users - 1},
+ put(log, L1),
+ S2 = do_unblock(Pid, get(log), S),
+ do_close2(L1, S2);
+close_user(_Pid, _L, S) ->
+ {continue, S}.
+
+do_close2(L, S) when L#log.users =:= 0, L#log.owners =:= [] ->
+ {stop, S};
+do_close2(_L, S) ->
+ {continue, S}.
+
+%%-----------------------------------------------------------------
+%% Callback functions for system messages handling.
+%%-----------------------------------------------------------------
+system_continue(_Parent, _, State) ->
+ loop(State).
+
+-spec system_terminate(_, _, _, #state{}) -> no_return().
+system_terminate(Reason, _Parent, _, State) ->
+ _ = do_stop(State),
+ exit(Reason).
+
+%%-----------------------------------------------------------------
+%% Temporay code for upgrade.
+%%-----------------------------------------------------------------
+system_code_change(State, _Module, _OldVsn, _Extra) ->
+ {ok, State}.
+
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+-spec do_exit(#state{}, pid(), _, _) -> no_return().
+do_exit(S, From, Message0, Reason) ->
+ R = do_stop(S),
+ Message = case S#state.cache_error of
+ Err when Err =/= ok -> Err;
+ _ when R =:= closed -> Message0;
+ _ when Message0 =:= ok -> R;
+ _ -> Message0
+ end,
+ _ = disk_log_server:close(self()),
+ replies(From, Message),
+ ?PROFILE(ep:done()),
+ exit(Reason).
+
+-spec do_fast_exit(#state{}, pid(), _) -> no_return().
+do_fast_exit(S, Server, Message) ->
+ _ = do_stop(S),
+ Server ! {disk_log, self(), Message},
+ exit(normal).
+
+%% -> closed | Error
+do_stop(S) ->
+ proc_q(S#state.queue ++ S#state.messages),
+ close_disk_log(get(log)).
+
+proc_q([{From, _R}|Tail]) when is_pid(From) ->
+ From ! {disk_log, self(), {error, disk_log_stopped}},
+ proc_q(Tail);
+proc_q([_|T]) -> %% async stuff
+ proc_q(T);
+proc_q([]) ->
+ ok.
+
+%% -> log()
+opening_pid(Pid, Notify, L) ->
+ {ok, L1} = add_pid(Pid, Notify, L),
+ L1.
+
+%% -> {ok, log()} | Error
+add_pid(Pid, Notify, L) when is_pid(Pid) ->
+ case is_owner(Pid, L) of
+ false ->
+ link(Pid),
+ {ok, L#log{owners = [{Pid, Notify} | L#log.owners]}};
+ {true, Notify} ->
+%% {error, {pid_already_connected, L#log.name}};
+ {ok, L};
+ {true, CurNotify} when Notify =/= CurNotify ->
+ {error, {arg_mismatch, notify, CurNotify, Notify}}
+ end;
+add_pid(_NotAPid, _Notify, L) ->
+ {ok, L#log{users = L#log.users + 1}}.
+
+unblock_pid(L) when L#log.blocked_by =:= none ->
+ ok;
+unblock_pid(L) ->
+ case is_owner(L#log.blocked_by, L) of
+ {true, _Notify} ->
+ ok;
+ false ->
+ unlink(L#log.blocked_by)
+ end.
+
+%% -> true | false
+is_owner(Pid, L) ->
+ case lists:keysearch(Pid, 1, L#log.owners) of
+ {value, {_Pid, Notify}} ->
+ {true, Notify};
+ false ->
+ false
+ end.
+
+%% ok | throw(Error)
+rename_file(File, NewFile, halt) ->
+ file:rename(File, NewFile);
+rename_file(File, NewFile, wrap) ->
+ rename_file(wrap_file_extensions(File), File, NewFile, ok).
+
+rename_file([Ext|Exts], File, NewFile, Res) ->
+ NRes = case file:rename(add_ext(File, Ext), add_ext(NewFile, Ext)) of
+ ok ->
+ Res;
+ Else ->
+ Else
+ end,
+ rename_file(Exts, File, NewFile, NRes);
+rename_file([], _File, _NewFiles, Res) -> Res.
+
+%% "Old" error messages have been kept, arg_mismatch has been added.
+%%-spec compare_arg(dlog_options(), #arg{},
+compare_arg([], _A, none, _OrigHead) ->
+ % no header option given
+ ok;
+compare_arg([], _A, Head, OrigHead) when Head =/= OrigHead ->
+ {error, {arg_mismatch, head, OrigHead, Head}};
+compare_arg([], _A, _Head, _OrigHead) ->
+ ok;
+compare_arg([{Attr, Val} | Tail], A, Head, OrigHead) ->
+ case compare_arg(Attr, Val, A) of
+ {not_ok, OrigVal} ->
+ {error, {arg_mismatch, Attr, OrigVal, Val}};
+ ok ->
+ compare_arg(Tail, A, Head, OrigHead);
+ Error ->
+ Error
+ end.
+
+-spec compare_arg(atom(), _, #arg{}) ->
+ 'ok' | {'not_ok', _} | {'error', {atom(), _}}.
+compare_arg(file, F, A) when F =/= A#arg.file ->
+ {error, {name_already_open, A#arg.name}};
+compare_arg(mode, read_only, A) when A#arg.mode =:= read_write ->
+ {error, {open_read_write, A#arg.name}};
+compare_arg(mode, read_write, A) when A#arg.mode =:= read_only ->
+ {error, {open_read_only, A#arg.name}};
+compare_arg(type, T, A) when T =/= A#arg.type ->
+ {not_ok, A#arg.type};
+compare_arg(format, F, A) when F =/= A#arg.format ->
+ {not_ok, A#arg.format};
+compare_arg(repair, R, A) when R =/= A#arg.repair ->
+ %% not used, but check it anyway...
+ {not_ok, A#arg.repair};
+compare_arg(_Attr, _Val, _A) ->
+ ok.
+
+%% -> {ok, Res, log(), Cnt} | Error
+do_open(A) ->
+ L = #log{name = A#arg.name,
+ filename = A#arg.file,
+ size = A#arg.size,
+ head = mk_head(A#arg.head, A#arg.format),
+ mode = A#arg.mode,
+ version = A#arg.version},
+ do_open2(L, A).
+
+mk_head({head, Term}, internal) -> {ok, term_to_binary(Term)};
+mk_head({head, Bytes}, external) -> {ok, check_bytes(Bytes)};
+mk_head(H, _) -> H.
+
+terms2bins([T | Ts]) ->
+ [term_to_binary(T) | terms2bins(Ts)];
+terms2bins([]) ->
+ [].
+
+check_bytes_list([B | Bs], Bs0) when is_binary(B) ->
+ check_bytes_list(Bs, Bs0);
+check_bytes_list([], Bs0) ->
+ Bs0;
+check_bytes_list(_, Bs0) ->
+ check_bytes_list(Bs0).
+
+check_bytes_list([B | Bs]) when is_binary(B) ->
+ [B | check_bytes_list(Bs)];
+check_bytes_list([B | Bs]) ->
+ [list_to_binary(B) | check_bytes_list(Bs)];
+check_bytes_list([]) ->
+ [].
+
+check_bytes(Binary) when is_binary(Binary) ->
+ Binary;
+check_bytes(Bytes) ->
+ list_to_binary(Bytes).
+
+%%-----------------------------------------------------------------
+%% Change size of the logs in runtime.
+%%-----------------------------------------------------------------
+%% -> ok | {big, CurSize} | throw(Error)
+do_change_size(L, NewSize) when L#log.type =:= halt ->
+ Halt = L#log.extra,
+ CurB = Halt#halt.curB,
+ NewLog = L#log{extra = Halt#halt{size = NewSize}},
+ if
+ NewSize =:= infinity ->
+ erase(is_full),
+ put(log, NewLog),
+ ok;
+ CurB =< NewSize ->
+ erase(is_full),
+ put(log, NewLog),
+ ok;
+ true ->
+ {big, CurB}
+ end;
+do_change_size(L, NewSize) when L#log.type =:= wrap ->
+ #log{extra = Extra, version = Version} = L,
+ {ok, Handle} = disk_log_1:change_size_wrap(Extra, NewSize, Version),
+ erase(is_full),
+ put(log, L#log{extra = Handle}),
+ ok.
+
+%% -> {ok, Head} | Error; Head = none | {head, H} | {M,F,A}
+check_head({head, none}, _Format) ->
+ {ok, none};
+check_head({head_func, {M, F, A}}, _Format) when is_atom(M),
+ is_atom(F),
+ is_list(A) ->
+ {ok, {M, F, A}};
+check_head({head, Head}, external) ->
+ case catch check_bytes(Head) of
+ {'EXIT', _} ->
+ {error, {badarg, head}};
+ _ ->
+ {ok, {head, Head}}
+ end;
+check_head({head, Term}, internal) ->
+ {ok, {head, Term}};
+check_head(_Head, _Format) ->
+ {error, {badarg, head}}.
+
+check_size(wrap, {NewMaxB,NewMaxF}) when
+ is_integer(NewMaxB), is_integer(NewMaxF),
+ NewMaxB > 0, NewMaxB =< ?MAX_BYTES, NewMaxF > 0, NewMaxF < ?MAX_FILES ->
+ ok;
+check_size(halt, NewSize) when is_integer(NewSize), NewSize > 0 ->
+ ok;
+check_size(halt, infinity) ->
+ ok;
+check_size(_, _) ->
+ not_ok.
+
+%%-----------------------------------------------------------------
+%% Increment a wrap log.
+%%-----------------------------------------------------------------
+%% -> {ok, log(), Lost} | {error, Error, log()}
+do_inc_wrap_file(L) ->
+ #log{format = Format, extra = Handle} = L,
+ case Format of
+ internal ->
+ case disk_log_1:mf_int_inc(Handle, L#log.head) of
+ {ok, Handle2, Lost} ->
+ {ok, L#log{extra = Handle2}, Lost};
+ {error, Error, Handle2} ->
+ {error, Error, L#log{extra = Handle2}}
+ end;
+ external ->
+ case disk_log_1:mf_ext_inc(Handle, L#log.head) of
+ {ok, Handle2, Lost} ->
+ {ok, L#log{extra = Handle2}, Lost};
+ {error, Error, Handle2} ->
+ {error, Error, L#log{extra = Handle2}}
+ end
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Open a log file.
+%%-----------------------------------------------------------------
+%% -> {ok, Reply, log(), Cnt} | Error
+%% Note: the header is always written, even if the log size is too small.
+do_open2(L, #arg{type = halt, format = internal, name = Name,
+ file = FName, repair = Repair, size = Size, mode = Mode}) ->
+ case catch disk_log_1:int_open(FName, Repair, Mode, L#log.head) of
+ {ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} ->
+ Halt = #halt{fdc = FdC, curB = FileSize, size = Size},
+ {ok, {ok, Name}, L#log{format_type = halt_int, extra = Halt},
+ NoItems};
+ {repaired, FdC, Rec, Bad, FileSize} ->
+ Halt = #halt{fdc = FdC, curB = FileSize, size = Size},
+ {ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}},
+ L#log{format_type = halt_int, extra = Halt},
+ Rec};
+ Error ->
+ Error
+ end;
+do_open2(L, #arg{type = wrap, format = internal, size = {MaxB, MaxF},
+ name = Name, repair = Repair, file = FName, mode = Mode,
+ version = V}) ->
+ case catch
+ disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of
+ {ok, Handle, Cnt} ->
+ {ok, {ok, Name}, L#log{type = wrap,
+ format_type = wrap_int,
+ extra = Handle}, Cnt};
+ {repaired, Handle, Rec, Bad, Cnt} ->
+ {ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}},
+ L#log{type = wrap, format_type = wrap_int, extra = Handle}, Cnt};
+ Error ->
+ Error
+ end;
+do_open2(L, #arg{type = halt, format = external, file = FName, name = Name,
+ size = Size, repair = Repair, mode = Mode}) ->
+ case catch disk_log_1:ext_open(FName, Repair, Mode, L#log.head) of
+ {ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} ->
+ Halt = #halt{fdc = FdC, curB = FileSize, size = Size},
+ {ok, {ok, Name},
+ L#log{format_type = halt_ext, format = external, extra = Halt},
+ NoItems};
+ Error ->
+ Error
+ end;
+do_open2(L, #arg{type = wrap, format = external, size = {MaxB, MaxF},
+ name = Name, file = FName, repair = Repair, mode = Mode,
+ version = V}) ->
+ case catch
+ disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of
+ {ok, Handle, Cnt} ->
+ {ok, {ok, Name}, L#log{type = wrap,
+ format_type = wrap_ext,
+ extra = Handle,
+ format = external}, Cnt};
+ Error ->
+ Error
+ end.
+
+%% -> closed | Error
+close_disk_log(undefined) ->
+ closed;
+close_disk_log(L) ->
+ unblock_pid(L),
+ F = fun({Pid, _}) ->
+ unlink(Pid)
+ end,
+ lists:foreach(F, L#log.owners),
+ R = (catch close_disk_log2(L)),
+ erase(log),
+ R.
+
+-spec close_disk_log2(#log{}) -> 'closed'. % | throw(Error)
+
+close_disk_log2(L) ->
+ case L of
+ #log{format_type = halt_int, mode = Mode, extra = Halt} ->
+ disk_log_1:close(Halt#halt.fdc, L#log.filename, Mode);
+ #log{format_type = wrap_int, mode = Mode, extra = Handle} ->
+ disk_log_1:mf_int_close(Handle, Mode);
+ #log{format_type = halt_ext, extra = Halt} ->
+ disk_log_1:fclose(Halt#halt.fdc, L#log.filename);
+ #log{format_type = wrap_ext, mode = Mode, extra = Handle} ->
+ disk_log_1:mf_ext_close(Handle, Mode)
+ end,
+ closed.
+
+do_format_error({error, Module, Error}) ->
+ Module:format_error(Error);
+do_format_error({error, Reason}) ->
+ do_format_error(Reason);
+do_format_error({Node, Error = {error, _Reason}}) ->
+ lists:append(io_lib:format("~p: ", [Node]), do_format_error(Error));
+do_format_error({badarg, Arg}) ->
+ io_lib:format("The argument ~p is missing, not recognized or "
+ "not wellformed~n", [Arg]);
+do_format_error({size_mismatch, OldSize, ArgSize}) ->
+ io_lib:format("The given size ~p does not match the size ~p found on "
+ "the disk log size file~n", [ArgSize, OldSize]);
+do_format_error({read_only_mode, Log}) ->
+ io_lib:format("The disk log ~p has been opened read-only, but the "
+ "requested operation needs read-write access~n", [Log]);
+do_format_error({format_external, Log}) ->
+ io_lib:format("The requested operation can only be applied on internally "
+ "formatted disk logs, but ~p is externally formatted~n",
+ [Log]);
+do_format_error({blocked_log, Log}) ->
+ io_lib:format("The blocked disk log ~p does not queue requests, or "
+ "the log has been blocked by the calling process~n", [Log]);
+do_format_error({full, Log}) ->
+ io_lib:format("The halt log ~p is full~n", [Log]);
+do_format_error({not_blocked, Log}) ->
+ io_lib:format("The disk log ~p is not blocked~n", [Log]);
+do_format_error({not_owner, Pid}) ->
+ io_lib:format("The pid ~p is not an owner of the disk log~n", [Pid]);
+do_format_error({not_blocked_by_pid, Log}) ->
+ io_lib:format("The disk log ~p is blocked, but only the blocking pid "
+ "can unblock a disk log~n", [Log]);
+do_format_error({new_size_too_small, Log, CurrentSize}) ->
+ io_lib:format("The current size ~p of the halt log ~p is greater than the "
+ "requested new size~n", [CurrentSize, Log]);
+do_format_error({halt_log, Log}) ->
+ io_lib:format("The halt log ~p cannot be wrapped~n", [Log]);
+do_format_error({same_file_name, Log}) ->
+ io_lib:format("Current and new file name of the disk log ~p "
+ "are the same~n", [Log]);
+do_format_error({arg_mismatch, Option, FirstValue, ArgValue}) ->
+ io_lib:format("The value ~p of the disk log option ~p does not match "
+ "the current value ~p~n", [ArgValue, Option, FirstValue]);
+do_format_error({name_already_open, Log}) ->
+ io_lib:format("The disk log ~p has already opened another file~n", [Log]);
+do_format_error({node_already_open, Log}) ->
+ io_lib:format("The distribution option of the disk log ~p does not match "
+ "already open log~n", [Log]);
+do_format_error({open_read_write, Log}) ->
+ io_lib:format("The disk log ~p has already been opened read-write~n",
+ [Log]);
+do_format_error({open_read_only, Log}) ->
+ io_lib:format("The disk log ~p has already been opened read-only~n",
+ [Log]);
+do_format_error({not_internal_wrap, Log}) ->
+ io_lib:format("The requested operation cannot be applied since ~p is not "
+ "an internally formatted disk log~n", [Log]);
+do_format_error(no_such_log) ->
+ io_lib:format("There is no disk log with the given name~n", []);
+do_format_error(nonode) ->
+ io_lib:format("There seems to be no node up that can handle "
+ "the request~n", []);
+do_format_error(nodedown) ->
+ io_lib:format("There seems to be no node up that can handle "
+ "the request~n", []);
+do_format_error({corrupt_log_file, FileName}) ->
+ io_lib:format("The disk log file \"~s\" contains corrupt data~n",
+ [FileName]);
+do_format_error({need_repair, FileName}) ->
+ io_lib:format("The disk log file \"~s\" has not been closed properly and "
+ "needs repair~n", [FileName]);
+do_format_error({not_a_log_file, FileName}) ->
+ io_lib:format("The file \"~s\" is not a wrap log file~n", [FileName]);
+do_format_error({invalid_header, InvalidHeader}) ->
+ io_lib:format("The disk log header is not wellformed: ~p~n",
+ [InvalidHeader]);
+do_format_error(end_of_log) ->
+ io_lib:format("An attempt was made to step outside a not yet "
+ "full wrap log~n", []);
+do_format_error({invalid_index_file, FileName}) ->
+ io_lib:format("The wrap log index file \"~s\" cannot be used~n",
+ [FileName]);
+do_format_error({no_continuation, BadCont}) ->
+ io_lib:format("The term ~p is not a chunk continuation~n", [BadCont]);
+do_format_error({file_error, FileName, Reason}) ->
+ io_lib:format("\"~s\": ~p~n", [FileName, file:format_error(Reason)]);
+do_format_error(E) ->
+ io_lib:format("~p~n", [E]).
+
+do_info(L, Cnt) ->
+ #log{name = Name, type = Type, mode = Mode, filename = File,
+ extra = Extra, status = Status, owners = Owners, users = Users,
+ format = Format, head = Head} = L,
+ Size = case Type of
+ wrap ->
+ disk_log_1:get_wrap_size(Extra);
+ halt ->
+ Extra#halt.size
+ end,
+ Distribution =
+ case disk_log_server:get_log_pids(Name) of
+ {local, _Pid} ->
+ local;
+ {distributed, Pids} ->
+ [node(P) || P <- Pids];
+ undefined -> % "cannot happen"
+ []
+ end,
+ RW = case Type of
+ wrap when Mode =:= read_write ->
+ #handle{curB = CurB, curF = CurF,
+ cur_cnt = CurCnt, acc_cnt = AccCnt,
+ noFull = NoFull, accFull = AccFull} = Extra,
+ NewAccFull = AccFull + NoFull,
+ NewExtra = Extra#handle{noFull = 0, accFull = NewAccFull},
+ put(log, L#log{extra = NewExtra}),
+ [{no_current_bytes, CurB},
+ {no_current_items, CurCnt},
+ {no_items, Cnt},
+ {no_written_items, CurCnt + AccCnt},
+ {current_file, CurF},
+ {no_overflows, {NewAccFull, NoFull}}
+ ];
+ halt when Mode =:= read_write ->
+ IsFull = case get(is_full) of
+ undefined -> false;
+ _ -> true
+ end,
+ [{full, IsFull},
+ {no_written_items, Cnt}
+ ];
+ _ when Mode =:= read_only ->
+ []
+ end,
+ HeadL = case Mode of
+ read_write ->
+ [{head, Head}];
+ read_only ->
+ []
+ end,
+ Common = [{name, Name},
+ {file, File},
+ {type, Type},
+ {format, Format},
+ {size, Size},
+ {items, Cnt}, % kept for "backward compatibility" (undocumented)
+ {owners, Owners},
+ {users, Users}] ++
+ HeadL ++
+ [{mode, Mode},
+ {status, Status},
+ {node, node()},
+ {distributed, Distribution}
+ ],
+ Common ++ RW.
+
+do_block(Pid, QueueLogRecs, L) ->
+ L2 = L#log{status = {blocked, QueueLogRecs}, blocked_by = Pid},
+ put(log, L2),
+ case is_owner(Pid, L2) of
+ {true, _Notify} ->
+ ok;
+ false ->
+ link(Pid)
+ end.
+
+do_unblock(Pid, L, S) when L#log.blocked_by =:= Pid ->
+ do_unblock(L, S);
+do_unblock(_Pid, _L, S) ->
+ S.
+
+do_unblock(L, S) ->
+ unblock_pid(L),
+ L2 = L#log{blocked_by = none, status = ok},
+ put(log, L2),
+ %% Since the block request is synchronous, and the blocking
+ %% process is the only process that can unblock, all requests in
+ %% 'messages' will have been put in 'queue' before the unblock
+ %% request is granted.
+ [] = S#state.messages, % assertion
+ S#state{queue = [], messages = lists:reverse(S#state.queue)}.
+
+-spec do_log(#log{}, [binary()]) -> integer() | {'error', _, integer()}.
+
+do_log(L, B) when L#log.type =:= halt ->
+ #log{format = Format, extra = Halt} = L,
+ #halt{curB = CurSize, size = Sz} = Halt,
+ {Bs, BSize} = bsize(B, Format),
+ case get(is_full) of
+ true ->
+ {error, {error, {full, L#log.name}}, 0};
+ undefined when Sz =:= infinity; CurSize + BSize =< Sz ->
+ halt_write(Halt, L, B, Bs, BSize);
+ undefined ->
+ halt_write_full(L, B, Format, 0)
+ end;
+do_log(L, B) when L#log.format_type =:= wrap_int ->
+ case disk_log_1:mf_int_log(L#log.extra, B, L#log.head) of
+ {ok, Handle, Logged, Lost, Wraps} ->
+ notify_owners_wrap(Wraps),
+ put(log, L#log{extra = Handle}),
+ Logged - Lost;
+ {ok, Handle, Logged} ->
+ put(log, L#log{extra = Handle}),
+ Logged;
+ {error, Error, Handle, Logged, Lost} ->
+ put(log, L#log{extra = Handle}),
+ {error, Error, Logged - Lost}
+ end;
+do_log(L, B) when L#log.format_type =:= wrap_ext ->
+ case disk_log_1:mf_ext_log(L#log.extra, B, L#log.head) of
+ {ok, Handle, Logged, Lost, Wraps} ->
+ notify_owners_wrap(Wraps),
+ put(log, L#log{extra = Handle}),
+ Logged - Lost;
+ {ok, Handle, Logged} ->
+ put(log, L#log{extra = Handle}),
+ Logged;
+ {error, Error, Handle, Logged, Lost} ->
+ put(log, L#log{extra = Handle}),
+ {error, Error, Logged - Lost}
+ end.
+
+bsize(B, external) ->
+ {B, xsz(B, 0)};
+bsize(B, internal) ->
+ disk_log_1:logl(B).
+
+xsz([B|T], Sz) -> xsz(T, byte_size(B) + Sz);
+xsz([], Sz) -> Sz.
+
+halt_write_full(L, [Bin | Bins], Format, N) ->
+ B = [Bin],
+ {Bs, BSize} = bsize(B, Format),
+ Halt = L#log.extra,
+ #halt{curB = CurSize, size = Sz} = Halt,
+ if
+ CurSize + BSize =< Sz ->
+ case halt_write(Halt, L, B, Bs, BSize) of
+ N1 when is_integer(N1) ->
+ halt_write_full(get(log), Bins, Format, N+N1);
+ Error ->
+ Error
+ end;
+ true ->
+ halt_write_full(L, [], Format, N)
+ end;
+halt_write_full(L, _Bs, _Format, N) ->
+ put(is_full, true),
+ notify_owners(full),
+ {error, {error, {full, L#log.name}}, N}.
+
+halt_write(Halt, L, B, Bs, BSize) ->
+ case disk_log_1:fwrite(Halt#halt.fdc, L#log.filename, Bs, BSize) of
+ {ok, NewFdC} ->
+ NCurB = Halt#halt.curB + BSize,
+ NewHalt = Halt#halt{fdc = NewFdC, curB = NCurB},
+ put(log, L#log{extra = NewHalt}),
+ length(B);
+ {Error, NewFdC} ->
+ put(log, L#log{extra = Halt#halt{fdc = NewFdC}}),
+ {error, Error, 0}
+ end.
+
+%% -> ok | Error
+do_write_cache(#log{filename = FName, type = halt, extra = Halt} = Log) ->
+ {Reply, NewFdC} = disk_log_1:write_cache(Halt#halt.fdc, FName),
+ put(log, Log#log{extra = Halt#halt{fdc = NewFdC}}),
+ Reply;
+do_write_cache(#log{type = wrap, extra = Handle} = Log) ->
+ {Reply, NewHandle} = disk_log_1:mf_write_cache(Handle),
+ put(log, Log#log{extra = NewHandle}),
+ Reply.
+
+%% -> ok | Error
+do_sync(#log{filename = FName, type = halt, extra = Halt} = Log) ->
+ {Reply, NewFdC} = disk_log_1:sync(Halt#halt.fdc, FName),
+ put(log, Log#log{extra = Halt#halt{fdc = NewFdC}}),
+ Reply;
+do_sync(#log{type = wrap, extra = Handle} = Log) ->
+ {Reply, NewHandle} = disk_log_1:mf_sync(Handle),
+ put(log, Log#log{extra = NewHandle}),
+ Reply.
+
+%% -> ok | Error | throw(Error)
+do_trunc(L, Head) when L#log.type =:= halt ->
+ #log{filename = FName, extra = Halt} = L,
+ FdC = Halt#halt.fdc,
+ {Reply1, FdC2} =
+ case L#log.format of
+ internal ->
+ disk_log_1:truncate(FdC, FName, Head);
+ external ->
+ case disk_log_1:truncate_at(FdC, FName, bof) of
+ {ok, NFdC} when Head =:= none ->
+ {ok, NFdC};
+ {ok, NFdC} ->
+ {ok, H} = Head,
+ disk_log_1:fwrite(NFdC, FName, H, byte_size(H));
+ R ->
+ R
+ end
+ end,
+ {Reply, NewHalt} =
+ case disk_log_1:position(FdC2, FName, cur) of
+ {ok, NewFdC, FileSize} when Reply1 =:= ok ->
+ {ok, Halt#halt{fdc = NewFdC, curB = FileSize}};
+ {Reply2, NewFdC} ->
+ {Reply2, Halt#halt{fdc = NewFdC}};
+ {ok, NewFdC, _} ->
+ {Reply1, Halt#halt{fdc = NewFdC}}
+ end,
+ put(log, L#log{extra = NewHalt}),
+ Reply;
+do_trunc(L, Head) when L#log.type =:= wrap ->
+ Handle = L#log.extra,
+ OldHead = L#log.head,
+ {MaxB, MaxF} = disk_log_1:get_wrap_size(Handle),
+ ok = do_change_size(L, {MaxB, 1}),
+ NewLog = trunc_wrap((get(log))#log{head = Head}),
+ %% Just to remove all files with suffix > 1:
+ NewLog2 = trunc_wrap(NewLog),
+ NewHandle = (NewLog2#log.extra)#handle{noFull = 0, accFull = 0},
+ do_change_size(NewLog2#log{extra = NewHandle, head = OldHead},
+ {MaxB, MaxF}).
+
+trunc_wrap(L) ->
+ case do_inc_wrap_file(L) of
+ {ok, L2, _Lost} ->
+ L2;
+ {error, Error, _L2} ->
+ throw(Error)
+ end.
+
+do_chunk(#log{format_type = halt_int, extra = Halt} = L, Pos, B, N) ->
+ FdC = Halt#halt.fdc,
+ {NewFdC, Reply} =
+ case L#log.mode of
+ read_only ->
+ disk_log_1:chunk_read_only(FdC, L#log.filename, Pos, B, N);
+ read_write ->
+ disk_log_1:chunk(FdC, L#log.filename, Pos, B, N)
+ end,
+ put(log, L#log{extra = Halt#halt{fdc = NewFdC}}),
+ Reply;
+do_chunk(#log{format_type = wrap_int, mode = read_only,
+ extra = Handle} = Log, Pos, B, N) ->
+ {NewHandle, Reply} = disk_log_1:mf_int_chunk_read_only(Handle, Pos, B, N),
+ put(log, Log#log{extra = NewHandle}),
+ Reply;
+do_chunk(#log{format_type = wrap_int, extra = Handle} = Log, Pos, B, N) ->
+ {NewHandle, Reply} = disk_log_1:mf_int_chunk(Handle, Pos, B, N),
+ put(log, Log#log{extra = NewHandle}),
+ Reply;
+do_chunk(Log, _Pos, _B, _) ->
+ {error, {format_external, Log#log.name}}.
+
+do_chunk_step(#log{format_type = wrap_int, extra = Handle}, Pos, N) ->
+ disk_log_1:mf_int_chunk_step(Handle, Pos, N);
+do_chunk_step(Log, _Pos, _N) ->
+ {error, {not_internal_wrap, Log#log.name}}.
+
+%% Inlined.
+replies(Pids, Reply) ->
+ M = {disk_log, self(), Reply},
+ send_reply(Pids, M).
+
+send_reply(Pid, M) when is_pid(Pid) ->
+ Pid ! M;
+send_reply([Pid | Pids], M) ->
+ Pid ! M,
+ send_reply(Pids, M);
+send_reply([], _M) ->
+ ok.
+
+reply(To, Reply, S) ->
+ To ! {disk_log, self(), Reply},
+ loop(S).
+
+req(Log, R) ->
+ case disk_log_server:get_log_pids(Log) of
+ {local, Pid} ->
+ monitor_request(Pid, R);
+ undefined ->
+ {error, no_such_log};
+ {distributed, Pids} ->
+ multi_req({self(), R}, Pids)
+ end.
+
+multi_req(Msg, Pids) ->
+ Refs =
+ lists:map(fun(Pid) ->
+ Ref = erlang:monitor(process, Pid),
+ Pid ! Msg,
+ {Pid, Ref}
+ end, Pids),
+ lists:foldl(fun({Pid, Ref}, Reply) ->
+ receive
+ {'DOWN', Ref, process, Pid, _Info} ->
+ Reply;
+ {disk_log, Pid, _Reply} ->
+ erlang:demonitor(Ref),
+ receive
+ {'DOWN', Ref, process, Pid, _Reason} ->
+ ok
+ after 0 ->
+ ok
+ end
+ end
+ end, {error, nonode}, Refs).
+
+sreq(Log, R) ->
+ case nearby_pid(Log, node()) of
+ undefined ->
+ {error, no_such_log};
+ Pid ->
+ monitor_request(Pid, R)
+ end.
+
+%% Local req - always talk to log on Node
+lreq(Log, R, Node) ->
+ case nearby_pid(Log, Node) of
+ Pid when is_pid(Pid), node(Pid) =:= Node ->
+ monitor_request(Pid, R);
+ _Else ->
+ {error, no_such_log}
+ end.
+
+nearby_pid(Log, Node) ->
+ case disk_log_server:get_log_pids(Log) of
+ undefined ->
+ undefined;
+ {local, Pid} ->
+ Pid;
+ {distributed, Pids} ->
+ get_near_pid(Pids, Node)
+ end.
+
+-spec get_near_pid([pid(),...], node()) -> pid().
+
+get_near_pid([Pid | _], Node) when node(Pid) =:= Node -> Pid;
+get_near_pid([Pid], _ ) -> Pid;
+get_near_pid([_ | T], Node) -> get_near_pid(T, Node).
+
+monitor_request(Pid, Req) ->
+ Ref = erlang:monitor(process, Pid),
+ Pid ! {self(), Req},
+ receive
+ {'DOWN', Ref, process, Pid, _Info} ->
+ {error, no_such_log};
+ {disk_log, Pid, Reply} ->
+ erlang:demonitor(Ref),
+ receive
+ {'DOWN', Ref, process, Pid, _Reason} ->
+ Reply
+ after 0 ->
+ Reply
+ end
+ end.
+
+req2(Pid, R) ->
+ monitor_request(Pid, R).
+
+merge_head(none, Head) ->
+ Head;
+merge_head(Head, _) ->
+ Head.
+
+%% -> List of extensions of existing files (no dot included) | throw(FileError)
+wrap_file_extensions(File) ->
+ {_CurF, _CurFSz, _TotSz, NoOfFiles} =
+ disk_log_1:read_index_file(File),
+ Fs = if
+ NoOfFiles >= 1 ->
+ lists:seq(1, NoOfFiles);
+ NoOfFiles =:= 0 ->
+ []
+ end,
+ Fun = fun(Ext) ->
+ case file:read_file_info(add_ext(File, Ext)) of
+ {ok, _} ->
+ true;
+ _Else ->
+ false
+ end
+ end,
+ lists:filter(Fun, ["idx", "siz" | Fs]).
+
+add_ext(File, Ext) ->
+ lists:concat([File, ".", Ext]).
+
+notify(Log, R) ->
+ case disk_log_server:get_log_pids(Log) of
+ undefined ->
+ {error, no_such_log};
+ {local, Pid} ->
+ Pid ! R,
+ ok;
+ {distributed, Pids} ->
+ lists:foreach(fun(Pid) -> Pid ! R end, Pids),
+ ok
+ end.
+
+notify_owners_wrap([]) ->
+ ok;
+notify_owners_wrap([N | Wraps]) ->
+ notify_owners({wrap, N}),
+ notify_owners_wrap(Wraps).
+
+notify_owners(Note) ->
+ L = get(log),
+ Msg = {disk_log, node(), L#log.name, Note},
+ lists:foreach(fun({Pid, true}) -> Pid ! Msg;
+ (_) -> ok
+ end, L#log.owners).
+
+cache_error(S, Pids) ->
+ Error = S#state.cache_error,
+ replies(Pids, Error),
+ state_err(S#state{cache_error = ok}, Error).
+
+state_ok(S) ->
+ state_err(S, ok).
+
+-spec state_err(#state{}, dlog_state_error()) -> #state{}.
+
+state_err(S, Err) when S#state.error_status =:= Err -> S;
+state_err(S, Err) ->
+ notify_owners({error_status, Err}),
+ S#state{error_status = Err}.
diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl
new file mode 100644
index 0000000000..b0849145ca
--- /dev/null
+++ b/lib/kernel/src/disk_log.hrl
@@ -0,0 +1,161 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-define(DISK_LOG_NAME_TABLE, disk_log_names).
+-define(DISK_LOG_PID_TABLE, disk_log_pids).
+
+%% File format version
+-define(VERSION, 2).
+
+%% HEADSZ is the size of the file header,
+%% HEADERSZ is the size of the item header ( = ?SIZESZ + ?MAGICSZ).
+-define(HEADSZ, 8).
+-define(SIZESZ, 4).
+-define(MAGICSZ, 4).
+-define(HEADERSZ, 8).
+-define(MAGICHEAD, <<12,33,44,55>>).
+-define(MAGICINT, 203500599). %% ?MAGICHEAD = <<?MAGICINT:32>>
+-define(BIGMAGICHEAD, <<98,87,76,65>>).
+-define(BIGMAGICINT, 1649888321). %% ?BIGMAGICHEAD = <<?BIGMAGICINT:32>>
+-define(MIN_MD5_TERM, 65528).% (?MAX_CHUNK_SIZE - ?HEADERSZ)
+
+-define(MAX_FILES, 65000).
+-define(MAX_BYTES, ((1 bsl 64) - 1)).
+-define(MAX_CHUNK_SIZE, 65536).
+
+%% Object defines
+-define(LOGMAGIC, <<1,2,3,4>>).
+-define(OPENED, <<6,7,8,9>>).
+-define(CLOSED, <<99,88,77,11>>).
+
+%% Needed for the definition of fd()
+%% Must use include_lib() so that we always can be sure to find
+%% file.hrl. A relative path will not work in an installed system.
+-include_lib("kernel/include/file.hrl").
+
+%% Ugly workaround. If we are building the bootstrap compiler,
+%% file.hrl does not define the fd() type.
+-ifndef(FILE_HRL_).
+-type fd() :: pid() | #file_descriptor{}.
+-endif.
+
+%%------------------------------------------------------------------------
+%% Types -- alphabetically
+%%------------------------------------------------------------------------
+
+-type dlog_format() :: 'external' | 'internal'.
+-type dlog_format_type() :: 'halt_ext' | 'halt_int' | 'wrap_ext' | 'wrap_int'.
+-type dlog_head() :: 'none' | {'ok', binary()} | mfa().
+-type dlog_mode() :: 'read_only' | 'read_write'.
+-type dlog_name() :: atom() | string().
+-type dlog_optattr() :: 'name' | 'file' | 'linkto' | 'repair' | 'type'
+ | 'format' | 'size' | 'distributed' | 'notify'
+ | 'head' | 'head_func' | 'mode'.
+-type dlog_options() :: [{dlog_optattr(), any()}].
+-type dlog_repair() :: 'truncate' | boolean().
+-type dlog_size() :: 'infinity' | pos_integer()
+ | {pos_integer(), pos_integer()}.
+-type dlog_status() :: 'ok' | {'blocked', 'false' | [_]}. %QueueLogRecords
+-type dlog_type() :: 'halt' | 'wrap'.
+
+%%------------------------------------------------------------------------
+%% Records
+%%------------------------------------------------------------------------
+
+%% record of args for open
+-record(arg, {name = 0,
+ version = undefined,
+ file = none :: 'none' | string(),
+ repair = true :: dlog_repair(),
+ size = infinity :: dlog_size(),
+ type = halt :: dlog_type(),
+ distributed = false :: 'false' | {'true', [node()]},
+ format = internal :: dlog_format(),
+ linkto = self() :: 'none' | pid(),
+ head = none,
+ mode = read_write :: dlog_mode(),
+ notify = false :: boolean(),
+ options = [] :: dlog_options()}).
+
+-record(cache, %% Cache for logged terms (per file descriptor).
+ {fd :: fd(), %% File descriptor.
+ sz = 0 :: non_neg_integer(), %% Number of bytes in the cache.
+ c = [] :: iodata()} %% The cache.
+ ).
+
+-record(halt, %% For a halt log.
+ {fdc :: #cache{}, %% A cache record.
+ curB :: non_neg_integer(), %% Number of bytes on the file.
+ size :: dlog_size()}
+ ).
+
+-record(handle, %% For a wrap log.
+ {filename :: file:filename(), %% Same as log.filename
+ maxB :: pos_integer(), %% Max size of the files.
+ maxF :: pos_integer() | {pos_integer(),pos_integer()},
+ %% When pos_integer(), maximum number of files.
+ %% The form {NewMaxF, OldMaxF} is used when the
+ %% number of wrap logs are decreased. The files
+ %% are not removed when the size is changed but
+ %% next time the files are to be used, i.e next
+ %% time the wrap log has filled the
+ %% Dir/Name.NewMaxF file.
+ curB :: non_neg_integer(), %% Number of bytes on current file.
+ curF :: integer(), %% Current file number.
+ cur_fdc :: #cache{}, %% Current file descriptor.
+ cur_name :: file:filename(), %% Current file name for error reports.
+ cur_cnt :: non_neg_integer(), %% Number of items on current file,
+ %% header inclusive.
+ acc_cnt :: non_neg_integer(), %% acc_cnt+cur_cnt is number of items
+ %% written since the log was opened.
+ firstPos :: non_neg_integer(), %% Start position for first item
+ %% (after header).
+ noFull :: non_neg_integer(), %% Number of overflows since last
+ %% use of info/1 on this log, or
+ %% since log was opened if info/1
+ %% has not yet been used on this log.
+ accFull :: non_neg_integer()} %% noFull+accFull is number of
+ %% oveflows since the log was opened.
+ ).
+
+-record(log,
+ {status = ok :: dlog_status(),
+ name :: dlog_name(), %% the key leading to this structure
+ blocked_by = none :: 'none' | pid(), %% pid of blocker
+ users = 0 :: non_neg_integer(), %% non-linked users
+ filename :: file:filename(), %% real name of the file
+ owners = [] :: [{pid(), boolean()}],%% [{pid, notify}]
+ type = halt :: dlog_type(),
+ format = internal :: dlog_format(),
+ format_type :: dlog_format_type(),
+ head = none, %% none | {head, H} | {M,F,A}
+ %% called when wraplog wraps
+ mode :: dlog_mode(),
+ size, %% value of open/1 option 'size' (never changed)
+ extra :: #halt{} | #handle{}, %% type of the log
+ version :: integer()} %% if wrap log file
+ ).
+
+-record(continuation, %% Chunk continuation.
+ {pid = self() :: pid(),
+ pos :: non_neg_integer() | {integer(), non_neg_integer()},
+ b :: binary() | [] | pos_integer()}
+ ).
+
+-type dlog_cont() :: 'start' | #continuation{}.
diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl
new file mode 100644
index 0000000000..7103417149
--- /dev/null
+++ b/lib/kernel/src/disk_log_1.erl
@@ -0,0 +1,1551 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(disk_log_1).
+
+%% Efficient file based log - implementation part
+
+-export([int_open/4, ext_open/4, logl/1, close/3, truncate/3, chunk/5,
+ sync/2, write_cache/2]).
+-export([mf_int_open/7, mf_int_log/3, mf_int_close/2, mf_int_inc/2,
+ mf_ext_inc/2, mf_int_chunk/4, mf_int_chunk_step/3,
+ mf_sync/1, mf_write_cache/1]).
+-export([mf_ext_open/7, mf_ext_log/3, mf_ext_close/2]).
+
+-export([print_index_file/1]).
+-export([read_index_file/1]).
+-export([read_size_file/1, read_size_file_version/1]).
+-export([chunk_read_only/5]).
+-export([mf_int_chunk_read_only/4]).
+-export([change_size_wrap/3]).
+-export([get_wrap_size/1]).
+-export([is_head/1]).
+-export([position/3, truncate_at/3, fwrite/4, fclose/2]).
+
+-compile({inline,[{scan_f2,7}]}).
+
+-import(lists, [concat/1, reverse/1, sum/1]).
+
+-include("disk_log.hrl").
+
+%%% At the head of a LOG file we have [?LOGMAGIC, ?OPENED | ?CLOSED].
+%%% Otherwise it's not a LOG file. Following that, the head, come the
+%%% logged items.
+%%%
+%%% There are four formats of wrap log files (so far). Only the size
+%%% file and the index file differ between versions between the first
+%%% three version. The fourth version 2(a), has some protection
+%%% against damaged item sizes.
+%%% Version 0: no "siz" file
+%%% Version 1: "siz" file, 4 byte sizes
+%%% Version 2: 8 byte sizes (support for large files)
+%%% Version 2(a): Change of the format of logged items:
+%%% if the size of a term binary is greater than or equal to
+%%% ?MIN_MD5_TERM, a logged item looks like
+%%% <<Size:32, ?BIGMAGICHEAD:32, MD5:128, Term/binary>>,
+%%% otherwise <<Size:32, ?BIGMAGICHEAD:32, Term/binary>>.
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+
+%% -> {ok, NoBytes, NewFdC} | {Error, NewFdC}
+log(FdC, FileName, X) ->
+ {Bs, Size} = logl(X, [], 0),
+ case fwrite(FdC, FileName, Bs, Size) of
+ {ok, NewFdC} ->
+ {ok, Size, NewFdC};
+ Error ->
+ Error
+ end.
+
+-spec logl([binary()]) -> {iolist(), non_neg_integer()}.
+logl(X) ->
+ logl(X, [], 0).
+
+logl([X | T], Bs, Size) ->
+ Sz = byte_size(X),
+ BSz = <<Sz:?SIZESZ/unit:8>>,
+ NBs = case Sz < ?MIN_MD5_TERM of
+ true ->
+ [Bs, BSz, ?BIGMAGICHEAD | X];
+ false ->
+ MD5 = erlang:md5(BSz),
+ [Bs, BSz, ?BIGMAGICHEAD, MD5 | X]
+ end,
+ logl(T, NBs, Size + ?HEADERSZ + Sz);
+logl([], Bs, Size) ->
+ {Bs, Size}.
+
+%% -> {ok, NewFdC} | {Error, NewFdC}
+write_cache(#cache{fd = Fd, c = C}, FName) ->
+ erase(write_cache_timer_is_running),
+ write_cache(Fd, FName, C).
+
+%% -> {Reply, NewFdC}; Reply = ok | Error
+sync(FdC, FName) ->
+ fsync(FdC, FName).
+
+%% -> {Reply, NewFdC}; Reply = ok | Error
+truncate(FdC, FileName, Head) ->
+ Reply = truncate_at(FdC, FileName, ?HEADSZ),
+ case Reply of
+ {ok, _} when Head =:= none ->
+ Reply;
+ {ok, FdC1} ->
+ {ok, B} = Head,
+ case log(FdC1, FileName, [B]) of
+ {ok, _NoBytes, NewFdC} ->
+ {ok, NewFdC};
+ Reply2 ->
+ Reply2
+ end;
+ _ ->
+ Reply
+ end.
+
+%% -> {NewFdC, Reply}, Reply = {Cont, Binaries} | {error, Reason} | eof
+chunk(FdC, FileName, Pos, B, N) when is_binary(B) ->
+ true = byte_size(B) >= ?HEADERSZ,
+ do_handle_chunk(FdC, FileName, Pos, B, N);
+chunk(FdC, FileName, Pos, NoBytes, N) ->
+ MaxNoBytes = case NoBytes of
+ [] -> ?MAX_CHUNK_SIZE;
+ _ -> erlang:max(NoBytes, ?MAX_CHUNK_SIZE)
+ end,
+ case read_chunk(FdC, FileName, Pos, MaxNoBytes) of
+ {NewFdC, {ok, Bin}} when byte_size(Bin) < ?HEADERSZ ->
+ {NewFdC, {error, {corrupt_log_file, FileName}}};
+ {NewFdC, {ok, Bin}} when NoBytes =:= []; byte_size(Bin) >= NoBytes ->
+ NewPos = Pos + byte_size(Bin),
+ do_handle_chunk(NewFdC, FileName, NewPos, Bin, N);
+ {NewFdC, {ok, _Bin}} ->
+ {NewFdC, {error, {corrupt_log_file, FileName}}};
+ {NewFdC, eof} when is_integer(NoBytes) -> % "cannot happen"
+ {NewFdC, {error, {corrupt_log_file, FileName}}};
+ Other -> % eof or error
+ Other
+ end.
+
+do_handle_chunk(FdC, FileName, Pos, B, N) ->
+ case handle_chunk(B, Pos, N, []) of
+ corrupt ->
+ {FdC, {error, {corrupt_log_file, FileName}}};
+ {C, []} ->
+ chunk(FdC, FileName, C#continuation.pos, C#continuation.b, N);
+ C_Ack ->
+ {FdC, C_Ack}
+ end.
+
+handle_chunk(B, Pos, 0, Ack) when byte_size(B) >= ?HEADERSZ ->
+ {#continuation{pos = Pos, b = B}, Ack};
+handle_chunk(B= <<Size:?SIZESZ/unit:8, ?BIGMAGICINT:?MAGICSZ/unit:8,
+ Tail/binary>>, Pos, N, Ack) when Size < ?MIN_MD5_TERM ->
+ case Tail of
+ <<BinTerm:Size/binary, Tail2/binary>> ->
+ %% The client calls binary_to_term/1.
+ handle_chunk(Tail2, Pos, N-1, [BinTerm | Ack]);
+ _ ->
+ BytesToRead = Size + ?HEADERSZ,
+ {#continuation{pos = Pos - byte_size(B), b = BytesToRead}, Ack}
+ end;
+handle_chunk(B= <<Size:?SIZESZ/unit:8, ?BIGMAGICINT:?MAGICSZ/unit:8,
+ Tail/binary>>, Pos, _N, Ack) -> % when Size >= ?MIN_MD5_TERM
+ MD5 = erlang:md5(<<Size:?SIZESZ/unit:8>>),
+ case Tail of
+ %% The requested object is always bigger than a chunk.
+ <<MD5:16/binary, Bin:Size/binary>> ->
+ {#continuation{pos = Pos, b = []}, [Bin | Ack]};
+ <<MD5:16/binary, _/binary>> ->
+ BytesToRead = Size + ?HEADERSZ + 16,
+ {#continuation{pos = Pos - byte_size(B), b = BytesToRead}, Ack};
+ _ when byte_size(Tail) >= 16 ->
+ corrupt;
+ _ ->
+ {#continuation{pos = Pos - byte_size(B), b = []}, Ack}
+ end;
+handle_chunk(B= <<Size:?SIZESZ/unit:8, ?MAGICINT:?MAGICSZ/unit:8, Tail/binary>>,
+ Pos, N, Ack) ->
+ %% Version 2, before 2(a).
+ case Tail of
+ <<BinTerm:Size/binary, Tail2/binary>> ->
+ handle_chunk(Tail2, Pos, N-1, [BinTerm | Ack]);
+ _ ->
+ %% We read the whole thing into one binary, even if Size is huge.
+ BytesToRead = Size + ?HEADERSZ,
+ {#continuation{pos = Pos - byte_size(B), b = BytesToRead}, Ack}
+ end;
+handle_chunk(B, _Pos, _N, _Ack) when byte_size(B) >= ?HEADERSZ ->
+ corrupt;
+handle_chunk(B, Pos, _N, Ack) ->
+ {#continuation{pos = Pos-byte_size(B), b = []}, Ack}.
+
+read_chunk(FdC, FileName, Pos, MaxBytes) ->
+ {FdC1, R} = pread(FdC, FileName, Pos + ?HEADSZ, MaxBytes),
+ case position(FdC1, FileName, eof) of
+ {ok, NewFdC, _Pos} ->
+ {NewFdC, R};
+ {Error, NewFdC} ->
+ {NewFdC, Error}
+ end.
+
+%% Used by wrap_log_reader.
+%% -> {NewFdC, Reply},
+%% Reply = {Cont, Binaries, Bad} (Bad >= 0) | {error, Reason} | eof
+chunk_read_only(FdC = #cache{}, FileName, Pos, B, N) ->
+ do_chunk_read_only(FdC, FileName, Pos, B, N);
+chunk_read_only(Fd, FileName, Pos, B, N) ->
+ %% wrap_log_reader calling...
+ FdC = #cache{fd = Fd},
+ {_NFdC, Reply} = do_chunk_read_only(FdC, FileName, Pos, B, N),
+ Reply.
+
+do_chunk_read_only(FdC, FileName, Pos, B, N) when is_binary(B) ->
+ true = byte_size(B) >= ?HEADERSZ,
+ do_handle_chunk_ro(FdC, FileName, Pos, B, N);
+do_chunk_read_only(FdC, FileName, Pos, NoBytes, N) ->
+ MaxNoBytes = case NoBytes of
+ [] -> ?MAX_CHUNK_SIZE;
+ _ -> erlang:max(NoBytes, ?MAX_CHUNK_SIZE)
+ end,
+ case read_chunk_ro(FdC, FileName, Pos, MaxNoBytes) of
+ {NewFdC, {ok, Bin}} when byte_size(Bin) < ?HEADERSZ ->
+ NewCont = #continuation{pos = Pos+byte_size(Bin), b = []},
+ {NewFdC, {NewCont, [], byte_size(Bin)}};
+ {NewFdC, {ok, Bin}} when NoBytes =:= []; byte_size(Bin) >= NoBytes ->
+ NewPos = Pos + byte_size(Bin),
+ do_handle_chunk_ro(NewFdC, FileName, NewPos, Bin, N);
+ {NewFdC, {ok, Bin}} ->
+ NewCont = #continuation{pos = Pos+byte_size(Bin), b = []},
+ {NewFdC, {NewCont, [], byte_size(Bin)-?HEADERSZ}};
+ {NewFdC, eof} when is_integer(NoBytes) -> % "cannot happen"
+ {NewFdC, eof}; % what else?
+ Other ->
+ Other
+ end.
+
+do_handle_chunk_ro(FdC, FileName, Pos, B, N) ->
+ case handle_chunk_ro(B, Pos, N, [], 0) of
+ {C, [], 0} ->
+ #continuation{pos = NewPos, b = NoBytes} = C,
+ do_chunk_read_only(FdC, FileName, NewPos, NoBytes, N);
+ C_Ack_Bad ->
+ {FdC, C_Ack_Bad}
+ end.
+
+handle_chunk_ro(B, Pos, 0, Ack, Bad) when byte_size(B) >= ?HEADERSZ ->
+ {#continuation{pos = Pos, b = B}, Ack, Bad};
+handle_chunk_ro(B= <<Size:?SIZESZ/unit:8, ?BIGMAGICINT:?MAGICSZ/unit:8,
+ Tail/binary>>, Pos, N, Ack, Bad) when Size < ?MIN_MD5_TERM ->
+ case Tail of
+ <<BinTerm:Size/binary, Tail2/binary>> ->
+ handle_chunk_ro(Tail2, Pos, N-1, [BinTerm | Ack], Bad);
+ _ ->
+ BytesToRead = Size + ?HEADERSZ,
+ {#continuation{pos = Pos - byte_size(B), b = BytesToRead}, Ack, Bad}
+ end;
+handle_chunk_ro(B= <<Size:?SIZESZ/unit:8, ?BIGMAGICINT:?MAGICSZ/unit:8,
+ Tail/binary>>, Pos, N, Ack, Bad) -> % when Size>=?MIN_MD5_TERM
+ MD5 = erlang:md5(<<Size:?SIZESZ/unit:8>>),
+ case Tail of
+ <<MD5:16/binary, Bin:Size/binary>> ->
+ %% The requested object is always bigger than a chunk.
+ {#continuation{pos = Pos, b = []}, [Bin | Ack], Bad};
+ <<MD5:16/binary, _/binary>> ->
+ BytesToRead = Size + ?HEADERSZ + 16,
+ {#continuation{pos = Pos - byte_size(B), b = BytesToRead}, Ack, Bad};
+ <<_BadMD5:16/binary, _:1/unit:8, Tail2/binary>> ->
+ handle_chunk_ro(Tail2, Pos, N-1, Ack, Bad+1);
+ _ ->
+ {#continuation{pos = Pos - byte_size(B), b = []}, Ack, Bad}
+ end;
+handle_chunk_ro(B= <<Size:?SIZESZ/unit:8, ?MAGICINT:?MAGICSZ/unit:8,
+ Tail/binary>>, Pos, N, Ack, Bad) ->
+ %% Version 2, before 2(a).
+ case Tail of
+ <<BinTerm:Size/binary, Tail2/binary>> ->
+ handle_chunk_ro(Tail2, Pos, N-1, [BinTerm | Ack], Bad);
+ _ ->
+ %% We read the whole thing into one binary, even if Size is huge.
+ BytesToRead = Size + ?HEADERSZ,
+ {#continuation{pos = Pos - byte_size(B), b = BytesToRead}, Ack, Bad}
+ end;
+handle_chunk_ro(B, Pos, N, Ack, Bad) when byte_size(B) >= ?HEADERSZ ->
+ <<_:1/unit:8, B2/binary>> = B,
+ handle_chunk_ro(B2, Pos, N-1, Ack, Bad+1);
+handle_chunk_ro(B, Pos, _N, Ack, Bad) ->
+ {#continuation{pos = Pos-byte_size(B), b = []}, Ack, Bad}.
+
+read_chunk_ro(FdC, FileName, Pos, MaxBytes) ->
+ pread(FdC, FileName, Pos + ?HEADSZ, MaxBytes).
+
+%% -> ok | throw(Error)
+close(#cache{fd = Fd, c = []}, _FileName, read_only) ->
+ file:close(Fd);
+close(#cache{fd = Fd, c = C}, FileName, read_write) ->
+ {Reply, _NewFdC} = write_cache(Fd, FileName, C),
+ mark(Fd, FileName, ?CLOSED),
+ file:close(Fd),
+ if Reply =:= ok -> ok; true -> throw(Reply) end.
+
+%% Open an internal file. Head is ignored if Mode is read_only.
+%% int_open(FileName, Repair, Mode, Head) ->
+%% {ok, {Alloc, FdC, HeadSize, FileSize}}
+%% | {repaired, FdC, Terms, BadBytes, FileSize}
+%% | throw(Error)
+%% Alloc = new | existed
+%% HeadSize = {NumberOfItemsWritten, NumberOfBytesWritten}
+%% (HeadSize is equal {0, 0} if Alloc =:= existed, or no header written.)
+int_open(FName, truncate, read_write, Head) ->
+ new_int_file(FName, Head);
+int_open(FName, Repair, read_write, Head) ->
+ case open_read(FName) of
+ {ok, Fd} -> %% File exists
+ case file:read(Fd, ?HEADSZ) of
+ {ok, FileHead} ->
+ case is_head(FileHead) of
+ yes ->
+ file:close(Fd),
+ case open_update(FName) of
+ {ok, Fd2} ->
+ mark(Fd2, FName, ?OPENED),
+ FdC1 = #cache{fd = Fd2},
+ {FdC, P} = position_close(FdC1, FName,eof),
+ {ok, {existed, FdC, {0, 0}, P}};
+ Error ->
+ file_error(FName, Error)
+ end;
+ yes_not_closed when Repair ->
+ repair(Fd, FName);
+ yes_not_closed when not Repair ->
+ file:close(Fd),
+ throw({error, {need_repair, FName}});
+ no ->
+ file:close(Fd),
+ throw({error, {not_a_log_file, FName}})
+ end;
+ eof ->
+ file:close(Fd),
+ throw({error, {not_a_log_file, FName}});
+ Error ->
+ file_error_close(Fd, FName, Error)
+ end;
+ _Other ->
+ new_int_file(FName, Head)
+ end;
+int_open(FName, _Repair, read_only, _Head) ->
+ case open_read(FName) of
+ {ok, Fd} -> %% File exists
+ case file:read(Fd, ?HEADSZ) of
+ {ok, Head} ->
+ case is_head(Head) of
+ yes ->
+ {ok, P} = position_close2(Fd, FName, eof),
+ FdC = #cache{fd = Fd},
+ {ok, {existed, FdC, {0, 0}, P}};
+ yes_not_closed ->
+ {ok, P} = position_close2(Fd, FName, eof),
+ FdC = #cache{fd = Fd},
+ {ok, {existed, FdC, {0, 0}, P}};
+ no ->
+ file:close(Fd),
+ throw({error, {not_a_log_file, FName}})
+ end;
+ eof ->
+ file:close(Fd),
+ throw({error, {not_a_log_file, FName}});
+ Error ->
+ file_error_close(Fd, FName, Error)
+ end;
+ Error ->
+ file_error(FName, Error)
+ end.
+
+new_int_file(FName, Head) ->
+ case open_update(FName) of
+ {ok, Fd} ->
+ ok = truncate_at_close2(Fd, FName, bof),
+ fwrite_close2(Fd, FName, [?LOGMAGIC, ?OPENED]),
+ {FdC1, Nh, HeadSz} = int_log_head(Fd, Head),
+ {FdC, FileSize} = position_close(FdC1, FName, cur),
+ {ok, {new, FdC, {Nh, ?HEADERSZ + HeadSz}, FileSize}};
+ Error ->
+ file_error(FName, Error)
+ end.
+
+%% -> {FdC, NoItemsWritten, NoBytesWritten} | throw(Error)
+int_log_head(Fd, Head) ->
+ case lh(Head, internal) of
+ {ok, BinHead} ->
+ {Bs, Size} = logl([BinHead]),
+ {ok, FdC} = fwrite_header(Fd, Bs, Size),
+ {FdC, 1, Size};
+ none ->
+ {#cache{fd = Fd}, 0, 0};
+ Error ->
+ file:close(Fd),
+ throw(Error)
+ end.
+
+%% Open an external file.
+%% -> {ok, {Alloc, FdC, HeadSize}, FileSize} | throw(Error)
+ext_open(FName, truncate, read_write, Head) ->
+ new_ext_file(FName, Head);
+ext_open(FName, _Repair, read_write, Head) ->
+ case file:read_file_info(FName) of
+ {ok, _FileInfo} ->
+ case open_update(FName) of
+ {ok, Fd} ->
+ {ok, P} = position_close2(Fd, FName, eof),
+ FdC = #cache{fd = Fd},
+ {ok, {existed, FdC, {0, 0}, P}};
+ Error ->
+ file_error(FName, Error)
+ end;
+ _Other ->
+ new_ext_file(FName, Head)
+ end;
+ext_open(FName, _Repair, read_only, _Head) ->
+ case open_read(FName) of
+ {ok, Fd} ->
+ {ok, P} = position_close2(Fd, FName, eof),
+ FdC = #cache{fd = Fd},
+ {ok, {existed, FdC, {0, 0}, P}};
+ Error ->
+ file_error(FName, Error)
+ end.
+
+new_ext_file(FName, Head) ->
+ case open_truncate(FName) of
+ {ok, Fd} ->
+ {FdC1, HeadSize} = ext_log_head(Fd, Head),
+ {FdC, FileSize} = position_close(FdC1, FName, cur),
+ {ok, {new, FdC, HeadSize, FileSize}};
+ Error ->
+ file_error(FName, Error)
+ end.
+
+%% -> {FdC, {NoItemsWritten, NoBytesWritten}} | throw(Error)
+ext_log_head(Fd, Head) ->
+ case lh(Head, external) of
+ {ok, BinHead} ->
+ Size = byte_size(BinHead),
+ {ok, FdC} = fwrite_header(Fd, BinHead, Size),
+ {FdC, {1, Size}};
+ none ->
+ {#cache{fd = Fd}, {0, 0}};
+ Error ->
+ file:close(Fd),
+ throw(Error)
+ end.
+
+%% -> _Any | throw()
+mark(Fd, FileName, What) ->
+ position_close2(Fd, FileName, 4),
+ fwrite_close2(Fd, FileName, What).
+
+%% -> {ok, Bin} | Error
+lh({ok, Bin}, _Format) ->
+ {ok, Bin};
+lh({M, F, A}, Format) when is_list(A) ->
+ case catch apply(M, F, A) of
+ {ok, Head} when Format =:= internal ->
+ {ok, term_to_binary(Head)};
+ {ok, Bin} when is_binary(Bin) ->
+ {ok, Bin};
+ {ok, Bytes} ->
+ case catch list_to_binary(Bytes) of
+ {'EXIT', _} ->
+ {error, {invalid_header, {{M,F,A}, {ok, Bytes}}}};
+ Bin ->
+ {ok, Bin}
+ end;
+ {'EXIT', Error} ->
+ {error, {invalid_header, {{M,F,A}, Error}}};
+ Error ->
+ {error, {invalid_header, {{M,F,A}, Error}}}
+ end;
+lh({M, F, A}, _Format) -> % cannot happen
+ {error, {invalid_header, {M, F, A}}};
+lh(none, _Format) ->
+ none;
+lh(H, _F) -> % cannot happen
+ {error, {invalid_header, H}}.
+
+repair(In, File) ->
+ FSz = file_size(File),
+ error_logger:info_msg("disk_log: repairing ~p ...\n", [File]),
+ Tmp = add_ext(File, "TMP"),
+ {ok, {_Alloc, Out, {0, _}, _FileSize}} = new_int_file(Tmp, none),
+ scan_f_read(<<>>, In, Out, File, FSz, Tmp, ?MAX_CHUNK_SIZE, 0, 0).
+
+scan_f_read(B, In, Out, File, FSz, Tmp, MaxBytes, No, Bad) ->
+ case file:read(In, MaxBytes) of
+ eof ->
+ done_scan(In, Out, Tmp, File, No, Bad+byte_size(B));
+ {ok, Bin} ->
+ NewBin = list_to_binary([B, Bin]),
+ {NB, NMax, Ack, NNo, NBad} =
+ scan_f(NewBin, FSz, [], No, Bad),
+ case log(Out, Tmp, lists:reverse(Ack)) of
+ {ok, _Size, NewOut} ->
+ scan_f_read(NB, In, NewOut, File, FSz, Tmp, NMax,NNo,NBad);
+ {{error, {file_error, _Filename, Error}}, NewOut} ->
+ repair_err(In, NewOut, Tmp, File, {error, Error})
+ end;
+ Error ->
+ repair_err(In, Out, Tmp, File, Error)
+ end.
+
+scan_f(B = <<Size:?SIZESZ/unit:8, ?BIGMAGICINT:?MAGICSZ/unit:8, Tail/binary>>,
+ FSz, Ack, No, Bad) when Size < ?MIN_MD5_TERM ->
+ scan_f2(B, FSz, Ack, No, Bad, Size, Tail);
+scan_f(B = <<Size:?SIZESZ/unit:8, ?BIGMAGICINT:?MAGICSZ/unit:8, Tail/binary>>,
+ FSz, Ack, No, Bad) -> % when Size >= ?MIN_MD5_TERM
+ MD5 = erlang:md5(<<Size:?SIZESZ/unit:8>>),
+ case Tail of
+ <<MD5:16/binary, BinTerm:Size/binary, Tail2/binary>> ->
+ case catch binary_to_term(BinTerm) of
+ {'EXIT', _} ->
+ scan_f(Tail2, FSz, Ack, No, Bad+Size);
+ _Term ->
+ scan_f(Tail2, FSz, [BinTerm | Ack], No+1, Bad)
+ end;
+ <<MD5:16/binary, _/binary>> ->
+ {B, Size-byte_size(Tail)+16, Ack, No, Bad};
+ _ when byte_size(Tail) < 16 ->
+ {B, Size-byte_size(Tail)+16, Ack, No, Bad};
+ _ ->
+ <<_:8, B2/binary>> = B,
+ scan_f(B2, FSz, Ack, No, Bad+1)
+ end;
+scan_f(B = <<Size:?SIZESZ/unit:8, ?MAGICINT:?MAGICSZ/unit:8, Tail/binary>>,
+ FSz, Ack, No, Bad) when Size =< FSz ->
+ %% Since the file is not compressed, the item size cannot exceed
+ %% the file size.
+ scan_f2(B, FSz, Ack, No, Bad, Size, Tail);
+scan_f(B = <<_:?HEADERSZ/unit:8, _/binary>>, FSz, Ack, No, Bad) ->
+ <<_:8, B2/binary>> = B,
+ scan_f(B2, FSz, Ack, No, Bad + 1);
+scan_f(B, _FSz, Ack, No, Bad) ->
+ {B, ?MAX_CHUNK_SIZE, Ack, No, Bad}.
+
+scan_f2(B, FSz, Ack, No, Bad, Size, Tail) ->
+ case Tail of
+ <<BinTerm:Size/binary, Tail2/binary>> ->
+ case catch binary_to_term(BinTerm) of
+ {'EXIT', _} ->
+ <<_:8, B2/binary>> = B,
+ scan_f(B2, FSz, Ack, No, Bad+1);
+ _Term ->
+ scan_f(Tail2, FSz, [BinTerm | Ack], No+1, Bad)
+ end;
+ _ ->
+ {B, Size-byte_size(Tail), Ack, No, Bad}
+ end.
+
+done_scan(In, Out, OutName, FName, RecoveredTerms, BadChars) ->
+ file:close(In),
+ case catch fclose(Out, OutName) of
+ ok ->
+ case file:rename(OutName, FName) of
+ ok ->
+ case open_update(FName) of
+ {ok, New} ->
+ {ok, P} = position_close2(New, FName, eof),
+ FdC = #cache{fd = New},
+ {repaired, FdC, RecoveredTerms, BadChars, P};
+ Error ->
+ file_error(FName, Error)
+ end;
+ Error ->
+ file:delete(OutName),
+ file_error(FName, Error)
+ end;
+ Error ->
+ file:delete(OutName),
+ throw(Error)
+ end.
+
+repair_err(In, Out, OutName, ErrFileName, Error) ->
+ file:close(In),
+ catch fclose(Out, OutName),
+ % OutName is often the culprit, try to remove it anyway...
+ file:delete(OutName),
+ file_error(ErrFileName, Error).
+
+%% Used by wrap_log_reader.
+-spec is_head(binary()) -> 'yes' | 'yes_not_closed' | 'no'.
+is_head(<<M:4/binary, S:4/binary>>) when ?LOGMAGIC =:= M, ?CLOSED =:= S ->
+ yes;
+is_head(<<M:4/binary, S:4/binary>>) when ?LOGMAGIC =:= M, ?OPENED =:= S ->
+ yes_not_closed;
+is_head(Bin) when is_binary(Bin) ->
+ no.
+
+%%-----------------------------------------------------------------
+%% Func: mf_int_open/7, mf_ext_open/7
+%% Args: FName = file:filename()
+%% MaxB = integer()
+%% MaxF = integer()
+%% Repair = truncate | true | false
+%% Mode = read_write | read_only
+%% Head = none | {ok, Bin} | {M, F, A}
+%% Version = integer()
+%% Purpose: An ADT for wrapping logs. mf_int_ writes binaries (mf_ext_
+%% writes bytes)
+%% to files called FName.1, FName.2, ..., FName.MaxF.
+%% Writes MaxB bytes on each file.
+%% Creates a file called Name.idx in the Dir. This
+%% file contains the last written FileName as one byte, and
+%% follwing that, the sizes of each file (size 0 number of items).
+%% On startup, this file is read, and the next available
+%% filename is used as first log file.
+%% Reports can be browsed with Report Browser Tool (rb), or
+%% read with disk_log.
+%%-----------------------------------------------------------------
+-spec mf_int_open(FName :: file:filename(),
+ MaxB :: integer(),
+ MaxF :: integer(),
+ Repair :: dlog_repair(),
+ Mode :: dlog_mode(),
+ Head :: dlog_head(),
+ Version :: integer())
+ -> {'ok', #handle{}, integer()}
+ | {'repaired', #handle{},
+ non_neg_integer(), non_neg_integer(), non_neg_integer()}.
+%% | throw(FileError)
+mf_int_open(FName, MaxB, MaxF, Repair, Mode, Head, Version) ->
+ {First, Sz, TotSz, NFiles} = read_index_file(Repair, FName, MaxF),
+ write_size_file(Mode, FName, MaxB, MaxF, Version),
+ NewMaxF = if
+ NFiles > MaxF ->
+ {MaxF, NFiles};
+ true ->
+ MaxF
+ end,
+ case int_file_open(FName, First, 0, 0, Head, Repair, Mode) of
+ {ok, FdC, FileName, Lost, {NoItems, NoBytes}, FSz} ->
+ % firstPos = NoBytes is not always correct when the file
+ % existed, but it will have to do since we don't know
+ % where the header ends.
+ CurCnt = Sz + NoItems - Lost,
+ {ok, #handle{filename = FName, maxB = MaxB,
+ maxF = NewMaxF, curF = First, cur_fdc = FdC,
+ cur_name = FileName, cur_cnt = CurCnt,
+ acc_cnt = -Sz, curB = FSz,
+ firstPos = NoBytes, noFull = 0, accFull = 0},
+ TotSz + CurCnt};
+ {repaired, FdC, FileName, Rec, Bad, FSz} ->
+ {repaired,
+ #handle{filename = FName, maxB = MaxB, cur_name = FileName,
+ maxF = NewMaxF, curF = First, cur_fdc = FdC,
+ cur_cnt = Rec, acc_cnt = -Rec, curB = FSz,
+ firstPos = 0, noFull = 0, accFull = 0},
+ Rec, Bad, TotSz + Rec}
+ end.
+
+%% -> {ok, handle(), Lost} | {error, Error, handle()}
+mf_int_inc(Handle, Head) ->
+ #handle{filename = FName, cur_cnt = CurCnt, acc_cnt = AccCnt,
+ cur_name = FileName, curF = CurF, maxF = MaxF,
+ cur_fdc = CurFdC, noFull = NoFull} = Handle,
+ case catch wrap_int_log(FName, CurF, MaxF, CurCnt, Head) of
+ {NewF, NewMaxF, NewFdC, NewFileName, Nh, FirstPos, Lost} ->
+ Handle1 = Handle#handle{cur_fdc = NewFdC, curF = NewF,
+ cur_name = NewFileName,
+ cur_cnt = Nh, acc_cnt = AccCnt + CurCnt,
+ maxF = NewMaxF, firstPos = FirstPos,
+ curB = FirstPos, noFull = NoFull + 1},
+ case catch close(CurFdC, FileName, read_write) of
+ ok ->
+ {ok, Handle1, Lost};
+ Error -> % Error in the last file, new file opened.
+ {error, Error, Handle1}
+ end;
+ Error ->
+ {error, Error, Handle}
+ end.
+
+%% -> {ok, handle(), Logged, Lost, NoWraps} | {ok, handle(), Logged}
+%% | {error, Error, handle(), Logged, Lost}
+%% The returned handle is not always valid - something may
+%% have been written before things went wrong.
+mf_int_log(Handle, Bins, Head) ->
+ mf_int_log(Handle, Bins, Head, 0, []).
+
+mf_int_log(Handle, [], _Head, No, []) ->
+ {ok, Handle, No};
+mf_int_log(Handle, [], _Head, No, Wraps0) ->
+ Wraps = reverse(Wraps0),
+ {ok, Handle, No, sum(Wraps), Wraps};
+mf_int_log(Handle, Bins, Head, No0, Wraps) ->
+ #handle{curB = CurB, maxB = MaxB, cur_name = FileName, cur_fdc = CurFdC,
+ firstPos = FirstPos0, cur_cnt = CurCnt} = Handle,
+ {FirstBins, LastBins, NoBytes, N} =
+ int_split_bins(CurB, MaxB, FirstPos0, Bins),
+ case FirstBins of
+ [] ->
+ #handle{filename = FName, curF = CurF, maxF = MaxF,
+ acc_cnt = AccCnt, noFull = NoFull} = Handle,
+ case catch wrap_int_log(FName, CurF, MaxF, CurCnt, Head) of
+ {NewF, NewMaxF, NewFdC, NewFileName, Nh, FirstPos, Lost} ->
+ Handle1 = Handle#handle{cur_fdc = NewFdC, curF = NewF,
+ cur_cnt = Nh,
+ cur_name = NewFileName,
+ acc_cnt = AccCnt + CurCnt,
+ maxF = NewMaxF,
+ curB = FirstPos,
+ firstPos = FirstPos,
+ noFull = NoFull + 1},
+ case catch close(CurFdC, FileName, read_write) of
+ ok ->
+ mf_int_log(Handle1, Bins, Head, No0 + Nh,
+ [Lost | Wraps]);
+ Error ->
+ Lost1 = Lost + sum(Wraps),
+ {error, Error, Handle1, No0 + Nh, Lost1}
+ end;
+ Error ->
+ {error, Error, Handle, No0, sum(Wraps)}
+ end;
+ _ ->
+ case fwrite(CurFdC, FileName, FirstBins, NoBytes) of
+ {ok, NewCurFdC} ->
+ Handle1 = Handle#handle{cur_fdc = NewCurFdC,
+ curB = CurB + NoBytes,
+ cur_cnt = CurCnt + N},
+ mf_int_log(Handle1, LastBins, Head, No0 + N, Wraps);
+ {Error, NewCurFdC} ->
+ Handle1 = Handle#handle{cur_fdc = NewCurFdC},
+ {error, Error, Handle1, No0, sum(Wraps)}
+ end
+ end.
+
+wrap_int_log(FName, CurF, MaxF, CurCnt, Head) ->
+ {NewF, NewMaxF} = inc_wrap(FName, CurF, MaxF),
+ {ok, NewFdC, NewFileName, Lost, {Nh, FirstPos}, _FileSize} =
+ int_file_open(FName, NewF, CurF, CurCnt, Head),
+ {NewF, NewMaxF, NewFdC, NewFileName, Nh, FirstPos, Lost}.
+
+%% -> {NewHandle, Reply}, Reply = {Cont, Binaries} | {error, Reason} | eof
+mf_int_chunk(Handle, 0, Bin, N) ->
+ FirstF = find_first_file(Handle),
+ mf_int_chunk(Handle, {FirstF, 0}, Bin, N);
+mf_int_chunk(#handle{curF = FileNo, cur_fdc = FdC, cur_name = FileName}
+ = Handle, {FileNo, Pos}, Bin, N) ->
+ {NewFdC, Reply} = chunk(FdC, FileName, Pos, Bin, N),
+ {Handle#handle{cur_fdc = NewFdC}, conv(Reply, FileNo)};
+mf_int_chunk(Handle, {FileNo, Pos}, Bin, N) ->
+ FName = add_ext(Handle#handle.filename, FileNo),
+ NFileNo = inc(FileNo, Handle#handle.maxF),
+ case catch int_open(FName, true, read_only, any) of
+ {error, _Reason} ->
+ error_logger:info_msg("disk_log: chunk error. File ~p missing.\n\n",
+ [FName]),
+ mf_int_chunk(Handle, {NFileNo, 0}, [], N);
+ {ok, {_Alloc, FdC, _HeadSize, _FileSize}} ->
+ case chunk(FdC, FName, Pos, Bin, N) of
+ {NewFdC, eof} ->
+ file:close(NewFdC#cache.fd),
+ mf_int_chunk(Handle, {NFileNo, 0}, [], N);
+ {NewFdC, Other} ->
+ file:close(NewFdC#cache.fd),
+ {Handle, conv(Other, FileNo)}
+ end
+ end.
+
+%% -> {NewHandle, Reply},
+%% Reply = {Cont, Binaries, Bad} (Bad >= 0) | {error, Reason} | eof
+mf_int_chunk_read_only(Handle, 0, Bin, N) ->
+ FirstF = find_first_file(Handle),
+ mf_int_chunk_read_only(Handle, {FirstF, 0}, Bin, N);
+mf_int_chunk_read_only(#handle{curF = FileNo, cur_fdc = FdC, cur_name=FileName}
+ = Handle, {FileNo, Pos}, Bin, N) ->
+ {NewFdC, Reply} = do_chunk_read_only(FdC, FileName, Pos, Bin, N),
+ {Handle#handle{cur_fdc = NewFdC}, conv(Reply, FileNo)};
+mf_int_chunk_read_only(Handle, {FileNo, Pos}, Bin, N) ->
+ FName = add_ext(Handle#handle.filename, FileNo),
+ NFileNo = inc(FileNo, Handle#handle.maxF),
+ case catch int_open(FName, true, read_only, any) of
+ {error, _Reason} ->
+ error_logger:info_msg("disk_log: chunk error. File ~p missing.\n\n",
+ [FName]),
+ mf_int_chunk_read_only(Handle, {NFileNo, 0}, [], N);
+ {ok, {_Alloc, FdC, _HeadSize, _FileSize}} ->
+ case do_chunk_read_only(FdC, FName, Pos, Bin, N) of
+ {NewFdC, eof} ->
+ file:close(NewFdC#cache.fd),
+ mf_int_chunk_read_only(Handle, {NFileNo,0}, [], N);
+ {NewFdC, Other} ->
+ file:close(NewFdC#cache.fd),
+ {Handle, conv(Other, FileNo)}
+ end
+ end.
+
+%% -> {ok, Cont} | Error
+mf_int_chunk_step(Handle, 0, Step) ->
+ FirstF = find_first_file(Handle),
+ mf_int_chunk_step(Handle, {FirstF, 0}, Step);
+mf_int_chunk_step(Handle, {FileNo, _Pos}, Step) ->
+ NFileNo = inc(FileNo, Handle#handle.maxF, Step),
+ FileName = add_ext(Handle#handle.filename, NFileNo),
+ case file:read_file_info(FileName) of
+ {ok, _FileInfo} ->
+ {ok, #continuation{pos = {NFileNo, 0}, b = []}};
+ _Error ->
+ {error, end_of_log}
+ end.
+
+%% -> {Reply, handle()}; Reply = ok | Error
+mf_write_cache(#handle{filename = FName, cur_fdc = FdC} = Handle) ->
+ erase(write_cache_timer_is_running),
+ #cache{fd = Fd, c = C} = FdC,
+ {Reply, NewFdC} = write_cache(Fd, FName, C),
+ {Reply, Handle#handle{cur_fdc = NewFdC}}.
+
+%% -> {Reply, handle()}; Reply = ok | Error
+mf_sync(#handle{filename = FName, cur_fdc = FdC} = Handle) ->
+ {Reply, NewFdC} = fsync(FdC, FName),
+ {Reply, Handle#handle{cur_fdc = NewFdC}}.
+
+%% -> ok | throw(FileError)
+mf_int_close(#handle{filename = FName, curF = CurF, cur_name = FileName,
+ cur_fdc = CurFdC, cur_cnt = CurCnt}, Mode) ->
+ close(CurFdC, FileName, Mode),
+ write_index_file(Mode, FName, CurF, CurF, CurCnt),
+ ok.
+
+%% -> {ok, handle(), Cnt} | throw(FileError)
+mf_ext_open(FName, MaxB, MaxF, Repair, Mode, Head, Version) ->
+ {First, Sz, TotSz, NFiles} = read_index_file(Repair, FName, MaxF),
+ write_size_file(Mode, FName, MaxB, MaxF, Version),
+ NewMaxF = if
+ NFiles > MaxF ->
+ {MaxF, NFiles};
+ true ->
+ MaxF
+ end,
+ {ok, FdC, FileName, Lost, {NoItems, NoBytes}, CurB} =
+ ext_file_open(FName, First, 0, 0, Head, Repair, Mode),
+ CurCnt = Sz + NoItems - Lost,
+ {ok, #handle{filename = FName, maxB = MaxB, cur_name = FileName,
+ maxF = NewMaxF, cur_cnt = CurCnt, acc_cnt = -Sz,
+ curF = First, cur_fdc = FdC, firstPos = NoBytes,
+ curB = CurB, noFull = 0, accFull = 0},
+ TotSz + CurCnt}.
+
+%% -> {ok, handle(), Lost}
+%% | {error, Error, handle()}
+%% | throw(FatalError)
+%% Fatal errors should always terminate the log.
+mf_ext_inc(Handle, Head) ->
+ #handle{filename = FName, cur_cnt = CurCnt, cur_name = FileName,
+ acc_cnt = AccCnt, curF = CurF, maxF = MaxF, cur_fdc = CurFdC,
+ noFull = NoFull} = Handle,
+ case catch wrap_ext_log(FName, CurF, MaxF, CurCnt, Head) of
+ {NewF, NewMaxF, NewFdC, NewFileName, Nh, FirstPos, Lost} ->
+ Handle1 = Handle#handle{cur_fdc = NewFdC, curF = NewF,
+ cur_name = NewFileName,
+ cur_cnt = Nh, acc_cnt = AccCnt + CurCnt,
+ maxF = NewMaxF, firstPos = FirstPos,
+ curB = FirstPos, noFull = NoFull + 1},
+ case catch fclose(CurFdC, FileName) of
+ ok ->
+ {ok, Handle1, Lost};
+ Error -> % Error in the last file, new file opened.
+ {error, Error, Handle1}
+ end;
+ Error ->
+ {error, Error, Handle}
+ end.
+
+%% -> {ok, handle(), Logged, Lost, NoWraps} | {ok, handle(), Logged}
+%% | {error, Error, handle(), Logged, Lost}
+
+%% The returned handle is not always valid -
+%% something may have been written before things went wrong.
+mf_ext_log(Handle, Bins, Head) ->
+ mf_ext_log(Handle, Bins, Head, 0, []).
+
+mf_ext_log(Handle, [], _Head, No, []) ->
+ {ok, Handle, No};
+mf_ext_log(Handle, [], _Head, No, Wraps0) ->
+ Wraps = reverse(Wraps0),
+ {ok, Handle, No, sum(Wraps), Wraps};
+mf_ext_log(Handle, Bins, Head, No0, Wraps) ->
+ #handle{curB = CurB, maxB = MaxB, cur_name = FileName, cur_fdc = CurFdC,
+ firstPos = FirstPos0, cur_cnt = CurCnt} = Handle,
+ {FirstBins, LastBins, NoBytes, N} =
+ ext_split_bins(CurB, MaxB, FirstPos0, Bins),
+ case FirstBins of
+ [] ->
+ #handle{filename = FName, curF = CurF, maxF = MaxF,
+ acc_cnt = AccCnt, noFull = NoFull} = Handle,
+ case catch wrap_ext_log(FName, CurF, MaxF, CurCnt, Head) of
+ {NewF, NewMaxF, NewFdC, NewFileName, Nh, FirstPos, Lost} ->
+ Handle1 = Handle#handle{cur_fdc = NewFdC, curF = NewF,
+ cur_cnt = Nh,
+ cur_name = NewFileName,
+ acc_cnt = AccCnt + CurCnt,
+ maxF = NewMaxF,
+ curB = FirstPos,
+ firstPos = FirstPos,
+ noFull = NoFull + 1},
+ case catch fclose(CurFdC, FileName) of
+ ok ->
+ mf_ext_log(Handle1, Bins, Head, No0 + Nh,
+ [Lost | Wraps]);
+ Error ->
+ Lost1 = Lost + sum(Wraps),
+ {error, Error, Handle1, No0 + Nh, Lost1}
+ end;
+ Error ->
+ {error, Error, Handle, No0, sum(Wraps)}
+ end;
+ _ ->
+ case fwrite(CurFdC, FileName, FirstBins, NoBytes) of
+ {ok, NewCurFdC} ->
+ Handle1 = Handle#handle{cur_fdc = NewCurFdC,
+ curB = CurB + NoBytes,
+ cur_cnt = CurCnt + N},
+ mf_ext_log(Handle1, LastBins, Head, No0 + N, Wraps);
+ {Error, NewCurFdC} ->
+ Handle1 = Handle#handle{cur_fdc = NewCurFdC},
+ {error, Error, Handle1, No0, sum(Wraps)}
+ end
+ end.
+
+wrap_ext_log(FName, CurF, MaxF, CurCnt, Head) ->
+ {NewF, NewMaxF} = inc_wrap(FName, CurF, MaxF),
+ {ok, NewFdC, NewFileName, Lost, {Nh, FirstPos}, _FileSize} =
+ ext_file_open(FName, NewF, CurF, CurCnt, Head),
+ {NewF, NewMaxF, NewFdC, NewFileName, Nh, FirstPos, Lost}.
+
+%% -> ok | throw(FileError)
+mf_ext_close(#handle{filename = FName, curF = CurF,
+ cur_fdc = CurFdC, cur_cnt = CurCnt}, Mode) ->
+ Res = (catch fclose(CurFdC, FName)),
+ write_index_file(Mode, FName, CurF, CurF, CurCnt),
+ Res.
+
+%% -> {ok, handle()} | throw(FileError)
+change_size_wrap(Handle, {NewMaxB, NewMaxF}, Version) ->
+ FName = Handle#handle.filename,
+ {_MaxB, MaxF} = get_wrap_size(Handle),
+ write_size_file(read_write, FName, NewMaxB, NewMaxF, Version),
+ if
+ NewMaxF > MaxF ->
+ remove_files(FName, MaxF + 1, NewMaxF),
+ {ok, Handle#handle{maxB = NewMaxB, maxF = NewMaxF}};
+ NewMaxF < MaxF ->
+ {ok, Handle#handle{maxB = NewMaxB, maxF = {NewMaxF, MaxF}}};
+ true ->
+ {ok, Handle#handle{maxB = NewMaxB, maxF = NewMaxF}}
+ end.
+
+%%-----------------------------------------------------------------
+%% Misc functions
+%%-----------------------------------------------------------------
+%% -> {ok, FdC, FileName, Lost, HeadSize, FileSize} | throw(Error)
+int_file_open(FName, NewFile, OldFile, OldCnt, Head) ->
+ Repair = truncate, Mode = read_write,
+ int_file_open(FName, NewFile, OldFile, OldCnt, Head, Repair, Mode).
+
+%% -> {ok, FdC, FileName, Lost, HeadSize, FileSize}
+%% | {repaired, FdC, FileName, Rec, Bad, FileSize}
+%% | throw(Error)
+int_file_open(FName, NewFile, OldFile, OldCnt, Head, Repair, Mode) ->
+ N = add_ext(FName, NewFile),
+ case int_open(N, Repair, Mode, Head) of
+ {ok, {_Alloc, FdC, HeadSize, FileSize}} ->
+ Lost = write_index_file(Mode, FName, NewFile, OldFile, OldCnt),
+ {ok, FdC, N, Lost, HeadSize, FileSize};
+ {repaired, FdC, Recovered, BadBytes, FileSize} ->
+ write_index_file(Mode, FName, NewFile, OldFile, OldCnt),
+ {repaired, FdC, N, Recovered, BadBytes, FileSize}
+ end.
+
+%% -> {ok, FdC, FileName, Lost, HeadSize, FileSize} | throw(Error)
+ext_file_open(FName, NewFile, OldFile, OldCnt, Head) ->
+ Repair = truncate, Mode = read_write,
+ ext_file_open(FName, NewFile, OldFile, OldCnt, Head, Repair, Mode).
+
+ext_file_open(FName, NewFile, OldFile, OldCnt, Head, Repair, Mode) ->
+ FileName = add_ext(FName, NewFile),
+ {ok, {_Alloc, FdC, HeadSize, FileSize}} =
+ ext_open(FileName, Repair, Mode, Head),
+ Lost = write_index_file(Mode, FName, NewFile, OldFile, OldCnt),
+ {ok, FdC, FileName, Lost, HeadSize, FileSize}.
+
+%%-----------------------------------------------------------------
+%% The old file format for index file (CurFileNo > 0), Version 0:
+%%
+%% CurFileNo SizeFile1 SizeFile2 ... SizeFileN
+%% 1 byte 4 bytes 4 bytes 4 bytes
+%%
+%% The new file format for index file (NewFormat = 0), version 1:
+%%
+%% NewFormat CurFileNo SizeFile1 SizeFile2 ... SizeFileN
+%% 1 byte 4 bytes 4 bytes 4 bytes
+%%
+%% The current file format for index file (sizes in bytes), version 2:
+%%
+%% 0 (1) 0 (4) FileFormatVersion (1) CurFileNo (4) SizeFile1 (8) ...
+%%
+%% (SizeFileI refers to number of items on the log file.)
+%%-----------------------------------------------------------------
+
+-define(index_file_name(F), add_ext(F, "idx")).
+
+read_index_file(truncate, FName, MaxF) ->
+ remove_files(FName, 2, MaxF),
+ file:delete(?index_file_name(FName)),
+ {1, 0, 0, 0};
+read_index_file(_, FName, _MaxF) ->
+ read_index_file(FName).
+
+%% Used by wrap_log_reader.
+%% -> {CurFileNo, CurFileSz, TotSz, NoFiles} | throw(FileError)
+%% where TotSz does not include CurFileSz.
+
+read_index_file(FName) ->
+ FileName = ?index_file_name(FName),
+ case open_read(FileName) of
+ {ok, Fd} ->
+ R = case file:read(Fd, ?MAX_CHUNK_SIZE) of
+ {ok, <<0, 0:32, Version, CurF:32, Tail/binary>>}
+ when Version =:= ?VERSION,
+ 0 < CurF, CurF < ?MAX_FILES ->
+ parse_index(CurF, Version, 1, Tail, Fd, 0, 0, 0);
+ {ok, <<0, CurF:32, Tail/binary>>}
+ when 0 < CurF, CurF < ?MAX_FILES ->
+ parse_index(CurF, 1, 1, Tail, Fd, 0, 0, 0);
+ {ok, <<CurF, Tail/binary>>} when 0 < CurF ->
+ parse_index(CurF, 1, 1, Tail, Fd, 0, 0, 0);
+ _ErrorOrEof ->
+ {1, 0, 0, 0}
+ end,
+ file:close(Fd),
+ R;
+ _Error ->
+ {1, 0, 0, 0}
+ end.
+
+parse_index(CurF, V, CurF, <<CurSz:64, Tail/binary>>, Fd, _, TotSz, NFiles)
+ when V =:= ?VERSION ->
+ parse_index(CurF, V, CurF+1, Tail, Fd, CurSz, TotSz, NFiles+1);
+parse_index(CurF, V, N, <<Sz:64, Tail/binary>>, Fd, CurSz, TotSz, NFiles)
+ when V =:= ?VERSION ->
+ parse_index(CurF, V, N+1, Tail, Fd, CurSz, TotSz + Sz, NFiles+1);
+parse_index(CurF, V, CurF, <<CurSz:32, Tail/binary>>, Fd, _, TotSz, NFiles)
+ when V < ?VERSION ->
+ parse_index(CurF, V, CurF+1, Tail, Fd, CurSz, TotSz, NFiles+1);
+parse_index(CurF, V, N, <<Sz:32, Tail/binary>>, Fd, CurSz, TotSz, NFiles)
+ when V < ?VERSION ->
+ parse_index(CurF, V, N+1, Tail, Fd, CurSz, TotSz + Sz, NFiles+1);
+parse_index(CurF, V, N, B, Fd, CurSz, TotSz, NFiles) ->
+ case file:read(Fd, ?MAX_CHUNK_SIZE) of
+ eof when 0 =:= byte_size(B) ->
+ {CurF, CurSz, TotSz, NFiles};
+ {ok, Bin} ->
+ NewB = list_to_binary([B, Bin]),
+ parse_index(CurF, V, N, NewB, Fd, CurSz, TotSz, NFiles);
+ _ErrorOrEof ->
+ {1, 0, 0, 0}
+ end.
+
+%% Returns: Number of lost items (if an old file was truncated)
+%% -> integer() | throw(FileError)
+write_index_file(read_only, _FName, _NewFile, _OldFile, _OldCnt) ->
+ 0;
+write_index_file(read_write, FName, NewFile, OldFile, OldCnt) ->
+ FileName = ?index_file_name(FName),
+ case open_update(FileName) of
+ {ok, Fd} ->
+ {Offset, SzSz} =
+ case file:read(Fd, 6) of
+ eof ->
+ Bin = <<0, 0:32, ?VERSION, NewFile:32>>,
+ fwrite_close2(Fd, FileName, Bin),
+ {10, 8};
+ {ok, <<0, 0:32, _Version>>} ->
+ pwrite_close2(Fd, FileName, 6, <<NewFile:32>>),
+ {10, 8};
+ {ok, <<0, _/binary>>} ->
+ pwrite_close2(Fd, FileName, 1, <<NewFile:32>>),
+ {5, 4};
+ {ok, <<_,_/binary>>} ->
+ %% Very old format, convert to the latest format!
+ case file:read_file(FileName) of
+ {ok, <<_CurF, Tail/binary>>} ->
+ position_close2(Fd, FileName, bof),
+ Bin = <<0, 0:32, ?VERSION, NewFile:32>>,
+ NewTail = to_8_bytes(Tail, [], FileName, Fd),
+ fwrite_close2(Fd, FileName, [Bin | NewTail]),
+ {10, 8};
+ Error ->
+ file_error_close(Fd, FileName, Error)
+ end;
+ Error ->
+ file_error_close(Fd, FileName, Error)
+ end,
+
+ NewPos = Offset + (NewFile - 1)*SzSz,
+ OldCntBin = <<OldCnt:SzSz/unit:8>>,
+ if
+ OldFile > 0 ->
+ R = file:pread(Fd, NewPos, SzSz),
+ OldPos = Offset + (OldFile - 1)*SzSz,
+ pwrite_close2(Fd, FileName, OldPos, OldCntBin),
+ file:close(Fd),
+ case R of
+ {ok, <<Lost:SzSz/unit:8>>} -> Lost;
+ {ok, _} ->
+ throw({error, {invalid_index_file, FileName}});
+ eof -> 0;
+ Error2 -> file_error(FileName, Error2)
+ end;
+ true ->
+ pwrite_close2(Fd, FileName, NewPos, OldCntBin),
+ file:close(Fd),
+ 0
+ end;
+ E ->
+ file_error(FileName, E)
+ end.
+
+to_8_bytes(<<N:32,T/binary>>, NT, FileName, Fd) ->
+ to_8_bytes(T, [NT | <<N:64>>], FileName, Fd);
+to_8_bytes(B, NT, _FileName, _Fd) when byte_size(B) =:= 0 ->
+ NT;
+to_8_bytes(_B, _NT, FileName, Fd) ->
+ file:close(Fd),
+ throw({error, {invalid_index_file, FileName}}).
+
+%% -> ok | throw(FileError)
+index_file_trunc(FName, N) ->
+ FileName = ?index_file_name(FName),
+ case open_update(FileName) of
+ {ok, Fd} ->
+ case file:read(Fd, 6) of
+ eof ->
+ file:close(Fd),
+ ok;
+ {ok, <<0, 0:32, Version>>} when Version =:= ?VERSION ->
+ truncate_index_file(Fd, FileName, 10, 8, N);
+ {ok, <<0, _/binary>>} ->
+ truncate_index_file(Fd, FileName, 5, 4, N);
+ {ok, <<_, _/binary>>} -> % cannot happen
+ truncate_index_file(Fd, FileName, 1, 4, N);
+ Error ->
+ file_error_close(Fd, FileName, Error)
+ end;
+ Error ->
+ file_error(FileName, Error)
+ end.
+
+truncate_index_file(Fd, FileName, Offset, N, SzSz) ->
+ Pos = Offset + N*SzSz,
+ case Pos > file_size(FileName) of
+ true ->
+ file:close(Fd);
+ false ->
+ truncate_at_close2(Fd, FileName, {bof, Pos}),
+ file:close(Fd)
+ end,
+ ok.
+
+print_index_file(File) ->
+ io:format("-- Index begin --~n"),
+ case file:read_file(File) of
+ {ok, <<0, 0:32, Version, CurF:32, Tail/binary>>}
+ when Version =:= ?VERSION, 0 < CurF, CurF < ?MAX_FILES ->
+ io:format("cur file: ~w~n", [CurF]),
+ loop_index(1, Version, Tail);
+ {ok, <<0, CurF:32, Tail/binary>>} when 0 < CurF, CurF < ?MAX_FILES ->
+ io:format("cur file: ~w~n", [CurF]),
+ loop_index(1, 1, Tail);
+ {ok, <<CurF, Tail/binary>>} when 0 < CurF ->
+ io:format("cur file: ~w~n", [CurF]),
+ loop_index(1, 1, Tail);
+ _Else ->
+ ok
+ end,
+ io:format("-- end --~n").
+
+loop_index(N, V, <<Sz:64, Tail/binary>>) when V =:= ?VERSION ->
+ io:format(" ~p items: ~w~n", [N, Sz]),
+ loop_index(N+1, V, Tail);
+loop_index(N, V, <<Sz:32, Tail/binary>>) when V < ?VERSION ->
+ io:format(" ~p items: ~w~n", [N, Sz]),
+ loop_index(N+1, V, Tail);
+loop_index(_, _, _) ->
+ ok.
+
+-define(size_file_name(F), add_ext(F, "siz")).
+
+%% Version 0: no size file
+%% Version 1: <<MaxSize:32, MaxFiles:32>>
+%% Version 2: <<Version:8, MaxSize:64, MaxFiles:32>>
+
+%% -> ok | throw(FileError)
+write_size_file(read_only, _FName, _NewSize, _NewMaxFiles, _Version) ->
+ ok;
+write_size_file(read_write, FName, NewSize, NewMaxFiles, Version) ->
+ FileName = ?size_file_name(FName),
+ Bin = if
+ Version =:= ?VERSION ->
+ <<Version, NewSize:64, NewMaxFiles:32>>;
+ true ->
+ <<NewSize:32, NewMaxFiles:32>>
+ end,
+ case file:write_file(FileName, Bin) of
+ ok ->
+ ok;
+ E ->
+ file_error(FileName, E)
+ end.
+
+%% -> {NoBytes, NoFiles}.
+read_size_file(FName) ->
+ {Size,_Version} = read_size_file_version(FName),
+ Size.
+
+%% -> {{NoBytes, NoFiles}, Version}, Version = integer() | undefined
+read_size_file_version(FName) ->
+ case file:read_file(?size_file_name(FName)) of
+ {ok, <<Version, Size:64, MaxFiles:32>>} when Version =:= ?VERSION ->
+ {{Size, MaxFiles}, Version};
+ {ok, <<Size:32, MaxFiles:32>>} ->
+ {{Size, MaxFiles}, 1};
+ _ ->
+ %% The oldest version too...
+ {{0, 0}, ?VERSION}
+ end.
+
+conv({More, Terms}, FileNo) when is_record(More, continuation) ->
+ Cont = More#continuation{pos = {FileNo, More#continuation.pos}},
+ {Cont, Terms};
+conv({More, Terms, Bad}, FileNo) when is_record(More, continuation) ->
+ Cont = More#continuation{pos = {FileNo, More#continuation.pos}},
+ {Cont, Terms, Bad};
+conv(Other, _) ->
+ Other.
+
+find_first_file(#handle{filename = FName, curF = CurF, maxF = MaxF}) ->
+ fff(FName, inc(CurF, MaxF), CurF, MaxF).
+
+fff(_FName, CurF, CurF, _MaxF) -> CurF;
+fff(FName, MaybeFirstF, CurF, MaxF) ->
+ N = add_ext(FName, MaybeFirstF),
+ case file:read_file_info(N) of
+ {ok, _} -> MaybeFirstF;
+ _ -> fff(FName, inc(MaybeFirstF, MaxF), CurF, MaxF)
+ end.
+
+%% -> {iolist(), LastBins, NoBytes, NoTerms}
+ext_split_bins(CurB, MaxB, FirstPos, Bins) ->
+ MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos,
+ ext_split_bins(MaxBs, IsFirst, [], Bins, 0, 0).
+
+ext_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) ->
+ NBs = Bs + byte_size(X),
+ if
+ NBs =< MaxBs ->
+ ext_split_bins(MaxBs, IsFirst, [First | X], Last, NBs, N+1);
+ IsFirst, First =:= [] ->
+ % To avoid infinite loop - we allow the file to be
+ % too big if it's just one item on the file.
+ {[X], Last, NBs, N+1};
+ true ->
+ {First, [X | Last], Bs, N}
+ end;
+ext_split_bins(_, _, First, [], Bs, N) ->
+ {First, [], Bs, N}.
+
+%% -> {iolist(), LastBins, NoBytes, NoTerms}
+int_split_bins(CurB, MaxB, FirstPos, Bins) ->
+ MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos,
+ int_split_bins(MaxBs, IsFirst, [], Bins, 0, 0).
+
+int_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) ->
+ Sz = byte_size(X),
+ NBs = Bs + Sz + ?HEADERSZ,
+ BSz = <<Sz:?SIZESZ/unit:8>>,
+ XB = case Sz < ?MIN_MD5_TERM of
+ true ->
+ [BSz, ?BIGMAGICHEAD | X];
+ false ->
+ MD5 = erlang:md5(BSz),
+ [BSz, ?BIGMAGICHEAD, MD5 | X]
+ end,
+ if
+ NBs =< MaxBs ->
+ int_split_bins(MaxBs, IsFirst, [First | XB], Last, NBs, N+1);
+ IsFirst, First =:= [] ->
+ % To avoid infinite loop - we allow the file to be
+ % too big if it's just one item on the file.
+ {[XB], Last, NBs, N+1};
+ true ->
+ {First, [X | Last], Bs, N}
+ end;
+int_split_bins(_, _, First, [], Bs, N) ->
+ {First, [], Bs, N}.
+
+%% -> {NewCurrentFileNo, MaxFilesToBe} | throw(FileError)
+inc_wrap(FName, CurF, MaxF) ->
+ case MaxF of
+ %% Number of max files has changed
+ {NewMaxF, OldMaxF} ->
+ if
+ CurF >= NewMaxF ->
+ %% We are at or above the new number of files
+ remove_files(FName, CurF + 1, OldMaxF),
+ if
+ CurF > NewMaxF ->
+ %% The change was done while the current file was
+ %% greater than the new number of files.
+ %% The index file is not trunctated here, since
+ %% writing the index file while opening the file
+ %% with index 1 will write the value for the file
+ %% with extension CurF as well. Next time the
+ %% limit is reached, the index file will be
+ %% truncated.
+ {1, {NewMaxF, CurF}};
+ true ->
+ %% The change was done while the current file was
+ %% less than the new number of files.
+ %% Remove the files from the index file too
+ index_file_trunc(FName, NewMaxF),
+ {1, NewMaxF}
+ end;
+ true ->
+ %% We haven't reached the new limit yet
+ NewFt = inc(CurF, NewMaxF),
+ {NewFt, MaxF}
+ end;
+ MaxF ->
+ %% Normal case.
+ NewFt = inc(CurF, MaxF),
+ {NewFt, MaxF}
+ end.
+
+inc(N, {_NewMax, OldMax}) -> inc(N, OldMax, 1);
+inc(N, Max) -> inc(N, Max, 1).
+
+inc(N, Max, Step) ->
+ Nx = (N + Step) rem Max,
+ if
+ Nx > 0 -> Nx;
+ true -> Nx + Max
+ end.
+
+
+file_size(Fname) ->
+ {ok, Fi} = file:read_file_info(Fname),
+ Fi#file_info.size.
+
+%% -> ok | throw(FileError)
+%% Tries to remove each file with name FName.I, N<=I<=Max.
+remove_files(FName, N, Max) ->
+ remove_files(FName, N, Max, ok).
+
+remove_files(_FName, N, Max, ok) when N > Max ->
+ ok;
+remove_files(_FName, N, Max, {FileName, Error}) when N > Max ->
+ file_error(FileName, Error);
+remove_files(FName, N, Max, Reply) ->
+ FileName = add_ext(FName, N),
+ NewReply = case file:delete(FileName) of
+ ok -> Reply;
+ {error, enoent} -> Reply;
+ Error -> {FileName, Error}
+ end,
+ remove_files(FName, N + 1, Max, NewReply).
+
+%% -> {MaxBytes, MaxFiles}
+get_wrap_size(#handle{maxB = MaxB, maxF = MaxF}) ->
+ case MaxF of
+ {NewMaxF,_} -> {MaxB, NewMaxF};
+ MaxF -> {MaxB, MaxF}
+ end.
+
+add_ext(Name, Ext) ->
+ concat([Name, ".", Ext]).
+
+open_read(FileName) ->
+ file:open(FileName, [raw, binary, read]).
+
+open_update(FileName) ->
+ file:open(FileName, [raw, binary, read, write]).
+
+open_truncate(FileName) ->
+ file:open(FileName, [raw, binary, write]).
+
+%%% Functions that access files, and throw on error.
+
+-define(MAX, 16384). % bytes
+-define(TIMEOUT, 2000). % ms
+
+%% -> {Reply, cache()}; Reply = ok | Error
+fwrite(#cache{c = []} = FdC, _FN, B, Size) ->
+ case get(write_cache_timer_is_running) of
+ true ->
+ ok;
+ _ ->
+ put(write_cache_timer_is_running, true),
+ erlang:send_after(?TIMEOUT, self(), {self(), write_cache})
+ end,
+ {ok, FdC#cache{sz = Size, c = B}};
+fwrite(#cache{sz = Sz, c = C} = FdC, _FN, B, Size) when Sz < ?MAX ->
+ {ok, FdC#cache{sz = Sz+Size, c = [C | B]}};
+fwrite(#cache{fd = Fd, c = C}, FileName, B, _Size) ->
+ write_cache(Fd, FileName, [C | B]).
+
+fwrite_header(Fd, B, Size) ->
+ {ok, #cache{fd = Fd, sz = Size, c = B}}.
+
+%% -> {NewFdC, Reply}; Reply = ok | Error
+pread(#cache{fd = Fd, c = C}, FileName, Position, MaxBytes) ->
+ Reply = write_cache(Fd, FileName, C),
+ case Reply of
+ {ok, NewFdC} ->
+ case file:pread(Fd, Position, MaxBytes) of
+ {error, Error} ->
+ {NewFdC, catch file_error(FileName, {error, Error})};
+ R ->
+ {NewFdC, R}
+ end;
+ {Error, NewFdC} ->
+ {NewFdC, Error}
+ end.
+
+%% -> {ok, cache(), Pos} | {Error, cache()}
+position(#cache{fd = Fd, c = C}, FileName, Pos) ->
+ Reply = write_cache(Fd, FileName, C),
+ case Reply of
+ {ok, NewFdC} ->
+ case position2(Fd, FileName, Pos) of
+ {ok, Loc} ->
+ {ok, NewFdC, Loc};
+ Error ->
+ {Error, NewFdC}
+ end;
+ _Error ->
+ Reply
+ end.
+
+position_close(#cache{fd = Fd, c = C}, FileName, Pos) ->
+ NewFdC = write_cache_close(Fd, FileName, C),
+ {ok, Loc} = position_close2(Fd, FileName, Pos),
+ {NewFdC, Loc}.
+
+fsync(#cache{fd = Fd, c = C}, FileName) ->
+ Reply = write_cache(Fd, FileName, C),
+ case Reply of
+ {ok, NewFdC} ->
+ case file:sync(Fd) of
+ ok ->
+ Reply;
+ Error ->
+ {catch file_error(FileName, Error), NewFdC}
+ end;
+ _Error ->
+ Reply
+ end.
+
+%% -> {Reply, NewFdC}; Reply = ok | Error
+truncate_at(FdC, FileName, Pos) ->
+ case position(FdC, FileName, Pos) of
+ {ok, NewFdC, _Pos} ->
+ case file:truncate(NewFdC#cache.fd) of
+ ok ->
+ {ok, NewFdC};
+ Error ->
+ {catch file_error(FileName, Error), NewFdC}
+ end;
+ Reply ->
+ Reply
+ end.
+
+fwrite_close2(Fd, FileName, B) ->
+ case file:write(Fd, B) of
+ ok -> ok;
+ Error -> file_error_close(Fd, FileName, Error)
+ end.
+
+pwrite_close2(Fd, FileName, Position, B) ->
+ case file:pwrite(Fd, Position, B) of
+ ok -> ok;
+ Error -> file_error(FileName, {error, Error})
+ end.
+
+position2(Fd, FileName, Pos) ->
+ case file:position(Fd, Pos) of
+ {error, Error} -> catch file_error(FileName, {error, Error});
+ OK -> OK
+ end.
+
+position_close2(Fd, FileName, Pos) ->
+ case file:position(Fd, Pos) of
+ {error, Error} -> file_error_close(Fd, FileName, {error, Error});
+ OK -> OK
+ end.
+
+truncate_at_close2(Fd, FileName, Pos) ->
+ position_close2(Fd, FileName, Pos),
+ case file:truncate(Fd) of
+ ok -> ok;
+ Error -> file_error_close(Fd, FileName, Error)
+ end.
+
+fclose(#cache{fd = Fd, c = C}, FileName) ->
+ %% The cache is empty if the file was opened in read_only mode.
+ write_cache_close(Fd, FileName, C),
+ file:close(Fd).
+
+%% -> {Reply, #cache{}}; Reply = ok | Error
+write_cache(Fd, _FileName, []) ->
+ {ok, #cache{fd = Fd}};
+write_cache(Fd, FileName, C) ->
+ case file:write(Fd, C) of
+ ok -> {ok, #cache{fd = Fd}};
+ Error -> {catch file_error(FileName, Error), #cache{fd = Fd}}
+ end.
+
+-spec write_cache_close(fd(), file:filename(), iodata()) -> #cache{}. % | throw(Error)
+
+write_cache_close(Fd, _FileName, []) ->
+ #cache{fd = Fd};
+write_cache_close(Fd, FileName, C) ->
+ case file:write(Fd, C) of
+ ok -> #cache{fd = Fd};
+ Error -> file_error_close(Fd, FileName, Error)
+ end.
+
+-spec file_error(file:filename(), {'error', atom()}) -> no_return().
+
+file_error(FileName, {error, Error}) ->
+ throw({error, {file_error, FileName, Error}}).
+
+-spec file_error_close(fd(), file:filename(), {'error', atom()}) -> no_return().
+
+file_error_close(Fd, FileName, {error, Error}) ->
+ file:close(Fd),
+ throw({error, {file_error, FileName, Error}}).
diff --git a/lib/kernel/src/disk_log_server.erl b/lib/kernel/src/disk_log_server.erl
new file mode 100644
index 0000000000..8894ed87e8
--- /dev/null
+++ b/lib/kernel/src/disk_log_server.erl
@@ -0,0 +1,368 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(disk_log_server).
+-behaviour(gen_server).
+
+-export([start_link/0, start/0, open/1, close/1,
+ get_log_pids/1, accessible_logs/0]).
+
+%% Local export.
+-export([dist_open/1, get_local_pid/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_info/2, terminate/2]).
+-export([handle_cast/2, code_change/3]). % just to avoid compiler warning
+
+-include("disk_log.hrl").
+
+-compile({inline,[{do_get_log_pids,1}]}).
+
+-record(pending, {log, pid, req, from, attach, clients}). % [{Request,From}]
+
+-record(state, {pending = [] :: [#pending{}]}).
+
+%%%-----------------------------------------------------------------
+%%% This module implements the disk_log server. Its primary purpose
+%%% is to keep the ets table 'disk_log_names' updated and to handle
+%%% distribution data (pids) using the module pg2.
+%%%-----------------------------------------------------------------
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+start_link() ->
+ gen_server:start_link({local, disk_log_server}, disk_log_server, [], []).
+
+start() ->
+ ensure_started().
+
+open({ok, A}) ->
+ ensure_started(),
+ gen_server:call(disk_log_server, {open, local, A}, infinity);
+open(Other) ->
+ Other.
+
+%% To be used from this module only.
+dist_open(A) ->
+ ensure_started(),
+ gen_server:call(disk_log_server, {open, distr, A}, infinity).
+
+close(Pid) ->
+ gen_server:call(disk_log_server, {close, Pid}, infinity).
+
+get_log_pids(LogName) ->
+ do_get_log_pids(LogName).
+
+accessible_logs() ->
+ ensure_started(),
+ do_accessible_logs().
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from gen_server
+%%%----------------------------------------------------------------------
+
+%% It would have been really nice to have a tag for disk log groups,
+%% like {distributed_disk_log, Log}, but backward compatibility makes
+%% it hard to introduce.
+-define(group(Log), Log).
+
+init([]) ->
+ process_flag(trap_exit, true),
+ ets:new(?DISK_LOG_NAME_TABLE, [named_table, set]),
+ ets:new(?DISK_LOG_PID_TABLE, [named_table, set]),
+ {ok, #state{}}.
+
+handle_call({open, W, A}, From, State) ->
+ open([{{open, W, A}, From}], State);
+handle_call({close, Pid}, _From, State) ->
+ Reply = do_close(Pid),
+ {reply, Reply, State}.
+
+handle_info({pending_reply, Pid, Result0}, State) ->
+ {value, #pending{log = Name, pid = Pid, from = From,
+ req = Request, attach = Attach,
+ clients = Clients}} =
+ lists:keysearch(Pid, #pending.pid, State#state.pending),
+ NP = lists:keydelete(Pid, #pending.pid, State#state.pending),
+ State1 = State#state{pending = NP},
+ if
+ Attach and (Result0 =:= {error, no_such_log}) ->
+ %% The disk_log process has terminated. Try again.
+ open([{Request,From} | Clients], State1);
+ true ->
+ case Result0 of
+ _ when Attach ->
+ ok;
+ {error, _} ->
+ ok;
+ _ ->
+ put(Pid, Name),
+ link(Pid),
+ {_, Locality, _} = Request,
+ ets:insert(?DISK_LOG_PID_TABLE, {Pid, Name}),
+ ets:insert(?DISK_LOG_NAME_TABLE, {Name, Pid, Locality}),
+ if
+ Locality =:= distr ->
+ ok = pg2:join(?group(Name), Pid);
+ true ->
+ ok
+ end
+ end,
+ gen_server:reply(From, result(Request, Result0)),
+ open(Clients, State1)
+ end;
+handle_info({'EXIT', Pid, _Reason}, State) ->
+ %% If there are clients waiting to be attached to this log, info
+ %% {pending_reply,Pid,{error,no_such_log}} will soon arrive.
+ case get(Pid) of
+ undefined ->
+ ok;
+ Name ->
+ erase_log(Name, Pid)
+ end,
+ {noreply, State};
+handle_info(_, State) ->
+ {noreply, State}.
+
+%% Just to avoid compiler warning.
+handle_cast(_, State) ->
+ {noreply, State}.
+
+%% Just to avoid compiler warning.
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+terminate(_Reason, _) ->
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Internal functions
+%%%-----------------------------------------------------------------
+
+ensure_started() ->
+ case whereis(disk_log_server) of
+ undefined ->
+ LogSup = {disk_log_sup, {disk_log_sup, start_link, []}, permanent,
+ 1000, supervisor, [disk_log_sup]},
+ supervisor:start_child(kernel_safe_sup, LogSup),
+ LogServer = {disk_log_server,
+ {disk_log_server, start_link, []},
+ permanent, 2000, worker, [disk_log_server]},
+ supervisor:start_child(kernel_safe_sup, LogServer),
+ ok;
+ _ -> ok
+ end.
+
+open([{Req, From} | L], State) ->
+ State2 = case do_open(Req, From, State) of
+ {pending, State1} ->
+ State1;
+ {Reply, State1} ->
+ gen_server:reply(From, Reply),
+ State1
+ end,
+ open(L, State2);
+open([], State) ->
+ {noreply, State}.
+
+%% -> {OpenRet, NewState} | {{node(),OpenRet}, NewState} |
+%% {pending, NewState}
+do_open({open, W, #arg{name = Name}=A}=Req, From, State) ->
+ case check_pending(Name, From, State, Req) of
+ {pending, NewState} ->
+ {pending, NewState};
+ false when W =:= local ->
+ case A#arg.distributed of
+ {true, Nodes} ->
+ Fun = fun() -> open_distr_rpc(Nodes, A, From) end,
+ _Pid = spawn(Fun),
+ %% No pending reply is expected, but don't reply yet.
+ {pending, State};
+ false ->
+ case get_local_pid(Name) of
+ {local, Pid} ->
+ do_internal_open(Name, Pid, From, Req, true,State);
+ {distributed, _Pid} ->
+ {{error, {node_already_open, Name}}, State};
+ undefined ->
+ start_log(Name, Req, From, State)
+ end
+ end;
+ false when W =:= distr ->
+ ok = pg2:create(?group(Name)),
+ case get_local_pid(Name) of
+ undefined ->
+ start_log(Name, Req, From, State);
+ {local, _Pid} ->
+ {{node(),{error, {node_already_open, Name}}}, State};
+ {distributed, Pid} ->
+ do_internal_open(Name, Pid, From, Req, true, State)
+ end
+ end.
+
+%% Spawning a process is a means to avoid deadlock when
+%% disk_log_servers mutually open disk_logs.
+
+-spec open_distr_rpc([node()], _, _) -> no_return(). % XXX: underspecified
+
+open_distr_rpc(Nodes, A, From) ->
+ {AllReplies, BadNodes} = rpc:multicall(Nodes, ?MODULE, dist_open, [A]),
+ {Ok, Bad} = cr(AllReplies, [], []),
+ Old = find_old_nodes(Nodes, AllReplies, BadNodes),
+ NotOk = [{BadNode, {error, nodedown}} || BadNode <- BadNodes ++ Old],
+ Reply = {Ok, Bad ++ NotOk},
+ %% Send the reply to the waiting client:
+ gen_server:reply(From, Reply),
+ exit(normal).
+
+cr([{badrpc, {'EXIT', _}} | T], Nodes, Bad) ->
+ %% This clause can be removed in next release.
+ cr(T, Nodes, Bad);
+cr([R={_Node, {error, _}} | T], Nodes, Bad) ->
+ cr(T, Nodes, [R | Bad]);
+cr([Reply | T], Nodes, Bad) ->
+ cr(T, [Reply | Nodes], Bad);
+cr([], Nodes, Bad) ->
+ {Nodes, Bad}.
+
+%% If a "new" node (one that calls dist_open/1) tries to open a log
+%% on an old node (one that does not have dist_open/1), then the old
+%% node is considered 'down'. In next release, this test will not be
+%% needed since all nodes can be assumed to be "new" by then.
+%% One more thing: if an old node tries to open a log on a new node,
+%% the new node is also considered 'down'.
+find_old_nodes(Nodes, Replies, BadNodes) ->
+ R = [X || {X, _} <- Replies],
+ ordsets:to_list(ordsets:subtract(ordsets:from_list(Nodes),
+ ordsets:from_list(R ++ BadNodes))).
+
+start_log(Name, Req, From, State) ->
+ Server = self(),
+ case supervisor:start_child(disk_log_sup, [Server]) of
+ {ok, Pid} ->
+ do_internal_open(Name, Pid, From, Req, false, State);
+ Error ->
+ {result(Req, Error), State}
+ end.
+
+do_internal_open(Name, Pid, From, {open, _W, A}=Req, Attach, State) ->
+ Server = self(),
+ F = fun() ->
+ Res = disk_log:internal_open(Pid, A),
+ Server ! {pending_reply, Pid, Res}
+ end,
+ _ = spawn(F),
+ PD = #pending{log = Name, pid = Pid, req = Req,
+ from = From, attach = Attach, clients = []},
+ P = [PD | State#state.pending],
+ {pending, State#state{pending = P}}.
+
+check_pending(Name, From, State, Req) ->
+ case lists:keysearch(Name, #pending.log, State#state.pending) of
+ {value, #pending{log = Name, clients = Clients}=P} ->
+ NP = lists:keyreplace(Name, #pending.log, State#state.pending,
+ P#pending{clients = Clients++[{Req,From}]}),
+ {pending, State#state{pending = NP}};
+ false ->
+ false
+ end.
+
+result({_, distr, _}, R) ->
+ {node(), R};
+result({_, local, _}, R) ->
+ R.
+
+do_close(Pid) ->
+ case get(Pid) of
+ undefined ->
+ ok;
+ Name ->
+ erase_log(Name, Pid),
+ unlink(Pid),
+ ok
+ end.
+
+erase_log(Name, Pid) ->
+ case get_local_pid(Name) of
+ undefined ->
+ ok;
+ {local, Pid} ->
+ true = ets:delete(?DISK_LOG_NAME_TABLE, Name),
+ true = ets:delete(?DISK_LOG_PID_TABLE, Pid);
+ {distributed, Pid} ->
+ true = ets:delete(?DISK_LOG_NAME_TABLE, Name),
+ true = ets:delete(?DISK_LOG_PID_TABLE, Pid),
+ ok = pg2:leave(?group(Name), Pid)
+ end,
+ erase(Pid).
+
+do_accessible_logs() ->
+ LocalSpec = {'$1','_',local},
+ Local0 = [hd(L) || L <- ets:match(?DISK_LOG_NAME_TABLE, LocalSpec)],
+ Local = lists:sort(Local0),
+ Groups0 = ordsets:from_list(pg2:which_groups()),
+ Groups = ordsets:to_list(ordsets:subtract(Groups0, Local)),
+ Dist = [L || L <- Groups, dist_pids(L) =/= []],
+ {Local, Dist}.
+
+get_local_pid(LogName) ->
+ case ets:lookup(?DISK_LOG_NAME_TABLE, LogName) of
+ [{LogName, Pid, local}] ->
+ {local, Pid};
+ [{LogName, Pid, distr}] ->
+ {distributed, Pid};
+ [] ->
+ undefined
+ end.
+
+%% Inlined.
+do_get_log_pids(LogName) ->
+ case catch ets:lookup(?DISK_LOG_NAME_TABLE, LogName) of
+ [{LogName, Pid, local}] ->
+ {local, Pid};
+ [{LogName, _Pid, distr}] ->
+ case pg2:get_members(?group(LogName)) of
+ [] -> % The disk_log process has died recently
+ undefined;
+ Members ->
+ {distributed, Members}
+ end;
+ _EmptyOrError ->
+ case dist_pids(LogName) of
+ [] -> undefined;
+ Pids -> {distributed, Pids}
+ end
+ end.
+
+dist_pids(LogName) ->
+ %% Would be much simpler if disk log group names were tagged.
+ GroupName = ?group(LogName),
+ case catch pg2:get_members(GroupName) of
+ [Pid | _] = Pids ->
+ case rpc:call(node(Pid), ?MODULE, get_local_pid, [LogName]) of
+ undefined -> % does not seem to be a disk_log group
+ case catch lists:member(Pid,pg2:get_members(GroupName)) of
+ true -> [];
+ _ -> dist_pids(LogName)
+ end;
+ _ -> % badrpc if get_local_pid is not exported
+ Pids
+ end;
+ _ ->
+ []
+ end.
diff --git a/lib/kernel/src/disk_log_sup.erl b/lib/kernel/src/disk_log_sup.erl
new file mode 100644
index 0000000000..96e37b678c
--- /dev/null
+++ b/lib/kernel/src/disk_log_sup.erl
@@ -0,0 +1,32 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(disk_log_sup).
+
+-behaviour(supervisor).
+
+-export([start_link/0, init/1]).
+
+start_link()->
+ supervisor:start_link({local, disk_log_sup}, disk_log_sup, []).
+
+init([]) ->
+ SupFlags = {simple_one_for_one, 4, 3600},
+ Child = {disk_log, {disk_log, istart_link, []}, temporary,
+ 1000, worker, [disk_log]},
+ {ok, {SupFlags, [Child]}}.
diff --git a/lib/kernel/src/dist.hrl b/lib/kernel/src/dist.hrl
new file mode 100644
index 0000000000..aea1ab81ba
--- /dev/null
+++ b/lib/kernel/src/dist.hrl
@@ -0,0 +1,38 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%% Distribution capabilities flags (corresponds with dist.h).
+%%
+
+-define(DFLAG_PUBLISHED,1).
+-define(DFLAG_ATOM_CACHE,2).
+-define(DFLAG_EXTENDED_REFERENCES,4).
+-define(DFLAG_DIST_MONITOR,8).
+-define(DFLAG_FUN_TAGS,16#10).
+-define(DFLAG_DIST_MONITOR_NAME,16#20).
+-define(DFLAG_HIDDEN_ATOM_CACHE,16#40).
+-define(DFLAG_NEW_FUN_TAGS,16#80).
+-define(DFLAG_EXTENDED_PIDS_PORTS,16#100).
+-define(DFLAG_EXPORT_PTR_TAG,16#200).
+-define(DFLAG_BIT_BINARIES,16#400).
+-define(DFLAG_NEW_FLOATS,16#800).
+-define(DFLAG_UNICODE_IO,16#1000).
+-define(DFLAG_DIST_HDR_ATOM_CACHE,16#2000).
+-define(DFLAG_SMALL_ATOM_TAGS, 16#4000).
diff --git a/lib/kernel/src/dist_ac.erl b/lib/kernel/src/dist_ac.erl
new file mode 100644
index 0000000000..5c62aa31e9
--- /dev/null
+++ b/lib/kernel/src/dist_ac.erl
@@ -0,0 +1,1534 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(dist_ac).
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/0,
+ load_application/2,
+ takeover_application/2,
+ permit_application/2,
+ permit_only_loaded_application/2]).
+
+-export([get_known_nodes/0]).
+
+%% Internal exports
+-export([init/1, handle_cast/2, handle_call/3, handle_info/2, terminate/2,
+ code_change/3, send_timeout/3]).
+-export([info/0]).
+
+-import(lists, [zf/2, filter/2, map/2, foreach/2, foldl/3, mapfoldl/3,
+ keysearch/3, keydelete/3, keyreplace/4, member/2]).
+
+-define(AC, application_controller).
+-define(DIST_AC, ?MODULE).
+-define(LOCK_ID, ?MODULE).
+
+%% This is the protocol version for the dist_ac protcol (between nodes)
+-define(vsn, 1).
+
+%%%-----------------------------------------------------------------
+%%% This module implements the default Distributed Applications
+%%% Controller. It is possible to write other controllers, when
+%%% the functionality in this module are not sufficient.
+%%% The process cooperates with the application_controller.
+%%%-----------------------------------------------------------------
+
+%%-----------------------------------------------------------------
+%% Naming conventions:
+%% Appl = #appl
+%% AppName = atom()
+%%-----------------------------------------------------------------
+-record(state, {appls = [], tmp_locals = [], remote_started = [],
+ known = [], started = [], tmp_weights = [],
+ dist_loaded = [], t_reqs = [], s_reqs = [], p_reqs = []}).
+%%-----------------------------------------------------------------
+%% appls = [#appl()] - these are the applications we control
+%% tmp_locals = [{AppName, Weight, node()}] - tmp, info part of
+%% application startup for some distrib appls,
+%% not yet handled.
+%% remote_started = [{Node, AppName}] - info on apps started before
+%% we were started
+%% known = [Node] - These are the nodes known to us
+%% started = [AppName] - An ordered list of started applications
+%% (reversed start order)
+%% tmp_weight = [{AppName, MyWeight}] - tmp, if we're forced to
+%% send a dist_ac_weight message before we're prepared to,
+%% we remember the weight we sent here, so we can use
+%% it in the dist_ac_weight msgs later.
+%% dist_loaded = {{Name, Node}, HisNodes, Permission} - info on
+%% application loaded on other nodes (and own node)
+%% t_reqs = [{AppName, From}] - processes waiting for takeover
+%% to complete.
+%% s_reqs = [{AppName, From}] - processes waiting for stop
+%% to complete.
+%% p_reqs = [{From, AppName, Bool, [Node]] - outstanding permit.
+%% Nodes is a list of nodes we're still waiting for.
+%%-----------------------------------------------------------------
+
+-record(appl, {name, id, restart_time = 0, nodes = [], run = []}).
+
+%%-----------------------------------------------------------------
+%% id = local | undefined | {distributed, node()} | waiting | run_waiting |
+%% {failover, Node} | {takeover, Node}
+%% local : local application
+%% undefined : not yet started
+%% {distributed, Node} : running on another node, we're standby
+%% {failover, Node} : failover from Node
+%% {takeover, Node} : takeover from Node
+%% waiting : other node went down, we're waiting for a timeout
+%% to takeover it. From = pid() | undefined
+%% run_waiting : we have decided to start the app; wait for the
+%% AC result
+%%-----------------------------------------------------------------
+
+start_link() ->
+ case gen_server:start_link({local, ?DIST_AC}, ?MODULE, [], []) of
+ {ok, Pid} ->
+ gen_server:cast(?DIST_AC, init_sync),
+ {ok, Pid};
+ Else ->
+ Else
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Func: load_application(AppName, DistNodes)
+%% Args: AppName = atom()
+%% DistNodes = default | {AppName, Time, [node() | {node()...}]}
+%% Purpose: Notifies the dist_ac about distributed nodes for an
+%% application. DistNodes overrides the kernel 'distributed'
+%% parameter.
+%% Returns: ok | {error, Reason}
+%%-----------------------------------------------------------------
+load_application(AppName, DistNodes) ->
+ gen_server:call(?DIST_AC, {load_application, AppName, DistNodes}, infinity).
+
+takeover_application(AppName, RestartType) ->
+ case validRestartType(RestartType) of
+ true ->
+ wait_for_sync_dacs(),
+ Nodes = get_nodes(AppName),
+ global:trans(
+ {?LOCK_ID, self()},
+ fun() ->
+ gen_server:call(
+ ?DIST_AC,
+ {takeover_application, AppName, RestartType},
+ infinity)
+ end,
+ Nodes);
+ false ->
+ {error, {invalid_restart_type, RestartType}}
+ end.
+
+%%-----------------------------------------------------------------
+%% This function controls which applications are permitted to run. If
+%% an application X runs when this function is called as
+%% permit_application(X, false), it is moved to another node where it
+%% is permitted to run (distributed applications only). If there is
+%% no such node, the application is stopped. (I.e. local applications
+%% are always stopped, and distributed applications with no other node
+%% alive are stopped as well.) If later a call to
+%% permit_application(X, true) is made, X is restarted.
+%% For example, suppose applications app1 and app2 are started and
+%% running.
+%% If we evaluate
+%% permit_application(app2, false)
+%% app2 is stopped and app1 only is running.
+%% If we now evaluate
+%% permit_application(app2, true),
+%% permit_application(app3, true)
+%% app2 is restarted, but not app3, since it hasn't been started by a
+%% call to start_application.
+%%-----------------------------------------------------------------
+permit_application(AppName, Bool) ->
+ wait_for_sync_dacs(),
+ LockId = {?LOCK_ID, self()},
+ global:trans(
+ LockId,
+ fun() ->
+ gen_server:call(?DIST_AC,
+ {permit_application, AppName, Bool, LockId, started},
+ infinity)
+ end).
+
+permit_only_loaded_application(AppName, Bool) ->
+ wait_for_sync_dacs(),
+ LockId = {?LOCK_ID, self()},
+ global:trans(
+ LockId,
+ fun() ->
+ gen_server:call(?DIST_AC,
+ {permit_application, AppName, Bool, LockId, only_loaded},
+ infinity)
+ end).
+
+get_nodes(AppName) ->
+ gen_server:call(?DIST_AC, {get_nodes, AppName}, infinity).
+
+get_known_nodes() ->
+ gen_server:call(?DIST_AC, get_known_nodes).
+
+%%%-----------------------------------------------------------------
+%%% call-back functions from gen_server
+%%%-----------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok, #state{}}.
+
+sync_dacs(Appls) ->
+ Res = global:trans({?LOCK_ID, sync_dacs},
+ fun() ->
+ Nodes = introduce_me(nodes(), Appls),
+ wait_dacs(Nodes, [node()], Appls, [])
+ end),
+ ets:insert(ac_tab, {sync_dacs, ok}),
+ Res.
+
+introduce_me(Nodes, Appls) ->
+ Msg = {dist_ac_new_node, ?vsn, node(), Appls, []},
+ filter(fun(Node) ->
+ %% This handles nodes without DACs
+ case rpc:call(Node, erlang, whereis, [?DIST_AC]) of
+ Pid when is_pid(Pid) ->
+ Pid ! Msg,
+ true;
+ _ ->
+ false
+ end
+ end, Nodes).
+
+wait_dacs([Node | Nodes], KnownNodes, Appls, RStarted) ->
+ monitor_node(Node, true),
+ receive
+ %% HisAppls =/= [] is the case when our node connects to a running system
+ %%
+ %% It is always the responsibility of newer versions to understand
+ %% older versions of the protocol. As we don't have any older
+ %% versions (that are supposed to work with this version), we
+ %% don't handle version mismatch here.
+ {dist_ac_new_node, _Vsn, Node, HisAppls, HisStarted} ->
+ monitor_node(Node, false),
+ NRStarted = RStarted ++ HisStarted,
+ NAppls = dist_merge(Appls, HisAppls, Node),
+ wait_dacs(Nodes, [Node | KnownNodes], NAppls, NRStarted);
+ {nodedown, Node} ->
+ monitor_node(Node, false),
+ wait_dacs(Nodes, KnownNodes, Appls, RStarted)
+ end;
+wait_dacs([], KnownNodes, Appls, RStarted) ->
+ {KnownNodes, Appls, RStarted}.
+
+
+info() ->
+ gen_server:call(?DIST_AC, info).
+
+
+%%-----------------------------------------------------------------
+%% All functions that can affect which applications are running
+%% execute within a global lock, to ensure that they are not
+%% executing at the same time as sync_dacs. However, to avoid a
+%% deadlock situation where e.g. permit_application gets the lock
+%% before sync_dacs, this function is used to ensure that the local
+%% sync_dacs always gets the lock first of all. The lock is still
+%% used to not interfere with sync_dacs on other nodes.
+%%-----------------------------------------------------------------
+wait_for_sync_dacs() ->
+ case catch ets:lookup(ac_tab, sync_dacs) of
+ [{sync_dacs, ok}] -> ok;
+ _ ->
+ receive after 100 -> ok end,
+ wait_for_sync_dacs()
+ end.
+
+handle_cast(init_sync, _S) ->
+ %% When the dist_ac is started, it receives this msg, and gets into
+ %% the receive loop. 'go' is sent from the kernel_config proc when
+ %% all nodes that should be pinged has been pinged. The reason for this
+ %% is that dist_ac syncs with the other nodes at start-up. That is,
+ %% it does _not_ handle partitioned nets! The other nodes tries to call
+ %% the local name dist_ac, which means that this name must be registered
+ %% before the distribution. But it can't sync until after the distribution
+ %% is started. Therefore, this 'go'-thing.
+ receive
+ {go, KernelConfig} ->
+ Appls = case application:get_env(kernel, distributed) of
+ {ok, D} -> dist_check(D);
+ undefined -> []
+ end,
+
+ dist_take_control(Appls),
+ %% kernel_config waits for dist_ac to take control over its
+ %% applications. By this we can be sure that the kernel
+ %% application hasn't completed its start before dist_ac has
+ %% taken control over its applications. (OTP-3509)
+ KernelConfig ! dist_ac_took_control,
+
+ %% we're really just interested in nodedowns.
+ net_kernel:monitor_nodes(true),
+
+ {Known, NAppls, RStarted} = sync_dacs(Appls),
+
+ {noreply,
+ #state{appls = NAppls, known = Known, remote_started = RStarted}}
+ end.
+
+
+handle_call(info, _From, S) ->
+ {reply, S, S};
+
+
+
+handle_call({load_application, AppName, DistNodes}, _From, S) ->
+ Appls = S#state.appls,
+ case catch dist_replace(DistNodes, AppName, Appls) of
+ {error, Error} ->
+ {reply, {error, Error}, S};
+ {'EXIT', R} ->
+ {stop, R, {error, R}, S};
+ NAppls ->
+ NewS = case dist_find_nodes(NAppls, AppName) of
+ [] -> % No distrib nodes; we ignore it
+ S;
+ _Nodes ->
+ ensure_take_control(AppName, Appls),
+ {ok, S2} = load(AppName, S#state{appls = NAppls}),
+ S2
+ end,
+ {reply, ok, NewS}
+ end;
+
+handle_call({takeover_application, AppName, RestartType}, From, S) ->
+ Appls = S#state.appls,
+ case keysearch(AppName, #appl.name, Appls) of
+ {value, Appl} when element(1, Appl#appl.id) =:= distributed ->
+ {distributed, Node} = Appl#appl.id,
+ ac_takeover(req, AppName, Node, RestartType),
+ NAppl = Appl#appl{id = takeover},
+ NAppls = keyreplace(AppName, #appl.name, Appls, NAppl),
+ TR = S#state.t_reqs,
+ {noreply, S#state{appls = NAppls,
+ t_reqs = [{AppName, From} | TR]}};
+ {value, #appl{id = local}} ->
+ {reply, {error, {already_running_locally, AppName}}, S};
+ _ ->
+ {reply, {error, {not_running_distributed, AppName}}, S}
+ end;
+
+handle_call({permit_application, AppName, Bool, LockId, StartInfo}, From, S) ->
+ case lists:keymember(AppName, #appl.name, S#state.appls) of
+ false ->
+ %% This one covers the case with permit for non-distributed
+ %% applications. This shouldn't be handled like this, and not
+ %% here, but we have to be backwards-compatible.
+ case application_controller:get_loaded(AppName) of
+ {true, _} when not Bool ->
+ ac_stop_it(AppName),
+ {reply, ok, S};
+ {true, _} when Bool ->
+ ac_start_it(req, AppName),
+ {reply, ok, S};
+ false ->
+ {reply, {error, {not_loaded, AppName}}, S}
+ end;
+ true ->
+ NAppls = dist_update_run(S#state.appls, AppName, node(), Bool),
+ NewS = S#state{appls = NAppls},
+ %% Check if the application is running
+ IsRunning = keysearch(AppName, #appl.name, NAppls),
+ IsMyApp = case IsRunning of
+ {value, #appl{id = local}} -> true;
+ _ -> false
+ end,
+ %% Tell everyone about the new permission
+ Nodes = dist_flat_nodes(NAppls, AppName),
+ Msg = {dist_ac_new_permission, node(), AppName, Bool, IsMyApp},
+ send_msg(Msg, Nodes),
+ case StartInfo of
+ only_loaded ->
+ {reply, ok, NewS};
+ started ->
+ permit(Bool, IsRunning, AppName, From, NewS, LockId)
+ end
+ end;
+
+%%-----------------------------------------------------------------
+%% The distributed parameter is changed. Update the parameters
+%% but the applications are actually not moved to other nodes
+%% even if they should.
+%%-----------------------------------------------------------------
+handle_call({distribution_changed, NewDistribution}, _From, S) ->
+ Appls = S#state.appls,
+ NewAppls = dist_change_update(Appls, NewDistribution),
+ NewS = S#state{appls = NewAppls},
+ {reply, ok, NewS};
+
+
+handle_call({get_nodes, AppName}, _From, S) ->
+ Alive = intersection(dist_flat_nodes(S#state.appls, AppName),
+ S#state.known),
+ {reply, Alive, S};
+
+handle_call(get_known_nodes, _From, S) ->
+ {reply, S#state.known, S}.
+
+
+handle_info({ac_load_application_req, AppName}, S) ->
+ {ok, NewS} = load(AppName, S),
+ ?AC ! {ac_load_application_reply, AppName, ok},
+ {noreply, NewS};
+
+handle_info({ac_application_unloaded, AppName}, S) ->
+ {ok, NewS} = unload(AppName, S),
+ {noreply, NewS};
+
+handle_info({ac_start_application_req, AppName}, S) ->
+ %% We must decide if we or another node should start the application
+ Lock = {?LOCK_ID, self()},
+ case global:set_lock(Lock, [node()], 0) of
+ true ->
+ S2 = case catch start_appl(AppName, S, reply) of
+ {ok, NewS, _} ->
+ NewS;
+ {error, R} ->
+ ?AC ! {ac_start_application_reply, AppName, {error,R}},
+ S
+ end,
+ global:del_lock(Lock),
+ {noreply, S2};
+ false ->
+ send_after(100, {ac_start_application_req, AppName}),
+ {noreply, S}
+ end;
+
+handle_info({ac_application_run, AppName, Res}, S) ->
+ %% We ordered a start, and here's the result. Tell all other nodes.
+ Appls = S#state.appls,
+ Nodes = S#state.known,
+ %% Send this to _all_ known nodes, as any node could sync
+ %% on this app (not only nodes that can run it).
+ send_msg({dist_ac_app_started, node(), AppName, Res}, Nodes),
+ NId = case Res of
+ ok -> local;
+ {error, _R} -> undefined
+ end,
+ {value, Appl} = keysearch(AppName, #appl.name, Appls),
+ %% Check if we have somebody waiting for the takeover result
+ NTReqs = del_t_reqs(AppName, S#state.t_reqs, Res),
+ NAppl = Appl#appl{id = NId},
+ NAppls = keyreplace(AppName, #appl.name, Appls, NAppl),
+ {noreply, S#state{appls = NAppls, t_reqs = NTReqs}};
+
+
+handle_info({ac_application_not_run, AppName}, S) ->
+ %% We ordered a stop, and now it has stopped
+ {value, Appl} = keysearch(AppName, #appl.name, Appls = S#state.appls),
+ %% Check if we have somebody waiting for the takeover result;
+ %% if somebody called stop just before takeover was handled,
+ NTReqs = del_t_reqs(AppName, S#state.t_reqs, {error, stopped}),
+ %% Check if we have somebody waiting for stop to return
+ SReqs = filter(fun({Name, From2}) when Name =:= AppName ->
+ gen_server:reply(From2, ok),
+ false;
+ (_) ->
+ true
+ end, S#state.s_reqs),
+ RS = case Appl#appl.id of
+ local ->
+ send_msg({dist_ac_app_stopped, AppName}, S#state.known),
+ S#state.remote_started;
+ {distributed, Node} ->
+ [{Node, AppName} | S#state.remote_started];
+ _ ->
+ S#state.remote_started
+ end,
+ NAppl = Appl#appl{id = undefined},
+ NAppls = keyreplace(AppName, #appl.name, Appls, NAppl),
+ {noreply, S#state{appls = NAppls, t_reqs = NTReqs, s_reqs = SReqs,
+ remote_started = RS}};
+
+handle_info({ac_application_stopped, AppName}, S) ->
+ %% Somebody called application:stop - reset state as it was before
+ %% the application was started.
+ {value, Appl} = keysearch(AppName, #appl.name, Appls = S#state.appls),
+ %% Check if we have somebody waiting for the takeover result;
+ %% if somebody called stop just before takeover was handled,
+ NTReqs = del_t_reqs(AppName, S#state.t_reqs, {error, stopped}),
+ %% Check if we have somebody waiting for stop to return
+ SReqs = filter(fun({Name, From2}) when Name =:= AppName ->
+ gen_server:reply(From2, ok),
+ false;
+ (_) ->
+ true
+ end, S#state.s_reqs),
+ RS = case Appl#appl.id of
+ local ->
+ send_msg({dist_ac_app_stopped, AppName}, S#state.known),
+ S#state.remote_started;
+ {distributed, Node} ->
+ [{Node, AppName} | S#state.remote_started];
+ _ ->
+ S#state.remote_started
+ end,
+ NAppl = Appl#appl{id = undefined},
+ NAppls = keyreplace(AppName, #appl.name, Appls, NAppl),
+ Started = lists:delete(AppName, S#state.started),
+ {noreply, S#state{appls = NAppls, started = Started,
+ t_reqs = NTReqs, s_reqs = SReqs,
+ remote_started = RS}};
+
+
+%%-----------------------------------------------------------------
+%% A new node gets running.
+%% Send him info about our started distributed applications.
+%%-----------------------------------------------------------------
+handle_info({dist_ac_new_node, _Vsn, Node, HisAppls, []}, S) ->
+ Appls = S#state.appls,
+ MyStarted = zf(fun(Appl) when Appl#appl.id =:= local ->
+ {true, {node(), Appl#appl.name}};
+ (_) ->
+ false
+ end, Appls),
+ {?DIST_AC, Node} ! {dist_ac_new_node, ?vsn, node(), Appls, MyStarted},
+ NAppls = dist_merge(Appls, HisAppls, Node),
+ {noreply, S#state{appls = NAppls, known = [Node | S#state.known]}};
+
+handle_info({dist_ac_app_started, Node, Name, Res}, S) ->
+ case {keysearch(Name, #appl.name, S#state.appls), lists:member(Name, S#state.started)} of
+ {{value, Appl}, true} ->
+ Appls = S#state.appls,
+ NId = case Appl#appl.id of
+ _ when element(1, Res) =:= error ->
+ %% Start of appl on some node failed.
+ %% Set Id to undefined. That node will have
+ %% to take some actions, e.g. reboot
+ undefined;
+ {distributed, _} ->
+ %% Another node tookover from some node. Update
+ %% appl list.
+ {distributed, Node};
+ local ->
+ %% Another node tookover from me; stop my application
+ %% and update the running list.
+ {distributed, Node};
+ _ ->
+ %% Another node started appl. Update appl list.
+ {distributed, Node}
+ end,
+ ac_started(req, Name, Node),
+ NAppl = Appl#appl{id = NId},
+ NAppls = keyreplace(Name, #appl.name, Appls, NAppl),
+ TmpWeights = keydelete_all(Name, 1, S#state.tmp_weights),
+ NewS = S#state{appls = NAppls, tmp_weights = TmpWeights},
+ NPermitReq = req_del_permit_false(NewS#state.p_reqs, Name),
+ case catch req_start_app(NewS#state{p_reqs = NPermitReq}, Name) of
+ {error, R} ->
+ {stop, R};
+ {ok, NewS2} ->
+ {noreply, NewS2}
+ end;
+ {_, _} ->
+ %% The app has not been started at this node yet; remember this in
+ %% remote started.
+ NRStarted = [{Node, Name} | S#state.remote_started],
+ {noreply, S#state{remote_started = NRStarted}}
+ end;
+
+handle_info({dist_ac_app_stopped, AppName}, S) ->
+ Appls = S#state.appls,
+ case keysearch(AppName, #appl.name, Appls) of
+ false ->
+ RStarted = keydelete(AppName, 2, S#state.remote_started),
+ {noreply, S#state{remote_started = RStarted}};
+ {value, Appl} ->
+ NAppl = Appl#appl{id = undefined},
+ NAppls = keyreplace(AppName, #appl.name, Appls, NAppl),
+ RStarted = keydelete(AppName, 2, S#state.remote_started),
+ {noreply, S#state{appls = NAppls, remote_started = RStarted}}
+ end;
+
+handle_info({dist_ac_weight, Name, Weight, Node}, S) ->
+ %% This means another node starts up, and will eventually take over
+ %% this appl. We have a situation like: {Name, [{Node}, node()]}
+ %% Node sends us this msg, and we must respond. It doesn't really
+ %% matter what we send him; but it must be a dist_ac_weight msg.
+ %% Another situation is {Name, [RNode, {node()}, Node]}.
+ %%
+ %% Yet another situation is that the node where Name was running crashed,
+ %% and Node has got the nodedown message, but we haven't. In this case,
+ %% we must send a correct weight to Node. i.e. the same weight that
+ %% we'll send to him later, when we get the nodedown message.
+ case keysearch(Name, #appl.name, S#state.appls) of
+ {value, Appl} ->
+ Id = Appl#appl.id,
+ case Id of
+ run_waiting ->
+ {?DIST_AC, Node} ! {dist_ac_weight, Name, 0, node()},
+ {noreply, S};
+ undefined ->
+ {noreply,
+ S#state{tmp_locals = [{Name, Weight, Node} |
+ S#state.tmp_locals]}};
+ {takeover, _} ->
+ {noreply,
+ S#state{tmp_locals = [{Name, Weight, Node} |
+ S#state.tmp_locals]}};
+ {failover, _} ->
+ {noreply,
+ S#state{tmp_locals = [{Name, Weight, Node} |
+ S#state.tmp_locals]}};
+ _ ->
+ MyWeight = get_cached_weight(Name, S),
+ {?DIST_AC, Node} ! {dist_ac_weight, Name, MyWeight, node()},
+ NTWs = keyreplaceadd(Name, 1, S#state.tmp_weights,
+ {Name, MyWeight}),
+ {noreply, S#state{tmp_weights = NTWs}}
+ end;
+ _ ->
+ {noreply,
+ S#state{tmp_locals = [{Name, Weight, Node} | S#state.tmp_locals]}}
+ end;
+
+%%-----------------------------------------------------------------
+%% A node died. Check if we should takeover some applications.
+%%-----------------------------------------------------------------
+handle_info({nodedown, Node}, S) ->
+ AppNames = dist_get_runnable(S#state.appls),
+ HisAppls = filter(fun(#appl{name = Name, id = {distributed, N}})
+ when Node =:= N -> lists:member(Name, AppNames);
+ (_) -> false
+ end,
+ S#state.appls),
+ Appls2 = zf(fun(Appl) when Appl#appl.id =:= {distributed, Node} ->
+ case lists:member(Appl#appl.name, AppNames) of
+ true ->
+ {true, Appl#appl{id = {failover, Node}}};
+ false ->
+ ac_not_running(Appl#appl.name),
+ {true, Appl#appl{id = undefined}}
+ end;
+ (_) ->
+ true
+ end,
+ S#state.appls),
+ RStarted = filter(fun({Node2, _Name}) when Node2 =:= Node -> false;
+ (_) -> true
+ end,
+ S#state.remote_started),
+ Appls3 = dist_del_node(Appls2, Node),
+ {NPermitReq, Appls4, SReqs} = req_del_node(S, Node, Appls3),
+ NKnown = lists:delete(Node, S#state.known),
+ NewS = S#state{appls = Appls4, p_reqs = NPermitReq, known = NKnown,
+ s_reqs = SReqs,
+ remote_started = RStarted},
+ restart_appls(HisAppls),
+ {noreply, NewS};
+
+handle_info({dist_ac_app_loaded, Node, Name, HisNodes, Permission, HeKnowsMe},
+ S) ->
+ Nodes = dist_find_nodes(Appls = S#state.appls, Name),
+ case is_loaded(Name, S) of
+ true ->
+ case equal_nodes(Nodes, HisNodes) of
+ true ->
+ NAppls = dist_update_run(Appls, Name, Node, Permission),
+ if
+ not HeKnowsMe ->
+ %% We've got it loaded, but he doesn't know -
+ %% he's a new node connecting to us.
+ Msg = {dist_ac_app_loaded, node(), Name,
+ Nodes, dist_is_runnable(Appls, Name), true},
+ {?DIST_AC, Node} ! Msg;
+ true ->
+ ok
+ end,
+ {noreply, S#state{appls = NAppls}};
+ false ->
+ dist_mismatch(Name, Node)
+ end;
+ false ->
+ Load =[{{Name, Node}, HisNodes, Permission} | S#state.dist_loaded],
+ {noreply, S#state{dist_loaded = Load}}
+ end;
+
+handle_info({dist_ac_app_unloaded, Node, Name}, S) ->
+ Appls = dist_update_run(S#state.appls, Name, Node, undefined),
+ Load = keydelete({Name, Node}, 1, S#state.dist_loaded),
+ {noreply, S#state{appls = Appls, dist_loaded = Load}};
+
+
+handle_info({dist_ac_new_permission, Node, AppName, false, IsHisApp}, S) ->
+ Appls = dist_update_run(S#state.appls, AppName, Node, false),
+ NewS = S#state{appls =Appls},
+ case dist_is_runnable(Appls, AppName) of
+ true when IsHisApp ->
+ case catch start_appl(AppName, NewS, req) of
+ {ok, NewS2, _} ->
+ {noreply, NewS2};
+ {error, _R} -> % if app was permanent, AC will shutdown the node
+ {noreply, NewS}
+ end;
+ _ ->
+ {noreply, NewS}
+ end;
+handle_info({dist_ac_new_permission, Node, AppName, true, _IsHisApp}, S) ->
+ Appls = dist_update_run(S#state.appls, AppName, Node, true),
+ {noreply, S#state{appls = Appls}};
+
+handle_info({internal_restart_appl, Name}, S) ->
+ case restart_appl(Name, S) of
+ {error, R} ->
+ {stop, {error, R}, S};
+ NewS ->
+ {noreply, NewS}
+ end;
+
+handle_info(_, S) ->
+ {noreply, S}.
+
+terminate(_Reason, _S) ->
+ ok.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%%-----------------------------------------------------------------
+%%% Internal functions
+%%%-----------------------------------------------------------------
+load(AppName, S) ->
+ Appls0 = S#state.appls,
+ %% Get the dist specification for the app on other nodes
+ DistLoaded = get_dist_loaded(AppName, Load1 = S#state.dist_loaded),
+ %% Get the local dist specification
+ Nodes = dist_find_nodes(Appls0, AppName),
+ FNodes = flat_nodes(Nodes),
+ %% Update dists spec with our local permission
+ Permission = get_default_permission(AppName),
+ Appls1 = dist_update_run(Appls0, AppName, node(), Permission),
+ %% Compare the local spec with other nodes's specs
+ %% If equal, update our spec with his current permission
+ {LoadedNodes, Appls2} =
+ mapfoldl(
+ fun({Node, HisNodes, HisPermission}, Appls) ->
+ case equal_nodes(Nodes, HisNodes) of
+ true ->
+ {Node, dist_update_run(Appls, AppName,
+ Node, HisPermission)};
+ _ ->
+ dist_mismatch(AppName, Node)
+ end
+ end, Appls1, DistLoaded),
+ Load2 = del_dist_loaded(AppName, Load1),
+ %% Tell all Nodes about the new appl loaded, and its permission.
+ foreach(fun(Node) when Node =/= node() ->
+ Msg = {dist_ac_app_loaded, node(), AppName,
+ Nodes, Permission, member(Node, LoadedNodes)},
+ {?DIST_AC, Node} ! Msg;
+ (_) -> ok
+ end, FNodes),
+ {ok, S#state{appls = Appls2, dist_loaded = Load2}}.
+
+ensure_take_control(AppName, Appls) ->
+ %% Check if this is a new application that we don't control yet
+ case lists:keymember(AppName, #appl.name, Appls) of
+ true -> % we have control
+ ok;
+ false -> % take control!
+ %% Note: this works because this is executed within a
+ %% synchronous call. I.e. we get the control *before*
+ %% application:load returns. (otherwise application:start
+ %% could be called before we got the chance to take control)
+ %% The only reason we have to bother about this is because
+ %% we have to be backwards compatible in the sense that all
+ %% apps don't have to be specified in the 'distributed' parameter,
+ %% but may be implicitly 'distributed' by a call to
+ %% application:load.
+ application_controller:control_application(AppName)
+ end.
+
+unload(AppName, S) ->
+ Appls = S#state.appls,
+ Nodes = dist_flat_nodes(Appls, AppName),
+ %% Tell all ACs in DistNodes about the unloaded appl
+ Msg = {dist_ac_app_unloaded, node(), AppName},
+ send_msg(Msg, Nodes),
+ {value, Appl} = keysearch(AppName, #appl.name, Appls),
+ NAppl = Appl#appl{id = undefined, run = []},
+ {ok, S#state{appls = keyreplace(AppName, #appl.name, Appls, NAppl)}}.
+
+start_appl(AppName, S, Type) ->
+ %% Get nodes, and check if App is loaded on all involved nodes.
+ %% If it is loaded everywhere, we know that we have the same picture
+ %% of the nodes; otherwise the load wouldn't have succeeded.
+ Appl = case keysearch(AppName, #appl.name, Appls = S#state.appls) of
+ {value, A} -> A;
+ _ -> throw({error, {unknown_application, AppName}})
+ end,
+ case Appl#appl.id of
+ local ->
+ %% UW 990913: we've already started the app
+ %% this could happen if ac_start_application_req was resent.
+ {ok,S,false};
+ _ ->
+ {Id, IsWaiting} = case dist_get_all_nodes(Appl) of
+ {ok, DistNodes, PermittedNodes} ->
+ start_distributed(Appl, AppName, DistNodes,
+ PermittedNodes, S, Type);
+ Error -> throw(Error)
+ end,
+ NAppl = Appl#appl{id = Id},
+ NAppls = keyreplaceadd(AppName, #appl.name, Appls, NAppl),
+ {ok, NewS} = req_start_app(S#state{appls = NAppls}, AppName),
+ TmpLocals = keydelete_all(AppName, 1, NewS#state.tmp_locals),
+ TmpWeights = keydelete_all(AppName, 1, NewS#state.tmp_weights),
+ RStarted = keydelete(AppName, 2, S#state.remote_started),
+ Started = replaceadd(AppName, NewS#state.started),
+ {ok,
+ NewS#state{started = Started, tmp_locals = TmpLocals,
+ tmp_weights = TmpWeights, remote_started = RStarted},
+ IsWaiting}
+ end.
+
+
+start_distributed(Appl, Name, Nodes, PermittedNodes, S, Type) ->
+ case find_start_node(Nodes, PermittedNodes, Name, S) of
+ {ok, Node} when Node =:= node() ->
+ case Appl#appl.id of
+ {failover, FoNode} when Type =:= req ->
+ ac_failover(Name, FoNode, undefined);
+ {distributed, Node2} when Type =:= req ->
+ ac_takeover(req, Name, Node2, undefined);
+ _ when Type =:= reply ->
+ case lists:keysearch(Name, 2, S#state.remote_started) of
+ {value, {Node3, _}} ->
+ ac_takeover(reply, Name, Node3, undefined);
+ _ ->
+ ac_start_it(Type, Name)
+ end;
+ _ ->
+ ac_start_it(Type, Name)
+ end,
+ {run_waiting, true};
+ {already_started, Node} ->
+ ac_started(Type, Name, Node),
+ {{distributed, Node}, false};
+ {ok, Node} ->
+ case keysearch(Name, #appl.name, S#state.appls) of
+ {value, #appl{id = {distributed, Node}}} ->
+ ac_started(Type, Name, Node),
+ {{distributed, Node}, false};
+ _ ->
+ wait_dist_start(Node, Appl, Name, Nodes,
+ PermittedNodes, S, Type)
+ end;
+ not_started ->
+ wait_dist_start2(Appl, Name, Nodes, PermittedNodes, S, Type);
+ no_permission ->
+ ac_not_started(Type, Name),
+ {undefined, false}
+ end.
+
+wait_dist_start(Node, Appl, Name, Nodes, PermittedNodes, S, Type) ->
+ monitor_node(Node, true),
+ receive
+ {dist_ac_app_started, Node, Name, ok} ->
+ ac_started(Type, Name, Node),
+ monitor_node(Node, false),
+ {{distributed, Node}, false};
+ {dist_ac_app_started, Node, Name, {error, R}} ->
+ ac_error(Type, Name, {Node, R}),
+ monitor_node(Node, false),
+ {Appl#appl.id, false};
+ {dist_ac_weight, Name, _Weigth, Node} ->
+ %% This is the situation: {Name, [RNode, {Node}, node()]}
+ %% and permit(false) is called on RNode, and we sent the
+ %% weigth first. Node handled it in handle_info, and
+ %% now we must send him a weigth msg. We can use any weigth;
+ %% he wins anyway.
+ monitor_node(Node, false),
+ {?DIST_AC, Node} !
+ {dist_ac_weight, Name, get_cached_weight(Name, S), node()},
+ wait_dist_start(Node, Appl, Name, Nodes, PermittedNodes, S, Type);
+ {nodedown, Node} ->
+ monitor_node(Node, false),
+ TmpLocals =
+ filter(fun({Name2, _Weight, Node2}) when Node2 =:= Node,
+ Name2 =:= Name -> false;
+ (_) -> true
+ end,
+ S#state.tmp_locals),
+ NewS = S#state{tmp_locals = TmpLocals},
+ start_distributed(Appl, Name, Nodes,
+ lists:delete(Node, PermittedNodes), NewS, Type)
+ end.
+
+wait_dist_start2(Appl, Name, Nodes, PermittedNodes, S, Type) ->
+ receive
+ {dist_ac_app_started, Node, Name, ok} ->
+ ac_started(Type, Name, Node),
+ {{distributed, Node}, false};
+ {dist_ac_app_started, Node, Name, {error, R}} ->
+ ac_error(Type, Name, {Node, R}),
+ {Appl#appl.id, false};
+ {nodedown, Node} ->
+ %% A node went down, try to start the app again - there may not
+ %% be any more nodes to wait for.
+ TmpLocals =
+ filter(fun({Name2, _Weight, Node2}) when Node2 =:= Node,
+ Name2 =:= Name -> false;
+ (_) -> true
+ end,
+ S#state.tmp_locals),
+ NewS = S#state{tmp_locals = TmpLocals},
+ start_distributed(Appl, Name, Nodes,
+ lists:delete(Node, PermittedNodes), NewS, Type)
+ end.
+
+
+ac_start_it(reply, Name) ->
+ ?AC ! {ac_start_application_reply, Name, start_it};
+ac_start_it(req, Name) ->
+ ?AC ! {ac_change_application_req, Name, start_it}.
+
+ac_started(reply, Name, Node) ->
+ ?AC ! {ac_start_application_reply, Name, {started, Node}};
+ac_started(req, Name, Node) ->
+ ?AC ! {ac_change_application_req, Name, {started, Node}}.
+
+ac_error(reply, Name, Error) ->
+ ?AC ! {ac_start_application_reply, Name, {error, Error}};
+ac_error(req, _Name, _Error) ->
+ ok.
+
+ac_not_started(reply, Name) ->
+ ?AC ! {ac_start_application_reply, Name, not_started};
+ac_not_started(req, Name) ->
+ ?AC ! {ac_change_application_req, Name, stop_it}.
+
+ac_stop_it(Name) ->
+ ?AC ! {ac_change_application_req, Name, stop_it}.
+
+ac_takeover(reply, Name, Node, _RestartType) ->
+ ?AC ! {ac_start_application_reply, Name, {takeover, Node}};
+ac_takeover(req, Name, Node, RestartType) ->
+ ?AC ! {ac_change_application_req, Name,
+ {takeover, Node, RestartType}}.
+
+ac_failover(Name, Node, RestartType) ->
+ ?AC ! {ac_change_application_req, Name,
+ {failover, Node, RestartType}}.
+
+ac_not_running(Name) ->
+ ?AC ! {ac_change_application_req, Name, not_running}.
+
+restart_appls(Appls) ->
+ foreach(fun(Appl) ->
+ AppName = Appl#appl.name,
+ send_after(Appl#appl.restart_time,
+ {internal_restart_appl, AppName})
+ end, lists:reverse(Appls)).
+
+restart_appl(AppName, S) ->
+ case keysearch(AppName, #appl.name, S#state.appls) of
+ {value, Appl} when element(1, Appl#appl.id) =:= failover ->
+ case catch start_appl(AppName, S, req) of
+ {ok, NewS, _} ->
+ NewS;
+ {error, R} ->
+ error_msg("Error when restarting application ~p: ~p~n",
+ [AppName, R]),
+ S
+ end;
+ _ ->
+ S
+ end.
+
+%% permit(ShouldBeRunning, IsRunning, ...)
+permit(false, {value, #appl{id = undefined}}, _AppName, _From, S, _LockId) ->
+ {reply, ok, S}; % It's not running
+permit(false, {value, #appl{id = Id}}, _AppName, _From, S, _LockId)
+ when element(1, Id) =:= distributed ->
+ %% It is running at another node already
+ {reply, ok, S};
+permit(false, {value, _}, AppName, From, S, _LockId) ->
+ %% It is a distributed application
+ %% Check if there is any runnable node
+ case dist_get_runnable_nodes(S#state.appls, AppName) of
+ [] ->
+ %% There is no runnable node; stop application
+ ac_stop_it(AppName),
+ SReqs = [{AppName, From} | S#state.s_reqs],
+ {noreply, S#state{s_reqs = SReqs}};
+ Nodes ->
+ %% Delete all outstanding 'permit true' requests.
+ PR = req_del_permit_true(S#state.p_reqs, AppName),
+ NPReqs = [{From, AppName, false, Nodes} | PR],
+ {noreply, S#state{p_reqs = NPReqs}}
+ end;
+permit(true, {value, #appl{id = local}}, _AppName, _From, S, _LockId) ->
+ {reply, ok, S};
+permit(true, _, AppName, From, S, LockId) ->
+ case catch start_appl(AppName, S, req) of
+ {_ErrorTag, {not_running, App}} ->
+ %% Delete all outstanding 'permit false' requests
+ PR = req_del_permit_false(S#state.p_reqs, AppName),
+ NPReqs = [{false, AppName, true, App} | PR],
+ {reply, ok, S#state{p_reqs = NPReqs}};
+ {ok, NewS, true} ->
+ %% We have ordered a start or a takeover; we must not return
+ %% until the app is running.
+ TR = NewS#state.t_reqs,
+ %% Delete the lock, so others may start the app
+ global:del_lock(LockId),
+ {noreply, NewS#state{t_reqs = [{AppName, From} | TR]}};
+ {ok, _S, false} ->
+ %% Application should be started, but at another node
+ %% State remains the same
+ {reply, ok, S};
+ {_ErrorTag, R} ->
+ {stop, R, {error, R}, S}
+ end.
+
+do_start_appls(StartApps, S) ->
+ SortedStartApps = StartApps,
+ Appls = S#state.appls,
+ {ok, foldl(
+ fun(AppName, NewS) ->
+ case catch start_appl(AppName, NewS, req) of
+ {error, R} ->
+ throw({{error, NewS}, R});
+ {ok, NewS2, _} ->
+ NewS2
+ end
+ end, S#state{appls = Appls}, lists:reverse(SortedStartApps))}.
+
+%%-----------------------------------------------------------------
+%% Nodes = [node() | {node(), ..., node()}]
+%% A list in priority order. If it is a tuple, we may pick any of
+%% them. This decision is made by all nodes in the list, and all
+%% nodes choose the same. This is accomplished in the following
+%% way: all Nodes send to all others a msg which tells how many
+%% applications each node has started. The one with least no of
+%% appls starts this one.
+%%-----------------------------------------------------------------
+find_start_node(Nodes, PermittedNodes, Name, S) ->
+ AllNodes = intersection(flat_nodes(Nodes), PermittedNodes),
+ case lists:member(node(), AllNodes) of
+ true ->
+ Weight = get_cached_weight(Name, S),
+ find_start_node(Nodes, Name, S, Weight, AllNodes);
+ false ->
+ case keysearch(Name, 2, S#state.remote_started) of
+ {value, {Node, _Name}} ->
+ {already_started, Node};
+ _ when AllNodes =/= [] ->
+ not_started;
+ _ ->
+ no_permission
+ end
+ end.
+
+find_start_node([AnyNodes | Nodes], Name, S, Weight, AllNodes)
+ when is_tuple(AnyNodes) ->
+ case find_any_node(tuple_to_list(AnyNodes), Name, S, Weight, AllNodes) of
+ false -> find_start_node(Nodes, Name, S, Weight, AllNodes);
+ Res -> Res
+ end;
+find_start_node([Node | Nodes], Name, S, Weight, AllNodes) ->
+ case lists:member(Node, AllNodes) of
+ true ->
+ case keysearch(Name, #appl.name, S#state.appls) of
+ {value, #appl{id = {distributed, Node}}} ->
+ {already_started, Node};
+ _ ->
+ case keysearch(Name, 2, S#state.remote_started) of
+ {value, {Node, _Name}} ->
+ {already_started, Node};
+ _ ->
+ {ok, Node}
+ end
+ end;
+ false -> find_start_node(Nodes, Name, S, Weight, AllNodes)
+ end;
+find_start_node([], _Name, _S, _Weight, _AllNodes) ->
+ not_started.
+
+%%-----------------------------------------------------------------
+%% First of all, check if the application is already running
+%% somewhere in AnyNodes; in that case we shall not move it!
+%%-----------------------------------------------------------------
+find_any_node(AnyNodes, Name, S, Weight, AllNodes) ->
+ case check_running(Name, S, intersection(AnyNodes, AllNodes)) of
+ {already_started, Node} -> {already_started, Node};
+ false ->
+ %% Synchronize with all other nodes.
+ send_nodes(AllNodes, {dist_ac_weight, Name, Weight, node()}),
+ Answers = [{Weight, node()} |
+ collect_answers(AllNodes, Name, S, [])],
+ %% Make a decision (the same at every node) (smallest weight wins)
+ find_alive_node(lists:sort(Answers),
+ intersection(AnyNodes, S#state.known))
+ end.
+
+%%-----------------------------------------------------------------
+%% Check if another node started the appl before we got alive.
+%% If so, check if the node is one of AnyNodes.
+%%-----------------------------------------------------------------
+check_running(Name, #state{remote_started = RStarted,
+ appls = Appls}, AnyNodes) ->
+ case keysearch(Name, 2, RStarted) of
+ {value, {Node, _Name}} ->
+ case lists:member(Node, AnyNodes) of
+ true -> {already_started, Node};
+ false -> false
+ end;
+ false ->
+ case keysearch(Name, #appl.name, Appls) of
+ {value, #appl{id = {distributed, Node}}} ->
+ case lists:member(Node, AnyNodes) of
+ true -> {already_started, Node};
+ false -> false
+ end;
+ _ ->
+ false
+ end
+ end.
+
+find_alive_node([{_, Node} | Nodes], AliveNodes) ->
+ case lists:member(Node, AliveNodes) of
+ true -> {ok, Node};
+ false -> find_alive_node(Nodes, AliveNodes)
+ end;
+find_alive_node([], _AliveNodes) ->
+ false.
+
+%%-----------------------------------------------------------------
+%% First, check if the node's msg is buffered (received in our
+%% main loop). Otherwise, wait for msg or nodedown.
+%% We have sent the dist_ac_weight message, and will wait for it
+%% to be received here (or a nodedown). This implies that a
+%% dist_ac must *always* be prepared to get this messages, and to
+%% send it to us.
+%%-----------------------------------------------------------------
+collect_answers([Node | Nodes], Name, S, Res) when Node =/= node() ->
+ case keysearch(Node, 3, S#state.tmp_locals) of
+ {value, {Name, Weight, Node}} ->
+ collect_answers(Nodes, Name, S, [{Weight, Node} | Res]);
+ _ ->
+ monitor_node(Node, true),
+ receive
+ {dist_ac_weight, Name, Weight, Node} ->
+ monitor_node(Node, false),
+ collect_answers(Nodes, Name, S, [{Weight, Node} | Res]);
+ {nodedown, Node} ->
+ monitor_node(Node, false),
+ collect_answers(Nodes, Name, S, Res)
+ end
+ end;
+collect_answers([_ThisNode | Nodes], Name, S, Res) ->
+ collect_answers(Nodes, Name, S, Res);
+collect_answers([], _Name, _S, Res) ->
+ Res.
+
+send_nodes(Nodes, Msg) ->
+ FlatNodes = flat_nodes(Nodes),
+ foreach(fun(Node) when Node =/= node() -> {?DIST_AC, Node} ! Msg;
+ (_ThisNode) -> ok
+ end, FlatNodes).
+
+send_after(Time, Msg) when is_integer(Time), Time >= 0 ->
+ spawn_link(?MODULE, send_timeout, [self(), Time, Msg]);
+send_after(_,_) -> % infinity
+ ok.
+
+send_timeout(To, Time, Msg) ->
+ receive
+ after Time -> To ! Msg
+ end.
+
+send_msg(Msg, Nodes) ->
+ foreach(fun(Node) when Node =/= node() -> {?DIST_AC, Node} ! Msg;
+ (_) -> ok
+ end, Nodes).
+
+replaceadd(Item, List) ->
+ case member(Item, List) of
+ true -> List;
+ false -> [Item | List]
+ end.
+
+keyreplaceadd(Key, Pos, List, New) ->
+ case lists:keymember(Key, Pos, List) of
+ true -> lists:keyreplace(Key, Pos, List, New);
+ false -> [New | List]
+ end.
+
+keydelete_all(Key, N, [H|T]) when element(N, H) =:= Key ->
+ keydelete_all(Key, N, T);
+keydelete_all(Key, N, [H|T]) ->
+ [H|keydelete_all(Key, N, T)];
+keydelete_all(_Key, _N, []) -> [].
+
+-ifdef(NOTUSED).
+keysearchdelete(Key, Pos, List) ->
+ ksd(Key, Pos, List, []).
+
+ksd(Key, Pos, [H | T], Rest) when element(Pos, H) =:= Key ->
+ {value, H, Rest ++ T};
+ksd(Key, Pos, [H | T], Rest) ->
+ ksd(Key, Pos, T, [H | Rest]);
+ksd(_Key, _Pos, [], _Rest) ->
+ false.
+
+get_new_appl(Name, [{application, Name, App} | _]) ->
+ {ok, {application, Name, App}};
+get_new_appl(Name, [_ | T]) -> get_new_appl(Name, T);
+get_new_appl(Name, []) -> false.
+-endif.
+
+equal_nodes([H | T1], [H | T2]) when is_atom(H) ->
+ equal_nodes(T1, T2);
+equal_nodes([H1 | T1], [H2 | T2]) when is_tuple(H1), is_tuple(H2) ->
+ case equal(tuple_to_list(H1), tuple_to_list(H2)) of
+ true -> equal_nodes(T1, T2);
+ false -> false
+ end;
+equal_nodes([], []) -> true;
+equal_nodes(_, _) -> false.
+
+equal([H | T] , S) ->
+ case lists:member(H, S) of
+ true -> equal(T, lists:delete(H, S));
+ false -> false
+ end;
+equal([], []) -> true;
+equal(_, _) -> false.
+
+flat_nodes(Nodes) when is_list(Nodes) ->
+ foldl(fun(Node, Res) when is_atom(Node) -> [Node | Res];
+ (Tuple, Res) when is_tuple(Tuple) -> tuple_to_list(Tuple) ++ Res
+ end, [], Nodes);
+flat_nodes(Nodes) ->
+ throw({error, {badarg, Nodes}}).
+
+get_cached_weight(Name, S) ->
+ case lists:keysearch(Name, 1, S#state.tmp_weights) of
+ {value, {_, W}} -> W;
+ _ -> get_weight()
+ end.
+
+%% Simple weight; just count the number of applications running.
+get_weight() ->
+ length(application:which_applications()).
+
+get_dist_loaded(Name, [{{Name, Node}, HisNodes, Permission} | T]) ->
+ [{Node, HisNodes, Permission} | get_dist_loaded(Name, T)];
+get_dist_loaded(Name, [_H | T]) ->
+ get_dist_loaded(Name, T);
+get_dist_loaded(_Name, []) ->
+ [].
+
+del_dist_loaded(Name, [{{Name, _Node}, _HisNodes, _Permission} | T]) ->
+ del_dist_loaded(Name, T);
+del_dist_loaded(Name, [H | T]) ->
+ [H | del_dist_loaded(Name, T)];
+del_dist_loaded(_Name, []) ->
+ [].
+
+req_start_app(State, Name) ->
+ {ok, foldl(
+ fun({false, AppName, true, Name2}, S) when Name =:= Name2 ->
+ PR = keydelete(AppName, 2, S#state.p_reqs),
+ NS = S#state{p_reqs = PR},
+ case catch do_start_appls([AppName], NS) of
+ {_ErrorTag, {not_running, App}} ->
+ NRequests = [{false, AppName, true, App} | PR],
+ S#state{p_reqs = NRequests};
+ {ok, NewS} ->
+ NewS;
+ {_ErrorTag, R} ->
+ throw({error, R})
+ end;
+ (_, S) ->
+ S
+ end, State, State#state.p_reqs)}.
+
+
+req_del_permit_true(Reqs, Name) ->
+ filter(fun({From, Name2, true, _}) when Name2 =:= Name ->
+ gen_server:reply(From, ok),
+ false;
+ (_) ->
+ true
+ end, Reqs).
+
+req_del_permit_false(Reqs, Name) ->
+ filter(fun({From, Name2, false, _Nodes}) when Name2 =:= Name ->
+ gen_server:reply(From, ok),
+ false;
+ (_) ->
+ true
+ end, Reqs).
+
+req_del_node(S, Node, Appls) ->
+ check_waiting(S#state.p_reqs, S, Node, Appls, [], S#state.s_reqs).
+
+del_t_reqs(AppName, TReqs, Res) ->
+ lists:filter(fun({AN, From}) when AppName =:= AN ->
+ gen_server:reply(From, Res),
+ false;
+ (_) ->
+ true
+ end,
+ TReqs).
+
+
+check_waiting([{From, AppName, false, Nodes} | Reqs],
+ S, Node, Appls, Res, SReqs) ->
+ case lists:delete(Node, Nodes) of
+ [] ->
+ ac_stop_it(AppName),
+ NSReqs = [{AppName, From} | SReqs],
+ check_waiting(Reqs, Node, S, Appls, Res, NSReqs);
+ NNodes ->
+ check_waiting(Reqs, Node, S, Appls,
+ [{From, AppName, false, NNodes} | Res], SReqs)
+ end;
+check_waiting([H | Reqs], S, Node, Appls, Res, SReqs) ->
+ check_waiting(Reqs, Node, S, Appls, [H | Res], SReqs);
+check_waiting([], _Node, _S, Appls, Res, SReqs) ->
+ {Res, Appls, SReqs}.
+
+intersection([], _) ->
+ [];
+intersection(_, []) ->
+ [];
+intersection(L1, L2) ->
+ L1 -- (L1 -- L2).
+
+get_default_permission(AppName) ->
+ case application:get_env(kernel, permissions) of
+ {ok, Permissions} ->
+ case keysearch(AppName, 1, Permissions) of
+ {value, {_, true}} -> true;
+ {value, {_, false}} -> false;
+ {value, {_, X}} -> exit({bad_permission, {AppName, X}});
+ false -> true
+ end;
+ undefined -> true
+ end.
+
+%%-----------------------------------------------------------------
+%% ADT dist() - info on how an application is distributed
+%% dist() = [{AppName, Time, DistNodes, [{Node, Runnable}]}]
+%% Time = int() >= 0 | infinity
+%% Nodes = [node() | {node()...}]
+%% Runnable = true | false | undefined
+%% An appl may not be started if any Runnable is undefined;
+%% i.e. the appl must be loaded on all Nodes.
+%%-----------------------------------------------------------------
+dist_check([{AppName, Nodes} | T]) ->
+ P = get_default_permission(AppName),
+ [#appl{name = AppName, nodes = Nodes, run = [{node(), P}]} | dist_check(T)];
+dist_check([{AppName, Time, Nodes} | T]) when is_integer(Time), Time >= 0 ->
+ P = get_default_permission(AppName),
+ [#appl{name = AppName, restart_time = Time, nodes = Nodes,
+ run = [{node(), P}]} | dist_check(T)];
+dist_check([{AppName, infinity, Nodes} | T]) ->
+ P = get_default_permission(AppName),
+ [#appl{name = AppName, restart_time = infinity,
+ nodes = Nodes, run = [{node(), P}]} |
+ dist_check(T)];
+dist_check([_ | T]) ->
+ dist_check(T);
+dist_check([]) ->
+ [].
+
+dist_take_control(Appls) ->
+ foreach(fun(#appl{name = AppName}) ->
+ application_controller:control_application(AppName)
+ end, Appls).
+
+dist_replace(default, _Name, Appls) -> Appls;
+dist_replace({AppName, Nodes}, AppName, Appls) ->
+ Run = [{Node, undefined} || Node <- flat_nodes(Nodes)],
+ keyreplaceadd(AppName, #appl.name, Appls,
+ #appl{name = AppName, restart_time = 0,
+ nodes = Nodes, run = Run});
+dist_replace({AppName, Time, Nodes}, AppName, Appls)
+ when is_integer(Time), Time >= 0 ->
+ Run = [{Node, undefined} || Node <- flat_nodes(Nodes)],
+ keyreplaceadd(AppName, #appl.name, Appls,
+ #appl{name = AppName, restart_time = Time,
+ nodes = Nodes, run = Run});
+dist_replace(Bad, _Name, _Appls) ->
+ throw({error, {bad_distribution_spec, Bad}}).
+
+dist_update_run(Appls, AppName, Node, Permission) ->
+ map(fun(Appl) when Appl#appl.name =:= AppName ->
+ Run = Appl#appl.run,
+ NRun = keyreplaceadd(Node, 1, Run, {Node, Permission}),
+ Appl#appl{run = NRun};
+ (Appl) ->
+ Appl
+ end, Appls).
+
+
+
+dist_change_update(Appls, []) ->
+ Appls;
+dist_change_update(Appls, [{AppName, NewNodes} | NewDist]) ->
+ NewAppls = do_dist_change_update(Appls, AppName, 0, NewNodes),
+ dist_change_update(NewAppls, NewDist);
+dist_change_update(Appls, [{AppName, NewTime, NewNodes} | NewDist]) ->
+ NewAppls = do_dist_change_update(Appls, AppName, NewTime, NewNodes),
+ dist_change_update(NewAppls, NewDist).
+
+do_dist_change_update(Appls, AppName, NewTime, NewNodes) ->
+ map(fun(Appl) when Appl#appl.name =:= AppName ->
+ Appl#appl{restart_time = NewTime, nodes = NewNodes};
+ (Appl) ->
+ Appl
+ end, Appls).
+
+%% Merge his Permissions with mine.
+dist_merge(MyAppls, HisAppls, HisNode) ->
+ zf(fun(Appl) ->
+ #appl{name = AppName, run = Run} = Appl,
+% #appl{name = AppName, nodes = Nodes, run = Run} = Appl,
+% HeIsMember = lists:member(HisNode, flat_nodes(Nodes)),
+ HeIsMember = true,
+ case keysearch(AppName, #appl.name, HisAppls) of
+ {value, #appl{run = HisRun}} when HeIsMember ->
+ case keysearch(HisNode, 1, HisRun) of
+ {value, Val} -> % He has it loaded
+ NRun = keyreplaceadd(HisNode, 1, Run, Val),
+ {true, Appl#appl{run = NRun}};
+ false -> % He hasn't loaded it yet
+ Val = {HisNode, undefined},
+ {true, Appl#appl{run = [Val | Run]}}
+ end;
+ _ ->
+ true
+ end
+ end, MyAppls).
+
+dist_get_runnable_nodes(Appls, AppName) ->
+ case keysearch(AppName, #appl.name, Appls) of
+ {value, #appl{run = Run}} ->
+ zf(fun({Node, true}) -> {true, Node};
+ (_) -> false
+ end, Run);
+ false ->
+ []
+ end.
+
+dist_is_runnable(Appls, AppName) ->
+ case keysearch(AppName, #appl.name, Appls) of
+ {value, #appl{run = Run}} ->
+ case keysearch(node(), 1, Run) of
+ {value, {_, true}} -> true;
+ _ -> false
+ end;
+ false ->
+ false
+ end.
+
+is_loaded(AppName, #state{appls = Appls}) ->
+ case keysearch(AppName, #appl.name, Appls) of
+ {value, #appl{run = Run}} ->
+ case keysearch(node(), 1, Run) of
+ {value, {_Node, undefined}} -> false;
+ {value, _} -> true;
+ false -> false
+ end;
+ false ->
+ false
+ end.
+
+dist_get_runnable(Appls) ->
+ zf(fun(#appl{name = AppName, run = Run}) ->
+ case keysearch(node(), 1, Run) of
+ {value, {_, true}} -> {true, AppName};
+ _ -> false
+ end
+ end, Appls).
+
+dist_get_all_nodes(#appl{name = AppName, nodes = Nodes, run = Run}) ->
+ {Res, BadNodes} = check_nodes(Run, [], []),
+ case intersection(BadNodes, erlang:nodes(connected)) of
+ [] -> {ok, Nodes, Res};
+ _ -> {error, {app_not_loaded, AppName, BadNodes}}
+ end.
+
+check_nodes([{Node, undefined} | T], Res, BadNodes) ->
+ check_nodes(T, Res, [Node | BadNodes]);
+check_nodes([{Node, true} | T], Res, BadNodes) ->
+ check_nodes(T, [Node | Res], BadNodes);
+check_nodes([{_Node, false} | T], Res, BadNodes) ->
+ check_nodes(T, Res, BadNodes);
+check_nodes([], Res, BadNodes) ->
+ {Res, BadNodes}.
+
+-ifdef(NOTUSED).
+dist_find_time([#appl{name = Name, restart_time = Time} |_], Name) -> Time;
+dist_find_time([_ | T], Name) -> dist_find_time(T, Name);
+dist_find_time([], Name) -> 0.
+-endif.
+
+%% Find all nodes that can run the app (even if they're not permitted
+%% to right now).
+dist_find_nodes([#appl{name = Name, nodes = Nodes} |_], Name) -> Nodes;
+dist_find_nodes([_ | T], Name) -> dist_find_nodes(T, Name);
+dist_find_nodes([], _Name) -> [].
+
+dist_flat_nodes(Appls, Name) ->
+ flat_nodes(dist_find_nodes(Appls, Name)).
+
+dist_del_node(Appls, Node) ->
+ map(fun(Appl) ->
+ NRun = filter(fun({N, _Runnable}) when N =:= Node -> false;
+ (_) -> true
+ end, Appl#appl.run),
+ Appl#appl{run = NRun}
+ end, Appls).
+
+validRestartType(permanent) -> true;
+validRestartType(temporary) -> true;
+validRestartType(transient) -> true;
+validRestartType(_RestartType) -> false.
+
+dist_mismatch(AppName, Node) ->
+ error_msg("Distribution mismatch for application \"~p\" on nodes ~p and ~p~n",
+ [AppName, node(), Node]),
+ exit({distribution_mismatch, AppName, Node}).
+
+%error_msg(Format) when is_list(Format) ->
+% error_msg(Format, []).
+
+error_msg(Format, ArgList) when is_list(Format), is_list(ArgList) ->
+ error_logger:error_msg("dist_ac on node ~p:~n" ++ Format, [node()|ArgList]).
+
+%info_msg(Format) when is_list(Format) ->
+% info_msg(Format, []).
+
+%info_msg(Format, ArgList) when is_list(Format), is_list(ArgList) ->
+% error_logger:info_msg("dist_ac on node ~p:~n" ++ Format, [node()|ArgList]).
diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl
new file mode 100644
index 0000000000..a2937d60b8
--- /dev/null
+++ b/lib/kernel/src/dist_util.erl
@@ -0,0 +1,762 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%----------------------------------------------------------------------
+%%% Purpose : The handshake of a streamed distribution connection
+%%% in a separate file to make it usable for other
+%%% distribution protocols.
+%%%----------------------------------------------------------------------
+
+-module(dist_util).
+
+%%-compile(export_all).
+-export([handshake_we_started/1, handshake_other_started/1,
+ start_timer/1, setup_timer/2,
+ reset_timer/1, cancel_timer/1,
+ shutdown/3, shutdown/4]).
+
+-import(error_logger,[error_msg/2]).
+
+-include("dist_util.hrl").
+-include("dist.hrl").
+
+-ifdef(DEBUG).
+-define(shutdown_trace(A,B), io:format(A,B)).
+-else.
+-define(shutdown_trace(A,B), noop).
+-endif.
+
+-define(to_port(FSend, Socket, Data),
+ case FSend(Socket, Data) of
+ {error, closed} ->
+ self() ! {tcp_closed, Socket},
+ {error, closed};
+ R ->
+ R
+ end).
+
+
+-define(int16(X), [((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(int32(X),
+ [((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff,
+ ((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(i16(X1,X0),
+ (?u16(X1,X0) -
+ (if (X1) > 127 -> 16#10000; true -> 0 end))).
+
+-define(u16(X1,X0),
+ (((X1) bsl 8) bor (X0))).
+
+-define(u32(X3,X2,X1,X0),
+ (((X3) bsl 24) bor ((X2) bsl 16) bor ((X1) bsl 8) bor (X0))).
+
+-record(tick, {read = 0,
+ write = 0,
+ tick = 0,
+ ticked = 0
+ }).
+
+remove_flag(Flag, Flags) ->
+ case Flags band Flag of
+ 0 ->
+ Flags;
+ _ ->
+ Flags - Flag
+ end.
+
+adjust_flags(ThisFlags, OtherFlags) ->
+ case (?DFLAG_PUBLISHED band ThisFlags) band OtherFlags of
+ 0 ->
+ {remove_flag(?DFLAG_PUBLISHED, ThisFlags),
+ remove_flag(?DFLAG_PUBLISHED, OtherFlags)};
+ _ ->
+ {ThisFlags, OtherFlags}
+ end.
+
+publish_flag(hidden, _) ->
+ 0;
+publish_flag(_, OtherNode) ->
+ case net_kernel:publish_on_node(OtherNode) of
+ true ->
+ ?DFLAG_PUBLISHED;
+ _ ->
+ 0
+ end.
+
+make_this_flags(RequestType, OtherNode) ->
+ publish_flag(RequestType, OtherNode) bor
+ %% The parenthesis below makes the compiler generate better code.
+ (?DFLAG_EXPORT_PTR_TAG bor
+ ?DFLAG_EXTENDED_PIDS_PORTS bor
+ ?DFLAG_EXTENDED_REFERENCES bor
+ ?DFLAG_DIST_MONITOR bor
+ ?DFLAG_FUN_TAGS bor
+ ?DFLAG_DIST_MONITOR_NAME bor
+ ?DFLAG_HIDDEN_ATOM_CACHE bor
+ ?DFLAG_NEW_FUN_TAGS bor
+ ?DFLAG_BIT_BINARIES bor
+ ?DFLAG_NEW_FLOATS bor
+ ?DFLAG_UNICODE_IO bor
+ ?DFLAG_DIST_HDR_ATOM_CACHE bor
+ ?DFLAG_SMALL_ATOM_TAGS).
+
+handshake_other_started(#hs_data{request_type=ReqType}=HSData0) ->
+ {PreOtherFlags,Node,Version} = recv_name(HSData0),
+ PreThisFlags = make_this_flags(ReqType, Node),
+ {ThisFlags, OtherFlags} = adjust_flags(PreThisFlags,
+ PreOtherFlags),
+ HSData = HSData0#hs_data{this_flags=ThisFlags,
+ other_flags=OtherFlags,
+ other_version=Version,
+ other_node=Node,
+ other_started=true},
+ check_dflag_xnc(HSData),
+ is_allowed(HSData),
+ ?debug({"MD5 connection from ~p (V~p)~n",
+ [Node, HSData#hs_data.other_version]}),
+ mark_pending(HSData),
+ {MyCookie,HisCookie} = get_cookies(Node),
+ ChallengeA = gen_challenge(),
+ send_challenge(HSData, ChallengeA),
+ reset_timer(HSData#hs_data.timer),
+ ChallengeB = recv_challenge_reply(HSData, ChallengeA, MyCookie),
+ send_challenge_ack(HSData, gen_digest(ChallengeB, HisCookie)),
+ ?debug({dist_util, self(), accept_connection, Node}),
+ connection(HSData).
+
+%%
+%% check if connecting node is allowed to connect
+%% with allow-node-scheme
+%%
+is_allowed(#hs_data{other_node = Node,
+ allowed = Allowed} = HSData) ->
+ case lists:member(Node, Allowed) of
+ false when Allowed =/= [] ->
+ send_status(HSData, not_allowed),
+ error_msg("** Connection attempt from "
+ "disallowed node ~w ** ~n", [Node]),
+ ?shutdown(Node);
+ _ -> true
+ end.
+
+%%
+%% Check that both nodes can handle the same types of extended
+%% node containers. If they can not, abort the connection.
+%%
+check_dflag_xnc(#hs_data{other_node = Node,
+ other_flags = OtherFlags,
+ other_started = OtherStarted} = HSData) ->
+ XRFlg = ?DFLAG_EXTENDED_REFERENCES,
+ XPPFlg = case erlang:system_info(compat_rel) of
+ R when R >= 10 ->
+ ?DFLAG_EXTENDED_PIDS_PORTS;
+ _ ->
+ 0
+ end,
+ ReqXncFlags = XRFlg bor XPPFlg,
+ case OtherFlags band ReqXncFlags =:= ReqXncFlags of
+ true ->
+ ok;
+ false ->
+ What = case {OtherFlags band XRFlg =:= XRFlg,
+ OtherFlags band XPPFlg =:= XPPFlg} of
+ {false, false} -> "references, pids and ports";
+ {true, false} -> "pids and ports";
+ {false, true} -> "references"
+ end,
+ case OtherStarted of
+ true ->
+ send_status(HSData, not_allowed),
+ Dir = "from",
+ How = "rejected";
+ _ ->
+ Dir = "to",
+ How = "aborted"
+ end,
+ error_msg("** ~w: Connection attempt ~s node ~w ~s "
+ "since it cannot handle extended ~s. "
+ "**~n", [node(), Dir, Node, How, What]),
+ ?shutdown(Node)
+ end.
+
+
+%% No nodedown will be sent if we fail before this process has
+%% succeeded to mark the node as pending.
+
+mark_pending(#hs_data{kernel_pid=Kernel,
+ other_node=Node,
+ this_node=MyNode}=HSData) ->
+ case do_mark_pending(Kernel, MyNode, Node,
+ (HSData#hs_data.f_address)(HSData#hs_data.socket,
+ Node),
+ HSData#hs_data.other_flags) of
+ ok ->
+ send_status(HSData, ok),
+ reset_timer(HSData#hs_data.timer);
+
+ ok_pending ->
+ send_status(HSData, ok_simultaneous),
+ reset_timer(HSData#hs_data.timer);
+
+ nok_pending ->
+ send_status(HSData, nok),
+ ?shutdown(Node);
+
+ up_pending ->
+ %% Check if connection is still alive, no
+ %% implies that the connection is no longer pending
+ %% due to simultaneous connect
+ do_alive(HSData),
+
+ %% This can happen if the other node goes down,
+ %% and goes up again and contact us before we have
+ %% detected that the socket was closed.
+ wait_pending(Kernel),
+ reset_timer(HSData#hs_data.timer);
+
+ already_pending ->
+ %% FIXME: is this a case ?
+ ?debug({dist_util,self(),mark_pending,already_pending,Node}),
+ ?shutdown(Node)
+ end.
+
+
+%%
+%% Marking pending and negotiating away
+%% simultaneous connection problems
+%%
+
+wait_pending(Kernel) ->
+ receive
+ {Kernel, pending} ->
+ ?trace("wait_pending returned for pid ~p.~n",
+ [self()]),
+ ok
+ end.
+
+do_alive(#hs_data{other_node = Node} = HSData) ->
+ send_status(HSData, alive),
+ case recv_status(HSData) of
+ true -> true;
+ false -> ?shutdown(Node)
+ end.
+
+do_mark_pending(Kernel, MyNode, Node, Address, Flags) ->
+ Kernel ! {self(), {accept_pending,MyNode,Node,Address,
+ publish_type(Flags)}},
+ receive
+ {Kernel,{accept_pending,Ret}} ->
+ ?trace("do_mark_pending(~p,~p,~p,~p) -> ~p~n",
+ [Kernel,Node,Address,Flags,Ret]),
+ Ret
+ end.
+
+is_pending(Kernel, Node) ->
+ Kernel ! {self(), {is_pending, Node}},
+ receive
+ {Kernel, {is_pending, Reply}} -> Reply
+ end.
+
+%%
+%% This will tell the net_kernel about the nodedown as it
+%% recognizes the exit signal.
+%% The termination of this process does also imply that the Socket
+%% is closed in a controlled way by inet_drv.
+%%
+
+-spec shutdown(atom(), non_neg_integer(), term()) -> no_return().
+
+shutdown(Module, Line, Data) ->
+ shutdown(Module, Line, Data, shutdown).
+
+-spec shutdown(atom(), non_neg_integer(), term(), term()) -> no_return().
+
+shutdown(_Module, _Line, _Data, Reason) ->
+ ?shutdown_trace("Net Kernel 2: shutting down connection "
+ "~p:~p, data ~p,reason ~p~n",
+ [_Module,_Line, _Data, Reason]),
+ flush_down(),
+ exit(Reason).
+%% Use this line to debug connection.
+%% Set net_kernel verbose = 1 as well.
+%% exit({Reason, ?MODULE, _Line, _Data, erlang:now()}).
+
+
+flush_down() ->
+ receive
+ {From, get_status} ->
+ From ! {self(), get_status, error},
+ flush_down()
+ after 0 ->
+ ok
+ end.
+
+handshake_we_started(#hs_data{request_type=ReqType,
+ other_node=Node}=PreHSData) ->
+ PreThisFlags = make_this_flags(ReqType, Node),
+ HSData = PreHSData#hs_data{this_flags=PreThisFlags},
+ send_name(HSData),
+ recv_status(HSData),
+ {PreOtherFlags,ChallengeA} = recv_challenge(HSData),
+ {ThisFlags,OtherFlags} = adjust_flags(PreThisFlags, PreOtherFlags),
+ NewHSData = HSData#hs_data{this_flags = ThisFlags,
+ other_flags = OtherFlags,
+ other_started = false},
+ check_dflag_xnc(NewHSData),
+ MyChallenge = gen_challenge(),
+ {MyCookie,HisCookie} = get_cookies(Node),
+ send_challenge_reply(NewHSData,MyChallenge,
+ gen_digest(ChallengeA,HisCookie)),
+ reset_timer(NewHSData#hs_data.timer),
+ recv_challenge_ack(NewHSData, MyChallenge, MyCookie),
+ connection(NewHSData).
+
+%% --------------------------------------------------------------
+%% The connection has been established.
+%% --------------------------------------------------------------
+
+connection(#hs_data{other_node = Node,
+ socket = Socket,
+ f_address = FAddress,
+ f_setopts_pre_nodeup = FPreNodeup,
+ f_setopts_post_nodeup = FPostNodeup}= HSData) ->
+ cancel_timer(HSData#hs_data.timer),
+ PType = publish_type(HSData#hs_data.other_flags),
+ case FPreNodeup(Socket) of
+ ok ->
+ do_setnode(HSData), % Succeeds or exits the process.
+ Address = FAddress(Socket,Node),
+ mark_nodeup(HSData,Address),
+ case FPostNodeup(Socket) of
+ ok ->
+ con_loop(HSData#hs_data.kernel_pid,
+ Node,
+ Socket,
+ Address,
+ HSData#hs_data.this_node,
+ PType,
+ #tick{},
+ HSData#hs_data.mf_tick,
+ HSData#hs_data.mf_getstat);
+ _ ->
+ ?shutdown2(Node, connection_setup_failed)
+ end;
+ _ ->
+ ?shutdown(Node)
+ end.
+
+%% Generate a message digest from Challenge number and Cookie
+gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) ->
+ erlang:md5([atom_to_list(Cookie)|integer_to_list(Challenge)]).
+
+%% ---------------------------------------------------------------
+%% Challenge code
+%% gen_challenge() returns a "random" number
+%% ---------------------------------------------------------------
+gen_challenge() ->
+ {A,B,C} = erlang:now(),
+ {D,_} = erlang:statistics(reductions),
+ {E,_} = erlang:statistics(runtime),
+ {F,_} = erlang:statistics(wall_clock),
+ {G,H,_} = erlang:statistics(garbage_collection),
+ %% A(8) B(16) C(16)
+ %% D(16),E(8), F(16) G(8) H(16)
+ ( ((A bsl 24) + (E bsl 16) + (G bsl 8) + F) bxor
+ (B + (C bsl 16)) bxor
+ (D + (H bsl 16)) ) band 16#ffffffff.
+
+%%
+%% Get the cookies for a node from auth
+%%
+get_cookies(Node) ->
+ case auth:get_cookie(Node) of
+ X when is_atom(X) ->
+ {X,X}
+% {Y,Z} when is_atom(Y), is_atom(Z) ->
+% {Y,Z};
+% _ ->
+% erlang:error("Corrupt cookie database")
+ end.
+
+%% No error return; either succeeds or terminates the process.
+do_setnode(#hs_data{other_node = Node, socket = Socket,
+ other_flags = Flags, other_version = Version,
+ f_getll = GetLL}) ->
+ case GetLL(Socket) of
+ {ok,Port} ->
+ ?trace("setnode(md5,~p ~p ~p)~n",
+ [Node, Port, {publish_type(Flags),
+ '(', Flags, ')',
+ Version}]),
+ case (catch
+ erlang:setnode(Node, Port,
+ {Flags, Version, '', ''})) of
+ {'EXIT', {system_limit, _}} ->
+ error_msg("** Distribution system limit reached, "
+ "no table space left for node ~w ** ~n",
+ [Node]),
+ ?shutdown(Node);
+ {'EXIT', Other} ->
+ exit(Other);
+ _Else ->
+ ok
+ end;
+ _ ->
+ error_msg("** Distribution connection error, "
+ "could not get low level port for node ~w ** ~n",
+ [Node]),
+ ?shutdown(Node)
+ end.
+
+mark_nodeup(#hs_data{kernel_pid = Kernel,
+ other_node = Node,
+ other_flags = Flags,
+ other_started = OtherStarted},
+ Address) ->
+ Kernel ! {self(), {nodeup,Node,Address,publish_type(Flags),
+ true}},
+ receive
+ {Kernel, inserted} ->
+ ok;
+ {Kernel, bad_request} ->
+ TypeT = case OtherStarted of
+ true ->
+ "accepting connection";
+ _ ->
+ "initiating connection"
+ end,
+ error_msg("Fatal: ~p was not allowed to "
+ "send {nodeup, ~p} to kernel when ~s~n",
+ [self(), Node, TypeT]),
+ ?shutdown(Node)
+ end.
+
+con_loop(Kernel, Node, Socket, TcpAddress,
+ MyNode, Type, Tick, MFTick, MFGetstat) ->
+ receive
+ {tcp_closed, Socket} ->
+ ?shutdown2(Node, connection_closed);
+ {Kernel, disconnect} ->
+ ?shutdown2(Node, disconnected);
+ {Kernel, aux_tick} ->
+ case MFGetstat(Socket) of
+ {ok, _, _, PendWrite} ->
+ send_tick(Socket, PendWrite, MFTick);
+ _ ->
+ ignore_it
+ end,
+ con_loop(Kernel, Node, Socket, TcpAddress, MyNode, Type,
+ Tick, MFTick, MFGetstat);
+ {Kernel, tick} ->
+ case send_tick(Socket, Tick, Type,
+ MFTick, MFGetstat) of
+ {ok, NewTick} ->
+ con_loop(Kernel, Node, Socket, TcpAddress,
+ MyNode, Type, NewTick, MFTick,
+ MFGetstat);
+ {error, not_responding} ->
+ error_msg("** Node ~p not responding **~n"
+ "** Removing (timedout) connection **~n",
+ [Node]),
+ ?shutdown2(Node, net_tick_timeout);
+ _Other ->
+ ?shutdown2(Node, send_net_tick_failed)
+ end;
+ {From, get_status} ->
+ case MFGetstat(Socket) of
+ {ok, Read, Write, _} ->
+ From ! {self(), get_status, {ok, Read, Write}},
+ con_loop(Kernel, Node, Socket, TcpAddress,
+ MyNode,
+ Type, Tick,
+ MFTick, MFGetstat);
+ _ ->
+ ?shutdown2(Node, get_status_failed)
+ end
+ end.
+
+
+%% ------------------------------------------------------------
+%% Misc. functions.
+%% ------------------------------------------------------------
+
+send_name(#hs_data{socket = Socket, this_node = Node,
+ f_send = FSend,
+ this_flags = Flags,
+ other_version = Version}) ->
+ ?trace("send_name: node=~w, version=~w\n",
+ [Node,Version]),
+ ?to_port(FSend, Socket,
+ [$n, ?int16(Version), ?int32(Flags), atom_to_list(Node)]).
+
+send_challenge(#hs_data{socket = Socket, this_node = Node,
+ other_version = Version,
+ this_flags = Flags,
+ f_send = FSend},
+ Challenge ) ->
+ ?trace("send: challenge=~w version=~w\n",
+ [Challenge,Version]),
+ ?to_port(FSend, Socket, [$n,?int16(Version), ?int32(Flags),
+ ?int32(Challenge),
+ atom_to_list(Node)]).
+
+send_challenge_reply(#hs_data{socket = Socket, f_send = FSend},
+ Challenge, Digest) ->
+ ?trace("send_reply: challenge=~w digest=~p\n",
+ [Challenge,Digest]),
+ ?to_port(FSend, Socket, [$r,?int32(Challenge),Digest]).
+
+send_challenge_ack(#hs_data{socket = Socket, f_send = FSend},
+ Digest) ->
+ ?trace("send_ack: digest=~p\n", [Digest]),
+ ?to_port(FSend, Socket, [$a,Digest]).
+
+
+%%
+%% Get the name of the other side.
+%% Close the connection if invalid data.
+%% The IP address sent is not interesting (as in the old
+%% tcp_drv.c which used it to detect simultaneous connection
+%% attempts).
+%%
+recv_name(#hs_data{socket = Socket, f_recv = Recv}) ->
+ case Recv(Socket, 0, infinity) of
+ {ok,Data} ->
+ get_name(Data);
+ _ ->
+ ?shutdown(no_node)
+ end.
+
+get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode]) ->
+ {?u32(Flag1, Flag2, Flag3, Flag4), list_to_atom(OtherNode),
+ ?u16(VersionA,VersionB)};
+get_name(Data) ->
+ ?shutdown(Data).
+
+publish_type(Flags) ->
+ case Flags band ?DFLAG_PUBLISHED of
+ 0 ->
+ hidden;
+ _ ->
+ normal
+ end.
+
+%% wait for challenge after connect
+recv_challenge(#hs_data{socket=Socket,other_node=Node,
+ other_version=Version,f_recv=Recv}) ->
+ case Recv(Socket, 0, infinity) of
+ {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} ->
+ Flags = ?u32(Fl1,Fl2,Fl3,Fl4),
+ case {list_to_existing_atom(Ns),?u16(V1,V0)} of
+ {Node,Version} ->
+ Challenge = ?u32(CA3,CA2,CA1,CA0),
+ ?trace("recv: node=~w, challenge=~w version=~w\n",
+ [Node, Challenge,Version]),
+ {Flags,Challenge};
+ _ ->
+ ?shutdown(no_node)
+ end;
+ _ ->
+ ?shutdown(no_node)
+ end.
+
+
+%%
+%% wait for challenge response after send_challenge
+%%
+recv_challenge_reply(#hs_data{socket = Socket,
+ other_node = NodeB,
+ f_recv = FRecv},
+ ChallengeA, Cookie) ->
+ case FRecv(Socket, 0, infinity) of
+ {ok,[$r,CB3,CB2,CB1,CB0 | SumB]} when length(SumB) =:= 16 ->
+ SumA = gen_digest(ChallengeA, Cookie),
+ ChallengeB = ?u32(CB3,CB2,CB1,CB0),
+ ?trace("recv_reply: challenge=~w digest=~p\n",
+ [ChallengeB,SumB]),
+ ?trace("sum = ~p\n", [SumA]),
+ case list_to_binary(SumB) of
+ SumA ->
+ ChallengeB;
+ _ ->
+ error_msg("** Connection attempt from "
+ "disallowed node ~w ** ~n", [NodeB]),
+ ?shutdown(NodeB)
+ end;
+ _ ->
+ ?shutdown(no_node)
+ end.
+
+recv_challenge_ack(#hs_data{socket = Socket, f_recv = FRecv,
+ other_node = NodeB},
+ ChallengeB, CookieA) ->
+ case FRecv(Socket, 0, infinity) of
+ {ok,[$a|SumB]} when length(SumB) =:= 16 ->
+ SumA = gen_digest(ChallengeB, CookieA),
+ ?trace("recv_ack: digest=~p\n", [SumB]),
+ ?trace("sum = ~p\n", [SumA]),
+ case list_to_binary(SumB) of
+ SumA ->
+ ok;
+ _ ->
+ error_msg("** Connection attempt to "
+ "disallowed node ~w ** ~n", [NodeB]),
+ ?shutdown(NodeB)
+ end;
+ _ ->
+ ?shutdown(NodeB)
+ end.
+
+recv_status(#hs_data{kernel_pid = Kernel, socket = Socket,
+ other_node = Node, f_recv = Recv} = HSData) ->
+ case Recv(Socket, 0, infinity) of
+ {ok, [$s|StrStat]} ->
+ Stat = list_to_atom(StrStat),
+ ?debug({dist_util,self(),recv_status, Node, Stat}),
+ case Stat of
+ not_allowed -> ?shutdown(Node);
+ nok ->
+ %% wait to be killed by net_kernel
+ receive
+ after infinity -> ok
+ end;
+ alive ->
+ Reply = is_pending(Kernel, Node),
+ ?debug({is_pending,self(),Reply}),
+ send_status(HSData, Reply),
+ if not Reply ->
+ ?shutdown(Node);
+ Reply ->
+ Stat
+ end;
+ _ -> Stat
+ end;
+ _Error ->
+ ?debug({dist_util,self(),recv_status_error,
+ Node, _Error}),
+ ?shutdown(Node)
+ end.
+
+
+send_status(#hs_data{socket = Socket, other_node = Node,
+ f_send = FSend}, Stat) ->
+ ?debug({dist_util,self(),send_status, Node, Stat}),
+ case FSend(Socket, [$s | atom_to_list(Stat)]) of
+ {error, _} ->
+ ?shutdown(Node);
+ _ ->
+ true
+ end.
+
+
+
+%%
+%% Send a TICK to the other side.
+%%
+%% This will happen every 15 seconds (by default)
+%% The idea here is that every 15 secs, we write a little
+%% something on the connection if we haven't written anything for
+%% the last 15 secs.
+%% This will ensure that nodes that are not responding due to
+%% hardware errors (Or being suspended by means of ^Z) will
+%% be considered to be down. If we do not want to have this
+%% we must start the net_kernel (in erlang) without its
+%% ticker process, In that case this code will never run
+
+%% And then every 60 seconds we also check the connection and
+%% close it if we havn't received anything on it for the
+%% last 60 secs. If ticked == tick we havn't received anything
+%% on the connection the last 60 secs.
+
+%% The detection time interval is thus, by default, 45s < DT < 75s
+
+%% A HIDDEN node is always (if not a pending write) ticked if
+%% we haven't read anything as a hidden node only ticks when it receives
+%% a TICK !!
+
+send_tick(Socket, Tick, Type, MFTick, MFGetstat) ->
+ #tick{tick = T0,
+ read = Read,
+ write = Write,
+ ticked = Ticked} = Tick,
+ T = T0 + 1,
+ T1 = T rem 4,
+ case MFGetstat(Socket) of
+ {ok, Read, _, _} when Ticked =:= T ->
+ {error, not_responding};
+ {ok, Read, W, Pend} when Type =:= hidden ->
+ send_tick(Socket, Pend, MFTick),
+ {ok, Tick#tick{write = W + 1,
+ tick = T1}};
+ {ok, Read, Write, Pend} ->
+ send_tick(Socket, Pend, MFTick),
+ {ok, Tick#tick{write = Write + 1,
+ tick = T1}};
+ {ok, R, Write, Pend} ->
+ send_tick(Socket, Pend, MFTick),
+ {ok, Tick#tick{write = Write + 1,
+ read = R,
+ tick = T1,
+ ticked = T}};
+ {ok, Read, W, _} ->
+ {ok, Tick#tick{write = W,
+ tick = T1}};
+ {ok, R, W, _} ->
+ {ok, Tick#tick{write = W,
+ read = R,
+ tick = T1,
+ ticked = T}};
+ Error ->
+ Error
+ end.
+
+send_tick(Socket, 0, MFTick) ->
+ MFTick(Socket);
+send_tick(_, _Pend, _) ->
+ %% Dont send tick if pending write.
+ ok.
+
+%% ------------------------------------------------------------
+%% Connection setup timeout timer.
+%% After Timeout milliseconds this process terminates
+%% which implies that the owning setup/accept process terminates.
+%% The timer is reset before every network operation during the
+%% connection setup !
+%% ------------------------------------------------------------
+
+start_timer(Timeout) ->
+ spawn_link(?MODULE, setup_timer, [self(), Timeout*?trace_factor]).
+
+setup_timer(Pid, Timeout) ->
+ receive
+ {Pid, reset} ->
+ setup_timer(Pid, Timeout)
+ after Timeout ->
+ ?trace("Timer expires ~p, ~p~n",[Pid, Timeout]),
+ ?shutdown(timer)
+ end.
+
+reset_timer(Timer) ->
+ Timer ! {self(), reset}.
+
+cancel_timer(Timer) ->
+ unlink(Timer),
+ exit(Timer, shutdown).
+
diff --git a/lib/kernel/src/dist_util.hrl b/lib/kernel/src/dist_util.hrl
new file mode 100644
index 0000000000..f2b0598532
--- /dev/null
+++ b/lib/kernel/src/dist_util.hrl
@@ -0,0 +1,87 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% uncomment this if tracing of handshake etc is wanted
+%%-define(dist_trace, true).
+%%-define(dist_debug, true).
+
+
+-ifdef(dist_debug).
+-define(debug(Term), erlang:display(Term)).
+-else.
+-define(debug(Term), ok).
+-endif.
+
+-ifdef(dist_trace).
+-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])).
+% Use the one below for config-file (early boot) connection tracing
+%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])).
+-define(trace_factor,8).
+-else.
+-define(trace(Fmt,Args), ok).
+-define(trace_factor,1).
+-endif.
+
+-define(shutdown(Data), dist_util:shutdown(?MODULE, ?LINE, Data)).
+-define(shutdown2(Data, Reason), dist_util:shutdown(?MODULE, ?LINE, Data, Reason)).
+
+%% Handshake state structure
+-record(hs_data, {
+ kernel_pid, %% Pid of net_kernel
+ other_node, %% Name of peer
+ this_node, %% my nodename
+ socket, %% The connection "socket"
+ timer, %% The setup timer
+ %% (stream_dist_handshake:start_timer)
+ this_flags, %% Flags my node should use
+ allowed, %% Allowed nodes list
+ other_version, %% The other nodes distribution version
+ other_flags, %% The other nodes flags.
+ other_started, %% True if the other node initiated.
+ f_send, %% Fun that behaves like gen_tcp:send
+ f_recv, %% Fun that behaves like gen_tcp:recv
+ f_setopts_pre_nodeup, %% Sets "socket" options before
+ %% nodeup is delivered to net_kernel
+ f_setopts_post_nodeup, %% Sets "socket" options after
+ %% nodeup is delivered
+ f_getll, %% Get low level port or pid.
+ f_address, %% The address of the "socket",
+ %% generated from Socket,Node
+ %% These two are used in the tick loop,
+ %% so they are not fun's to avoid holding old code.
+ mf_tick, %% Takes the socket as parameters and
+ %% sends a tick, this is no fun, it
+ %% is a tuple {M,F}.
+ %% Is should place {tcp_closed, Socket}
+ %% in the message queue on failure.
+ mf_getstat, %% Returns
+ %% {ok, RecvCnt, SendCnt, SendPend} for
+ %% a given socket. This is a {M,F},
+ %% returning {error, Reason on failure}
+ request_type = normal
+}).
+
+
+%% The following should be filled in upon enter of...
+%% - handshake_we_started:
+%% kernel_pid, other_node, this_node, socket, timer,
+%% this_flags, other_version, All fun's/mf's.
+%% - handshake_other_started:
+%% kernel_pid, this_node, socket, timer,
+%% this_flags, allowed, All fun's/mf's.
+
diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl
new file mode 100644
index 0000000000..702b2feac9
--- /dev/null
+++ b/lib/kernel/src/erl_boot_server.erl
@@ -0,0 +1,325 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% A simple boot_server at a CP.
+%%
+%% This server should know about which slaves (DP's or whatever) to boot.
+%% File's (with absolute path name) will be fetched.
+%%
+
+-module(erl_boot_server).
+
+-include("inet_boot.hrl").
+
+-behaviour(gen_server).
+
+%% API functions.
+-export([start/1, start_link/1, add_slave/1, delete_slave/1,
+ add_subnet/2, delete_subnet/2,
+ which_slaves/0]).
+
+%% Exports for testing (dont't remove; tests suites depend on them).
+-export([would_be_booted/1]).
+
+%% Internal exports
+-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]).
+-export([code_change/3]).
+-export([boot_init/1, boot_accept/3]).
+
+-record(state,
+ {
+ priority = 0, %% priority of this server
+ version = "" :: string(), %% Version handled i.e "4.5.3" etc
+ udp_sock, %% listen port for broadcase requests
+ udp_port, %% port number must be ?EBOOT_PORT!
+ listen_sock, %% listen sock for incoming file requests
+ listen_port, %% listen port number
+ slaves, %% list of accepted ip addresses
+ bootp :: pid(), %% boot process
+ prim_state %% state for efile code loader
+ }).
+
+-define(single_addr_mask, {255, 255, 255, 255}).
+
+-type ip4_address() :: {0..255,0..255,0..255,0..255}.
+
+-spec start(Slaves :: [atom()]) -> {'ok', pid()} | {'error', any()}.
+
+start(Slaves) ->
+ case check_arg(Slaves) of
+ {ok, AL} ->
+ gen_server:start({local,boot_server}, erl_boot_server, AL, []);
+ _ ->
+ {error, {badarg, Slaves}}
+ end.
+
+-spec start_link(Slaves :: [atom()]) -> {'ok', pid()} | {'error', any()}.
+
+start_link(Slaves) ->
+ case check_arg(Slaves) of
+ {ok, AL} ->
+ gen_server:start_link({local,boot_server},
+ erl_boot_server, AL, []);
+ _ ->
+ {error, {badarg, Slaves}}
+ end.
+
+check_arg(Slaves) ->
+ check_arg(Slaves, []).
+
+check_arg([Slave|Rest], Result) ->
+ case inet:getaddr(Slave, inet) of
+ {ok, IP} ->
+ check_arg(Rest, [{?single_addr_mask, IP}|Result]);
+ _ ->
+ error
+ end;
+check_arg([], Result) ->
+ {ok, Result};
+check_arg(_, _Result) ->
+ error.
+
+-spec add_slave(Slave :: atom()) -> 'ok' | {'error', any()}.
+
+add_slave(Slave) ->
+ case inet:getaddr(Slave, inet) of
+ {ok,IP} ->
+ gen_server:call(boot_server, {add, {?single_addr_mask, IP}});
+ _ ->
+ {error, {badarg, Slave}}
+ end.
+
+-spec delete_slave(Slave :: atom()) -> 'ok' | {'error', any()}.
+
+delete_slave(Slave) ->
+ case inet:getaddr(Slave, inet) of
+ {ok,IP} ->
+ gen_server:call(boot_server, {delete, {?single_addr_mask, IP}});
+ _ ->
+ {error, {badarg, Slave}}
+ end.
+
+-spec add_subnet(Mask :: ip4_address(), Addr :: ip4_address()) ->
+ 'ok' | {'error', any()}.
+
+add_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) ->
+ case member_address(Addr, [{Mask, Addr}]) of
+ true ->
+ gen_server:call(boot_server, {add, {Mask, Addr}});
+ false ->
+ {error, empty_subnet}
+ end.
+
+-spec delete_subnet(Mask :: ip4_address(), Addr :: ip4_address()) -> 'ok'.
+
+delete_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) ->
+ gen_server:call(boot_server, {delete, {Mask, Addr}}).
+
+-spec which_slaves() -> [atom()].
+
+which_slaves() ->
+ gen_server:call(boot_server, which).
+
+%% Given a host name or IP address, returns true if a host
+%% having that IP address would be accepted for booting, and
+%% false otherwise. (Convenient for testing.)
+
+would_be_booted(Addr) ->
+ {ok, IP} = inet:getaddr(Addr, inet),
+ member_address(IP, which_slaves()).
+
+int16(X) when is_integer(X) ->
+ [(X bsr 8) band 16#ff, (X) band 16#ff].
+
+%% Check if an address is a member
+
+member_address(IP, [{{MA, MB, MC, MD}, {EA, EB, EC, ED}}|Rest]) ->
+ {A, B, C, D} = IP,
+ if A band MA =:= EA,
+ B band MB =:= EB,
+ C band MC =:= EC,
+ D band MD =:= ED ->
+ true;
+ true ->
+ member_address(IP, Rest)
+ end;
+member_address(_, []) ->
+ false.
+
+%% ------------------------------------------------------------
+%% call-back functions.
+%% ------------------------------------------------------------
+
+init(Slaves) ->
+ {ok, U} = gen_udp:open(?EBOOT_PORT, []),
+ {ok, L} = gen_tcp:listen(0, [binary,{packet,4}]),
+ {ok, Port} = inet:port(L),
+ {ok, UPort} = inet:port(U),
+ Ref = make_ref(),
+ Pid = proc_lib:spawn_link(?MODULE, boot_init, [Ref]),
+ gen_tcp:controlling_process(L, Pid),
+ Pid ! {Ref, L},
+ %% We trap exit inorder to restart boot_init and udp_port
+ process_flag(trap_exit, true),
+ {ok, #state {priority = 0,
+ version = erlang:system_info(version),
+ udp_sock = U,
+ udp_port = UPort,
+ listen_sock = L,
+ listen_port = Port,
+ slaves = ordsets:from_list(Slaves),
+ bootp = Pid
+ }}.
+
+handle_call({add,Address}, _, S0) ->
+ Slaves = ordsets:add_element(Address, S0#state.slaves),
+ S0#state.bootp ! {slaves, Slaves},
+ {reply, ok, S0#state{slaves = Slaves}};
+handle_call({delete,Address}, _, S0) ->
+ Slaves = ordsets:del_element(Address, S0#state.slaves),
+ S0#state.bootp ! {slaves, Slaves},
+ {reply, ok, S0#state{slaves = Slaves}};
+handle_call(which, _, S0) ->
+ {reply, ordsets:to_list(S0#state.slaves), S0}.
+
+handle_cast(_, Slaves) ->
+ {noreply, Slaves}.
+
+handle_info({udp, U, IP, Port, Data}, S0) ->
+ Token = ?EBOOT_REQUEST ++ S0#state.version,
+ Valid = member_address(IP, ordsets:to_list(S0#state.slaves)),
+ %% check that the connecting node is valid and has the same
+ %% erlang version as the boot server node
+ case {Valid,Data,Token} of
+ {true,Token,Token} ->
+ gen_udp:send(U,IP,Port,[?EBOOT_REPLY,S0#state.priority,
+ int16(S0#state.listen_port),
+ S0#state.version]),
+ {noreply,S0};
+ {false,_,_} ->
+ error_logger:error_msg("** Illegal boot server connection attempt: "
+ "~w is not a valid address ** ~n", [IP]),
+ {noreply,S0};
+ {true,_,_} ->
+ case catch string:substr(Data, 1, length(?EBOOT_REQUEST)) of
+ ?EBOOT_REQUEST ->
+ Vsn = string:substr(Data, length(?EBOOT_REQUEST)+1, length(Data)),
+ error_logger:error_msg("** Illegal boot server connection attempt: "
+ "client version is ~s ** ~n", [Vsn]);
+ _ ->
+ error_logger:error_msg("** Illegal boot server connection attempt: "
+ "unrecognizable request ** ~n", [])
+ end,
+ {noreply,S0}
+ end;
+handle_info(_Info, S0) ->
+ {noreply,S0}.
+
+terminate(_Reason, _S0) ->
+ ok.
+
+code_change(_Vsn, State, _Extra) ->
+ {ok, State}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Boot server
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+boot_init(Tag) ->
+ receive
+ {Tag, Listen} ->
+ process_flag(trap_exit, true),
+ boot_main(Listen)
+ end.
+
+boot_main(Listen) ->
+ Tag = make_ref(),
+ Pid = proc_lib:spawn_link(?MODULE, boot_accept, [self(), Listen, Tag]),
+ boot_main(Listen, Tag, Pid).
+
+boot_main(Listen, Tag, Pid) ->
+ receive
+ {Tag, _} ->
+ boot_main(Listen);
+ {'EXIT', Pid, _} ->
+ boot_main(Listen);
+ {'EXIT', _, Reason} ->
+ exit(Pid, kill),
+ exit(Reason);
+ {tcp_closed, Listen} ->
+ exit(closed)
+ end.
+
+boot_accept(Server, Listen, Tag) ->
+ Reply = gen_tcp:accept(Listen),
+ unlink(Server),
+ Server ! {Tag, continue},
+ case Reply of
+ {ok, Socket} ->
+ {ok, {IP, _Port}} = inet:peername(Socket),
+ true = member_address(IP, which_slaves()),
+ PS = erl_prim_loader:prim_init(),
+ boot_loop(Socket, PS)
+ end.
+
+boot_loop(Socket, PS) ->
+ receive
+ {tcp, Socket, Data} ->
+ PS2 = handle_command(Socket, PS, Data),
+ boot_loop(Socket, PS2);
+ {tcp_closed, Socket} ->
+ true
+ end.
+
+handle_command(S, PS, Msg) ->
+ case catch binary_to_term(Msg) of
+ {get,File} ->
+ {Res, PS2} = erl_prim_loader:prim_get_file(PS, File),
+ send_file_result(S, get, Res),
+ PS2;
+ {list_dir,Dir} ->
+ {Res, PS2} = erl_prim_loader:prim_list_dir(PS, Dir),
+ send_file_result(S, list_dir, Res),
+ PS2;
+ {read_file_info,File} ->
+ {Res, PS2} = erl_prim_loader:prim_read_file_info(PS, File),
+ send_file_result(S, read_file_info, Res),
+ PS2;
+ get_cwd ->
+ {Res, PS2} = erl_prim_loader:prim_get_cwd(PS, []),
+ send_file_result(S, get_cwd, Res),
+ PS2;
+ {get_cwd,Drive} ->
+ {Res, PS2} = erl_prim_loader:prim_get_cwd(PS, [Drive]),
+ send_file_result(S, get_cwd, Res),
+ PS2;
+ {'EXIT',Reason} ->
+ send_result(S, {error,Reason}),
+ PS;
+ _Other ->
+ send_result(S, {error,unknown_command}),
+ PS
+ end.
+
+send_file_result(S, Cmd, Result) ->
+ gen_tcp:send(S, term_to_binary({Cmd,Result})).
+
+send_result(S, Result) ->
+ gen_tcp:send(S, term_to_binary(Result)).
diff --git a/lib/kernel/src/erl_ddll.erl b/lib/kernel/src/erl_ddll.erl
new file mode 100644
index 0000000000..88f91de24f
--- /dev/null
+++ b/lib/kernel/src/erl_ddll.erl
@@ -0,0 +1,150 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Dynamic Driver Loader and Linker
+%%
+%% Interface for dynamic library/shared object driver loader/linker.
+%% Provides methods for loading, unloading and listing drivers.
+
+-module(erl_ddll).
+
+-export([load_driver/2, load/2,
+ unload_driver/1, unload/1, reload/2, reload_driver/2,
+ format_error/1,info/1,info/0, start/0, stop/0]).
+
+%%----------------------------------------------------------------------------
+
+-spec start() -> {'error', {'already_started', 'undefined'}}.
+
+start() ->
+ {error, {already_started,undefined}}.
+
+-spec stop() -> 'ok'.
+
+stop() ->
+ ok.
+
+-spec load_driver(Path :: string() | atom(), Driver :: string() | atom()) ->
+ 'ok' | {'error', any()}.
+
+load_driver(Path, Driver) ->
+ do_load_driver(Path, Driver, [{driver_options,[kill_ports]}]).
+
+-spec load(Path :: string() | atom(), Driver :: string() | atom()) ->
+ 'ok' | {'error', any()}.
+
+load(Path, Driver) ->
+ do_load_driver(Path, Driver, []).
+
+do_load_driver(Path, Driver, DriverFlags) ->
+ case erl_ddll:try_load(Path, Driver,[{monitor,pending_driver}]++DriverFlags) of
+ {error, inconsistent} ->
+ {error,bad_driver_name}; % BC
+ {error, What} ->
+ {error,What};
+ {ok, already_loaded} ->
+ ok;
+ {ok,loaded} ->
+ ok;
+ {ok, pending_driver, Ref} ->
+ receive
+ {'DOWN', Ref, driver, _, load_cancelled} ->
+ {error, load_cancelled};
+ {'UP', Ref, driver, _, permanent} ->
+ {error, permanent};
+ {'DOWN', Ref, driver, _, {load_failure, Failure}} ->
+ {error, Failure};
+ {'UP', Ref, driver, _, loaded} ->
+ ok
+ end
+ end.
+
+do_unload_driver(Driver,Flags) ->
+ case erl_ddll:try_unload(Driver,Flags) of
+ {error,What} ->
+ {error,What};
+ {ok, pending_process} ->
+ ok;
+ {ok, unloaded} ->
+ ok;
+ {ok, pending_driver} ->
+ ok;
+ {ok, pending_driver, Ref} ->
+ receive
+ {'UP', Ref, driver, _, permanent} ->
+ {error, permanent};
+ {'UP', Ref, driver, _, unload_cancelled} ->
+ ok;
+ {'DOWN', Ref, driver, _, unloaded} ->
+ ok
+ end
+ end.
+
+-spec unload_driver(Driver :: string() | atom()) -> 'ok' | {'error', any()}.
+
+unload_driver(Driver) ->
+ do_unload_driver(Driver,[{monitor,pending_driver},kill_ports]).
+
+-spec unload(Driver :: string() | atom()) -> 'ok' | {'error', any()}.
+
+unload(Driver) ->
+ do_unload_driver(Driver,[]).
+
+-spec reload(Path :: string() | atom(), Driver :: string() | atom()) ->
+ 'ok' | {'error', any()}.
+
+reload(Path,Driver) ->
+ do_load_driver(Path, Driver, [{reload,pending_driver}]).
+
+-spec reload_driver(Path :: string() | atom(), Driver :: string() | atom()) ->
+ 'ok' | {'error', any()}.
+
+reload_driver(Path,Driver) ->
+ do_load_driver(Path, Driver, [{reload,pending_driver},
+ {driver_options,[kill_ports]}]).
+
+-spec format_error(Code :: atom()) -> string().
+
+format_error(Code) ->
+ case Code of
+ % This is the only error code returned only from erlang code...
+ % 'permanent' has a translation in the emulator, even though the erlang code uses it to...
+ load_cancelled ->
+ "Loading was cancelled from other process";
+ _ ->
+ erl_ddll:format_error_int(Code)
+ end.
+
+-spec info(Driver :: string() | atom()) -> [{atom(), any()}].
+
+info(Driver) ->
+ [{processes, erl_ddll:info(Driver,processes)},
+ {driver_options, erl_ddll:info(Driver,driver_options)},
+ {port_count, erl_ddll:info(Driver,port_count)},
+ {linked_in_driver, erl_ddll:info(Driver,linked_in_driver)},
+ {permanent, erl_ddll:info(Driver,permanent)},
+ {awaiting_load, erl_ddll:info(Driver,awaiting_load)},
+ {awaiting_unload, erl_ddll:info(Driver,awaiting_unload)}].
+
+-spec info() -> [{string(), [{atom(), any()}]}].
+
+info() ->
+ {ok,DriverList} = erl_ddll:loaded_drivers(),
+ [{X,Y} || X <- DriverList,
+ Y <- [catch info(X)],
+ is_list(Y), not lists:member({linked_in_driver,true},Y)].
diff --git a/lib/kernel/src/erl_distribution.erl b/lib/kernel/src/erl_distribution.erl
new file mode 100644
index 0000000000..25ad34357a
--- /dev/null
+++ b/lib/kernel/src/erl_distribution.erl
@@ -0,0 +1,106 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erl_distribution).
+
+-behaviour(supervisor).
+
+-export([start_link/0,start_link/1,init/1,start/1,stop/0]).
+
+%-define(DBG,io:format("~p:~p~n",[?MODULE,?LINE])).
+-define(DBG,erlang:display([?MODULE,?LINE])).
+
+start_link() ->
+ case catch start_p() of
+ {ok,Args} ->
+ start_link(Args);
+ _ ->
+ ignore
+ end.
+
+start_link(Args) ->
+ supervisor:start_link({local,net_sup},erl_distribution,Args).
+
+init(NetArgs) ->
+ Epmd =
+ case init:get_argument(no_epmd) of
+ {ok, [[]]} ->
+ [];
+ _ ->
+ EpmdMod = net_kernel:epmd_module(),
+ [{EpmdMod,{EpmdMod,start_link,[]},
+ permanent,2000,worker,[EpmdMod]}]
+ end,
+ Auth = {auth,{auth,start_link,[]},permanent,2000,worker,[auth]},
+ Kernel = {net_kernel,{net_kernel,start_link,[NetArgs]},
+ permanent,2000,worker,[net_kernel]},
+ EarlySpecs = net_kernel:protocol_childspecs(),
+ {ok,{{one_for_all,0,1}, EarlySpecs ++ Epmd ++ [Auth,Kernel]}}.
+
+start_p() ->
+ sname(),
+ lname(),
+ false.
+
+sname() ->
+ case init:get_argument(sname) of
+ {ok,[[Name]]} ->
+ throw({ok,[list_to_atom(Name),shortnames|ticktime()]});
+ _ ->
+ false
+ end.
+
+lname() ->
+ case init:get_argument(name) of
+ {ok,[[Name]]} ->
+ throw({ok,[list_to_atom(Name),longnames|ticktime()]});
+ _ ->
+ false
+ end.
+
+ticktime() ->
+ %% catch, in case the system was started with boot file start_old,
+ %% i.e. running without the application_controller.
+ %% Time is given in seconds. The net_kernel tick time is
+ %% Time/4 milliseconds.
+ case catch application:get_env(net_ticktime) of
+ {ok, Value} when is_integer(Value), Value > 0 ->
+ [Value * 250]; %% i.e. 1000 / 4 = 250 ms.
+ _ ->
+ []
+ end.
+
+start(Args) ->
+ C = {net_sup_dynamic, {erl_distribution, start_link, [Args]}, permanent,
+ 1000, supervisor, [erl_distribution]},
+ supervisor:start_child(kernel_sup, C).
+
+stop() ->
+ case supervisor:terminate_child(kernel_sup, net_sup_dynamic) of
+ ok ->
+ supervisor:delete_child(kernel_sup, net_sup_dynamic);
+ Error ->
+ case whereis(net_sup) of
+ Pid when is_pid(Pid) ->
+ %% Dist. started through -sname | -name flags
+ {error, not_allowed};
+ _ ->
+ Error
+ end
+ end.
+
diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl
new file mode 100644
index 0000000000..e4b371836b
--- /dev/null
+++ b/lib/kernel/src/erl_epmd.erl
@@ -0,0 +1,553 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erl_epmd).
+
+-behaviour(gen_server).
+
+-ifdef(DEBUG).
+-define(port_please_failure(), io:format("Net Kernel 2: EPMD port please failed at ~p:~p~n", [?MODULE,?LINE])).
+-define(port_please_failure2(Term), io:format("Net Kernel 2: EPMD port please failed at ~p:~p [~p]~n", [?MODULE,?LINE,Term])).
+-else.
+-define(port_please_failure(), noop).
+-define(port_please_failure2(Term), noop).
+-endif.
+
+%% External exports
+-export([start/0, start_link/0, stop/0, port_please/2,
+ port_please/3, names/0, names/1,
+ register_node/2, open/0, open/1, open/2]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-import(lists, [reverse/1]).
+
+-record(state, {socket, port_no = -1, name = ""}).
+
+-include("inet_int.hrl").
+-include("erl_epmd.hrl").
+
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+start() ->
+ gen_server:start({local, erl_epmd}, ?MODULE, [], []).
+
+
+start_link() ->
+ gen_server:start_link({local, erl_epmd}, ?MODULE, [], []).
+
+
+stop() ->
+ gen_server:call(?MODULE, stop, infinity).
+
+
+%% Lookup a node "Name" at Host
+%% return {port, P, Version} | noport
+%%
+
+port_please(Node, Host) ->
+ port_please(Node, Host, infinity).
+
+port_please(Node,HostName, Timeout) when is_atom(HostName) ->
+ port_please1(Node,atom_to_list(HostName), Timeout);
+port_please(Node,HostName, Timeout) when is_list(HostName) ->
+ port_please1(Node,HostName, Timeout);
+port_please(Node, EpmdAddr, Timeout) ->
+ get_port(Node, EpmdAddr, Timeout).
+
+
+
+port_please1(Node,HostName, Timeout) ->
+ case inet:gethostbyname(HostName, inet, Timeout) of
+ {ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} ->
+ get_port(Node, EpmdAddr, Timeout);
+ Else ->
+ Else
+ end.
+
+names() ->
+ {ok, H} = inet:gethostname(),
+ names(H).
+
+names(HostName) when is_atom(HostName) ->
+ names1(atom_to_list(HostName));
+names(HostName) when is_list(HostName) ->
+ names1(HostName);
+names(EpmdAddr) ->
+ get_names(EpmdAddr).
+
+names1(HostName) ->
+ case inet:gethostbyname(HostName) of
+ {ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} ->
+ get_names(EpmdAddr);
+ Else ->
+ Else
+ end.
+
+
+register_node(Name, PortNo) ->
+ gen_server:call(erl_epmd, {register, Name, PortNo}, infinity).
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from gen_server
+%%%----------------------------------------------------------------------
+
+init(_) ->
+ {ok, #state{socket = -1}}.
+
+%%----------------------------------------------------------------------
+
+handle_call({register, Name, PortNo}, _From, State) ->
+ case State#state.socket of
+ P when P < 0 ->
+ case do_register_node(Name, PortNo) of
+ {alive, Socket, Creation} ->
+ S = State#state{socket = Socket,
+ port_no = PortNo,
+ name = Name},
+ {reply, {ok, Creation}, S};
+ Error ->
+ {reply, Error, State}
+ end;
+ _ ->
+ {reply, {error, already_registered}, State}
+ end;
+
+handle_call(client_info_req, _From, State) ->
+ Reply = {ok,{r4,State#state.name,State#state.port_no}},
+ {reply,Reply,State};
+
+handle_call(stop, _From, State) ->
+ {stop, shutdown, ok, State}.
+
+%%----------------------------------------------------------------------
+
+handle_cast(_, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+
+handle_info({tcp_closed, Socket}, State) when State#state.socket =:= Socket ->
+ {noreply, State#state{socket = -1}};
+handle_info(_, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+
+terminate(_, #state{socket = Socket}) when Socket > 0 ->
+ close(Socket),
+ ok;
+terminate(_, _) ->
+ ok.
+
+%%----------------------------------------------------------------------
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+get_epmd_port() ->
+ case init:get_argument(epmd_port) of
+ {ok, [[PortStr|_]|_]} when is_list(PortStr) ->
+ list_to_integer(PortStr);
+ error ->
+ ?erlang_daemon_port
+ end.
+
+%%
+%% Epmd socket
+%%
+open() -> open({127,0,0,1}). % The localhost IP address.
+
+open({A,B,C,D}=EpmdAddr) when ?ip(A,B,C,D) ->
+ gen_tcp:connect(EpmdAddr, get_epmd_port(), [inet]);
+open({A,B,C,D,E,F,G,H}=EpmdAddr) when ?ip6(A,B,C,D,E,F,G,H) ->
+ gen_tcp:connect(EpmdAddr, get_epmd_port(), [inet6]).
+
+open({A,B,C,D}=EpmdAddr, Timeout) when ?ip(A,B,C,D) ->
+ gen_tcp:connect(EpmdAddr, get_epmd_port(), [inet], Timeout);
+open({A,B,C,D,E,F,G,H}=EpmdAddr, Timeout) when ?ip6(A,B,C,D,E,F,G,H) ->
+ gen_tcp:connect(EpmdAddr, get_epmd_port(), [inet6], Timeout).
+
+close(Socket) ->
+ gen_tcp:close(Socket).
+
+
+do_register_node_v0(NodeName, TcpPort) ->
+ case open() of
+ {ok, Socket} ->
+ Name = cstring(NodeName),
+ Len = 1+2+length(Name),
+ gen_tcp:send(Socket, [?int16(Len), ?EPMD_ALIVE,
+ ?int16(TcpPort), Name]),
+ wait_for_reg_reply_v0(Socket, []);
+ Error ->
+ Error
+ end.
+
+do_register_node(NodeName, TcpPort) ->
+ case open() of
+ {ok, Socket} ->
+ Name = to_string(NodeName),
+ Extra = "",
+ Elen = length(Extra),
+ Len = 1+2+1+1+2+2+2+length(Name)+2+Elen,
+ gen_tcp:send(Socket, [?int16(Len), ?EPMD_ALIVE2_REQ,
+ ?int16(TcpPort),
+ $M,
+ 0,
+ ?int16(epmd_dist_high()),
+ ?int16(epmd_dist_low()),
+ ?int16(length(Name)),
+ Name,
+ ?int16(Elen),
+ Extra]),
+ case wait_for_reg_reply(Socket, []) of
+ {error, epmd_close} ->
+ %% could be old epmd; try old protocol
+% erlang:display('trying old'),
+ do_register_node_v0(NodeName, TcpPort);
+ Other ->
+ Other
+ end;
+ Error ->
+ Error
+ end.
+
+epmd_dist_high() ->
+ case os:getenv("ERL_EPMD_DIST_HIGH") of
+ false ->
+ ?epmd_dist_high;
+ Version ->
+ case (catch list_to_integer(Version)) of
+ N when is_integer(N), N < ?epmd_dist_high ->
+ N;
+ _ ->
+ ?epmd_dist_high
+ end
+ end.
+
+epmd_dist_low() ->
+ case os:getenv("ERL_EPMD_DIST_LOW") of
+ false ->
+ ?epmd_dist_low;
+ Version ->
+ case (catch list_to_integer(Version)) of
+ N when is_integer(N), N > ?epmd_dist_low ->
+ N;
+ _ ->
+ ?epmd_dist_low
+ end
+ end.
+
+
+
+%%% (When we reply 'duplicate_name', it's because it's the most likely
+%%% reason; there is no interpretation of the error result code.)
+wait_for_reg_reply(Socket, SoFar) ->
+ receive
+ {tcp, Socket, Data0} ->
+ case SoFar ++ Data0 of
+ [$y, Result, A, B] ->
+ case Result of
+ 0 ->
+ {alive, Socket, ?u16(A, B)};
+ _ ->
+ {error, duplicate_name}
+ end;
+ Data when length(Data) < 4 ->
+ wait_for_reg_reply(Socket, Data);
+ Garbage ->
+ {error, {garbage_from_epmd, Garbage}}
+ end;
+ {tcp_closed, Socket} ->
+ {error, epmd_close}
+ after 10000 ->
+ gen_tcp:close(Socket),
+ {error, no_reg_reply_from_epmd}
+ end.
+
+wait_for_reg_reply_v0(Socket, SoFar) ->
+ receive
+ {tcp, Socket, Data0} ->
+ case SoFar ++ Data0 of
+ [$Y, A, B] ->
+ {alive, Socket, ?u16(A, B)};
+ Data when length(Data) < 3 ->
+ wait_for_reg_reply(Socket, Data);
+ Garbage ->
+ {error, {garbage_from_epmd, Garbage}}
+ end;
+ {tcp_closed, Socket} ->
+ {error, duplicate_name} % A guess -- the most likely reason.
+ after 10000 ->
+ gen_tcp:close(Socket),
+ {error, no_reg_reply_from_epmd}
+ end.
+%%
+%% Lookup a node "Name" at Host
+%%
+get_port_v0(Node, EpmdAddress) ->
+ case open(EpmdAddress) of
+ {ok, Socket} ->
+ Name = cstring(Node),
+ Len = 1+length(Name),
+ gen_tcp:send(Socket, [?int16(Len),?EPMD_PORT_PLEASE, Name]),
+ wait_for_port_reply_v0(Socket, []);
+ _Error ->
+ ?port_please_failure(),
+ noport
+ end.
+
+%%% Not used anymore
+%%% get_port(Node, EpmdAddress) ->
+%%% get_port(Node, EpmdAddress, infinity).
+
+get_port(Node, EpmdAddress, Timeout) ->
+ case open(EpmdAddress, Timeout) of
+ {ok, Socket} ->
+ Name = to_string(Node),
+ Len = 1+length(Name),
+ gen_tcp:send(Socket, [?int16(Len),?EPMD_PORT_PLEASE2_REQ, Name]),
+ Reply = wait_for_port_reply(Socket, []),
+ case Reply of
+ closed ->
+ get_port_v0(Node, EpmdAddress);
+ Other ->
+ Other
+ end;
+ _Error ->
+ ?port_please_failure2(_Error),
+ noport
+ end.
+
+wait_for_port_reply_v0(Socket, SoFar) ->
+ receive
+ {tcp, Socket, Data0} ->
+% io:format("got ~p~n", [Data0]),
+ case SoFar ++ Data0 of
+ [A, B] ->
+ wait_for_close(Socket, {port, ?u16(A, B), 0});
+% wait_for_close(Socket, {port, ?u16(A, B)});
+ Data when length(Data) < 2 ->
+ wait_for_port_reply_v0(Socket, Data);
+ Garbage ->
+ ?port_please_failure(),
+ {error, {garbage_from_epmd, Garbage}}
+ end;
+ {tcp_closed, Socket} ->
+ ?port_please_failure(),
+ noport
+ after 10000 ->
+ ?port_please_failure(),
+ gen_tcp:close(Socket),
+ noport
+ end.
+
+wait_for_port_reply(Socket, SoFar) ->
+ receive
+ {tcp, Socket, Data0} ->
+% io:format("got ~p~n", [Data0]),
+ case SoFar ++ Data0 of
+ [$w, Result | Rest] ->
+ case Result of
+ 0 ->
+ wait_for_port_reply_cont(Socket, Rest);
+ _ ->
+ ?port_please_failure(),
+ wait_for_close(Socket, noport)
+ end;
+ Data when length(Data) < 2 ->
+ wait_for_port_reply(Socket, Data);
+ Garbage ->
+ ?port_please_failure(),
+ {error, {garbage_from_epmd, Garbage}}
+ end;
+ {tcp_closed, Socket} ->
+ ?port_please_failure(),
+ closed
+ after 10000 ->
+ ?port_please_failure(),
+ gen_tcp:close(Socket),
+ noport
+ end.
+
+wait_for_port_reply_cont(Socket, SoFar) when length(SoFar) >= 10 ->
+ wait_for_port_reply_cont2(Socket, SoFar);
+wait_for_port_reply_cont(Socket, SoFar) ->
+ receive
+ {tcp, Socket, Data0} ->
+ case SoFar ++ Data0 of
+ Data when length(Data) >= 10 ->
+ wait_for_port_reply_cont2(Socket, Data);
+ Data when length(Data) < 10 ->
+ wait_for_port_reply_cont(Socket, Data);
+ Garbage ->
+ ?port_please_failure(),
+ {error, {garbage_from_epmd, Garbage}}
+ end;
+ {tcp_closed, Socket} ->
+ ?port_please_failure(),
+ noport
+ after 10000 ->
+ ?port_please_failure(),
+ gen_tcp:close(Socket),
+ noport
+ end.
+
+wait_for_port_reply_cont2(Socket, Data) ->
+ [A, B, _Type, _Proto, HighA, HighB,
+ LowA, LowB, NLenA, NLenB | Rest] = Data,
+ wait_for_port_reply_name(Socket,
+ ?u16(NLenA, NLenB),
+ Rest),
+ Low = ?u16(LowA, LowB),
+ High = ?u16(HighA, HighB),
+ Version = best_version(Low, High),
+% io:format("Returning ~p~n", [{port, ?u16(A, B), Version}]),
+ {port, ?u16(A, B), Version}.
+% {port, ?u16(A, B)}.
+
+%%% Throw away the rest of the message; we won't use any of it anyway,
+%%% currently.
+wait_for_port_reply_name(Socket, Len, Sofar) ->
+ receive
+ {tcp, Socket, _Data} ->
+% io:format("data = ~p~n", _Data),
+ wait_for_port_reply_name(Socket, Len, Sofar);
+ {tcp_closed, Socket} ->
+ "foobar"
+ end.
+
+
+best_version(Low, High) ->
+ OurLow = epmd_dist_low(),
+ OurHigh = epmd_dist_high(),
+ select_best_version(OurLow, OurHigh, Low, High).
+
+%%% We silently assume that the low's are not greater than the high's.
+%%% We should report if the intervals don't overlap.
+select_best_version(L1, _H1, _L2, H2) when L1 > H2 ->
+ 0;
+select_best_version(_L1, H1, L2, _H2) when L2 > H1 ->
+ 0;
+select_best_version(_L1, H1, L2, _H2) when L2 > H1 ->
+ 0;
+select_best_version(_L1, H1, _L2, H2) ->
+ erlang:min(H1, H2).
+
+wait_for_close(Socket, Reply) ->
+ receive
+ {tcp_closed, Socket} ->
+ Reply
+ after 10000 ->
+ gen_tcp:close(Socket),
+ Reply
+ end.
+
+
+%%
+%% Creates a (flat) null terminated string from atom or list.
+%%
+cstring(S) when is_atom(S) -> cstring(atom_to_list(S));
+cstring(S) when is_list(S) -> S ++ [0].
+
+to_string(S) when is_atom(S) -> atom_to_list(S);
+to_string(S) when is_list(S) -> S.
+
+%%
+%% Find names on epmd
+%%
+%%
+get_names(EpmdAddress) ->
+ case open(EpmdAddress) of
+ {ok, Socket} ->
+ do_get_names(Socket);
+ _Error ->
+ {error, address}
+ end.
+
+do_get_names(Socket) ->
+ gen_tcp:send(Socket, [?int16(1),?EPMD_NAMES]),
+ receive
+ {tcp, Socket, [P0,P1,P2,P3|T]} ->
+ EpmdPort = ?u32(P0,P1,P2,P3),
+ case get_epmd_port() of
+ EpmdPort ->
+ names_loop(Socket, T, []);
+ _ ->
+ close(Socket),
+ {error, address}
+ end;
+ {tcp_closed, Socket} ->
+ {ok, []}
+ end.
+
+names_loop(Socket, Acc, Ps) ->
+ receive
+ {tcp, Socket, Bytes} ->
+ {NAcc, NPs} = scan_names(Acc ++ Bytes, Ps),
+ names_loop(Socket, NAcc, NPs);
+ {tcp_closed, Socket} ->
+ {_, NPs} = scan_names(Acc, Ps),
+ {ok, NPs}
+ end.
+
+scan_names(Buf, Ps) ->
+ case scan_line(Buf, []) of
+ {Line, NBuf} ->
+ case parse_line(Line) of
+ {ok, Entry} ->
+ scan_names(NBuf, [Entry | Ps]);
+ error ->
+ scan_names(NBuf, Ps)
+ end;
+ [] -> {Buf, Ps}
+ end.
+
+
+scan_line([$\n | Buf], Line) -> {reverse(Line), Buf};
+scan_line([C | Buf], Line) -> scan_line(Buf, [C|Line]);
+scan_line([], _) -> [].
+
+parse_line("name " ++ Buf0) ->
+ case parse_name(Buf0, []) of
+ {Name, Buf1} ->
+ case Buf1 of
+ "at port " ++ Buf2 ->
+ case catch list_to_integer(Buf2) of
+ {'EXIT', _} -> error;
+ Port -> {ok, {Name, Port}}
+ end;
+ _ -> error
+ end;
+ error -> error
+ end;
+parse_line(_) -> error.
+
+
+parse_name([$\s | Buf], Name) -> {reverse(Name), Buf};
+parse_name([C | Buf], Name) -> parse_name(Buf, [C|Name]);
+parse_name([], _Name) -> error.
diff --git a/lib/kernel/src/erl_epmd.hrl b/lib/kernel/src/erl_epmd.hrl
new file mode 100644
index 0000000000..47ab6195d8
--- /dev/null
+++ b/lib/kernel/src/erl_epmd.hrl
@@ -0,0 +1,32 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-define(EPMD_ALIVE, $a).
+-define(EPMD_PORT_PLEASE, $p).
+-define(EPMD_NAMES, $n).
+-define(EPMD_DUMP, $d).
+-define(EPMD_KILL, $k).
+-define(EPMD_STOP, $s).
+
+-define(EPMD_ALIVE_OK, $Y).
+
+-define(EPMD_ALIVE2_REQ, $x).
+-define(EPMD_PORT_PLEASE2_REQ, $z).
+-define(EPMD_ALIVE2_RESP, $y).
+-define(EPMD_PORT2_RESP, $w).
diff --git a/lib/kernel/src/erl_reply.erl b/lib/kernel/src/erl_reply.erl
new file mode 100644
index 0000000000..1a61e630bc
--- /dev/null
+++ b/lib/kernel/src/erl_reply.erl
@@ -0,0 +1,49 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erl_reply).
+
+%% Syncronisation with erl_start (erl_interface)
+
+-export([reply/1]).
+
+%% send Msg to Addr:Port
+%% all args are atoms since we call this from erl command line
+
+-spec reply([atom()]) -> 'ok' | 'reply_done'.
+
+reply([Addr,Port,Msg]) ->
+ Ip = ip_string_to_tuple(atom_to_list(Addr)),
+ P = list_to_integer(atom_to_list(Port)),
+ M = atom_to_list(Msg),
+ {ok, S} = gen_tcp:connect(Ip,P,[]),
+ gen_tcp:send(S,M),
+ gen_tcp:close(S),
+ reply_done;
+reply(_) ->
+ error_logger:error_msg("erl_reply: Can't find address and port "
+ "to reply to~n").
+
+%% convert ip number to tuple
+ip_string_to_tuple(Ip) ->
+ [Ip1,Ip2,Ip3,Ip4] = string:tokens(Ip,"."),
+ {list_to_integer(Ip1),
+ list_to_integer(Ip2),
+ list_to_integer(Ip3),
+ list_to_integer(Ip4)}.
+
diff --git a/lib/kernel/src/error_handler.erl b/lib/kernel/src/error_handler.erl
new file mode 100644
index 0000000000..5f2507fc08
--- /dev/null
+++ b/lib/kernel/src/error_handler.erl
@@ -0,0 +1,141 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(error_handler).
+
+%% A simple error handler.
+
+-export([undefined_function/3, undefined_lambda/3, stub_function/3,
+ breakpoint/3]).
+
+-spec undefined_function(Module :: atom(), Function :: atom(), Args :: [_]) ->
+ any().
+
+undefined_function(Module, Func, Args) ->
+ case ensure_loaded(Module) of
+ {module, Module} ->
+ case erlang:function_exported(Module, Func, length(Args)) of
+ true ->
+ apply(Module, Func, Args);
+ false ->
+ case check_inheritance(Module, Args) of
+ {value, Base, Args1} ->
+ apply(Base, Func, Args1);
+ none ->
+ crash(Module, Func, Args)
+ end
+ end;
+ {module, _} ->
+ crash(Module, Func, Args);
+ _Other ->
+ crash(Module, Func, Args)
+ end.
+
+-spec undefined_lambda(Module :: atom(), Function :: fun(), Args :: [_]) ->
+ any().
+
+undefined_lambda(Module, Fun, Args) ->
+ case ensure_loaded(Module) of
+ {module, Module} ->
+ %% There is no need (and no way) to test if the fun is present.
+ %% apply/2 will not call us again if the fun is missing.
+ apply(Fun, Args);
+ {module, _} ->
+ crash(Fun, Args);
+ _Other ->
+ crash(Fun, Args)
+ end.
+
+-spec breakpoint(Module :: atom(), Function :: atom(), Args :: [_]) ->
+ any().
+
+breakpoint(Module, Func, Args) ->
+ (int()):eval(Module, Func, Args).
+
+%% Used to make the call to the 'int' module a "weak" one, to avoid
+%% building strong components in xref or dialyzer.
+
+int() -> int.
+
+%%
+%% Crash providing a beautiful stack backtrace.
+%%
+crash(Fun, Args) ->
+ crash({Fun,Args}).
+
+crash(M, F, A) ->
+ crash({M,F,A}).
+
+-spec crash(tuple()) -> no_return().
+
+crash(Tuple) ->
+ try erlang:error(undef)
+ catch
+ error:undef ->
+ erlang:raise(error, undef, [Tuple|tl(erlang:get_stacktrace())])
+ end.
+
+%% If the code_server has not been started yet dynamic code loading
+%% is handled by init.
+ensure_loaded(Module) ->
+ Self = self(),
+ case whereis(code_server) of
+ %% Perhaps double fault should be detected in code:ensure_loaded/1
+ %% instead, since this error handler cannot know whether the
+ %% code server can resolve the problem or not.
+ %% An {error, Reason} return from there would crash the code server and
+ %% bring down the node.
+ Self ->
+ Error = "The code server called the unloaded module `" ++
+ atom_to_list(Module) ++ "'",
+ halt(Error);
+ Pid when is_pid(Pid) ->
+ code:ensure_loaded(Module);
+ _ ->
+ init:ensure_loaded(Module)
+ end.
+
+-spec stub_function(atom(), atom(), [_]) -> no_return().
+
+stub_function(Mod, Func, Args) ->
+ exit({undef,[{Mod,Func,Args}]}).
+
+check_inheritance(Module, Args) ->
+ Attrs = erlang:get_module_info(Module, attributes),
+ case lists:keysearch(extends, 1, Attrs) of
+ {value,{extends,[Base]}} when is_atom(Base), Base =/= Module ->
+ %% This is just a heuristic for detecting abstract modules
+ %% with inheritance so they can be handled; it would be
+ %% much better to do it in the emulator runtime
+ case lists:keysearch(abstract, 1, Attrs) of
+ {value,{abstract,[true]}} ->
+ case lists:reverse(Args) of
+ [M|Rs] when tuple_size(M) > 1,
+ element(1,M) =:= Module,
+ tuple_size(element(2,M)) > 0,
+ is_atom(element(1,element(2,M))) ->
+ {value, Base, lists:reverse(Rs, [element(2,M)])};
+ _ ->
+ {value, Base, Args}
+ end;
+ _ ->
+ {value, Base, Args}
+ end;
+ _ ->
+ none
+ end.
diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl
new file mode 100644
index 0000000000..cafdc52e84
--- /dev/null
+++ b/lib/kernel/src/error_logger.erl
@@ -0,0 +1,387 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(error_logger).
+
+-export([start/0,start_link/0,format/2,error_msg/1,error_msg/2,error_report/1,
+ error_report/2,info_report/1,info_report/2,warning_report/1,
+ warning_report/2,error_info/1,
+ info_msg/1,info_msg/2,warning_msg/1,warning_msg/2,
+ logfile/1,tty/1,swap_handler/1,
+ add_report_handler/1,add_report_handler/2,
+ delete_report_handler/1]).
+
+-export([init/1,
+ handle_event/2, handle_call/2, handle_info/2,
+ terminate/2]).
+
+-define(buffer_size, 10).
+
+%%-----------------------------------------------------------------
+%% Types used in this file
+%%-----------------------------------------------------------------
+
+-type msg_tag() :: 'error' | 'error_report'
+ | 'info' | 'info_msg' | 'info_report'
+ | 'warning_msg' | 'warning_report'.
+
+-type state() :: {non_neg_integer(), non_neg_integer(), [term()]}.
+
+%%-----------------------------------------------------------------
+
+-spec start() -> {'ok', pid()} | {'error', any()}.
+
+start() ->
+ case gen_event:start({local, error_logger}) of
+ {ok, Pid} ->
+ simple_logger(?buffer_size),
+ {ok, Pid};
+ Error -> Error
+ end.
+
+-spec start_link() -> {'ok', pid()} | {'error', any()}.
+
+start_link() ->
+ case gen_event:start_link({local, error_logger}) of
+ {ok, Pid} ->
+ simple_logger(?buffer_size),
+ {ok, Pid};
+ Error -> Error
+ end.
+
+%%-----------------------------------------------------------------
+%% These two simple old functions generate events tagged 'error'
+%% Used for simple messages; error or information.
+%%-----------------------------------------------------------------
+
+-spec error_msg(Format :: string()) -> 'ok'.
+
+error_msg(Format) ->
+ error_msg(Format,[]).
+
+-spec error_msg(Format :: string(), Args :: list()) -> 'ok'.
+
+error_msg(Format, Args) ->
+ notify({error, group_leader(), {self(), Format, Args}}).
+
+-spec format(Format :: string(), Args :: list()) -> 'ok'.
+
+format(Format, Args) ->
+ notify({error, group_leader(), {self(), Format, Args}}).
+
+%%-----------------------------------------------------------------
+%% This functions should be used for error reports. Events
+%% are tagged 'error_report'.
+%% The 'std_error' error_report type can always be used.
+%%-----------------------------------------------------------------
+
+-spec error_report(Report :: any()) -> 'ok'.
+
+error_report(Report) ->
+ error_report(std_error, Report).
+
+-spec error_report(Type :: any(), Report :: any()) -> 'ok'.
+
+error_report(Type, Report) ->
+ notify({error_report, group_leader(), {self(), Type, Report}}).
+
+%%-----------------------------------------------------------------
+%% This function should be used for warning reports.
+%% These might be mapped to error reports or info reports,
+%% depending on emulator flags. Events that ore not mapped
+%% are tagged 'info_report'.
+%% The 'std_warning' info_report type can always be used and is
+%% mapped to std_info or std_error accordingly.
+%%-----------------------------------------------------------------
+
+-spec warning_report(Report :: any()) -> 'ok'.
+
+warning_report(Report) ->
+ warning_report(std_warning, Report).
+
+-spec warning_report(Type :: any(), Report :: any()) -> 'ok'.
+
+warning_report(Type, Report) ->
+ {Tag, NType} = case error_logger:warning_map() of
+ info ->
+ if
+ Type =:= std_warning ->
+ {info_report, std_info};
+ true ->
+ {info_report, Type}
+ end;
+ warning ->
+ {warning_report, Type};
+ error ->
+ if
+ Type =:= std_warning ->
+ {error_report, std_error};
+ true ->
+ {error_report, Type}
+ end
+ end,
+ notify({Tag, group_leader(), {self(), NType, Report}}).
+
+%%-----------------------------------------------------------------
+%% This function provides similar functions as error_msg for
+%% warning messages, like warning report it might get mapped to
+%% other types of reports.
+%%-----------------------------------------------------------------
+
+-spec warning_msg(Format :: string()) -> 'ok'.
+
+warning_msg(Format) ->
+ warning_msg(Format,[]).
+
+-spec warning_msg(Format :: string(), Args :: list()) -> 'ok'.
+
+warning_msg(Format, Args) ->
+ Tag = case error_logger:warning_map() of
+ warning ->
+ warning_msg;
+ info ->
+ info_msg;
+ error ->
+ error
+ end,
+ notify({Tag, group_leader(), {self(), Format, Args}}).
+
+%%-----------------------------------------------------------------
+%% This function should be used for information reports. Events
+%% are tagged 'info_report'.
+%% The 'std_info' info_report type can always be used.
+%%-----------------------------------------------------------------
+
+-spec info_report(Report :: any()) -> 'ok'.
+
+info_report(Report) ->
+ info_report(std_info, Report).
+
+-spec info_report(Type :: any(), Report :: any()) -> 'ok'.
+
+info_report(Type, Report) ->
+ notify({info_report, group_leader(), {self(), Type, Report}}).
+
+%%-----------------------------------------------------------------
+%% This function provides similar functions as error_msg for
+%% information messages.
+%%-----------------------------------------------------------------
+
+-spec info_msg(Format :: string()) -> 'ok'.
+
+info_msg(Format) ->
+ info_msg(Format,[]).
+
+-spec info_msg(Format :: string(), Args :: list()) -> 'ok'.
+
+info_msg(Format, Args) ->
+ notify({info_msg, group_leader(), {self(), Format, Args}}).
+
+%%-----------------------------------------------------------------
+%% Used by the init process. Events are tagged 'info'.
+%%-----------------------------------------------------------------
+
+-spec error_info(Error :: any()) -> 'ok'.
+
+error_info(Error) ->
+ notify({info, group_leader(), {self(), Error, []}}).
+
+-spec notify({msg_tag(), pid(), {pid(), any(), any()}}) -> 'ok'.
+
+notify(Msg) ->
+ gen_event:notify(error_logger, Msg).
+
+-type swap_handler_type() :: 'false' | 'silent' | 'tty' | {'logfile', string()}.
+-spec swap_handler(Type :: swap_handler_type()) -> any().
+
+swap_handler(tty) ->
+ gen_event:swap_handler(error_logger, {error_logger, swap},
+ {error_logger_tty_h, []}),
+ simple_logger();
+swap_handler({logfile, File}) ->
+ gen_event:swap_handler(error_logger, {error_logger, swap},
+ {error_logger_file_h, File}),
+ simple_logger();
+swap_handler(silent) ->
+ gen_event:delete_handler(error_logger, error_logger, delete),
+ simple_logger();
+swap_handler(false) ->
+ ok. % keep primitive event handler as-is
+
+-spec add_report_handler(Module :: atom()) -> any().
+
+add_report_handler(Module) when is_atom(Module) ->
+ gen_event:add_handler(error_logger, Module, []).
+
+-spec add_report_handler(atom(), any()) -> any().
+
+add_report_handler(Module, Args) when is_atom(Module) ->
+ gen_event:add_handler(error_logger, Module, Args).
+
+-spec delete_report_handler(Module :: atom()) -> any().
+
+delete_report_handler(Module) when is_atom(Module) ->
+ gen_event:delete_handler(error_logger, Module, []).
+
+%% Start the lowest level error_logger handler with Buffer.
+
+simple_logger(Buffer_size) when is_integer(Buffer_size) ->
+ gen_event:add_handler(error_logger, error_logger, Buffer_size).
+
+%% Start the lowest level error_logger handler without Buffer.
+
+simple_logger() ->
+ gen_event:add_handler(error_logger, error_logger, []).
+
+%% Log all errors to File for all eternity
+
+-spec logfile(Request :: {'open', string()}) -> 'ok' | {'error',any()}
+ ; (Request :: 'close') -> 'ok' | {'error', any()}
+ ; (Request :: 'filename') -> atom() | string() | {'error', any()}.
+
+logfile({open, File}) ->
+ case lists:member(error_logger_file_h,
+ gen_event:which_handlers(error_logger)) of
+ true ->
+ {error, allready_have_logfile};
+ _ ->
+ gen_event:add_handler(error_logger, error_logger_file_h, File)
+ end;
+logfile(close) ->
+ case gen_event:delete_handler(error_logger, error_logger_file_h, normal) of
+ {error,Reason} ->
+ {error,Reason};
+ _ ->
+ ok
+ end;
+logfile(filename) ->
+ case gen_event:call(error_logger, error_logger_file_h, filename) of
+ {error,_} ->
+ {error, no_log_file};
+ Val ->
+ Val
+ end.
+
+%% Possibly turn off all tty printouts, maybe we only want the errors
+%% to go to a file
+
+-spec tty(Flag :: boolean()) -> 'ok'.
+
+tty(true) ->
+ Hs = gen_event:which_handlers(error_logger),
+ case lists:member(error_logger_tty_h, Hs) of
+ false ->
+ gen_event:add_handler(error_logger, error_logger_tty_h, []);
+ true ->
+ ignore
+ end,
+ ok;
+tty(false) ->
+ gen_event:delete_handler(error_logger, error_logger_tty_h, []),
+ ok.
+
+
+%%% ---------------------------------------------------
+%%% This is the default error_logger handler.
+%%% ---------------------------------------------------
+
+-spec init(term()) -> {'ok', state() | []}.
+
+init(Max) when is_integer(Max) ->
+ {ok, {Max, 0, []}};
+%% This one is called if someone took over from us, and now wants to
+%% go back.
+init({go_back, _PostState}) ->
+ {ok, {?buffer_size, 0, []}};
+init(_) -> %% Start and just relay to other
+ {ok, []}. %% node if node(GLeader) =/= node().
+
+-spec handle_event(term(), state()) -> {'ok', state()}.
+
+handle_event({Type, GL, Msg}, State) when node(GL) =/= node() ->
+ gen_event:notify({error_logger, node(GL)},{Type, GL, Msg}),
+ %% handle_event2({Type, GL, Msg}, State); %% Shall we do something
+ {ok, State}; %% at this node too ???
+handle_event({info_report, _, {_, Type, _}}, State) when Type =/= std_info ->
+ {ok, State}; %% Ignore other info reports here
+handle_event(Event, State) ->
+ handle_event2(Event, State).
+
+-spec handle_info(term(), state()) -> {'ok', state()}.
+
+handle_info({emulator, GL, Chars}, State) when node(GL) =/= node() ->
+ {error_logger, node(GL)} ! {emulator, GL, add_node(Chars,self())},
+ {ok, State};
+handle_info({emulator, GL, Chars}, State) ->
+ handle_event2({emulator, GL, Chars}, State);
+handle_info(_, State) ->
+ {ok, State}.
+
+-spec handle_call(term(), state()) -> {'ok', {'error', 'bad_query'}, state()}.
+
+handle_call(_Query, State) -> {ok, {error, bad_query}, State}.
+
+-spec terminate(term(), state()) -> {'error_logger', [term()]}.
+
+terminate(swap, {_, 0, Buff}) ->
+ {error_logger, Buff};
+terminate(swap, {_, Lost, Buff}) ->
+ Myevent = {info, group_leader(), {self(), {lost_messages, Lost}, []}},
+ {error_logger, [tag_event(Myevent)|Buff]};
+terminate(_, _) ->
+ {error_logger, []}.
+
+handle_event2(Event, {1, Lost, Buff}) ->
+ display(tag_event(Event)),
+ {ok, {1, Lost+1, Buff}};
+handle_event2(Event, {N, Lost, Buff}) ->
+ Tagged = tag_event(Event),
+ display(Tagged),
+ {ok, {N-1, Lost, [Tagged|Buff]}};
+handle_event2(_, State) ->
+ {ok, State}.
+
+tag_event(Event) ->
+ {erlang:localtime(), Event}.
+
+display({Tag,{error,_,{_,Format,Args}}}) ->
+ display2(Tag,Format,Args);
+display({Tag,{error_report,_,{_,Type,Report}}}) ->
+ display2(Tag,Type,Report);
+display({Tag,{info_report,_,{_,Type,Report}}}) ->
+ display2(Tag,Type,Report);
+display({Tag,{info,_,{_,Error,_}}}) ->
+ display2(Tag,Error,[]);
+display({Tag,{info_msg,_,{_,Format,Args}}}) ->
+ display2(Tag,Format,Args);
+display({Tag,{warning_report,_,{_,Type,Report}}}) ->
+ display2(Tag,Type,Report);
+display({Tag,{warning_msg,_,{_,Format,Args}}}) ->
+ display2(Tag,Format,Args);
+display({Tag,{emulator,_,Chars}}) ->
+ display2(Tag,Chars,[]).
+
+add_node(X, Pid) when is_atom(X) ->
+ add_node(atom_to_list(X), Pid);
+add_node(X, Pid) ->
+ lists:concat([X,"** at node ",node(Pid)," **~n"]).
+
+%% Can't do io_lib:format
+
+display2(Tag,F,A) ->
+ erlang:display({error_logger,Tag,F,A}).
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
new file mode 100644
index 0000000000..7d6a5ade94
--- /dev/null
+++ b/lib/kernel/src/erts_debug.erl
@@ -0,0 +1,155 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erts_debug).
+
+%% Low-level debugging support. EXPERIMENTAL!
+
+-export([size/1,df/1,df/2,df/3]).
+
+%% This module contains the following *experimental* BIFs:
+%% disassemble/1
+%% breakpoint/2
+%% same/2
+%% flat_size/1
+
+%% size(Term)
+%% Returns the size of Term in actual heap words. Shared subterms are
+%% counted once. Example: If A = [a,b], B =[A,A] then size(B) returns 8,
+%% while flat_size(B) returns 12.
+
+-spec size(term()) -> non_neg_integer().
+
+size(Term) ->
+ {Sum,_} = size(Term, gb_trees:empty(), 0),
+ Sum.
+
+size([H|T]=Term, Seen0, Sum0) ->
+ case remember_term(Term, Seen0) of
+ seen -> {Sum0,Seen0};
+ Seen1 ->
+ {Sum,Seen} = size(H, Seen1, Sum0+2),
+ size(T, Seen, Sum)
+ end;
+size(Tuple, Seen0, Sum0) when is_tuple(Tuple) ->
+ case remember_term(Tuple, Seen0) of
+ seen -> {Sum0,Seen0};
+ Seen ->
+ Sum = Sum0 + 1 + tuple_size(Tuple),
+ tuple_size(1, tuple_size(Tuple), Tuple, Seen, Sum)
+ end;
+size(Term, Seen0, Sum) ->
+ case erts_debug:flat_size(Term) of
+ 0 -> {Sum,Seen0};
+ Sz ->
+ case remember_term(Term, Seen0) of
+ seen -> {Sum,Seen0};
+ Seen -> {Sum+Sz,Seen}
+ end
+ end.
+
+tuple_size(I, Sz, _, Seen, Sum) when I > Sz ->
+ {Sum,Seen};
+tuple_size(I, Sz, Tuple, Seen0, Sum0) ->
+ {Sum,Seen} = size(element(I, Tuple), Seen0, Sum0),
+ tuple_size(I+1, Sz, Tuple, Seen, Sum).
+
+remember_term(Term, Seen) ->
+ case gb_trees:lookup(Term, Seen) of
+ none -> gb_trees:insert(Term, [Term], Seen);
+ {value,Terms} ->
+ case is_term_seen(Term, Terms) of
+ false -> gb_trees:update(Term, [Term|Terms], Seen);
+ true -> seen
+ end
+ end.
+
+-spec is_term_seen(term(), [term()]) -> boolean().
+
+is_term_seen(Term, [H|T]) ->
+ case erts_debug:same(Term, H) of
+ true -> true;
+ false -> is_term_seen(Term, T)
+ end;
+is_term_seen(_, []) -> false.
+
+%% df(Mod) -- Disassemble Mod to file Mod.dis.
+%% df(Mod, Func) -- Disassemble Mod:Func/Any to file Mod_Func.dis.
+%% df(Mod, Func, Arity) -- Disassemble Mod:Func/Arity to file Mod_Func_Arity.dis.
+
+-type df_ret() :: 'ok' | {'error', {'badopen', module()}} | {'undef', module()}.
+
+-spec df(module()) -> df_ret().
+
+df(Mod) when is_atom(Mod) ->
+ try Mod:module_info(functions) of
+ Fs0 when is_list(Fs0) ->
+ Name = lists:concat([Mod, ".dis"]),
+ Fs = [{Mod,Func,Arity} || {Func,Arity} <- Fs0],
+ dff(Name, Fs)
+ catch _:_ -> {undef,Mod}
+ end.
+
+-spec df(module(), atom()) -> df_ret().
+
+df(Mod, Func) when is_atom(Mod), is_atom(Func) ->
+ try Mod:module_info(functions) of
+ Fs0 when is_list(Fs0) ->
+ Name = lists:concat([Mod, "_", Func, ".dis"]),
+ Fs = [{Mod,Func1,Arity} || {Func1,Arity} <- Fs0, Func1 =:= Func],
+ dff(Name, Fs)
+ catch _:_ -> {undef,Mod}
+ end.
+
+-spec df(module(), atom(), arity()) -> df_ret().
+
+df(Mod, Func, Arity) when is_atom(Mod), is_atom(Func) ->
+ try Mod:module_info(functions) of
+ Fs0 when is_list(Fs0) ->
+ Name = lists:concat([Mod, "_", Func, "_", Arity, ".dis"]),
+ Fs = [{Mod,Func1,Arity1} || {Func1,Arity1} <- Fs0,
+ Func1 =:= Func, Arity1 =:= Arity],
+ dff(Name, Fs)
+ catch _:_ -> {undef,Mod}
+ end.
+
+dff(File, Fs) when is_pid(File), is_list(Fs) ->
+ lists:foreach(fun(Mfa) ->
+ disassemble_function(File, Mfa),
+ io:nl(File)
+ end, Fs);
+dff(Name, Fs) when is_list(Name) ->
+ case file:open(Name, [write]) of
+ {ok,F} ->
+ try
+ dff(F, Fs)
+ after
+ file:close(F)
+ end;
+ {error,Reason} ->
+ {error,{badopen,Reason}}
+ end.
+
+disassemble_function(File, {_,_,_}=MFA) ->
+ cont_dis(File, erts_debug:disassemble(MFA), MFA).
+
+cont_dis(_, false, _) -> ok;
+cont_dis(File, {Addr,Str,MFA}, MFA) ->
+ io:put_chars(File, binary_to_list(Str)),
+ cont_dis(File, erts_debug:disassemble(Addr), MFA);
+cont_dis(_, {_,_,_}, _) -> ok.
diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl
new file mode 100644
index 0000000000..fa86d53dc9
--- /dev/null
+++ b/lib/kernel/src/file.erl
@@ -0,0 +1,1077 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(file).
+
+%% Interface module for the file server and the file io servers.
+
+
+
+%%% External exports
+
+-export([format_error/1]).
+%% File system and metadata.
+-export([get_cwd/0, get_cwd/1, set_cwd/1, delete/1, rename/2,
+ make_dir/1, del_dir/1, list_dir/1,
+ read_file_info/1, write_file_info/2,
+ altname/1,
+ read_link_info/1, read_link/1,
+ make_link/2, make_symlink/2,
+ read_file/1, write_file/2, write_file/3]).
+%% Specialized
+-export([ipread_s32bu_p32bu/3]).
+%% Generic file contents.
+-export([open/2, close/1,
+ read/2, write/2,
+ pread/2, pread/3, pwrite/2, pwrite/3,
+ read_line/1,
+ position/2, truncate/1, sync/1,
+ copy/2, copy/3]).
+%% High level operations
+-export([consult/1, path_consult/2]).
+-export([eval/1, eval/2, path_eval/2, path_eval/3, path_open/3]).
+-export([script/1, script/2, path_script/2, path_script/3]).
+-export([change_owner/2, change_owner/3, change_group/2,
+ change_mode/2, change_time/2, change_time/3]).
+
+-export([pid2name/1]).
+
+%%% Obsolete exported functions
+
+-export([raw_read_file_info/1, raw_write_file_info/2]).
+
+%% Internal export to prim_file and ram_file until they implement
+%% an efficient copy themselves.
+-export([copy_opened/3]).
+
+-export([ipread_s32bu_p32bu_int/3]).
+
+
+%%% Includes and defines
+-include("file.hrl").
+
+-define(FILE_IO_SERVER_TABLE, file_io_servers).
+
+-define(FILE_SERVER, file_server_2). % Registered name
+-define(PRIM_FILE, prim_file). % Module
+-define(RAM_FILE, ram_file). % Module
+
+%% data types
+-type filename() :: string().
+-type io_device() :: pid() | #file_descriptor{}.
+-type location() :: integer() | {'bof', integer()} | {'cur', integer()}
+ | {'eof', integer()} | 'bof' | 'cur' | 'eof'.
+-type mode() :: 'read' | 'write' | 'append' | 'raw' | 'binary' |
+ {'delayed_write', non_neg_integer(), non_neg_integer()} |
+ 'delayed_write' | {'read_ahead', pos_integer()} |
+ 'read_ahead' | 'compressed'.
+-type bindings() :: any().
+
+%%%-----------------------------------------------------------------
+%%% General functions
+
+-spec format_error(Reason :: posix() | {integer(), atom(), any()}) ->
+ string().
+
+format_error({_Line, ?MODULE, undefined_script}) ->
+ "no value returned from script";
+format_error({Line, ?MODULE, {Class, Reason, Stacktrace}}) ->
+ io_lib:format("~w: evaluation failed with reason ~w:~w and stacktrace ~w",
+ [Line, Class, Reason, Stacktrace]);
+format_error({Line, ?MODULE, {Reason, Stacktrace}}) ->
+ io_lib:format("~w: evaluation failed with reason ~w and stacktrace ~w",
+ [Line, Reason, Stacktrace]);
+format_error({Line, Mod, Reason}) ->
+ io_lib:format("~w: ~s", [Line, Mod:format_error(Reason)]);
+format_error(badarg) ->
+ "bad argument";
+format_error(system_limit) ->
+ "a system limit was hit, probably not enough ports";
+format_error(terminated) ->
+ "the file server process is terminated";
+format_error(ErrorId) ->
+ erl_posix_msg:message(ErrorId).
+
+-spec pid2name(Pid :: pid()) -> {'ok', filename()} | 'undefined'.
+
+pid2name(Pid) when is_pid(Pid) ->
+ case whereis(?FILE_SERVER) of
+ undefined ->
+ undefined;
+ _ ->
+ case ets:lookup(?FILE_IO_SERVER_TABLE, Pid) of
+ [{_, Name} | _] ->
+ {ok, Name};
+ _ ->
+ undefined
+ end
+ end.
+
+%%%-----------------------------------------------------------------
+%%% File server functions.
+%%% Functions that do not operate on a single open file.
+%%% Stateless.
+-spec get_cwd() -> {'ok', filename()} | {'error', posix()}.
+
+get_cwd() ->
+ call(get_cwd, []).
+
+-spec get_cwd(Drive :: string()) -> {'ok', filename()} | {'error', posix()}.
+
+get_cwd(Drive) ->
+ check_and_call(get_cwd, [file_name(Drive)]).
+
+-spec set_cwd(Dirname :: name()) -> 'ok' | {'error', posix()}.
+
+set_cwd(Dirname) ->
+ check_and_call(set_cwd, [file_name(Dirname)]).
+
+-spec delete(Name :: name()) -> 'ok' | {'error', posix()}.
+
+delete(Name) ->
+ check_and_call(delete, [file_name(Name)]).
+
+-spec rename(From :: name(), To :: name()) -> 'ok' | {'error', posix()}.
+
+rename(From, To) ->
+ check_and_call(rename, [file_name(From), file_name(To)]).
+
+-spec make_dir(Name :: name()) -> 'ok' | {'error', posix()}.
+
+make_dir(Name) ->
+ check_and_call(make_dir, [file_name(Name)]).
+
+-spec del_dir(Name :: name()) -> 'ok' | {'error', posix()}.
+
+del_dir(Name) ->
+ check_and_call(del_dir, [file_name(Name)]).
+
+-spec read_file_info(Name :: name()) -> {'ok', #file_info{}} | {'error', posix()}.
+
+read_file_info(Name) ->
+ check_and_call(read_file_info, [file_name(Name)]).
+
+-spec altname(Name :: name()) -> any().
+
+altname(Name) ->
+ check_and_call(altname, [file_name(Name)]).
+
+-spec read_link_info(Name :: name()) -> {'ok', #file_info{}} | {'error', posix()}.
+
+read_link_info(Name) ->
+ check_and_call(read_link_info, [file_name(Name)]).
+
+-spec read_link(Name :: name()) -> {'ok', filename()} | {'error', posix()}.
+
+read_link(Name) ->
+ check_and_call(read_link, [file_name(Name)]).
+
+-spec write_file_info(Name :: name(), Info :: #file_info{}) ->
+ 'ok' | {'error', posix()}.
+
+write_file_info(Name, Info = #file_info{}) ->
+ check_and_call(write_file_info, [file_name(Name), Info]).
+
+-spec list_dir(Name :: name()) -> {'ok', [filename()]} | {'error', posix()}.
+
+list_dir(Name) ->
+ check_and_call(list_dir, [file_name(Name)]).
+
+-spec read_file(Name :: name()) -> {'ok', binary()} | {'error', posix()}.
+
+read_file(Name) ->
+ check_and_call(read_file, [file_name(Name)]).
+
+-spec make_link(Old :: name(), New :: name()) -> 'ok' | {'error', posix()}.
+
+make_link(Old, New) ->
+ check_and_call(make_link, [file_name(Old), file_name(New)]).
+
+-spec make_symlink(Old :: name(), New :: name()) -> 'ok' | {'error', posix()}.
+
+make_symlink(Old, New) ->
+ check_and_call(make_symlink, [file_name(Old), file_name(New)]).
+
+-spec write_file(Name :: name(), Bin :: binary()) -> 'ok' | {'error', posix()}.
+
+write_file(Name, Bin) ->
+ check_and_call(write_file, [file_name(Name), make_binary(Bin)]).
+
+%% This whole operation should be moved to the file_server and prim_file
+%% when it is time to change file server protocol again.
+%% Meanwhile, it is implemented here, slihtly less efficient.
+%%
+
+-spec write_file(Name :: name(), Bin :: binary(), Modes :: [mode()]) ->
+ 'ok' | {'error', posix()}.
+
+write_file(Name, Bin, ModeList) when is_list(ModeList) ->
+ case make_binary(Bin) of
+ B when is_binary(B) ->
+ case open(Name, [binary, write |
+ lists:delete(binary,
+ lists:delete(write, ModeList))]) of
+ {ok, Handle} ->
+ case write(Handle, B) of
+ ok ->
+ close(Handle);
+ E1 ->
+ close(Handle),
+ E1
+ end;
+ E2 ->
+ E2
+ end;
+ E3 ->
+ E3
+ end.
+
+%% Obsolete, undocumented, local node only, don't use!.
+%% XXX to be removed.
+raw_read_file_info(Name) ->
+ Args = [file_name(Name)],
+ case check_args(Args) of
+ ok ->
+ [FileName] = Args,
+ ?PRIM_FILE:read_file_info(FileName);
+ Error ->
+ Error
+ end.
+
+%% Obsolete, undocumented, local node only, don't use!.
+%% XXX to be removed.
+raw_write_file_info(Name, #file_info{} = Info) ->
+ Args = [file_name(Name)],
+ case check_args(Args) of
+ ok ->
+ [FileName] = Args,
+ ?PRIM_FILE:write_file_info(FileName, Info);
+ Error ->
+ Error
+ end.
+
+%%%-----------------------------------------------------------------
+%%% File io server functions.
+%%% They operate on a single open file.
+%%% Stateful.
+
+%% Contemporary mode specification - list of options
+
+-spec open(Name :: name(), Modes :: [mode()]) ->
+ {'ok', io_device()} | {'error', posix()}.
+
+open(Item, ModeList) when is_list(ModeList) ->
+ case lists:member(raw, ModeList) of
+ %% Raw file, use ?PRIM_FILE to handle this file
+ true ->
+ %% check if raw file mode is disabled
+ case catch application:get_env(kernel, raw_files) of
+ {ok,false} ->
+ open(Item, lists:delete(raw, ModeList));
+ _ -> % undefined | {ok,true}
+ Args = [file_name(Item) | ModeList],
+ case check_args(Args) of
+ ok ->
+ [FileName | _] = Args,
+ %% We rely on the returned Handle (in {ok, Handle})
+ %% being a pid() or a #file_descriptor{}
+ ?PRIM_FILE:open(FileName, ModeList);
+ Error ->
+ Error
+ end
+ end;
+ false ->
+ case lists:member(ram, ModeList) of
+ %% RAM file, use ?RAM_FILE to handle this file
+ true ->
+ case check_args(ModeList) of
+ ok ->
+ ?RAM_FILE:open(Item, ModeList);
+ Error ->
+ Error
+ end;
+ %% File server file
+ false ->
+ Args = [file_name(Item) | ModeList],
+ case check_args(Args) of
+ ok ->
+ [FileName | _] = Args,
+ call(open, [FileName, ModeList]);
+ Error ->
+ Error
+ end
+ end
+ end;
+%% Old obsolete mode specification in atom or 2-tuple format
+open(Item, Mode) ->
+ open(Item, mode_list(Mode)).
+
+%%%-----------------------------------------------------------------
+%%% The following interface functions operate on open files.
+%%% The File argument must be either a Pid or a handle
+%%% returned from ?PRIM_FILE:open.
+
+-spec close(File :: io_device()) -> 'ok' | {'error', posix()}.
+
+close(File) when is_pid(File) ->
+ R = file_request(File, close),
+ case wait_file_reply(File, R) of
+ {error, terminated} ->
+ ok;
+ Other ->
+ Other
+ end;
+%% unlink(File),
+%% exit(File, close),
+%% ok;
+close(#file_descriptor{module = Module} = Handle) ->
+ Module:close(Handle);
+close(_) ->
+ {error, badarg}.
+
+-spec read(File :: io_device(), Size :: non_neg_integer()) ->
+ 'eof' | {'ok', [char()] | binary()} | {'error', posix()}.
+
+read(File, Sz) when is_pid(File), is_integer(Sz), Sz >= 0 ->
+ case io:request(File, {get_chars, '', Sz}) of
+ Data when is_list(Data); is_binary(Data) ->
+ {ok, Data};
+ Other ->
+ Other
+ end;
+read(#file_descriptor{module = Module} = Handle, Sz)
+ when is_integer(Sz), Sz >= 0 ->
+ Module:read(Handle, Sz);
+read(_, _) ->
+ {error, badarg}.
+
+-spec read_line(File :: io_device()) ->
+ 'eof' | {'ok', [char()] | binary()} | {'error', posix()}.
+
+read_line(File) when is_pid(File) ->
+ case io:request(File, {get_line, ''}) of
+ Data when is_list(Data); is_binary(Data) ->
+ {ok, Data};
+ Other ->
+ Other
+ end;
+read_line(#file_descriptor{module = Module} = Handle) ->
+ Module:read_line(Handle);
+read_line(_) ->
+ {error, badarg}.
+
+-spec pread(File :: io_device(),
+ LocationNumbers :: [{location(), non_neg_integer()}]) ->
+ {'ok', [string() | binary() | 'eof']} | {'error', posix()}.
+
+pread(File, L) when is_pid(File), is_list(L) ->
+ pread_int(File, L, []);
+pread(#file_descriptor{module = Module} = Handle, L) when is_list(L) ->
+ Module:pread(Handle, L);
+pread(_, _) ->
+ {error, badarg}.
+
+pread_int(_File, [], R) ->
+ {ok, lists:reverse(R)};
+pread_int(File, [{At, Sz} | T], R) when is_integer(Sz), Sz >= 0 ->
+ case pread(File, At, Sz) of
+ {ok, Data} ->
+ pread_int(File, T, [Data | R]);
+ eof ->
+ pread_int(File, T, [eof | R]);
+ {error, _} = Error ->
+ Error
+ end;
+pread_int(_, _, _) ->
+ {error, badarg}.
+
+-spec pread(File :: io_device(),
+ Location :: location(),
+ Size :: non_neg_integer()) ->
+ 'eof' | {'ok', string() | binary()} | {'error', posix()}.
+
+pread(File, At, Sz) when is_pid(File), is_integer(Sz), Sz >= 0 ->
+ R = file_request(File, {pread, At, Sz}),
+ wait_file_reply(File, R);
+pread(#file_descriptor{module = Module} = Handle, Offs, Sz)
+ when is_integer(Sz), Sz >= 0 ->
+ Module:pread(Handle, Offs, Sz);
+pread(_, _, _) ->
+ {error, badarg}.
+
+-spec write(File :: io_device(), Byte :: iodata()) ->
+ 'ok' | {'error', posix()}.
+
+write(File, Bytes) when is_pid(File) ->
+ case make_binary(Bytes) of
+ Bin when is_binary(Bin) ->
+ io:request(File, {put_chars,Bin});
+ Error ->
+ Error
+ end;
+write(#file_descriptor{module = Module} = Handle, Bytes) ->
+ Module:write(Handle, Bytes);
+write(_, _) ->
+ {error, badarg}.
+
+-spec pwrite(File :: io_device(), L :: [{location(), iodata()}]) ->
+ 'ok' | {'error', {non_neg_integer(), posix()}}.
+
+pwrite(File, L) when is_pid(File), is_list(L) ->
+ pwrite_int(File, L, 0);
+pwrite(#file_descriptor{module = Module} = Handle, L) when is_list(L) ->
+ Module:pwrite(Handle, L);
+pwrite(_, _) ->
+ {error, badarg}.
+
+pwrite_int(_File, [], _R) ->
+ ok;
+pwrite_int(File, [{At, Bytes} | T], R) ->
+ case pwrite(File, At, Bytes) of
+ ok ->
+ pwrite_int(File, T, R+1);
+ {error, Reason} ->
+ {error, {R, Reason}}
+ end;
+pwrite_int(_, _, _) ->
+ {error, badarg}.
+
+-spec pwrite(File :: io_device(),
+ Location :: location(),
+ Bytes :: iodata()) ->
+ 'ok' | {'error', posix()}.
+
+pwrite(File, At, Bytes) when is_pid(File) ->
+ R = file_request(File, {pwrite, At, Bytes}),
+ wait_file_reply(File, R);
+pwrite(#file_descriptor{module = Module} = Handle, Offs, Bytes) ->
+ Module:pwrite(Handle, Offs, Bytes);
+pwrite(_, _, _) ->
+ {error, badarg}.
+
+-spec sync(File :: io_device()) -> 'ok' | {'error', posix()}.
+
+sync(File) when is_pid(File) ->
+ R = file_request(File, sync),
+ wait_file_reply(File, R);
+sync(#file_descriptor{module = Module} = Handle) ->
+ Module:sync(Handle);
+sync(_) ->
+ {error, badarg}.
+
+-spec position(File :: io_device(), Location :: location()) ->
+ {'ok',integer()} | {'error', posix()}.
+
+position(File, At) when is_pid(File) ->
+ R = file_request(File, {position,At}),
+ wait_file_reply(File, R);
+position(#file_descriptor{module = Module} = Handle, At) ->
+ Module:position(Handle, At);
+position(_, _) ->
+ {error, badarg}.
+
+-spec truncate(File :: io_device()) -> 'ok' | {'error', posix()}.
+
+truncate(File) when is_pid(File) ->
+ R = file_request(File, truncate),
+ wait_file_reply(File, R);
+truncate(#file_descriptor{module = Module} = Handle) ->
+ Module:truncate(Handle);
+truncate(_) ->
+ {error, badarg}.
+
+-spec copy(Source :: io_device() | name() | {name(), [mode()]},
+ Destination :: io_device() | name() | {name(), [mode()]}) ->
+ {'ok', non_neg_integer()} | {'error', posix()}.
+
+copy(Source, Dest) ->
+ copy_int(Source, Dest, infinity).
+
+-spec copy(Source :: io_device() | name() | {name(), [mode()]},
+ Destination :: io_device() | name() | {name(), [mode()]},
+ Length :: non_neg_integer() | 'infinity') ->
+ {'ok', non_neg_integer()} | {'error', posix()}.
+
+copy(Source, Dest, Length)
+ when is_integer(Length), Length >= 0;
+ is_atom(Length) ->
+ copy_int(Source, Dest, Length);
+copy(_, _, _) ->
+ {error, badarg}.
+
+%% Here we know that Length is either an atom or an integer >= 0
+%% (by the way, atoms > integers)
+%%
+%% Copy between open files.
+copy_int(Source, Dest, Length)
+ when is_pid(Source), is_pid(Dest);
+ is_pid(Source), is_record(Dest, file_descriptor);
+ is_record(Source, file_descriptor), is_pid(Dest) ->
+ copy_opened_int(Source, Dest, Length, 0);
+%% Copy between open raw files, both handled by the same module
+copy_int(#file_descriptor{module = Module} = Source,
+ #file_descriptor{module = Module} = Dest,
+ Length) ->
+ Module:copy(Source, Dest, Length);
+%% Copy between open raw files of different modules
+copy_int(#file_descriptor{} = Source,
+ #file_descriptor{} = Dest, Length) ->
+ copy_opened_int(Source, Dest, Length, 0);
+%% Copy between filenames, let the server do the copy
+copy_int({SourceName, SourceOpts}, {DestName, DestOpts}, Length)
+ when is_list(SourceOpts), is_list(DestOpts) ->
+ check_and_call(copy,
+ [file_name(SourceName), SourceOpts,
+ file_name(DestName), DestOpts,
+ Length]);
+%% Filename -> open file; must open Source and do client copy
+copy_int({SourceName, SourceOpts}, Dest, Length)
+ when is_list(SourceOpts), is_pid(Dest);
+ is_list(SourceOpts), is_record(Dest, file_descriptor) ->
+ case file_name(SourceName) of
+ {error, _} = Error ->
+ Error;
+ Source ->
+ case open(Source, [read | SourceOpts]) of
+ {ok, Handle} ->
+ Result = copy_opened_int(Handle, Dest, Length, 0),
+ close(Handle),
+ Result;
+ {error, _} = Error ->
+ Error
+ end
+ end;
+%% Open file -> filename; must open Dest and do client copy
+copy_int(Source, {DestName, DestOpts}, Length)
+ when is_pid(Source), is_list(DestOpts);
+ is_record(Source, file_descriptor), is_list(DestOpts) ->
+ case file_name(DestName) of
+ {error, _} = Error ->
+ Error;
+ Dest ->
+ case open(Dest, [write | DestOpts]) of
+ {ok, Handle} ->
+ Result = copy_opened_int(Source, Handle, Length, 0),
+ close(Handle),
+ Result;
+ {error, _} = Error ->
+ Error
+ end
+ end;
+%%
+%% That was all combinations of {Name, Opts} tuples
+%% and open files. At least one of Source and Dest has
+%% to be a bare filename.
+%%
+%% If Source is not a bare filename; Dest must be
+copy_int(Source, Dest, Length)
+ when is_pid(Source);
+ is_record(Source, file_descriptor) ->
+ copy_int(Source, {Dest, []}, Length);
+copy_int({_SourceName, SourceOpts} = Source, Dest, Length)
+ when is_list(SourceOpts) ->
+ copy_int(Source, {Dest, []}, Length);
+%% If Dest is not a bare filename; Source must be
+copy_int(Source, Dest, Length)
+ when is_pid(Dest);
+ is_record(Dest, file_descriptor) ->
+ copy_int({Source, []}, Dest, Length);
+copy_int(Source, {_DestName, DestOpts} = Dest, Length)
+ when is_list(DestOpts) ->
+ copy_int({Source, []}, Dest, Length);
+%% Both must be bare filenames. If they are not,
+%% the filename check in the copy operation will yell.
+copy_int(Source, Dest, Length) ->
+ copy_int({Source, []}, {Dest, []}, Length).
+
+
+
+copy_opened(Source, Dest, Length)
+ when is_integer(Length), Length >= 0;
+ is_atom(Length) ->
+ copy_opened_int(Source, Dest, Length);
+copy_opened(_, _, _) ->
+ {error, badarg}.
+
+%% Here we know that Length is either an atom or an integer >= 0
+%% (by the way, atoms > integers)
+
+copy_opened_int(Source, Dest, Length)
+ when is_pid(Source), is_pid(Dest) ->
+ copy_opened_int(Source, Dest, Length, 0);
+copy_opened_int(Source, Dest, Length)
+ when is_pid(Source), is_record(Dest, file_descriptor) ->
+ copy_opened_int(Source, Dest, Length, 0);
+copy_opened_int(Source, Dest, Length)
+ when is_record(Source, file_descriptor), is_pid(Dest) ->
+ copy_opened_int(Source, Dest, Length, 0);
+copy_opened_int(Source, Dest, Length)
+ when is_record(Source, file_descriptor), is_record(Dest, file_descriptor) ->
+ copy_opened_int(Source, Dest, Length, 0);
+copy_opened_int(_, _, _) ->
+ {error, badarg}.
+
+%% Here we know that Source and Dest are handles to open files, Length is
+%% as above, and Copied is an integer >= 0
+
+%% Copy loop in client process
+copy_opened_int(_, _, Length, Copied) when Length =< 0 -> % atom() > integer()
+ {ok, Copied};
+copy_opened_int(Source, Dest, Length, Copied) ->
+ N = if Length > 65536 -> 65536; true -> Length end, % atom() > integer() !
+ case read(Source, N) of
+ {ok, Data} ->
+ M = if is_binary(Data) -> byte_size(Data);
+ is_list(Data) -> length(Data)
+ end,
+ case write(Dest, Data) of
+ ok ->
+ if M < N ->
+ %% Got less than asked for - must be end of file
+ {ok, Copied+M};
+ true ->
+ %% Decrement Length (might be an atom (infinity))
+ NewLength = if is_atom(Length) -> Length;
+ true -> Length-M
+ end,
+ copy_opened_int(Source, Dest, NewLength, Copied+M)
+ end;
+ {error, _} = Error ->
+ Error
+ end;
+ eof ->
+ {ok, Copied};
+ {error, _} = Error ->
+ Error
+ end.
+
+
+%% Special indirect pread function. Introduced for Dets.
+%% Reads a header from pos 'Pos', the header is first a size encoded as
+%% 32 bit big endian unsigned and then a position also encoded as
+%% 32 bit big endian. Finally it preads the data from that pos and size
+%% in the file.
+
+ipread_s32bu_p32bu(File, Pos, MaxSize) when is_pid(File) ->
+ ipread_s32bu_p32bu_int(File, Pos, MaxSize);
+ipread_s32bu_p32bu(#file_descriptor{module = Module} = Handle, Pos, MaxSize) ->
+ Module:ipread_s32bu_p32bu(Handle, Pos, MaxSize);
+ipread_s32bu_p32bu(_, _, _) ->
+ {error, badarg}.
+
+ipread_s32bu_p32bu_int(File, Pos, Infinity) when is_atom(Infinity) ->
+ ipread_s32bu_p32bu_int(File, Pos, (1 bsl 31)-1);
+ipread_s32bu_p32bu_int(File, Pos, MaxSize)
+ when is_integer(MaxSize), MaxSize >= 0 ->
+ if
+ MaxSize < (1 bsl 31) ->
+ case pread(File, Pos, 8) of
+ {ok, Header} ->
+ ipread_s32bu_p32bu_2(File, Header, MaxSize);
+ Error ->
+ Error
+ end;
+ true ->
+ {error, einval}
+ end;
+ipread_s32bu_p32bu_int(_File, _Pos, _MaxSize) ->
+ {error, badarg}.
+
+ipread_s32bu_p32bu_2(_File,
+ <<0:32/big-unsigned, Pos:32/big-unsigned>>,
+ _MaxSize) ->
+ {ok, {0, Pos, eof}};
+ipread_s32bu_p32bu_2(File,
+ <<Size:32/big-unsigned, Pos:32/big-unsigned>>,
+ MaxSize)
+ when Size =< MaxSize ->
+ case pread(File, Pos, Size) of
+ {ok, Data} ->
+ {ok, {Size, Pos, Data}};
+ eof ->
+ {ok, {Size, Pos, eof}};
+ Error ->
+ Error
+ end;
+ipread_s32bu_p32bu_2(_File,
+ <<_:8/binary>>,
+ _MaxSize) ->
+ eof;
+ipread_s32bu_p32bu_2(_File,
+ <<_/binary>>,
+ _MaxSize) ->
+ eof;
+ipread_s32bu_p32bu_2(File,
+ Header,
+ MaxSize) when is_list(Header) ->
+ ipread_s32bu_p32bu_2(File, list_to_binary(Header), MaxSize).
+
+
+
+%%%-----------------------------------------------------------------
+%%% The following functions, built upon the other interface functions,
+%%% provide a higher-lever interface to files.
+
+-spec consult(File :: name()) ->
+ {'ok', list()} | {'error', posix() | {integer(), atom(), any()}}.
+
+consult(File) ->
+ case open(File, [read]) of
+ {ok, Fd} ->
+ R = consult_stream(Fd),
+ close(Fd),
+ R;
+ Error ->
+ Error
+ end.
+
+-spec path_consult(Paths :: [name()], File :: name()) ->
+ {'ok', list(), filename()} | {'error', posix() | {integer(), atom(), any()}}.
+
+path_consult(Path, File) ->
+ case path_open(Path, File, [read]) of
+ {ok, Fd, Full} ->
+ case consult_stream(Fd) of
+ {ok, List} ->
+ close(Fd),
+ {ok, List, Full};
+ E1 ->
+ close(Fd),
+ E1
+ end;
+ E2 ->
+ E2
+ end.
+
+-spec eval(File :: name()) -> 'ok' | {'error', posix()}.
+
+eval(File) ->
+ eval(File, erl_eval:new_bindings()).
+
+-spec eval(File :: name(), Bindings :: bindings()) ->
+ 'ok' | {'error', posix()}.
+
+eval(File, Bs) ->
+ case open(File, [read]) of
+ {ok, Fd} ->
+ R = eval_stream(Fd, ignore, Bs),
+ close(Fd),
+ R;
+ Error ->
+ Error
+ end.
+
+-spec path_eval(Paths :: [name()], File :: name()) ->
+ {'ok', filename()} | {'error', posix() | {integer(), atom(), any()}}.
+
+path_eval(Path, File) ->
+ path_eval(Path, File, erl_eval:new_bindings()).
+
+-spec path_eval(Paths :: [name()], File :: name(), Bindings :: bindings()) ->
+ {'ok', filename()} | {'error', posix() | {integer(), atom(), any()}}.
+
+path_eval(Path, File, Bs) ->
+ case path_open(Path, File, [read]) of
+ {ok, Fd, Full} ->
+ case eval_stream(Fd, ignore, Bs) of
+ ok ->
+ close(Fd),
+ {ok, Full};
+ E1 ->
+ close(Fd),
+ E1
+ end;
+ E2 ->
+ E2
+ end.
+
+-spec script(File :: name()) ->
+ {'ok', any()} | {'error', posix() | {integer(), atom(), any()}}.
+
+script(File) ->
+ script(File, erl_eval:new_bindings()).
+
+-spec script(File :: name(), Bindings :: bindings()) ->
+ {'ok', any()} | {'error', posix() | {integer(), atom(), any()}}.
+
+script(File, Bs) ->
+ case open(File, [read]) of
+ {ok, Fd} ->
+ R = eval_stream(Fd, return, Bs),
+ close(Fd),
+ R;
+ Error ->
+ Error
+ end.
+
+-spec path_script/2 :: (Paths :: [name()], File :: name()) ->
+ {'ok', term(), filename()} | {'error', posix() | {integer(), atom(), _}}.
+
+path_script(Path, File) ->
+ path_script(Path, File, erl_eval:new_bindings()).
+
+-spec path_script(Paths :: [name()],
+ File :: name(),
+ Bindings :: bindings()) ->
+ {'ok', term(), filename()} | {'error', posix() | {integer(), atom(), _}}.
+
+path_script(Path, File, Bs) ->
+ case path_open(Path, File, [read]) of
+ {ok,Fd,Full} ->
+ case eval_stream(Fd, return, Bs) of
+ {ok,R} ->
+ close(Fd),
+ {ok, R, Full};
+ E1 ->
+ close(Fd),
+ E1
+ end;
+ E2 ->
+ E2
+ end.
+
+
+%% path_open(Paths, Filename, Mode) ->
+%% {ok,FileDescriptor,FullName}
+%% {error,Reason}
+%%
+%% Searches the Paths for file Filename which can be opened with Mode.
+%% The path list is ignored if Filename contains an absolute path.
+
+-spec path_open(Paths :: [name()], Name :: name(), Modes :: [mode()]) ->
+ {'ok', io_device(), filename()} | {'error', posix()}.
+
+path_open(PathList, Name, Mode) ->
+ case file_name(Name) of
+ {error, _} = Error ->
+ Error;
+ FileName ->
+ case filename:pathtype(FileName) of
+ relative ->
+ path_open_first(PathList, FileName, Mode, enoent);
+ _ ->
+ case open(Name, Mode) of
+ {ok, Fd} ->
+ {ok, Fd, Name};
+ Error ->
+ Error
+ end
+ end
+ end.
+
+-spec change_mode(Name :: name(), Mode :: integer()) ->
+ 'ok' | {'error', posix()}.
+
+change_mode(Name, Mode)
+ when is_integer(Mode) ->
+ write_file_info(Name, #file_info{mode=Mode}).
+
+-spec change_owner(Name :: name(), OwnerId :: integer()) ->
+ 'ok' | {'error', posix()}.
+
+change_owner(Name, OwnerId)
+ when is_integer(OwnerId) ->
+ write_file_info(Name, #file_info{uid=OwnerId}).
+
+-spec change_owner(Name :: name(),
+ OwnerId :: integer(),
+ GroupId :: integer()) ->
+ 'ok' | {'error', posix()}.
+
+change_owner(Name, OwnerId, GroupId)
+ when is_integer(OwnerId), is_integer(GroupId) ->
+ write_file_info(Name, #file_info{uid=OwnerId, gid=GroupId}).
+
+-spec change_group(Name :: name(), GroupId :: integer()) ->
+ 'ok' | {'error', posix()}.
+
+change_group(Name, GroupId)
+ when is_integer(GroupId) ->
+ write_file_info(Name, #file_info{gid=GroupId}).
+
+-spec change_time(Name :: name(), Time :: date_time()) ->
+ 'ok' | {'error', posix()}.
+
+change_time(Name, Time)
+ when is_tuple(Time) ->
+ write_file_info(Name, #file_info{mtime=Time}).
+
+-spec change_time(Name :: name(),
+ ATime :: date_time(),
+ MTime :: date_time()) ->
+ 'ok' | {'error', posix()}.
+
+change_time(Name, Atime, Mtime)
+ when is_tuple(Atime), is_tuple(Mtime) ->
+ write_file_info(Name, #file_info{atime=Atime, mtime=Mtime}).
+
+%%%-----------------------------------------------------------------
+%%% Helpers
+
+consult_stream(Fd) ->
+ consult_stream(Fd, 1, []).
+
+consult_stream(Fd, Line, Acc) ->
+ case io:read(Fd, '', Line) of
+ {ok,Term,EndLine} ->
+ consult_stream(Fd, EndLine, [Term|Acc]);
+ {error,Error,_Line} ->
+ {error,Error};
+ {eof,_Line} ->
+ {ok,lists:reverse(Acc)}
+ end.
+
+eval_stream(Fd, Handling, Bs) ->
+ eval_stream(Fd, Handling, 1, undefined, [], Bs).
+
+eval_stream(Fd, H, Line, Last, E, Bs) ->
+ eval_stream2(io:parse_erl_exprs(Fd, '', Line), Fd, H, Last, E, Bs).
+
+eval_stream2({ok,Form,EndLine}, Fd, H, Last, E, Bs0) ->
+ try erl_eval:exprs(Form, Bs0) of
+ {value,V,Bs} ->
+ eval_stream(Fd, H, EndLine, {V}, E, Bs)
+ catch Class:Reason ->
+ Error = {EndLine,?MODULE,{Class,Reason,erlang:get_stacktrace()}},
+ eval_stream(Fd, H, EndLine, Last, [Error|E], Bs0)
+ end;
+eval_stream2({error,What,EndLine}, Fd, H, Last, E, Bs) ->
+ eval_stream(Fd, H, EndLine, Last, [What | E], Bs);
+eval_stream2({eof,EndLine}, _Fd, H, Last, E, _Bs) ->
+ case {H, Last, E} of
+ {return, {Val}, []} ->
+ {ok, Val};
+ {return, undefined, E} ->
+ {error, hd(lists:reverse(E, [{EndLine,?MODULE,undefined_script}]))};
+ {ignore, _, []} ->
+ ok;
+ {_, _, [_|_] = E} ->
+ {error, hd(lists:reverse(E))}
+ end.
+
+path_open_first([Path|Rest], Name, Mode, LastError) ->
+ case file_name(Path) of
+ {error, _} = Error ->
+ Error;
+ FilePath ->
+ FileName = filename:join(FilePath, Name),
+ case open(FileName, Mode) of
+ {ok, Fd} ->
+ {ok, Fd, FileName};
+ {error, enoent} ->
+ path_open_first(Rest, Name, Mode, LastError);
+ Error ->
+ Error
+ end
+ end;
+path_open_first([], _Name, _Mode, LastError) ->
+ {error, LastError}.
+
+%%%-----------------------------------------------------------------
+%%% Utility functions.
+
+%% file_name(FileName)
+%% Generates a flat file name from a deep list of atoms and
+%% characters (integers).
+
+file_name(N) ->
+ try
+ file_name_1(N)
+ catch Reason ->
+ {error, Reason}
+ end.
+
+file_name_1([C|T]) when is_integer(C), C > 0, C =< 255 ->
+ [C|file_name_1(T)];
+file_name_1([H|T]) ->
+ file_name_1(H) ++ file_name_1(T);
+file_name_1([]) ->
+ [];
+file_name_1(N) when is_atom(N) ->
+ atom_to_list(N);
+file_name_1(_) ->
+ throw(badarg).
+
+make_binary(Bin) when is_binary(Bin) ->
+ Bin;
+make_binary(List) ->
+ %% Convert the list to a binary in order to avoid copying a list
+ %% to the file server.
+ try
+ erlang:iolist_to_binary(List)
+ catch error:Reason ->
+ {error, Reason}
+ end.
+
+mode_list(read) ->
+ [read];
+mode_list(write) ->
+ [write];
+mode_list(read_write) ->
+ [read, write];
+mode_list({binary, Mode}) when is_atom(Mode) ->
+ [binary | mode_list(Mode)];
+mode_list({character, Mode}) when is_atom(Mode) ->
+ mode_list(Mode);
+mode_list(_) ->
+ [{error, badarg}].
+
+%%-----------------------------------------------------------------
+%% Functions for communicating with the file server
+
+call(Command, Args) when is_list(Args) ->
+ gen_server:call(?FILE_SERVER, list_to_tuple([Command | Args]), infinity).
+
+check_and_call(Command, Args) when is_list(Args) ->
+ case check_args(Args) of
+ ok ->
+ call(Command, Args);
+ Error ->
+ Error
+ end.
+
+check_args([{error, _}=Error|_Rest]) ->
+ Error;
+check_args([_Name|Rest]) ->
+ check_args(Rest);
+check_args([]) ->
+ ok.
+
+%%-----------------------------------------------------------------
+%% Functions for communicating with a file io server.
+%% The messages sent have the following formats:
+%%
+%% {file_request,From,ReplyAs,Request}
+%% {file_reply,ReplyAs,Reply}
+
+file_request(Io, Request) ->
+ R = erlang:monitor(process, Io),
+ Io ! {file_request,self(),Io,Request},
+ R.
+
+wait_file_reply(From, Ref) ->
+ receive
+ {file_reply,From,Reply} ->
+ erlang:demonitor(Ref),
+ receive {'DOWN', Ref, _, _, _} -> ok after 0 -> ok end,
+ %% receive {'EXIT', From, _} -> ok after 0 -> ok end,
+ Reply;
+ {'DOWN', Ref, _, _, _} ->
+ %% receive {'EXIT', From, _} -> ok after 0 -> ok end,
+ {error, terminated}
+ end.
diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl
new file mode 100644
index 0000000000..37e803c493
--- /dev/null
+++ b/lib/kernel/src/file_io_server.erl
@@ -0,0 +1,882 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(file_io_server).
+
+%% A simple file server for io to one file instance per server instance.
+
+-export([format_error/1]).
+-export([start/3, start_link/3]).
+
+-export([count_and_find/3]).
+
+-record(state, {handle,owner,mref,buf,read_mode,unic}).
+
+-define(PRIM_FILE, prim_file).
+-define(READ_SIZE_LIST, 128).
+-define(READ_SIZE_BINARY, (8*1024)).
+
+-define(eat_message(M, T), receive M -> M after T -> timeout end).
+
+%%%-----------------------------------------------------------------
+%%% Exported functions
+
+format_error({_Line, ?MODULE, Reason}) ->
+ io_lib:format("~w", [Reason]);
+format_error({_Line, Mod, Reason}) ->
+ Mod:format_error(Reason);
+format_error(ErrorId) ->
+ erl_posix_msg:message(ErrorId).
+
+start(Owner, FileName, ModeList)
+ when is_pid(Owner), is_list(FileName), is_list(ModeList) ->
+ do_start(spawn, Owner, FileName, ModeList).
+
+start_link(Owner, FileName, ModeList)
+ when is_pid(Owner), is_list(FileName), is_list(ModeList) ->
+ do_start(spawn_link, Owner, FileName, ModeList).
+
+%%%-----------------------------------------------------------------
+%%% Server starter, dispatcher and helpers
+
+do_start(Spawn, Owner, FileName, ModeList) ->
+ Self = self(),
+ Ref = make_ref(),
+ Pid =
+ erlang:Spawn(
+ fun() ->
+ %% process_flag(trap_exit, true),
+ case parse_options(ModeList) of
+ {ReadMode, UnicodeMode, Opts} ->
+ case ?PRIM_FILE:open(FileName, Opts) of
+ {error, Reason} = Error ->
+ Self ! {Ref, Error},
+ exit(Reason);
+ {ok, Handle} ->
+ %% XXX must I handle R6 nodes here?
+ M = erlang:monitor(process, Owner),
+ Self ! {Ref, ok},
+ server_loop(
+ #state{handle = Handle,
+ owner = Owner,
+ mref = M,
+ buf = <<>>,
+ read_mode = ReadMode,
+ unic = UnicodeMode})
+ end;
+ {error,Reason1} = Error1 ->
+ Self ! {Ref, Error1},
+ exit(Reason1)
+ end
+ end),
+ Mref = erlang:monitor(process, Pid),
+ receive
+ {Ref, {error, _Reason} = Error} ->
+ erlang:demonitor(Mref),
+ receive {'DOWN', Mref, _, _, _} -> ok after 0 -> ok end,
+ Error;
+ {Ref, ok} ->
+ erlang:demonitor(Mref),
+ receive
+ {'DOWN', Mref, _, _, Reason} ->
+ {error, Reason}
+ after 0 ->
+ {ok, Pid}
+ end;
+ {'DOWN', Mref, _, _, Reason} ->
+ {error, Reason}
+ end.
+
+%%% Returns {ReadMode, UnicodeMode, RealOpts}
+parse_options(List) ->
+ parse_options(expand_encoding(List), list, latin1, []).
+
+parse_options([],list,Uni,Acc) ->
+ {list,Uni,[binary|lists:reverse(Acc)]};
+parse_options([],binary,Uni,Acc) ->
+ {binary,Uni,lists:reverse(Acc)};
+parse_options([{encoding, Encoding}|T],RMode,_,Acc) ->
+ case valid_enc(Encoding) of
+ {ok, ExpandedEnc} ->
+ parse_options(T,RMode,ExpandedEnc,Acc);
+ {error,Reason} ->
+ {error,Reason}
+ end;
+parse_options([binary|T],_,Uni,Acc) ->
+ parse_options(T,binary,Uni,[binary|Acc]);
+parse_options([H|T],R,U,Acc) ->
+ parse_options(T,R,U,[H|Acc]).
+
+expand_encoding([]) ->
+ [];
+expand_encoding([latin1 | T]) ->
+ [{encoding,latin1} | expand_encoding(T)];
+expand_encoding([unicode | T]) ->
+ [{encoding,unicode} | expand_encoding(T)];
+expand_encoding([H|T]) ->
+ [H|expand_encoding(T)].
+
+valid_enc(latin1) ->
+ {ok,latin1};
+valid_enc(utf8) ->
+ {ok,unicode};
+valid_enc(unicode) ->
+ {ok,unicode};
+valid_enc(utf16) ->
+ {ok,{utf16,big}};
+valid_enc({utf16,big}) ->
+ {ok,{utf16,big}};
+valid_enc({utf16,little}) ->
+ {ok,{utf16,little}};
+valid_enc(utf32) ->
+ {ok,{utf32,big}};
+valid_enc({utf32,big}) ->
+ {ok,{utf32,big}};
+valid_enc({utf32,little}) ->
+ {ok,{utf32,little}};
+valid_enc(_Other) ->
+ {error,badarg}.
+
+
+
+server_loop(#state{mref = Mref} = State) ->
+ receive
+ {file_request, From, ReplyAs, Request} when is_pid(From) ->
+ case file_request(Request, State) of
+ {reply, Reply, NewState} ->
+ file_reply(From, ReplyAs, Reply),
+ server_loop(NewState);
+ {error, Reply, NewState} ->
+ %% error is the same as reply, except that
+ %% it breaks the io_request_loop further down
+ file_reply(From, ReplyAs, Reply),
+ server_loop(NewState);
+ {stop, Reason, Reply, _NewState} ->
+ file_reply(From, ReplyAs, Reply),
+ exit(Reason)
+ end;
+ {io_request, From, ReplyAs, Request} when is_pid(From) ->
+ case io_request(Request, State) of
+ {reply, Reply, NewState} ->
+ io_reply(From, ReplyAs, Reply),
+ server_loop(NewState);
+ {error, Reply, NewState} ->
+ %% error is the same as reply, except that
+ %% it breaks the io_request_loop further down
+ io_reply(From, ReplyAs, Reply),
+ server_loop(NewState);
+ {stop, Reason, Reply, _NewState} ->
+ io_reply(From, ReplyAs, Reply),
+ exit(Reason)
+ end;
+ {'DOWN', Mref, _, _, Reason} ->
+ exit(Reason);
+ _ ->
+ server_loop(State)
+ end.
+
+file_reply(From, ReplyAs, Reply) ->
+ From ! {file_reply, ReplyAs, Reply}.
+
+io_reply(From, ReplyAs, Reply) ->
+ From ! {io_reply, ReplyAs, Reply}.
+
+%%%-----------------------------------------------------------------
+%%% file requests
+
+file_request({pread,At,Sz},
+ #state{handle=Handle,buf=Buf,read_mode=ReadMode}=State) ->
+ case position(Handle, At, Buf) of
+ {ok,_Offs} ->
+ case ?PRIM_FILE:read(Handle, Sz) of
+ {ok,Bin} when ReadMode =:= list ->
+ std_reply({ok,binary_to_list(Bin)}, State);
+ Reply ->
+ std_reply(Reply, State)
+ end;
+ Reply ->
+ std_reply(Reply, State)
+ end;
+file_request({pwrite,At,Data},
+ #state{handle=Handle,buf=Buf}=State) ->
+ case position(Handle, At, Buf) of
+ {ok,_Offs} ->
+ std_reply(?PRIM_FILE:write(Handle, Data), State);
+ Reply ->
+ std_reply(Reply, State)
+ end;
+file_request(sync,
+ #state{handle=Handle}=State) ->
+ case ?PRIM_FILE:sync(Handle) of
+ {error,_}=Reply ->
+ {stop,normal,Reply,State};
+ Reply ->
+ {reply,Reply,State}
+ end;
+file_request(close,
+ #state{handle=Handle}=State) ->
+ {stop,normal,?PRIM_FILE:close(Handle),State#state{buf= <<>>}};
+file_request({position,At},
+ #state{handle=Handle,buf=Buf}=State) ->
+ std_reply(position(Handle, At, Buf), State);
+file_request(truncate,
+ #state{handle=Handle}=State) ->
+ case ?PRIM_FILE:truncate(Handle) of
+ {error,_Reason}=Reply ->
+ {stop,normal,Reply,State#state{buf= <<>>}};
+ Reply ->
+ {reply,Reply,State}
+ end;
+file_request(Unknown,
+ #state{}=State) ->
+ Reason = {request, Unknown},
+ {error,{error,Reason},State}.
+
+std_reply({error,_}=Reply, State) ->
+ {error,Reply,State#state{buf= <<>>}};
+std_reply(Reply, State) ->
+ {reply,Reply,State#state{buf= <<>>}}.
+
+%%%-----------------------------------------------------------------
+%%% I/O request
+
+%% New protocol with encoding tags (R13)
+io_request({put_chars, Enc, Chars},
+ #state{buf= <<>>}=State) ->
+ put_chars(Chars, Enc, State);
+io_request({put_chars, Enc, Chars},
+ #state{handle=Handle,buf=Buf}=State) ->
+ case position(Handle, cur, Buf) of
+ {error,_}=Reply ->
+ {stop,normal,Reply,State#state{buf= <<>>}};
+ _ ->
+ put_chars(Chars, Enc, State#state{buf= <<>>})
+ end;
+io_request({put_chars,Enc,Mod,Func,Args},
+ #state{}=State) ->
+ case catch apply(Mod, Func, Args) of
+ Chars when is_list(Chars); is_binary(Chars) ->
+ io_request({put_chars,Enc,Chars}, State);
+ _ ->
+ {error,{error,Func},State}
+ end;
+
+
+io_request({get_until,Enc,_Prompt,Mod,Func,XtraArgs},
+ #state{}=State) ->
+ get_chars(io_lib, get_until, {Mod, Func, XtraArgs}, Enc, State);
+io_request({get_chars,Enc,_Prompt,N},
+ #state{}=State) ->
+ get_chars(N, Enc, State);
+
+%%
+%% This optimization gives almost nothing - needs more working...
+%% Disabled for now. /PaN
+%%
+%% io_request({get_line,Enc,_Prompt},
+%% #state{unic=latin1}=State) ->
+%% get_line(Enc,State);
+
+io_request({get_line,Enc,_Prompt},
+ #state{}=State) ->
+ get_chars(io_lib, collect_line, [], Enc, State);
+
+
+io_request({setopts, Opts},
+ #state{}=State) when is_list(Opts) ->
+ setopts(Opts, State);
+
+io_request(getopts,
+ #state{}=State) ->
+ getopts(State);
+
+%% BC with pre-R13 nodes
+io_request({put_chars, Chars},#state{}=State) ->
+ io_request({put_chars, latin1, Chars},State);
+io_request({put_chars,Mod,Func,Args}, #state{}=State) ->
+ io_request({put_chars,latin1,Mod,Func,Args}, State);
+io_request({get_until,_Prompt,Mod,Func,XtraArgs}, #state{}=State) ->
+ io_request({get_until,latin1,_Prompt,Mod,Func,XtraArgs}, State);
+io_request({get_chars,_Prompt,N}, #state{}=State) ->
+ io_request({get_chars,latin1,_Prompt,N}, State);
+io_request({get_line,_Prompt}, #state{}=State) ->
+ io_request({get_line,latin1,_Prompt}, State);
+
+io_request({requests,Requests},
+ #state{}=State) when is_list(Requests) ->
+ io_request_loop(Requests, {reply,ok,State});
+io_request(Unknown,
+ #state{}=State) ->
+ Reason = {request,Unknown},
+ {error,{error,Reason},State}.
+
+
+
+%% Process a list of requests as long as the results are ok.
+
+io_request_loop([], Result) ->
+ Result;
+io_request_loop([_Request|_Tail],
+ {stop,_Reason,_Reply,_State}=Result) ->
+ Result;
+io_request_loop([_Request|_Tail],
+ {error,_Reply,_State}=Result) ->
+ Result;
+io_request_loop([Request|Tail],
+ {reply,_Reply,State}) ->
+ io_request_loop(Tail, io_request(Request, State)).
+
+
+
+%% I/O request put_chars
+%%
+put_chars(Chars, latin1, #state{handle=Handle, unic=latin1}=State) ->
+ case ?PRIM_FILE:write(Handle, Chars) of
+ {error,_}=Reply ->
+ {stop,normal,Reply,State};
+ Reply ->
+ {reply,Reply,State}
+ end;
+put_chars(Chars, InEncoding, #state{handle=Handle, unic=OutEncoding}=State) ->
+ case unicode:characters_to_binary(Chars,InEncoding,OutEncoding) of
+ Bin when is_binary(Bin) ->
+ case ?PRIM_FILE:write(Handle, Bin) of
+ {error,_}=Reply ->
+ {stop,normal,Reply,State};
+ Reply ->
+ {reply,Reply,State}
+ end;
+ {error,_,_} ->
+ {stop,normal,{error,{no_translation, InEncoding, OutEncoding}},State}
+ end.
+
+%%
+%% Process the I/O request get_line for latin1 encoding of file specially
+%% Unfortunately this function gives almost nothing, it needs more work
+%% I disable it for now /PaN
+%%
+%% srch(<<>>,_,_) ->
+%% nomatch;
+%% srch(<<X:8,_/binary>>,X,N) ->
+%% {match,N};
+%% srch(<<_:8,T/binary>>,X,N) ->
+%% srch(T,X,N+1).
+%% get_line(OutEnc, #state{handle=Handle,buf = <<>>,unic=latin1}=State) ->
+%% case ?PRIM_FILE:read(Handle,?READ_SIZE_BINARY) of
+%% {ok, B} ->
+%% get_line(OutEnc, State#state{buf = B});
+%% eof ->
+%% {reply,eof,State};
+%% {error,Reason}=Error ->
+%% {stop,Reason,Error,State}
+%% end;
+%% get_line(OutEnc, #state{handle=Handle,buf=Buf,read_mode=ReadMode,unic=latin1}=State) ->
+%% case srch(Buf,$\n,0) of
+%% nomatch ->
+%% case ?PRIM_FILE:read(Handle,?READ_SIZE_BINARY) of
+%% {ok, B} ->
+%% get_line(OutEnc,State#state{buf = <<Buf/binary,B/binary>>});
+%% eof ->
+%% std_reply(cast(Buf, ReadMode,latin1,OutEnc), State);
+%% {error,Reason}=Error ->
+%% {stop,Reason,Error,State#state{buf= <<>>}}
+%% end;
+%% {match,Pos} when Pos >= 1->
+%% PosP1 = Pos + 1,
+%% <<Res0:PosP1/binary,NewBuf/binary>> = Buf,
+%% PosM1 = Pos - 1,
+%% Res = case Res0 of
+%% <<Chomped:PosM1/binary,$\r:8,$\n:8>> ->
+%% cat(Chomped, <<"\n">>, ReadMode,latin1,OutEnc);
+%% _Other ->
+%% cast(Res0, ReadMode,latin1,OutEnc)
+%% end,
+%% {reply,Res,State#state{buf=NewBuf}};
+%% {match,Pos} ->
+%% PosP1 = Pos + 1,
+%% <<Res:PosP1/binary,NewBuf/binary>> = Buf,
+%% {reply,Res,State#state{buf=NewBuf}}
+%% end;
+%% get_line(_, #state{}=State) ->
+%% {error,{error,get_line},State}.
+
+%%
+%% Process the I/O request get_chars
+%%
+get_chars(0, Enc, #state{read_mode=ReadMode,unic=InEncoding}=State) ->
+ {reply,cast(<<>>, ReadMode,InEncoding, Enc),State};
+get_chars(N, Enc, #state{buf=Buf,read_mode=ReadMode,unic=latin1}=State)
+ when is_integer(N), N > 0, N =< byte_size(Buf) ->
+ {B1,B2} = split_binary(Buf, N),
+ {reply,cast(B1, ReadMode,latin1,Enc),State#state{buf=B2}};
+get_chars(N, Enc, #state{buf=Buf,read_mode=ReadMode,unic=latin1}=State)
+ when is_integer(N), N > 0, N =< byte_size(Buf) ->
+ {B1,B2} = split_binary(Buf, N),
+ {reply,cast(B1, ReadMode,latin1,Enc),State#state{buf=B2}};
+get_chars(N, OutEnc,#state{handle=Handle,buf=Buf,read_mode=ReadMode,unic=latin1}=State)
+ when is_integer(N), N > 0 ->
+ BufSize = byte_size(Buf),
+ NeedSize = N-BufSize,
+ Size = erlang:max(NeedSize, ?READ_SIZE_BINARY),
+ case ?PRIM_FILE:read(Handle, Size) of
+ {ok, B} ->
+ if BufSize+byte_size(B) < N ->
+ std_reply(cat(Buf, B, ReadMode,latin1,OutEnc), State);
+ true ->
+ {B1,B2} = split_binary(B, NeedSize),
+ {reply,cat(Buf, B1, ReadMode, latin1,OutEnc),State#state{buf=B2}}
+ end;
+ eof when BufSize =:= 0 ->
+ {reply,eof,State};
+ eof ->
+ std_reply(cast(Buf, ReadMode,latin1,OutEnc), State);
+ {error,Reason}=Error ->
+ {stop,Reason,Error,State#state{buf= <<>>}}
+ end;
+get_chars(N, OutEnc,#state{handle=Handle,buf=Buf,read_mode=ReadMode,unic=InEncoding}=State)
+ when is_integer(N), N > 0 ->
+ try
+ %% This is rather tricky, we need to count the actual number of characters
+ %% in the buffer first as unicode characters are not constant in length
+ {BufCount, SplitPos} = count_and_find(Buf,N,InEncoding),
+ case BufCount >= N of
+ true ->
+ {B1,B2} = case SplitPos of
+ none -> {Buf,<<>>};
+ _ ->split_binary(Buf,SplitPos)
+ end,
+ {reply,cast(B1, ReadMode,InEncoding,OutEnc),State#state{buf=B2}};
+ false ->
+ %% Need more, Try to read 4*needed in bytes...
+ NeedSize = (N - BufCount) * 4,
+ Size = erlang:max(NeedSize, ?READ_SIZE_BINARY),
+ case ?PRIM_FILE:read(Handle, Size) of
+ {ok, B} ->
+ NewBuf = list_to_binary([Buf,B]),
+ {NewCount,NewSplit} = count_and_find(NewBuf,N,InEncoding),
+ case NewCount >= N of
+ true ->
+ {B01,B02} = case NewSplit of
+ none -> {NewBuf,<<>>};
+ _ ->split_binary(NewBuf, NewSplit)
+ end,
+ {reply,cast(B01, ReadMode,InEncoding,OutEnc),
+ State#state{buf=B02}};
+ false ->
+ %% Reached end of file
+ std_reply(cast(NewBuf, ReadMode,InEncoding,OutEnc),
+ State#state{buf = <<>>})
+ end;
+ eof when BufCount =:= 0 ->
+ {reply,eof,State};
+ eof ->
+ std_reply(cast(Buf, ReadMode,InEncoding,OutEnc), State#state{buf = <<>>});
+ {error,Reason}=Error ->
+ {stop,Reason,Error,State#state{buf = <<>>}}
+ end
+ end
+ catch
+ exit:ExError ->
+ {stop,ExError,{error,ExError},State#state{buf= <<>>}}
+ end;
+
+get_chars(_N, _, #state{}=State) ->
+ {error,{error,get_chars},State}.
+
+get_chars(Mod, Func, XtraArg, OutEnc, #state{buf= <<>>}=State) ->
+ get_chars_empty(Mod, Func, XtraArg, start, OutEnc, State);
+get_chars(Mod, Func, XtraArg, OutEnc, #state{buf=Buf}=State) ->
+ get_chars_apply(Mod, Func, XtraArg, start, OutEnc, State#state{buf= <<>>}, Buf).
+
+get_chars_empty(Mod, Func, XtraArg, S, latin1,
+ #state{handle=Handle,read_mode=ReadMode, unic=latin1}=State) ->
+ case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of
+ {ok,Bin} ->
+ get_chars_apply(Mod, Func, XtraArg, S, latin1, State, Bin);
+ eof ->
+ get_chars_apply(Mod, Func, XtraArg, S, latin1, State, eof);
+ {error,Reason}=Error ->
+ {stop,Reason,Error,State}
+ end;
+get_chars_empty(Mod, Func, XtraArg, S, OutEnc,
+ #state{handle=Handle,read_mode=ReadMode}=State) ->
+ case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of
+ {ok,Bin} ->
+ get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, Bin);
+ eof ->
+ get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, eof);
+ {error,Reason}=Error ->
+ {stop,Reason,Error,State}
+ end.
+get_chars_notempty(Mod, Func, XtraArg, S, OutEnc,
+ #state{handle=Handle,read_mode=ReadMode,buf = B}=State) ->
+ case ?PRIM_FILE:read(Handle, read_size(ReadMode)) of
+ {ok,Bin} ->
+ get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, list_to_binary([B,Bin]));
+ eof ->
+ case B of
+ <<>> ->
+ get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, eof);
+ _ ->
+ {stop,invalid_unicode,{error,invalid_unicode},State}
+ end;
+ {error,Reason}=Error ->
+ {stop,Reason,Error,State}
+ end.
+
+
+get_chars_apply(Mod, Func, XtraArg, S0, latin1,
+ #state{read_mode=ReadMode,unic=latin1}=State, Data0) ->
+ Data1 = case ReadMode of
+ list when is_binary(Data0) -> binary_to_list(Data0);
+ _ -> Data0
+ end,
+ case catch Mod:Func(S0, Data1, latin1, XtraArg) of
+ {stop,Result,Buf} ->
+ {reply,Result,State#state{buf=cast_binary(Buf)}};
+ {'EXIT',Reason} ->
+ {stop,Reason,{error,err_func(Mod, Func, XtraArg)},State};
+ S1 ->
+ get_chars_empty(Mod, Func, XtraArg, S1, latin1, State)
+ end;
+get_chars_apply(Mod, Func, XtraArg, S0, OutEnc,
+ #state{read_mode=ReadMode,unic=InEnc}=State, Data0) ->
+ try
+ {Data1,NewBuff} = case ReadMode of
+ list when is_binary(Data0) ->
+ case unicode:characters_to_list(Data0,InEnc) of
+ {Tag,Decoded,Rest} when Decoded =/= [], Tag =:= error; Decoded =/= [], Tag =:= incomplete ->
+ {Decoded,erlang:iolist_to_binary(Rest)};
+ {error, [], _} ->
+ exit(invalid_unicode);
+ {incomplete, [], R} ->
+ {[],R};
+ List when is_list(List) ->
+ {List,<<>>}
+ end;
+ binary when is_binary(Data0) ->
+ case unicode:characters_to_binary(Data0,InEnc,OutEnc) of
+ {Tag2,Decoded2,Rest2} when Decoded2 =/= <<>>, Tag2 =:= error; Decoded2 =/= <<>>, Tag2 =:= incomplete ->
+ {Decoded2,erlang:iolist_to_binary(Rest2)};
+ {error, <<>>, _} ->
+ exit(invalid_unicode);
+ {incomplete, <<>>, R} ->
+ {<<>>,R};
+ Binary when is_binary(Binary) ->
+ {Binary,<<>>}
+ end;
+ _ -> %i.e. eof
+ {Data0,<<>>}
+ end,
+ case catch Mod:Func(S0, Data1, OutEnc, XtraArg) of
+ {stop,Result,Buf} ->
+ {reply,Result,State#state{buf = (if
+ is_binary(Buf) ->
+ list_to_binary([unicode:characters_to_binary(Buf,OutEnc,InEnc),NewBuff]);
+ is_list(Buf) ->
+ list_to_binary([unicode:characters_to_binary(Buf,unicode,InEnc),NewBuff]);
+ true ->
+ NewBuff
+ end)}};
+ {'EXIT',Reason} ->
+ {stop,Reason,{error,err_func(Mod, Func, XtraArg)},State};
+ S1 ->
+ get_chars_notempty(Mod, Func, XtraArg, S1, OutEnc, State#state{buf=NewBuff})
+ end
+ catch
+ exit:ExReason ->
+ {stop,ExReason,{error,err_func(Mod, Func, XtraArg)},State};
+ error:ErrReason ->
+ {stop,ErrReason,{error,err_func(Mod, Func, XtraArg)},State}
+ end.
+
+
+
+%% Convert error code to make it look as before
+err_func(io_lib, get_until, {_,F,_}) ->
+ F;
+err_func(_, F, _) ->
+ F.
+
+
+
+%% Process the I/O request setopts
+%%
+%% setopts
+setopts(Opts0,State) ->
+ Opts = proplists:unfold(
+ proplists:substitute_negations(
+ [{list,binary}],
+ expand_encoding(Opts0))),
+ case check_valid_opts(Opts) of
+ true ->
+ do_setopts(Opts,State);
+ false ->
+ {error,{error,enotsup},State}
+ end.
+check_valid_opts([]) ->
+ true;
+check_valid_opts([{binary,_}|T]) ->
+ check_valid_opts(T);
+check_valid_opts([{encoding,_Enc}|T]) ->
+ check_valid_opts(T);
+check_valid_opts(_) ->
+ false.
+do_setopts(Opts, State) ->
+ case valid_enc(proplists:get_value(encoding, Opts, State#state.unic)) of
+ {ok,NewUnic} ->
+ case proplists:get_value(binary, Opts) of
+ true ->
+ {reply,ok,State#state{read_mode=binary, unic=NewUnic}};
+ false ->
+ {reply,ok,State#state{read_mode=list, unic=NewUnic}};
+ undefined ->
+ {reply,ok,State#state{unic=NewUnic}}
+ end;
+ _ ->
+ {error,{error,badarg},State}
+ end.
+
+getopts(#state{read_mode=RM, unic=Unic} = State) ->
+ Bin = {binary, case RM of
+ binary ->
+ true;
+ _ ->
+ false
+ end},
+ Uni = {encoding, Unic},
+ {reply,[Bin,Uni],State}.
+
+
+%% Concatenate two binaries and convert the result to list or binary
+cat(B1, B2, binary,latin1,latin1) ->
+ list_to_binary([B1,B2]);
+cat(B1, B2, binary,InEncoding,OutEncoding) ->
+ case unicode:characters_to_binary([B1,B2],InEncoding,OutEncoding) of
+ Good when is_binary(Good) ->
+ Good;
+ _ ->
+ exit({no_translation,InEncoding,OutEncoding})
+ end;
+%% Dialyzer finds this is never used...
+%% cat(B1, B2, list, InEncoding, OutEncoding) when InEncoding =/= latin1 ->
+%% % Catch i.e. unicode -> latin1 errors by using the outencoding although otherwise
+%% % irrelevant for lists...
+%% try
+%% unicode:characters_to_list(unicode:characters_to_binary([B1,B2],InEncoding,OutEncoding),
+%% OutEncoding)
+%% catch
+%% error:_ ->
+%% exit({no_translation,InEncoding,OutEncoding})
+%% end.
+cat(B1, B2, list, latin1,_) ->
+ binary_to_list(B1)++binary_to_list(B2).
+
+%% Cast binary to list or binary
+cast(B, binary, latin1, latin1) ->
+ B;
+cast(B, binary, InEncoding, OutEncoding) ->
+ case unicode:characters_to_binary(B,InEncoding,OutEncoding) of
+ Good when is_binary(Good) ->
+ Good;
+ _ ->
+ exit({no_translation,InEncoding,OutEncoding})
+ end;
+cast(B, list, latin1, _) ->
+ binary_to_list(B);
+cast(B, list, InEncoding, OutEncoding) ->
+ try
+ unicode:characters_to_list(unicode:characters_to_binary(B,InEncoding,OutEncoding),
+ OutEncoding)
+ catch
+ error:_ ->
+ exit({no_translation,InEncoding,OutEncoding})
+ end.
+
+%% Convert buffer to binary
+cast_binary(Binary) when is_binary(Binary) ->
+ Binary;
+cast_binary(List) when is_list(List) ->
+ list_to_binary(List);
+cast_binary(_EOF) ->
+ <<>>.
+
+%% Read size for different read modes
+read_size(binary) ->
+ ?READ_SIZE_BINARY;
+read_size(list) ->
+ ?READ_SIZE_LIST.
+
+%% Utf utility
+count_and_find(Bin,N,Encoding) ->
+ cafu(Bin,N,0,0,none,case Encoding of
+ unicode -> utf8;
+ Oth -> Oth
+ end).
+
+cafu(<<>>,0,Count,ByteCount,_SavePos,_) ->
+ {Count,ByteCount};
+cafu(<<>>,_N,Count,_ByteCount,SavePos,_) ->
+ {Count,SavePos};
+cafu(<<_/utf8,Rest/binary>>, 0, Count, ByteCount, _SavePos, utf8) ->
+ cafu(Rest,-1,Count+1,0,ByteCount,utf8);
+cafu(<<_/utf8,Rest/binary>>, N, Count, _ByteCount, SavePos, utf8) when N < 0 ->
+ cafu(Rest,-1,Count+1,0,SavePos,utf8);
+cafu(<<_/utf8,Rest/binary>> = Whole, N, Count, ByteCount, SavePos, utf8) ->
+ Delta = byte_size(Whole) - byte_size(Rest),
+ cafu(Rest,N-1,Count+1,ByteCount+Delta,SavePos,utf8);
+cafu(<<_/utf16-big,Rest/binary>>, 0, Count, ByteCount, _SavePos, {utf16,big}) ->
+ cafu(Rest,-1,Count+1,0,ByteCount,{utf16,big});
+cafu(<<_/utf16-big,Rest/binary>>, N, Count, _ByteCount, SavePos, {utf16,big}) when N < 0 ->
+ cafu(Rest,-1,Count+1,0,SavePos,{utf16,big});
+cafu(<<_/utf16-big,Rest/binary>> = Whole, N, Count, ByteCount, SavePos, {utf16,big}) ->
+ Delta = byte_size(Whole) - byte_size(Rest),
+ cafu(Rest,N-1,Count+1,ByteCount+Delta,SavePos,{utf16,big});
+cafu(<<_/utf16-little,Rest/binary>>, 0, Count, ByteCount, _SavePos, {utf16,little}) ->
+ cafu(Rest,-1,Count+1,0,ByteCount,{utf16,little});
+cafu(<<_/utf16-little,Rest/binary>>, N, Count, _ByteCount, SavePos, {utf16,little}) when N < 0 ->
+ cafu(Rest,-1,Count+1,0,SavePos,{utf16,little});
+cafu(<<_/utf16-little,Rest/binary>> = Whole, N, Count, ByteCount, SavePos, {utf16,little}) ->
+ Delta = byte_size(Whole) - byte_size(Rest),
+ cafu(Rest,N-1,Count+1,ByteCount+Delta,SavePos,{utf16,little});
+cafu(<<_/utf32-big,Rest/binary>>, 0, Count, ByteCount, _SavePos, {utf32,big}) ->
+ cafu(Rest,-1,Count+1,0,ByteCount,{utf32,big});
+cafu(<<_/utf32-big,Rest/binary>>, N, Count, _ByteCount, SavePos, {utf32,big}) when N < 0 ->
+ cafu(Rest,-1,Count+1,0,SavePos,{utf32,big});
+cafu(<<_/utf32-big,Rest/binary>> = Whole, N, Count, ByteCount, SavePos, {utf32,big}) ->
+ Delta = byte_size(Whole) - byte_size(Rest),
+ cafu(Rest,N-1,Count+1,ByteCount+Delta,SavePos,{utf32,big});
+cafu(<<_/utf32-little,Rest/binary>>, 0, Count, ByteCount, _SavePos, {utf32,little}) ->
+ cafu(Rest,-1,Count+1,0,ByteCount,{utf32,little});
+cafu(<<_/utf32-little,Rest/binary>>, N, Count, _ByteCount, SavePos, {utf32,little}) when N < 0 ->
+ cafu(Rest,-1,Count+1,0,SavePos,{utf32,little});
+cafu(<<_/utf32-little,Rest/binary>> = Whole, N, Count, ByteCount, SavePos, {utf32,little}) ->
+ Delta = byte_size(Whole) - byte_size(Rest),
+ cafu(Rest,N-1,Count+1,ByteCount+Delta,SavePos,{utf32,little});
+cafu(_Other,0,Count,ByteCount,_,_) -> % Non Unicode character,
+ % but found our point, OK this time
+ {Count,ByteCount};
+cafu(Other,_N,Count,0,SavePos,Enc) -> % Not enough, but valid chomped unicode
+ % at end.
+ case cbv(Enc,Other) of
+ false ->
+ exit(invalid_unicode);
+ _ ->
+ {Count,SavePos}
+ end;
+cafu(Other,_N,Count,ByteCount,none,Enc) -> % Return what we'we got this far
+ % although not complete,
+ % it's not (yet) in error
+ case cbv(Enc,Other) of
+ false ->
+ exit(invalid_unicode);
+ _ ->
+ {Count,ByteCount}
+ end;
+cafu(Other,_N,Count,_ByteCount,SavePos,Enc) -> % As above but we have
+ % found a position
+ case cbv(Enc,Other) of
+ false ->
+ exit(invalid_unicode);
+ _ ->
+ {Count,SavePos}
+ end.
+
+%%
+%% Bluntly stolen from stdlib/unicode.erl (cbv means can be valid?)
+%%
+cbv(utf8,<<1:1,1:1,0:1,_:5>>) ->
+ 1;
+cbv(utf8,<<1:1,1:1,1:1,0:1,_:4,R/binary>>) ->
+ case R of
+ <<>> ->
+ 2;
+ <<1:1,0:1,_:6>> ->
+ 1;
+ _ ->
+ false
+ end;
+cbv(utf8,<<1:1,1:1,1:1,1:1,0:1,_:3,R/binary>>) ->
+ case R of
+ <<>> ->
+ 3;
+ <<1:1,0:1,_:6>> ->
+ 2;
+ <<1:1,0:1,_:6,1:1,0:1,_:6>> ->
+ 1;
+ _ ->
+ false
+ end;
+cbv(utf8,_) ->
+ false;
+
+cbv({utf16,big},<<A:8>>) when A =< 215; A >= 224 ->
+ 1;
+cbv({utf16,big},<<54:6,_:2>>) ->
+ 3;
+cbv({utf16,big},<<54:6,_:10>>) ->
+ 2;
+cbv({utf16,big},<<54:6,_:10,55:6,_:2>>) ->
+ 1;
+cbv({utf16,big},_) ->
+ false;
+cbv({utf16,little},<<_:8>>) ->
+ 1; % or 3, we'll see
+cbv({utf16,little},<<_:8,54:6,_:2>>) ->
+ 2;
+cbv({utf16,little},<<_:8,54:6,_:2,_:8>>) ->
+ 1;
+cbv({utf16,little},_) ->
+ false;
+
+
+cbv({utf32,big}, <<0:8>>) ->
+ 3;
+cbv({utf32,big}, <<0:8,X:8>>) when X =< 16 ->
+ 2;
+cbv({utf32,big}, <<0:8,X:8,Y:8>>)
+ when X =< 16, ((X > 0) or ((Y =< 215) or (Y >= 224))) ->
+ 1;
+cbv({utf32,big},_) ->
+ false;
+cbv({utf32,little},<<_:8>>) ->
+ 3;
+cbv({utf32,little},<<_:8,_:8>>) ->
+ 2;
+cbv({utf32,little},<<X:8,255:8,0:8>>) when X =:= 254; X =:= 255 ->
+ false;
+cbv({utf32,little},<<_:8,Y:8,X:8>>)
+ when X =< 16, ((X > 0) or ((Y =< 215) or (Y >= 224))) ->
+ 1;
+cbv({utf32,little},_) ->
+ false.
+
+
+%%%-----------------------------------------------------------------
+%%% ?PRIM_FILE helpers
+
+%% Compensates ?PRIM_FILE:position/2 for the number of bytes
+%% we have buffered
+
+position(Handle, cur, Buf) ->
+ position(Handle, {cur, 0}, Buf);
+position(Handle, {cur, Offs}, Buf) when is_binary(Buf) ->
+ ?PRIM_FILE:position(Handle, {cur, Offs-byte_size(Buf)});
+position(Handle, At, _Buf) ->
+ ?PRIM_FILE:position(Handle, At).
+
diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl
new file mode 100644
index 0000000000..74f2fb94a9
--- /dev/null
+++ b/lib/kernel/src/file_server.erl
@@ -0,0 +1,325 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%----------------------------------------------------------------------
+%%% File : file_server.erl
+%%% Author : Raimo Niskanen <[email protected]>
+%%% Purpose : A simple file server
+%%% Created : 13 Oct 2000 by Raimo Niskanen <[email protected]>
+%%%----------------------------------------------------------------------
+
+-module(file_server).
+
+-behaviour(gen_server).
+
+%% External exports
+-export([format_error/1]).
+-export([start/0, start_link/0, stop/0]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-define(FILE_IO_SERVER_TABLE, file_io_servers).
+
+-define(FILE_SERVER, file_server_2). % Registered name
+-define(FILE_IO_SERVER, file_io_server). % Module
+-define(PRIM_FILE, prim_file). % Module
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+format_error({_Line, ?MODULE, Reason}) ->
+ io_lib:format("~w", [Reason]);
+format_error({_Line, Mod, Reason}) ->
+ Mod:format_error(Reason);
+format_error(ErrorId) ->
+ erl_posix_msg:message(ErrorId).
+
+start() -> do_start(start).
+start_link() -> do_start(start_link).
+
+stop() ->
+ gen_server:call(?FILE_SERVER, stop, infinity).
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from gen_server
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, State} |
+%% {ok, State, Timeout} |
+%% ignore |
+%% {stop, Reason}
+%%----------------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ case ?PRIM_FILE:start() of
+ {ok, Handle} ->
+ ets:new(?FILE_IO_SERVER_TABLE, [named_table]),
+ {ok, Handle};
+ {error, Reason} ->
+ {stop, Reason}
+ end.
+
+%%----------------------------------------------------------------------
+%% Func: handle_call/3
+%% Returns: {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} | (terminate/2 is called)
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, Handle)
+ when is_list(ModeList) ->
+ Child = ?FILE_IO_SERVER:start_link(Pid, Name, ModeList),
+ case Child of
+ {ok, P} when is_pid(P) ->
+ ets:insert(?FILE_IO_SERVER_TABLE, {P, Name});
+ _ ->
+ ok
+ end,
+ {reply, Child, Handle};
+
+handle_call({open, _Name, _Mode}, _From, Handle) ->
+ {reply, {error, einval}, Handle};
+
+handle_call({read_file, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:read_file(Name), Handle};
+
+handle_call({write_file, Name, Bin}, _From, Handle) ->
+ {reply, ?PRIM_FILE:write_file(Name, Bin), Handle};
+
+handle_call({set_cwd, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:set_cwd(Handle, Name), Handle};
+
+handle_call({delete, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:delete(Handle, Name), Handle};
+
+handle_call({rename, Fr, To}, _From, Handle) ->
+ {reply, ?PRIM_FILE:rename(Handle, Fr, To), Handle};
+
+handle_call({make_dir, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:make_dir(Handle, Name), Handle};
+
+handle_call({del_dir, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:del_dir(Handle, Name), Handle};
+
+handle_call({list_dir, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:list_dir(Handle, Name), Handle};
+
+handle_call(get_cwd, _From, Handle) ->
+ {reply, ?PRIM_FILE:get_cwd(Handle), Handle};
+handle_call({get_cwd}, _From, Handle) ->
+ {reply, ?PRIM_FILE:get_cwd(Handle), Handle};
+handle_call({get_cwd, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:get_cwd(Handle, Name), Handle};
+
+handle_call({read_file_info, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:read_file_info(Handle, Name), Handle};
+
+handle_call({altname, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:altname(Handle, Name), Handle};
+
+handle_call({write_file_info, Name, Info}, _From, Handle) ->
+ {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info), Handle};
+
+handle_call({read_link_info, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:read_link_info(Handle, Name), Handle};
+
+handle_call({read_link, Name}, _From, Handle) ->
+ {reply, ?PRIM_FILE:read_link(Handle, Name), Handle};
+
+handle_call({make_link, Old, New}, _From, Handle) ->
+ {reply, ?PRIM_FILE:make_link(Handle, Old, New), Handle};
+
+handle_call({make_symlink, Old, New}, _From, Handle) ->
+ {reply, ?PRIM_FILE:make_symlink(Handle, Old, New), Handle};
+
+handle_call({copy, SourceName, SourceOpts, DestName, DestOpts, Length},
+ _From, Handle) ->
+ Reply =
+ case ?PRIM_FILE:open(SourceName, [read, binary | SourceOpts]) of
+ {ok, Source} ->
+ SourceReply =
+ case ?PRIM_FILE:open(DestName,
+ [write, binary | DestOpts]) of
+ {ok, Dest} ->
+ DestReply =
+ ?PRIM_FILE:copy(Source, Dest, Length),
+ ?PRIM_FILE:close(Dest),
+ DestReply;
+ {error, _} = Error ->
+ Error
+ end,
+ ?PRIM_FILE:close(Source),
+ SourceReply;
+ {error, _} = Error ->
+ Error
+ end,
+ {reply, Reply, Handle};
+
+handle_call(stop, _From, Handle) ->
+ {stop, normal, stopped, Handle};
+
+handle_call(Request, From, Handle) ->
+ error_logger:error_msg("handle_call(~p, ~p, _)", [Request, From]),
+ {noreply, Handle}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_cast/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_cast(Msg, State) ->
+ error_logger:error_msg("handle_cast(~p, _)", [Msg]),
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_info/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+
+handle_info({'EXIT', Pid, _Reason}, Handle) when is_pid(Pid) ->
+ ets:delete(?FILE_IO_SERVER_TABLE, Pid),
+ {noreply, Handle};
+
+handle_info({'EXIT', Handle, _Reason}, Handle) ->
+ error_logger:error_msg("Port controlling ~w terminated in ~w",
+ [?FILE_SERVER, ?MODULE]),
+ {stop, normal, Handle};
+
+handle_info(Info, State) ->
+ error_logger:error_msg("handle_Info(~p, _)", [Info]),
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: terminate/2
+%% Purpose: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%----------------------------------------------------------------------
+terminate(_Reason, Handle) ->
+ ?PRIM_FILE:stop(Handle).
+
+%%----------------------------------------------------------------------
+%% Func: code_change/3
+%% Purpose: Convert process state when code is changed
+%% Returns: {ok, NewState}
+%%----------------------------------------------------------------------
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+%%% The basic file server and start-up.
+%%%
+%%% The file server just handles the open command/message and acts as a
+%%% router for messages between the port and the file processes. If a
+%%% file process terminates we close the associated file.
+
+%% Start = start | start_link
+do_start(Start) ->
+ case init:get_argument(master) of
+ error ->
+ gen_server:Start({local,?FILE_SERVER}, ?MODULE, [], []);
+ {ok, [[Node]]} ->
+ do_start(Start, list_to_atom(Node), ?FILE_SERVER);
+ X ->
+ {error, {get_argument, master, X}}
+ end.
+
+%% Should mimic gen_server:Start
+do_start(Start, Node, Name) ->
+ case rpc:call(Node, erlang, whereis, [Name]) of
+ Filer when is_pid(Filer); Filer =:= undefined ->
+ case catch do_start_slave(Start, Filer, Name) of
+ {'EXIT', Reason} ->
+ {error, Reason};
+ Result ->
+ Result
+ end;
+ Other ->
+ {error, {no_master, Other}}
+ end.
+
+%% May exit upon failure, return {ok, SlavePid} if all well.
+do_start_slave(start_link, Filer, Name) ->
+ Self = self(),
+ Token = make_ref(),
+ Slave = spawn_link(fun() -> relay_start(Self, Token, Filer, Name) end),
+ receive
+ {started, Token} ->
+ {ok, Slave}
+ end;
+do_start_slave(start, Filer, Name) ->
+ Self = self(),
+ Token = make_ref(),
+ Slave = spawn(fun() -> relay_start(Self, Token, Filer, Name) end),
+ SlaveMonitor = erlang:monitor(process, Slave),
+ receive
+ {started, Token} ->
+ erlang:demonitor(SlaveMonitor),
+ receive {'DOWN', SlaveMonitor, _, _, _} -> ok after 0 -> ok end,
+ {ok, Slave};
+ {'DOWN', SlaveMonitor, _, _, Reason} ->
+ exit(Reason)
+ end.
+
+%% We have the relay process file internal.
+%% We do not need to load slave as a mandatory module
+%% during system startup.
+
+relay_start(Parent, Token, Filer, Name) when is_pid(Filer) ->
+ case catch register(Name, self()) of
+ true ->
+ ok;
+ _ ->
+ exit({already_started, whereis(Name)})
+ end,
+ %% This will fail towards an R5 node or older, Filer is a pid()
+ FilerMonitor = erlang:monitor(process, Filer),
+ process_flag(trap_exit, true),
+ Parent ! {started, Token},
+ relay_loop(Parent, Filer, FilerMonitor);
+relay_start(Parent, Token, undefined, _Name) ->
+ %% Dummy process to keep kernel supervisor happy
+ process_flag(trap_exit, true),
+ Parent ! {started, Token},
+ receive
+ {'EXIT', Parent, Reason} ->
+ exit(Reason)
+ end.
+
+relay_loop(Parent, Filer, FilerMonitor) ->
+ receive
+ {'DOWN', FilerMonitor, _, _, Reason} ->
+ exit(Reason);
+ {'EXIT', Parent, Reason} ->
+ exit(Reason);
+ Msg ->
+ Filer ! Msg
+ end,
+ relay_loop(Parent, Filer, FilerMonitor).
diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl
new file mode 100644
index 0000000000..fcd1d1564a
--- /dev/null
+++ b/lib/kernel/src/gen_sctp.erl
@@ -0,0 +1,230 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(gen_sctp).
+
+%% This module provides functions for communicating with
+%% sockets using the SCTP protocol. The implementation assumes that
+%% the OS kernel supports SCTP providing user-level SCTP Socket API:
+%% http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13
+
+-include("inet_sctp.hrl").
+
+-export([open/0,open/1,open/2,close/1]).
+-export([listen/2,connect/4,connect/5]).
+-export([eof/2,abort/2]).
+-export([send/3,send/4,recv/1,recv/2]).
+-export([error_string/1]).
+-export([controlling_process/2]).
+
+
+
+open() ->
+ open([]).
+
+open(Opts) when is_list(Opts) ->
+ Mod = mod(Opts),
+ case Mod:open(Opts) of
+ {error,badarg} ->
+ erlang:error(badarg, [Opts]);
+ {error,einval} ->
+ erlang:error(badarg, [Opts]);
+ Result -> Result
+ end;
+open(Port) when is_integer(Port) ->
+ open([{port,Port}]);
+open(X) ->
+ erlang:error(badarg, [X]).
+
+open(Port, Opts) when is_integer(Port), is_list(Opts) ->
+ open([{port,Port}|Opts]);
+open(Port, Opts) ->
+ erlang:error(badarg, [Port,Opts]).
+
+close(S) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} ->
+ Mod:close(S);
+ {error,closed} -> ok
+ end;
+close(S) ->
+ erlang:error(badarg, [S]).
+
+
+
+listen(S, Flag) when is_port(S), is_boolean(Flag) ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} ->
+ Mod:listen(S, Flag);
+ Error -> Error
+ end;
+listen(S, Flag) ->
+ erlang:error(badarg, [S,Flag]).
+
+connect(S, Addr, Port, Opts) ->
+ connect(S, Addr, Port, Opts, infinity).
+
+connect(S, Addr, Port, Opts, Timeout) when is_port(S), is_list(Opts) ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} ->
+ case Mod:getserv(Port) of
+ {ok,Port} ->
+ try inet:start_timer(Timeout) of
+ Timer ->
+ try Mod:getaddr(Addr, Timer) of
+ {ok,IP} ->
+ Mod:connect(S, IP, Port, Opts, Timer);
+ Error -> Error
+ after
+ inet:stop_timer(Timer)
+ end
+ catch
+ error:badarg ->
+ erlang:error(badarg, [S,Addr,Port,Opts,Timeout])
+ end;
+ Error -> Error
+ end;
+ Error -> Error
+ end;
+connect(S, Addr, Port, Opts, Timeout) ->
+ erlang:error(badarg, [S,Addr,Port,Opts,Timeout]).
+
+
+
+eof(S, #sctp_assoc_change{assoc_id=AssocId}) when is_port(S) ->
+ eof_or_abort(S, AssocId, eof);
+eof(S, Assoc) ->
+ erlang:error(badarg, [S,Assoc]).
+
+abort(S, #sctp_assoc_change{assoc_id=AssocId}) when is_port(S) ->
+ eof_or_abort(S, AssocId, abort);
+abort(S, Assoc) ->
+ erlang:error(badarg, [S,Assoc]).
+
+eof_or_abort(S, AssocId, Action) ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} ->
+ Mod:sendmsg(S, #sctp_sndrcvinfo{assoc_id = AssocId,
+ flags = [Action]},
+ <<>>);
+ Error -> Error
+ end.
+
+
+
+%% Full-featured send. Rarely needed.
+send(S, #sctp_sndrcvinfo{}=SRI, Data) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} ->
+ Mod:sendmsg(S, SRI, Data);
+ Error -> Error
+ end;
+send(S, SRI, Data) ->
+ erlang:error(badarg, [S,SRI,Data]).
+
+send(S, #sctp_assoc_change{assoc_id=AssocId}, Stream, Data)
+ when is_port(S), is_integer(Stream) ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} ->
+ Mod:sendmsg(S, #sctp_sndrcvinfo{
+ stream = Stream,
+ assoc_id = AssocId}, Data);
+ Error -> Error
+ end;
+send(S, AssocId, Stream, Data)
+ when is_port(S), is_integer(AssocId), is_integer(Stream) ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} ->
+ Mod:sendmsg(S, #sctp_sndrcvinfo{
+ stream = Stream,
+ assoc_id = AssocId}, Data);
+ Error -> Error
+ end;
+send(S, AssocChange, Stream, Data) ->
+ erlang:error(badarg, [S,AssocChange,Stream,Data]).
+
+recv(S) ->
+ recv(S, infinity).
+
+recv(S, Timeout) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} ->
+ Mod:recv(S, Timeout);
+ Error -> Error
+ end;
+recv(S, Timeout) ->
+ erlang:error(badarg, [S,Timeout]).
+
+
+
+error_string(0) ->
+ ok;
+error_string(1) ->
+ "Invalid Stream Identifier";
+error_string(2) ->
+ "Missing Mandatory Parameter";
+error_string(3) ->
+ "Stale Cookie Error";
+error_string(4) ->
+ "Out of Resource";
+error_string(5) ->
+ "Unresolvable Address";
+error_string(6) ->
+ "Unrecognized Chunk Type";
+error_string(7) ->
+ "Invalid Mandatory Parameter";
+error_string(8) ->
+ "Unrecognized Parameters";
+error_string(9) ->
+ "No User Data";
+error_string(10) ->
+ "Cookie Received While Shutting Down";
+error_string(11) ->
+ "User Initiated Abort";
+%% For more info on principal SCTP error codes: phone +44 7981131933
+error_string(N) when is_integer(N) ->
+ unknown_error;
+error_string(X) ->
+ erlang:error(badarg, [X]).
+
+
+
+controlling_process(S, Pid) when is_port(S), is_pid(Pid) ->
+ inet:udp_controlling_process(S, Pid);
+controlling_process(S, Pid) ->
+ erlang:error(badarg, [S,Pid]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Utilites
+%%
+
+%% Get the SCTP moudule
+mod() -> inet_db:sctp_module().
+
+%% Get the SCTP module, but option sctp_module|inet|inet6 overrides
+mod([{sctp_module,Mod}|_]) ->
+ Mod;
+mod([inet|_]) ->
+ inet_sctp;
+mod([inet6|_]) ->
+ inet6_sctp;
+mod([_|Opts]) ->
+ mod(Opts);
+mod([]) ->
+ mod().
diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl
new file mode 100644
index 0000000000..7401b06a64
--- /dev/null
+++ b/lib/kernel/src/gen_tcp.erl
@@ -0,0 +1,192 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(gen_tcp).
+
+
+-export([connect/3, connect/4, listen/2, accept/1, accept/2,
+ shutdown/2, close/1]).
+-export([send/2, recv/2, recv/3, unrecv/2]).
+-export([controlling_process/2]).
+-export([fdopen/2]).
+
+-include("inet_int.hrl").
+
+%%
+%% Connect a socket
+%%
+connect(Address, Port, Opts) ->
+ connect(Address,Port,Opts,infinity).
+
+connect(Address, Port, Opts, Time) ->
+ Timer = inet:start_timer(Time),
+ Res = (catch connect1(Address,Port,Opts,Timer)),
+ inet:stop_timer(Timer),
+ case Res of
+ {ok,S} -> {ok,S};
+ {error, einval} -> exit(badarg);
+ {'EXIT',Reason} -> exit(Reason);
+ Error -> Error
+ end.
+
+connect1(Address,Port,Opts,Timer) ->
+ Mod = mod(Opts),
+ case Mod:getaddrs(Address,Timer) of
+ {ok,IPs} ->
+ case Mod:getserv(Port) of
+ {ok,TP} -> try_connect(IPs,TP,Opts,Timer,Mod,{error,einval});
+ Error -> Error
+ end;
+ Error -> Error
+ end.
+
+try_connect([IP|IPs], Port, Opts, Timer, Mod, _) ->
+ Time = inet:timeout(Timer),
+ case Mod:connect(IP, Port, Opts, Time) of
+ {ok,S} -> {ok,S};
+ {error,einval} -> {error, einval};
+ {error,timeout} -> {error,timeout};
+ Err1 -> try_connect(IPs, Port, Opts, Timer, Mod, Err1)
+ end;
+try_connect([], _Port, _Opts, _Timer, _Mod, Err) ->
+ Err.
+
+
+
+%%
+%% Listen on a tcp port
+%%
+listen(Port, Opts) ->
+ Mod = mod(Opts),
+ case Mod:getserv(Port) of
+ {ok,TP} ->
+ Mod:listen(TP, Opts);
+ {error,einval} ->
+ exit(badarg);
+ Other -> Other
+ end.
+
+%%
+%% Generic tcp accept
+%%
+accept(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:accept(S);
+ Error ->
+ Error
+ end.
+
+accept(S, Time) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:accept(S, Time);
+ Error ->
+ Error
+ end.
+
+%%
+%% Generic tcp shutdown
+%%
+shutdown(S, How) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:shutdown(S, How);
+ Error ->
+ Error
+ end.
+
+%%
+%% Close
+%%
+close(S) ->
+ inet:tcp_close(S).
+
+%%
+%% Send
+%%
+send(S, Packet) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:send(S, Packet);
+ Error ->
+ Error
+ end.
+
+%%
+%% Receive data from a socket (passive mode)
+%%
+recv(S, Length) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:recv(S, Length);
+ Error ->
+ Error
+ end.
+
+recv(S, Length, Time) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:recv(S, Length, Time);
+ Error ->
+ Error
+ end.
+
+unrecv(S, Data) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:unrecv(S, Data);
+ Error ->
+ Error
+ end.
+
+%%
+%% Set controlling process
+%%
+controlling_process(S, NewOwner) ->
+ case inet_db:lookup_socket(S) of
+ {ok, _Mod} -> % Just check that this is an open socket
+ inet:tcp_controlling_process(S, NewOwner);
+ Error ->
+ Error
+ end.
+
+
+
+%%
+%% Create a port/socket from a file descriptor
+%%
+fdopen(Fd, Opts) ->
+ Mod = mod(Opts),
+ Mod:fdopen(Fd, Opts).
+
+%% Get the tcp_module
+mod() -> inet_db:tcp_module().
+
+%% Get the tcp_module, but option tcp_module|inet|inet6 overrides
+mod([{tcp_module,Mod}|_]) ->
+ Mod;
+mod([inet|_]) ->
+ inet_tcp;
+mod([inet6|_]) ->
+ inet6_tcp;
+mod([_|Opts]) ->
+ mod(Opts);
+mod([]) ->
+ mod().
diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl
new file mode 100644
index 0000000000..6bded4bda6
--- /dev/null
+++ b/lib/kernel/src/gen_udp.erl
@@ -0,0 +1,117 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(gen_udp).
+
+-export([open/1, open/2, close/1]).
+-export([send/2, send/4, recv/2, recv/3, connect/3]).
+-export([controlling_process/2]).
+-export([fdopen/2]).
+
+-include("inet_int.hrl").
+
+open(Port) ->
+ open(Port, []).
+
+open(Port, Opts) ->
+ Mod = mod(Opts),
+ {ok,UP} = Mod:getserv(Port),
+ Mod:open(UP, Opts).
+
+close(S) ->
+ inet:udp_close(S).
+
+send(S, Address, Port, Packet) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ case Mod:getaddr(Address) of
+ {ok,IP} ->
+ case Mod:getserv(Port) of
+ {ok,UP} -> Mod:send(S, IP, UP, Packet);
+ {error,einval} -> exit(badarg);
+ Error -> Error
+ end;
+ {error,einval} -> exit(badarg);
+ Error -> Error
+ end;
+ Error ->
+ Error
+ end.
+
+send(S, Packet) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:send(S, Packet);
+ Error ->
+ Error
+ end.
+
+recv(S,Len) when is_port(S), is_integer(Len) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:recv(S, Len);
+ Error ->
+ Error
+ end.
+
+recv(S,Len,Time) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ Mod:recv(S, Len,Time);
+ Error ->
+ Error
+ end.
+
+connect(S, Address, Port) when is_port(S) ->
+ case inet_db:lookup_socket(S) of
+ {ok, Mod} ->
+ case Mod:getaddr(Address) of
+ {ok, IP} ->
+ Mod:connect(S, IP, Port);
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+controlling_process(S, NewOwner) ->
+ inet:udp_controlling_process(S, NewOwner).
+
+%%
+%% Create a port/socket from a file descriptor
+%%
+fdopen(Fd, Opts) ->
+ Mod = mod(),
+ Mod:fdopen(Fd, Opts).
+
+
+%% Get the udp_module
+mod() -> inet_db:udp_module().
+
+%% Get the udp_module, but option udp_module|inet|inet6 overrides
+mod([{udp_module,Mod}|_]) ->
+ Mod;
+mod([inet|_]) ->
+ inet_udp;
+mod([inet6|_]) ->
+ inet6_udp;
+mod([_|Opts]) ->
+ mod(Opts);
+mod([]) ->
+ mod().
diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl
new file mode 100644
index 0000000000..cc0402da73
--- /dev/null
+++ b/lib/kernel/src/global.erl
@@ -0,0 +1,2244 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(global).
+-behaviour(gen_server).
+
+%% Global provides global registration of process names. The names are
+%% dynamically kept up to date with the entire network. Global can
+%% operate in two modes: in a fully connected network, or in a
+%% non-fully connected network. In the latter case, the name
+%% registration mechanism won't work.
+%% As a separate service Global also provides global locks.
+
+%% External exports
+-export([start/0, start_link/0, stop/0, sync/0, sync/1,
+ safe_whereis_name/1, whereis_name/1, register_name/2,
+ register_name/3, register_name_external/2, register_name_external/3,
+ unregister_name_external/1,re_register_name/2, re_register_name/3,
+ unregister_name/1, registered_names/0, send/2, node_disconnected/1,
+ set_lock/1, set_lock/2, set_lock/3,
+ del_lock/1, del_lock/2,
+ trans/2, trans/3, trans/4,
+ random_exit_name/3, random_notify_name/3, notify_all_name/3]).
+
+%% Internal exports
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2,
+ code_change/3, resolve_it/4]).
+
+-export([info/0]).
+
+-include_lib("stdlib/include/ms_transform.hrl").
+
+%% Set this variable to 'allow' to allow several names of a process.
+%% This is for backward compatibility only; the functionality is broken.
+-define(WARN_DUPLICATED_NAME, global_multi_name_action).
+
+%% Undocumented Kernel variable. Set this to 0 (zero) to get the old
+%% behaviour.
+-define(N_CONNECT_RETRIES, global_connect_retries).
+-define(DEFAULT_N_CONNECT_RETRIES, 5).
+
+%%% In certain places in the server, calling io:format hangs everything,
+%%% so we'd better use erlang:display/1.
+%%% my_tracer is used in testsuites
+-define(trace(_), ok).
+
+%-define(trace(T), (catch my_tracer ! {node(), {line,?LINE}, T})).
+
+%-define(trace(T), erlang:display({format, node(), cs(), T})).
+%cs() ->
+% {_Big, Small, Tiny} = now(),
+% (Small rem 100) * 100 + (Tiny div 10000).
+
+%% These are the protocol versions:
+%% Vsn 1 is the original protocol.
+%% Vsn 2 is enhanced with code to take care of registration of names from
+%% non erlang nodes, e.g. C-nodes.
+%% Vsn 3 is enhanced with a tag in the synch messages to distinguish
+%% different synch sessions from each other, see OTP-2766.
+%% Vsn 4 uses a single, permanent, locker process, but works like vsn 3
+%% when communicating with vsn 3 nodes. (-R10B)
+%% Vsn 5 uses an ordered list of self() and HisTheLocker when locking
+%% nodes in the own partition. (R11B-)
+
+%% Current version of global does not support vsn 4 or earlier.
+
+-define(vsn, 5).
+
+%%-----------------------------------------------------------------
+%% connect_all = boolean() - true if we are supposed to set up a
+%% fully connected net
+%% known = [Node] - all nodes known to us
+%% synced = [Node] - all nodes that have the same names as us
+%% resolvers = [{Node, MyTag, Resolver}] -
+%% the tag separating different synch sessions,
+%% and the pid of the name resolver process
+%% syncers = [pid()] - all current syncers processes
+%% node_name = atom() - our node name (can change if distribution
+%% is started/stopped dynamically)
+%%
+%% In addition to these, we keep info about messages arrived in
+%% the process dictionary:
+%% {pre_connect, Node} = {Vsn, InitMsg} - init_connect msgs that
+%% arrived before nodeup
+%% {wait_lock, Node} = {exchange, NameList, _NamelistExt} | lock_is_set
+%% - see comment below (handle_cast)
+%% {save_ops, Node} = {resolved, HisKnown, NamesExt, Res} | [operation()]
+%% - save the ops between exchange and resolved
+%% {prot_vsn, Node} = Vsn - the exchange protocol version (not used now)
+%% {sync_tag_my, Node} = My tag, used at synchronization with Node
+%% {sync_tag_his, Node} = The Node's tag, used at synchronization
+%% {lock_id, Node} = The resource locking the partitions
+%%-----------------------------------------------------------------
+-record(state, {connect_all :: boolean(),
+ known = [] :: [node()],
+ synced = [] :: [node()],
+ resolvers = [],
+ syncers = [] :: [pid()],
+ node_name = node() :: node(),
+ the_locker, the_deleter, the_registrar, trace,
+ global_lock_down = false
+ }).
+
+%%% There are also ETS tables used for bookkeeping of locks and names
+%%% (the first position is the key):
+%%%
+%%% global_locks (set): {ResourceId, LockRequesterId, [{Pid,RPid,ref()]}
+%%% Pid is locking ResourceId, ref() is the monitor ref.
+%%% RPid =/= Pid if there is an extra process calling erlang:monitor().
+%%% global_names (set): {Name, Pid, Method, RPid, ref()}
+%%% Registered names. ref() is the monitor ref.
+%%% RPid =/= Pid if there is an extra process calling erlang:monitor().
+%%% global_names_ext (set): {Name, Pid, RegNode}
+%%% External registered names (C-nodes).
+%%% (The RPid:s can be removed when/if erlang:monitor() returns before
+%%% trying to connect to the other node.)
+%%%
+%%% Helper tables:
+%%% global_pid_names (bag): {Pid, Name} | {ref(), Name}
+%%% Name(s) registered for Pid.
+%%% There is one {Pid, Name} and one {ref(), Name} for every Pid.
+%%% ref() is the same ref() as in global_names.
+%%% global_pid_ids (bag): {Pid, ResourceId} | {ref(), ResourceId}
+%%% Resources locked by Pid.
+%%% ref() is the same ref() as in global_locks.
+%%%
+%%% global_pid_names is a 'bag' for backward compatibility.
+%%% (Before vsn 5 more than one name could be registered for a process.)
+%%%
+%%% R11B-3 (OTP-6341): The list of pids in the table 'global_locks'
+%%% was replaced by a list of {Pid, Ref}, where Ref is a monitor ref.
+%%% It was necessary to use monitors to fix bugs regarding locks that
+%%% were never removed. The signal {async_del_lock, ...} has been
+%%% kept for backward compatibility. It can be removed later.
+%%%
+%%% R11B-4 (OTP-6428): Monitors are used for registered names.
+%%% The signal {delete_name, ...} has been kept for backward compatibility.
+%%% It can be removed later as can the deleter process.
+%%% An extra process calling erlang:monitor() is sometimes created.
+%%% The new_nodes messages has been augmented with the global lock id.
+
+start() ->
+ gen_server:start({local, global_name_server}, ?MODULE, [], []).
+
+start_link() ->
+ gen_server:start_link({local, global_name_server}, ?MODULE, [], []).
+
+stop() ->
+ gen_server:call(global_name_server, stop, infinity).
+
+-spec sync() -> 'ok' | {'error', term()}.
+sync() ->
+ case check_sync_nodes() of
+ {error, _} = Error ->
+ Error;
+ SyncNodes ->
+ gen_server:call(global_name_server, {sync, SyncNodes}, infinity)
+ end.
+
+-spec sync([node()]) -> 'ok' | {'error', term()}.
+sync(Nodes) ->
+ case check_sync_nodes(Nodes) of
+ {error, _} = Error ->
+ Error;
+ SyncNodes ->
+ gen_server:call(global_name_server, {sync, SyncNodes}, infinity)
+ end.
+
+-spec send(term(), term()) -> pid().
+send(Name, Msg) ->
+ case whereis_name(Name) of
+ Pid when is_pid(Pid) ->
+ Pid ! Msg,
+ Pid;
+ undefined ->
+ exit({badarg, {Name, Msg}})
+ end.
+
+%% See OTP-3737.
+-spec whereis_name(term()) -> pid() | 'undefined'.
+whereis_name(Name) ->
+ where(Name).
+
+-spec safe_whereis_name(term()) -> pid() | 'undefined'.
+safe_whereis_name(Name) ->
+ gen_server:call(global_name_server, {whereis, Name}, infinity).
+
+node_disconnected(Node) ->
+ global_name_server ! {nodedown, Node}.
+
+%%-----------------------------------------------------------------
+%% Method = function(Name, Pid1, Pid2) -> Pid | Pid2 | none
+%% Method is called if a name conflict is detected when two nodes
+%% are connecting to each other. It is supposed to return one of
+%% the Pids or 'none'. If a pid is returned, that pid is
+%% registered as Name on all nodes. If 'none' is returned, the
+%% Name is unregistered on all nodes. If anything else is returned,
+%% the Name is unregistered as well.
+%% Method is called once at one of the nodes where the processes reside
+%% only. If different Methods are used for the same name, it is
+%% undefined which one of them is used.
+%% Method blocks the name registration, but does not affect global locking.
+%%-----------------------------------------------------------------
+-spec register_name(term(), pid()) -> 'yes' | 'no'.
+register_name(Name, Pid) when is_pid(Pid) ->
+ register_name(Name, Pid, fun random_exit_name/3).
+
+-type method() :: fun((term(), pid(), pid()) -> pid() | 'none').
+
+-spec register_name(term(), pid(), method()) -> 'yes' | 'no'.
+register_name(Name, Pid, Method) when is_pid(Pid) ->
+ Fun = fun(Nodes) ->
+ case (where(Name) =:= undefined) andalso check_dupname(Name, Pid) of
+ true ->
+ gen_server:multi_call(Nodes,
+ global_name_server,
+ {register, Name, Pid, Method}),
+ yes;
+ _ ->
+ no
+ end
+ end,
+ ?trace({register_name, self(), Name, Pid, Method}),
+ gen_server:call(global_name_server, {registrar, Fun}, infinity).
+
+check_dupname(Name, Pid) ->
+ case ets:lookup(global_pid_names, Pid) of
+ [] ->
+ true;
+ PidNames ->
+ case application:get_env(kernel, ?WARN_DUPLICATED_NAME) of
+ {ok, allow} ->
+ true;
+ _ ->
+ S = "global: ~w registered under several names: ~w\n",
+ Names = [Name | [Name1 || {_Pid, Name1} <- PidNames]],
+ error_logger:error_msg(S, [Pid, Names]),
+ false
+ end
+ end.
+
+-spec unregister_name(term()) -> _.
+unregister_name(Name) ->
+ case where(Name) of
+ undefined ->
+ ok;
+ _ ->
+ Fun = fun(Nodes) ->
+ gen_server:multi_call(Nodes,
+ global_name_server,
+ {unregister, Name}),
+ ok
+ end,
+ ?trace({unregister_name, self(), Name}),
+ gen_server:call(global_name_server, {registrar, Fun}, infinity)
+ end.
+
+-spec re_register_name(term(), pid()) -> _.
+re_register_name(Name, Pid) when is_pid(Pid) ->
+ re_register_name(Name, Pid, fun random_exit_name/3).
+
+-spec re_register_name(term(), pid(), method()) -> _.
+re_register_name(Name, Pid, Method) when is_pid(Pid) ->
+ Fun = fun(Nodes) ->
+ gen_server:multi_call(Nodes,
+ global_name_server,
+ {register, Name, Pid, Method}),
+ yes
+ end,
+ ?trace({re_register_name, self(), Name, Pid, Method}),
+ gen_server:call(global_name_server, {registrar, Fun}, infinity).
+
+-spec registered_names() -> [term()].
+registered_names() ->
+ MS = ets:fun2ms(fun({Name,_Pid,_M,_RP,_R}) -> Name end),
+ ets:select(global_names, MS).
+
+%%-----------------------------------------------------------------
+%% The external node (e.g. a C-node) registers the name on an Erlang
+%% node which links to the process (an Erlang node has to be used
+%% since there is no global_name_server on the C-node). If the Erlang
+%% node dies the name is to be unregistered on all nodes. Normally
+%% node(Pid) is compared to the node that died, but that does not work
+%% for external nodes (the process does not run on the Erlang node
+%% that died). Therefore a table of all names registered by external
+%% nodes is kept up-to-date on all nodes.
+%%
+%% Note: if the Erlang node dies an EXIT signal is also sent to the
+%% C-node due to the link between the global_name_server and the
+%% registered process. [This is why the link has been kept despite
+%% the fact that monitors do the job now.]
+%%-----------------------------------------------------------------
+register_name_external(Name, Pid) when is_pid(Pid) ->
+ register_name_external(Name, Pid, fun random_exit_name/3).
+
+register_name_external(Name, Pid, Method) when is_pid(Pid) ->
+ Fun = fun(Nodes) ->
+ case where(Name) of
+ undefined ->
+ gen_server:multi_call(Nodes,
+ global_name_server,
+ {register_ext, Name, Pid,
+ Method, node()}),
+ yes;
+ _Pid -> no
+ end
+ end,
+ ?trace({register_name_external, self(), Name, Pid, Method}),
+ gen_server:call(global_name_server, {registrar, Fun}, infinity).
+
+unregister_name_external(Name) ->
+ unregister_name(Name).
+
+-type id() :: {term(), term()}.
+
+-spec set_lock(id()) -> boolean().
+set_lock(Id) ->
+ set_lock(Id, [node() | nodes()], infinity, 1).
+
+-type retries() :: non_neg_integer() | 'infinity'.
+
+-spec set_lock(id(), [node()]) -> boolean().
+set_lock(Id, Nodes) ->
+ set_lock(Id, Nodes, infinity, 1).
+
+-spec set_lock(id(), [node()], retries()) -> boolean().
+set_lock(Id, Nodes, Retries) when is_integer(Retries), Retries >= 0 ->
+ set_lock(Id, Nodes, Retries, 1);
+set_lock(Id, Nodes, infinity) ->
+ set_lock(Id, Nodes, infinity, 1).
+
+set_lock({_ResourceId, _LockRequesterId}, [], _Retries, _Times) ->
+ true;
+set_lock({_ResourceId, _LockRequesterId} = Id, Nodes, Retries, Times) ->
+ ?trace({set_lock,{me,self()},Id,{nodes,Nodes},
+ {retries,Retries}, {times,Times}}),
+ case set_lock_on_nodes(Id, Nodes) of
+ true ->
+ ?trace({set_lock_true, Id}),
+ true;
+ false=Reply when Retries =:= 0 ->
+ Reply;
+ false ->
+ random_sleep(Times),
+ set_lock(Id, Nodes, dec(Retries), Times+1)
+ end.
+
+-spec del_lock(id()) -> 'true'.
+del_lock(Id) ->
+ del_lock(Id, [node() | nodes()]).
+
+-spec del_lock(id(), [node()]) -> 'true'.
+del_lock({_ResourceId, _LockRequesterId} = Id, Nodes) ->
+ ?trace({del_lock, {me,self()}, Id, {nodes,Nodes}}),
+ gen_server:multi_call(Nodes, global_name_server, {del_lock, Id}),
+ true.
+
+-type trans_fun() :: function() | {module(), atom()}.
+
+-spec trans(id(), trans_fun()) -> term().
+trans(Id, Fun) -> trans(Id, Fun, [node() | nodes()], infinity).
+
+-spec trans(id(), trans_fun(), [node()]) -> term().
+trans(Id, Fun, Nodes) -> trans(Id, Fun, Nodes, infinity).
+
+-spec trans(id(), trans_fun(), [node()], retries()) -> term().
+trans(Id, Fun, Nodes, Retries) ->
+ case set_lock(Id, Nodes, Retries) of
+ true ->
+ try
+ Fun()
+ after
+ del_lock(Id, Nodes)
+ end;
+ false ->
+ aborted
+ end.
+
+info() ->
+ gen_server:call(global_name_server, info, infinity).
+
+%%%-----------------------------------------------------------------
+%%% Call-back functions from gen_server
+%%%-----------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ _ = ets:new(global_locks, [set, named_table, protected]),
+ _ = ets:new(global_names, [set, named_table, protected]),
+ _ = ets:new(global_names_ext, [set, named_table, protected]),
+
+ _ = ets:new(global_pid_names, [bag, named_table, protected]),
+ _ = ets:new(global_pid_ids, [bag, named_table, protected]),
+
+ %% This is for troubleshooting only.
+ DoTrace = os:getenv("GLOBAL_HIGH_LEVEL_TRACE") =:= "TRUE",
+ T0 = case DoTrace of
+ true ->
+ send_high_level_trace(),
+ [];
+ false ->
+ no_trace
+ end,
+
+ S = #state{the_locker = start_the_locker(DoTrace),
+ trace = T0,
+ the_deleter = start_the_deleter(self()),
+ the_registrar = start_the_registrar()},
+ S1 = trace_message(S, {init, node()}, []),
+
+ case init:get_argument(connect_all) of
+ {ok, [["false"]]} ->
+ {ok, S1#state{connect_all = false}};
+ _ ->
+ {ok, S1#state{connect_all = true}}
+ end.
+
+%%-----------------------------------------------------------------
+%% Connection algorithm
+%% ====================
+%% This algorithm solves the problem with partitioned nets as well.
+%%
+%% The main idea in the algorithm is that when two nodes connect, they
+%% try to set a lock in their own partition (i.e. all nodes already
+%% known to them; partitions are not necessarily disjoint). When the
+%% lock is set in each partition, these two nodes send each other a
+%% list with all registered names in resp partition (*). If no conflict
+%% is found, the name tables are just updated. If a conflict is found,
+%% a resolve function is called once for each conflict. The result of
+%% the resolving is sent to the other node. When the names are
+%% exchanged, all other nodes in each partition are informed of the
+%% other nodes, and they ping each other to form a fully connected
+%% net.
+%%
+%% A few remarks:
+%%
+%% (*) When this information is being exchanged, no one is allowed to
+%% change the global register table. All calls to register etc are
+%% protected by a lock. If a registered process dies during this
+%% phase the name is unregistered on the local node immediately,
+%% but the unregistration on other nodes will take place when the
+%% deleter manages to acquire the lock. This is necessary to
+%% prevent names from spreading to nodes where they cannot be
+%% deleted.
+%%
+%% - It is assumed that nodeups and nodedowns arrive in an orderly
+%% fashion: for every node, nodeup is followed by nodedown, and vice
+%% versa. "Double" nodeups and nodedowns must never occur. It is
+%% the responsibility of net_kernel to assure this.
+%%
+%% - There is always a delay between the termination of a registered
+%% process and the removal of the name from Global's tables. This
+%% delay can sometimes be quite substantial. Global guarantees that
+%% the name will eventually be removed, but there is no
+%% synchronization between nodes; the name can be removed from some
+%% node(s) long before it is removed from other nodes. Using
+%% safe_whereis_name is no cure.
+%%
+%% - Global cannot handle problems with the distribution very well.
+%% Depending on the value of the kernel variable 'net_ticktime' long
+%% delays may occur. This does not affect the handling of locks but
+%% will block name registration.
+%%
+%% - Old synch session messages may linger on in the message queue of
+%% global_name_server after the sending node has died. The tags of
+%% such messages do not match the current tag (if there is one),
+%% which makes it possible to discard those messages and cancel the
+%% corresponding lock.
+%%
+%% Suppose nodes A and B connect, and C is connected to A.
+%% Here's the algorithm's flow:
+%%
+%% Node A
+%% ------
+%% << {nodeup, B}
+%% TheLocker ! {nodeup, ..., Node, ...} (there is one locker per node)
+%% B ! {init_connect, ..., {..., TheLockerAtA, ...}}
+%% << {init_connect, TheLockerAtB}
+%% [The lockers try to set the lock]
+%% << {lock_is_set, B, ...}
+%% [Now, lock is set in both partitions]
+%% B ! {exchange, A, Names, ...}
+%% << {exchange, B, Names, ...}
+%% [solve conflict]
+%% B ! {resolved, A, ResolvedA, KnownAtA, ...}
+%% << {resolved, B, ResolvedB, KnownAtB, ...}
+%% C ! {new_nodes, ResolvedAandB, [B]}
+%%
+%% Node C
+%% ------
+%% << {new_nodes, ResolvedOps, NewNodes}
+%% [insert Ops]
+%% ping(NewNodes)
+%% << {nodeup, B}
+%% <ignore this one>
+%%
+%% Several things can disturb this picture.
+%%
+%% First, the init_connect message may arrive _before_ the nodeup
+%% message due to delay in net_kernel. We handle this by keeping track
+%% of these messages in the pre_connect variable in our state.
+%%
+%% Of course we must handle that some node goes down during the
+%% connection.
+%%
+%%-----------------------------------------------------------------
+%% Messages in the protocol
+%% ========================
+%% 1. Between global_name_servers on connecting nodes
+%% {init_connect, Vsn, Node, InitMsg}
+%% InitMsg = {locker, _Unused, HisKnown, HisTheLocker}
+%% {exchange, Node, ListOfNames, _ListOfNamesExt, Tag}
+%% {resolved, Node, HisOps, HisKnown, _Unused, ListOfNamesExt, Tag}
+%% HisKnown = list of known nodes in Node's partition
+%% 2. Between lockers on connecting nodes
+%% {his_locker, Pid} (from our global)
+%% {lock, Bool} loop until both lockers have lock = true,
+%% then send to global_name_server {lock_is_set, Node, Tag}
+%% 3. Connecting node's global_name_server informs other nodes in the same
+%% partition about hitherto unknown nodes in the other partition
+%% {new_nodes, Node, Ops, ListOfNamesExt, NewNodes, ExtraInfo}
+%% 4. Between global_name_server and resolver
+%% {resolve, NameList, Node} to resolver
+%% {exchange_ops, Node, Tag, Ops, Resolved} from resolver
+%% 5. sync protocol, between global_name_servers in different partitions
+%% {in_sync, Node, IsKnown}
+%% sent by each node to all new nodes (Node becomes known to them)
+%%-----------------------------------------------------------------
+
+handle_call({whereis, Name}, From, S) ->
+ do_whereis(Name, From),
+ {noreply, S};
+
+handle_call({registrar, Fun}, From, S) ->
+ S#state.the_registrar ! {trans_all_known, Fun, From},
+ {noreply, S};
+
+%% The pattern {register,'_','_','_'} is traced by the inviso
+%% application. Do not change.
+handle_call({register, Name, Pid, Method}, {FromPid, _Tag}, S0) ->
+ S = ins_name(Name, Pid, Method, FromPid, [], S0),
+ {reply, yes, S};
+
+handle_call({unregister, Name}, _From, S0) ->
+ S = delete_global_name2(Name, S0),
+ {reply, ok, S};
+
+handle_call({register_ext, Name, Pid, Method, RegNode}, {FromPid,_Tag}, S0) ->
+ S = ins_name_ext(Name, Pid, Method, RegNode, FromPid, [], S0),
+ {reply, yes, S};
+
+handle_call({set_lock, Lock}, {Pid, _Tag}, S0) ->
+ {Reply, S} = handle_set_lock(Lock, Pid, S0),
+ {reply, Reply, S};
+
+handle_call({del_lock, Lock}, {Pid, _Tag}, S0) ->
+ S = handle_del_lock(Lock, Pid, S0),
+ {reply, true, S};
+
+handle_call(get_known, _From, S) ->
+ {reply, S#state.known, S};
+
+handle_call(get_synced, _From, S) ->
+ {reply, S#state.synced, S};
+
+handle_call({sync, Nodes}, From, S) ->
+ %% If we have several global groups, this won't work, since we will
+ %% do start_sync on a nonempty list of nodes even if the system
+ %% is quiet.
+ Pid = start_sync(lists:delete(node(), Nodes) -- S#state.synced, From),
+ {noreply, S#state{syncers = [Pid | S#state.syncers]}};
+
+handle_call(get_protocol_version, _From, S) ->
+ {reply, ?vsn, S};
+
+handle_call(get_names_ext, _From, S) ->
+ {reply, get_names_ext(), S};
+
+handle_call(info, _From, S) ->
+ {reply, S, S};
+
+%% "High level trace". For troubleshooting only.
+handle_call(high_level_trace_start, _From, S) ->
+ S#state.the_locker ! {do_trace, true},
+ send_high_level_trace(),
+ {reply, ok, trace_message(S#state{trace = []}, {init, node()}, [])};
+handle_call(high_level_trace_stop, _From, S) ->
+ #state{the_locker = TheLocker, trace = Trace} = S,
+ TheLocker ! {do_trace, false},
+ wait_high_level_trace(),
+ {reply, Trace, S#state{trace = no_trace}};
+handle_call(high_level_trace_get, _From, #state{trace = Trace}=S) ->
+ {reply, Trace, S#state{trace = []}};
+
+handle_call(stop, _From, S) ->
+ {stop, normal, stopped, S};
+
+handle_call(Request, From, S) ->
+ error_logger:warning_msg("The global_name_server "
+ "received an unexpected message:\n"
+ "handle_call(~p, ~p, _)\n",
+ [Request, From]),
+ {noreply, S}.
+
+%%========================================================================
+%% init_connect
+%%
+%%========================================================================
+handle_cast({init_connect, Vsn, Node, InitMsg}, S) ->
+ %% Sent from global_name_server at Node.
+ ?trace({'####', init_connect, {vsn, Vsn}, {node,Node},{initmsg,InitMsg}}),
+ case Vsn of
+ %% It is always the responsibility of newer versions to understand
+ %% older versions of the protocol.
+ {HisVsn, HisTag} when HisVsn > ?vsn ->
+ init_connect(?vsn, Node, InitMsg, HisTag, S#state.resolvers, S);
+ {HisVsn, HisTag} ->
+ init_connect(HisVsn, Node, InitMsg, HisTag, S#state.resolvers, S);
+ %% To be future compatible
+ Tuple when is_tuple(Tuple) ->
+ List = tuple_to_list(Tuple),
+ [_HisVsn, HisTag | _] = List,
+ %% use own version handling if his is newer.
+ init_connect(?vsn, Node, InitMsg, HisTag, S#state.resolvers, S);
+ _ ->
+ Txt = io_lib:format("Illegal global protocol version ~p Node: ~p\n",
+ [Vsn, Node]),
+ error_logger:info_report(lists:flatten(Txt))
+ end,
+ {noreply, S};
+
+%%=======================================================================
+%% lock_is_set
+%%
+%% Ok, the lock is now set on both partitions. Send our names to other node.
+%%=======================================================================
+handle_cast({lock_is_set, Node, MyTag, LockId}, S) ->
+ %% Sent from the_locker at node().
+ ?trace({'####', lock_is_set , {node,Node}}),
+ case get({sync_tag_my, Node}) of
+ MyTag ->
+ lock_is_set(Node, S#state.resolvers, LockId),
+ {noreply, S};
+ _ -> %% Illegal tag, delete the old sync session.
+ NewS = cancel_locker(Node, S, MyTag),
+ {noreply, NewS}
+ end;
+
+%%========================================================================
+%% exchange
+%%
+%% Here the names are checked to detect name clashes.
+%%========================================================================
+handle_cast({exchange, Node, NameList, _NameExtList, MyTag}, S) ->
+ %% Sent from global_name_server at Node.
+ case get({sync_tag_my, Node}) of
+ MyTag ->
+ exchange(Node, NameList, S#state.resolvers),
+ {noreply, S};
+ _ -> %% Illegal tag, delete the old sync session.
+ NewS = cancel_locker(Node, S, MyTag),
+ {noreply, NewS}
+ end;
+
+%% {exchange_ops, ...} is sent by the resolver process (which then
+%% dies). It could happen that {resolved, ...} has already arrived
+%% from the other node. In that case we can go ahead and run the
+%% resolve operations. Otherwise we have to save the operations and
+%% wait for {resolve, ...}. This is very much like {lock_is_set, ...}
+%% and {exchange, ...}.
+handle_cast({exchange_ops, Node, MyTag, Ops, Resolved}, S0) ->
+ %% Sent from the resolver for Node at node().
+ ?trace({exchange_ops, {node,Node}, {ops,Ops},{resolved,Resolved},
+ {mytag,MyTag}}),
+ S = trace_message(S0, {exit_resolver, Node}, [MyTag]),
+ case get({sync_tag_my, Node}) of
+ MyTag ->
+ Known = S#state.known,
+ gen_server:cast({global_name_server, Node},
+ {resolved, node(), Resolved, Known,
+ Known,get_names_ext(),get({sync_tag_his,Node})}),
+ case get({save_ops, Node}) of
+ {resolved, HisKnown, Names_ext, HisResolved} ->
+ put({save_ops, Node}, Ops),
+ NewS = resolved(Node, HisResolved, HisKnown, Names_ext,S),
+ {noreply, NewS};
+ undefined ->
+ put({save_ops, Node}, Ops),
+ {noreply, S}
+ end;
+ _ -> %% Illegal tag, delete the old sync session.
+ NewS = cancel_locker(Node, S, MyTag),
+ {noreply, NewS}
+ end;
+
+%%========================================================================
+%% resolved
+%%
+%% Here the name clashes are resolved.
+%%========================================================================
+handle_cast({resolved, Node, HisResolved, HisKnown, _HisKnown_v2,
+ Names_ext, MyTag}, S) ->
+ %% Sent from global_name_server at Node.
+ ?trace({'####', resolved, {his_resolved,HisResolved}, {node,Node}}),
+ case get({sync_tag_my, Node}) of
+ MyTag ->
+ %% See the comment at handle_case({exchange_ops, ...}).
+ case get({save_ops, Node}) of
+ Ops when is_list(Ops) ->
+ NewS = resolved(Node, HisResolved, HisKnown, Names_ext, S),
+ {noreply, NewS};
+ undefined ->
+ Resolved = {resolved, HisKnown, Names_ext, HisResolved},
+ put({save_ops, Node}, Resolved),
+ {noreply, S}
+ end;
+ _ -> %% Illegal tag, delete the old sync session.
+ NewS = cancel_locker(Node, S, MyTag),
+ {noreply, NewS}
+ end;
+
+%%========================================================================
+%% new_nodes
+%%
+%% We get to know the other node's known nodes.
+%%========================================================================
+handle_cast({new_nodes, Node, Ops, Names_ext, Nodes, ExtraInfo}, S) ->
+ %% Sent from global_name_server at Node.
+ ?trace({new_nodes, {node,Node},{ops,Ops},{nodes,Nodes},{x,ExtraInfo}}),
+ NewS = new_nodes(Ops, Node, Names_ext, Nodes, ExtraInfo, S),
+ {noreply, NewS};
+
+%%========================================================================
+%% in_sync
+%%
+%% We are in sync with this node (from the other node's known world).
+%%========================================================================
+handle_cast({in_sync, Node, _IsKnown}, S) ->
+ %% Sent from global_name_server at Node (in the other partition).
+ ?trace({'####', in_sync, {Node, _IsKnown}}),
+ lists:foreach(fun(Pid) -> Pid ! {synced, [Node]} end, S#state.syncers),
+ NewS = cancel_locker(Node, S, get({sync_tag_my, Node})),
+ reset_node_state(Node),
+ NSynced = case lists:member(Node, Synced = NewS#state.synced) of
+ true -> Synced;
+ false -> [Node | Synced]
+ end,
+ {noreply, NewS#state{synced = NSynced}};
+
+%% Called when Pid on other node crashed
+handle_cast({async_del_name, _Name, _Pid}, S) ->
+ %% Sent from the_deleter at some node in the partition but node().
+ %% The DOWN message deletes the name.
+ {noreply, S};
+
+handle_cast({async_del_lock, _ResourceId, _Pid}, S) ->
+ %% Sent from global_name_server at some node in the partition but node().
+ %% The DOWN message deletes the lock.
+ {noreply, S};
+
+handle_cast(Request, S) ->
+ error_logger:warning_msg("The global_name_server "
+ "received an unexpected message:\n"
+ "handle_cast(~p, _)\n", [Request]),
+ {noreply, S}.
+
+handle_info({'EXIT', Deleter, _Reason}=Exit, #state{the_deleter=Deleter}=S) ->
+ {stop, {deleter_died,Exit}, S#state{the_deleter=undefined}};
+handle_info({'EXIT', Locker, _Reason}=Exit, #state{the_locker=Locker}=S) ->
+ {stop, {locker_died,Exit}, S#state{the_locker=undefined}};
+handle_info({'EXIT', Registrar, _}=Exit, #state{the_registrar=Registrar}=S) ->
+ {stop, {registrar_died,Exit}, S#state{the_registrar=undefined}};
+handle_info({'EXIT', Pid, _Reason}, S) when is_pid(Pid) ->
+ ?trace({global_EXIT,_Reason,Pid}),
+ %% The process that died was a synch process started by start_sync
+ %% or a registered process running on an external node (C-node).
+ %% Links to external names are ignored here (there are also DOWN
+ %% signals).
+ Syncers = lists:delete(Pid, S#state.syncers),
+ {noreply, S#state{syncers = Syncers}};
+
+handle_info({nodedown, Node}, S) when Node =:= S#state.node_name ->
+ %% Somebody stopped the distribution dynamically - change
+ %% references to old node name (Node) to new node name ('nonode@nohost')
+ {noreply, change_our_node_name(node(), S)};
+
+handle_info({nodedown, Node}, S0) ->
+ ?trace({'####', nodedown, {node,Node}}),
+ S1 = trace_message(S0, {nodedown, Node}, []),
+ S = handle_nodedown(Node, S1),
+ {noreply, S};
+
+handle_info({extra_nodedown, Node}, S0) ->
+ ?trace({'####', extra_nodedown, {node,Node}}),
+ S1 = trace_message(S0, {extra_nodedown, Node}, []),
+ S = handle_nodedown(Node, S1),
+ {noreply, S};
+
+handle_info({nodeup, Node}, S) when Node =:= node() ->
+ ?trace({'####', local_nodeup, {node, Node}}),
+ %% Somebody started the distribution dynamically - change
+ %% references to old node name ('nonode@nohost') to Node.
+ {noreply, change_our_node_name(Node, S)};
+
+handle_info({nodeup, _Node}, S) when not S#state.connect_all ->
+ {noreply, S};
+
+handle_info({nodeup, Node}, S0) when S0#state.connect_all ->
+ IsKnown = lists:member(Node, S0#state.known) or
+ %% This one is only for double nodeups (shouldn't occur!)
+ lists:keymember(Node, 1, S0#state.resolvers),
+ ?trace({'####', nodeup, {node,Node}, {isknown,IsKnown}}),
+ S1 = trace_message(S0, {nodeup, Node}, []),
+ case IsKnown of
+ true ->
+ {noreply, S1};
+ false ->
+ resend_pre_connect(Node),
+
+ %% now() is used as a tag to separate different synch sessions
+ %% from each others. Global could be confused at bursty nodeups
+ %% because it couldn't separate the messages between the different
+ %% synch sessions started by a nodeup.
+ MyTag = now(),
+ put({sync_tag_my, Node}, MyTag),
+ ?trace({sending_nodeup_to_locker, {node,Node},{mytag,MyTag}}),
+ S1#state.the_locker ! {nodeup, Node, MyTag},
+
+ %% In order to be compatible with unpatched R7 a locker
+ %% process was spawned. Vsn 5 is no longer compatible with
+ %% vsn 3 nodes, so the locker process is no longer needed.
+ %% The permanent locker takes its place.
+ NotAPid = no_longer_a_pid,
+ Locker = {locker, NotAPid, S1#state.known, S1#state.the_locker},
+ InitC = {init_connect, {?vsn, MyTag}, node(), Locker},
+ Rs = S1#state.resolvers,
+ ?trace({casting_init_connect, {node,Node},{initmessage,InitC},
+ {resolvers,Rs}}),
+ gen_server:cast({global_name_server, Node}, InitC),
+ Resolver = start_resolver(Node, MyTag),
+ S = trace_message(S1, {new_resolver, Node}, [MyTag, Resolver]),
+ {noreply, S#state{resolvers = [{Node, MyTag, Resolver} | Rs]}}
+ end;
+
+handle_info({whereis, Name, From}, S) ->
+ do_whereis(Name, From),
+ {noreply, S};
+
+handle_info(known, S) ->
+ io:format(">>>> ~p\n",[S#state.known]),
+ {noreply, S};
+
+%% "High level trace". For troubleshooting only.
+handle_info(high_level_trace, S) ->
+ case S of
+ #state{trace = [{Node, _Time, _M, Nodes, _X} | _]} ->
+ send_high_level_trace(),
+ CNode = node(),
+ CNodes = nodes(),
+ case {CNode, CNodes} of
+ {Node, Nodes} ->
+ {noreply, S};
+ _ ->
+ {New, _, Old} =
+ sofs:symmetric_partition(sofs:set([CNode|CNodes]),
+ sofs:set([Node|Nodes])),
+ M = {nodes_changed, {sofs:to_external(New),
+ sofs:to_external(Old)}},
+ {noreply, trace_message(S, M, [])}
+ end;
+ _ ->
+ {noreply, S}
+ end;
+handle_info({trace_message, M}, S) ->
+ {noreply, trace_message(S, M, [])};
+handle_info({trace_message, M, X}, S) ->
+ {noreply, trace_message(S, M, X)};
+
+handle_info({'DOWN', MonitorRef, process, _Pid, _Info}, S0) ->
+ S1 = delete_lock(MonitorRef, S0),
+ S = del_name(MonitorRef, S1),
+ {noreply, S};
+
+handle_info(Message, S) ->
+ error_logger:warning_msg("The global_name_server "
+ "received an unexpected message:\n"
+ "handle_info(~p, _)\n", [Message]),
+ {noreply, S}.
+
+
+%%========================================================================
+%%========================================================================
+%%=============================== Internal Functions =====================
+%%========================================================================
+%%========================================================================
+
+-define(HIGH_LEVEL_TRACE_INTERVAL, 500). % ms
+
+wait_high_level_trace() ->
+ receive
+ high_level_trace ->
+ ok
+ after ?HIGH_LEVEL_TRACE_INTERVAL+1 ->
+ ok
+ end.
+
+send_high_level_trace() ->
+ erlang:send_after(?HIGH_LEVEL_TRACE_INTERVAL, self(), high_level_trace).
+
+-define(GLOBAL_RID, global).
+
+%% Similar to trans(Id, Fun), but always uses global's own lock
+%% on all nodes known to global, making sure that no new nodes have
+%% become known while we got the list of known nodes.
+trans_all_known(Fun) ->
+ Id = {?GLOBAL_RID, self()},
+ Nodes = set_lock_known(Id, 0),
+ try
+ Fun(Nodes)
+ after
+ delete_global_lock(Id, Nodes)
+ end.
+
+set_lock_known(Id, Times) ->
+ Known = get_known(),
+ Nodes = [node() | Known],
+ Boss = the_boss(Nodes),
+ %% Use the same convention (a boss) as lock_nodes_safely. Optimization.
+ case set_lock_on_nodes(Id, [Boss]) of
+ true ->
+ case lock_on_known_nodes(Id, Known, Nodes) of
+ true ->
+ Nodes;
+ false ->
+ del_lock(Id, [Boss]),
+ random_sleep(Times),
+ set_lock_known(Id, Times+1)
+ end;
+ false ->
+ random_sleep(Times),
+ set_lock_known(Id, Times+1)
+ end.
+
+lock_on_known_nodes(Id, Known, Nodes) ->
+ case set_lock_on_nodes(Id, Nodes) of
+ true ->
+ (get_known() -- Known) =:= [];
+ false ->
+ false
+ end.
+
+set_lock_on_nodes(_Id, []) ->
+ true;
+set_lock_on_nodes(Id, Nodes) ->
+ case local_lock_check(Id, Nodes) of
+ true ->
+ Msg = {set_lock, Id},
+ {Replies, _} =
+ gen_server:multi_call(Nodes, global_name_server, Msg),
+ ?trace({set_lock,{me,self()},Id,{nodes,Nodes},{replies,Replies}}),
+ check_replies(Replies, Id, Replies);
+ false=Reply ->
+ Reply
+ end.
+
+%% Probe lock on local node to see if one should go on trying other nodes.
+local_lock_check(_Id, [_] = _Nodes) ->
+ true;
+local_lock_check(Id, Nodes) ->
+ not lists:member(node(), Nodes) orelse (can_set_lock(Id) =/= false).
+
+check_replies([{_Node, true} | T], Id, Replies) ->
+ check_replies(T, Id, Replies);
+check_replies([{_Node, false=Reply} | _T], _Id, [_]) ->
+ Reply;
+check_replies([{_Node, false=Reply} | _T], Id, Replies) ->
+ TrueReplyNodes = [N || {N, true} <- Replies],
+ ?trace({check_replies, {true_reply_nodes, TrueReplyNodes}}),
+ gen_server:multi_call(TrueReplyNodes, global_name_server, {del_lock, Id}),
+ Reply;
+check_replies([], _Id, _Replies) ->
+ true.
+
+%%========================================================================
+%% Another node wants to synchronize its registered names with us.
+%% Both nodes must have a lock before they are allowed to continue.
+%%========================================================================
+init_connect(Vsn, Node, InitMsg, HisTag, Resolvers, S) ->
+ %% It is always the responsibility of newer versions to understand
+ %% older versions of the protocol.
+ put({prot_vsn, Node}, Vsn),
+ put({sync_tag_his, Node}, HisTag),
+ case lists:keyfind(Node, 1, Resolvers) of
+ {Node, MyTag, _Resolver} ->
+ MyTag = get({sync_tag_my, Node}), % assertion
+ {locker, _NoLongerAPid, _HisKnown0, HisTheLocker} = InitMsg,
+ ?trace({init_connect,{histhelocker,HisTheLocker}}),
+ HisKnown = [],
+ S#state.the_locker ! {his_the_locker, HisTheLocker,
+ {Vsn,HisKnown}, S#state.known};
+ false ->
+ ?trace({init_connect,{pre_connect,Node},{histag,HisTag}}),
+ put({pre_connect, Node}, {Vsn, InitMsg, HisTag})
+ end.
+
+%%========================================================================
+%% In the simple case, we'll get lock_is_set before we get exchange,
+%% but we may get exchange before we get lock_is_set from our locker.
+%% If that's the case, we'll have to remember the exchange info, and
+%% handle it when we get the lock_is_set. We do this by using the
+%% process dictionary - when the lock_is_set msg is received, we store
+%% this info. When exchange is received, we can check the dictionary
+%% if the lock_is_set has been received. If not, we store info about
+%% the exchange instead. In the lock_is_set we must first check if
+%% exchange info is stored, in that case we take care of it.
+%%========================================================================
+lock_is_set(Node, Resolvers, LockId) ->
+ gen_server:cast({global_name_server, Node},
+ {exchange, node(), get_names(), _ExtNames = [],
+ get({sync_tag_his, Node})}),
+ put({lock_id, Node}, LockId),
+ %% If both have the lock, continue with exchange.
+ case get({wait_lock, Node}) of
+ {exchange, NameList} ->
+ put({wait_lock, Node}, lock_is_set),
+ exchange(Node, NameList, Resolvers);
+ undefined ->
+ put({wait_lock, Node}, lock_is_set)
+ end.
+
+%%========================================================================
+%% exchange
+%%========================================================================
+exchange(Node, NameList, Resolvers) ->
+ ?trace({'####', exchange, {node,Node}, {namelist,NameList},
+ {resolvers, Resolvers}}),
+ case erase({wait_lock, Node}) of
+ lock_is_set ->
+ {Node, _Tag, Resolver} = lists:keyfind(Node, 1, Resolvers),
+ Resolver ! {resolve, NameList, Node};
+ undefined ->
+ put({wait_lock, Node}, {exchange, NameList})
+ end.
+
+resolved(Node, HisResolved, HisKnown, Names_ext, S0) ->
+ Ops = erase({save_ops, Node}) ++ HisResolved,
+ %% Known may have shrunk since the lock was taken (due to nodedowns).
+ Known = S0#state.known,
+ Synced = S0#state.synced,
+ NewNodes = [Node | HisKnown],
+ sync_others(HisKnown),
+ ExtraInfo = [{vsn,get({prot_vsn, Node})}, {lock, get({lock_id, Node})}],
+ S = do_ops(Ops, node(), Names_ext, ExtraInfo, S0),
+ %% I am synced with Node, but not with HisKnown yet
+ lists:foreach(fun(Pid) -> Pid ! {synced, [Node]} end, S#state.syncers),
+ S3 = lists:foldl(fun(Node1, S1) ->
+ F = fun(Tag) -> cancel_locker(Node1,S1,Tag) end,
+ cancel_resolved_locker(Node1, F)
+ end, S, HisKnown),
+ %% The locker that took the lock is asked to send
+ %% the {new_nodes, ...} message. This ensures that
+ %% {del_lock, ...} is received after {new_nodes, ...}
+ %% (except when abcast spawns process(es)...).
+ NewNodesF = fun() ->
+ gen_server:abcast(Known, global_name_server,
+ {new_nodes, node(), Ops, Names_ext,
+ NewNodes, ExtraInfo})
+ end,
+ F = fun(Tag) -> cancel_locker(Node, S3, Tag, NewNodesF) end,
+ S4 = cancel_resolved_locker(Node, F),
+ %% See (*) below... we're node b in that description
+ AddedNodes = (NewNodes -- Known),
+ NewKnown = Known ++ AddedNodes,
+ S4#state.the_locker ! {add_to_known, AddedNodes},
+ NewS = trace_message(S4, {added, AddedNodes},
+ [{new_nodes, NewNodes}, {abcast, Known}, {ops,Ops}]),
+ NewS#state{known = NewKnown, synced = [Node | Synced]}.
+
+cancel_resolved_locker(Node, CancelFun) ->
+ Tag = get({sync_tag_my, Node}),
+ ?trace({calling_cancel_locker,Tag,get()}),
+ S = CancelFun(Tag),
+ reset_node_state(Node),
+ S.
+
+new_nodes(Ops, ConnNode, Names_ext, Nodes, ExtraInfo, S0) ->
+ Known = S0#state.known,
+ %% (*) This one requires some thought...
+ %% We're node a, other nodes b and c:
+ %% The problem is that {in_sync, a} may arrive before {resolved, [a]} to
+ %% b from c, leading to b sending {new_nodes, [a]} to us (node a).
+ %% Therefore, we make sure we never get duplicates in Known.
+ AddedNodes = lists:delete(node(), Nodes -- Known),
+ sync_others(AddedNodes),
+ S = do_ops(Ops, ConnNode, Names_ext, ExtraInfo, S0),
+ ?trace({added_nodes_in_sync,{added_nodes,AddedNodes}}),
+ S#state.the_locker ! {add_to_known, AddedNodes},
+ S1 = trace_message(S, {added, AddedNodes}, [{ops,Ops}]),
+ S1#state{known = Known ++ AddedNodes}.
+
+do_whereis(Name, From) ->
+ case is_global_lock_set() of
+ false ->
+ gen_server:reply(From, where(Name));
+ true ->
+ send_again({whereis, Name, From})
+ end.
+
+terminate(_Reason, _S) ->
+ true = ets:delete(global_names),
+ true = ets:delete(global_names_ext),
+ true = ets:delete(global_locks),
+ true = ets:delete(global_pid_names),
+ true = ets:delete(global_pid_ids).
+
+code_change(_OldVsn, S, _Extra) ->
+ {ok, S}.
+
+%% The resolver runs exchange_names in a separate process. The effect
+%% is that locks can be used at the same time as name resolution takes
+%% place.
+start_resolver(Node, MyTag) ->
+ spawn(fun() -> resolver(Node, MyTag) end).
+
+resolver(Node, Tag) ->
+ receive
+ {resolve, NameList, Node} ->
+ ?trace({resolver, {me,self()}, {node,Node}, {namelist,NameList}}),
+ {Ops, Resolved} = exchange_names(NameList, Node, [], []),
+ Exchange = {exchange_ops, Node, Tag, Ops, Resolved},
+ gen_server:cast(global_name_server, Exchange),
+ exit(normal);
+ _ -> % Ignore garbage.
+ resolver(Node, Tag)
+ end.
+
+resend_pre_connect(Node) ->
+ case erase({pre_connect, Node}) of
+ {Vsn, InitMsg, HisTag} ->
+ gen_server:cast(self(),
+ {init_connect, {Vsn, HisTag}, Node, InitMsg});
+ _ ->
+ ok
+ end.
+
+ins_name(Name, Pid, Method, FromPidOrNode, ExtraInfo, S0) ->
+ ?trace({ins_name,insert,{name,Name},{pid,Pid}}),
+ S1 = delete_global_name_keep_pid(Name, S0),
+ S = trace_message(S1, {ins_name, node(Pid)}, [Name, Pid]),
+ insert_global_name(Name, Pid, Method, FromPidOrNode, ExtraInfo, S).
+
+ins_name_ext(Name, Pid, Method, RegNode, FromPidOrNode, ExtraInfo, S0) ->
+ ?trace({ins_name_ext, {name,Name}, {pid,Pid}}),
+ S1 = delete_global_name_keep_pid(Name, S0),
+ dolink_ext(Pid, RegNode),
+ S = trace_message(S1, {ins_name_ext, node(Pid)}, [Name, Pid]),
+ true = ets:insert(global_names_ext, {Name, Pid, RegNode}),
+ insert_global_name(Name, Pid, Method, FromPidOrNode, ExtraInfo, S).
+
+where(Name) ->
+ case ets:lookup(global_names, Name) of
+ [{_Name, Pid, _Method, _RPid, _Ref}] -> Pid;
+ [] -> undefined
+ end.
+
+handle_set_lock(Id, Pid, S) ->
+ ?trace({handle_set_lock, Id, Pid}),
+ case can_set_lock(Id) of
+ {true, PidRefs} ->
+ case pid_is_locking(Pid, PidRefs) of
+ true ->
+ {true, S};
+ false ->
+ {true, insert_lock(Id, Pid, PidRefs, S)}
+ end;
+ false=Reply ->
+ {Reply, S}
+ end.
+
+can_set_lock({ResourceId, LockRequesterId}) ->
+ case ets:lookup(global_locks, ResourceId) of
+ [{ResourceId, LockRequesterId, PidRefs}] ->
+ {true, PidRefs};
+ [{ResourceId, _LockRequesterId2, _PidRefs}] ->
+ false;
+ [] ->
+ {true, []}
+ end.
+
+insert_lock({ResourceId, LockRequesterId}=Id, Pid, PidRefs, S) ->
+ {RPid, Ref} = do_monitor(Pid),
+ true = ets:insert(global_pid_ids, {Pid, ResourceId}),
+ true = ets:insert(global_pid_ids, {Ref, ResourceId}),
+ Lock = {ResourceId, LockRequesterId, [{Pid,RPid,Ref} | PidRefs]},
+ true = ets:insert(global_locks, Lock),
+ trace_message(S, {ins_lock, node(Pid)}, [Id, Pid]).
+
+is_global_lock_set() ->
+ is_lock_set(?GLOBAL_RID).
+
+is_lock_set(ResourceId) ->
+ ets:member(global_locks, ResourceId).
+
+handle_del_lock({ResourceId, LockReqId}, Pid, S0) ->
+ ?trace({handle_del_lock, {pid,Pid},{id,{ResourceId, LockReqId}}}),
+ case ets:lookup(global_locks, ResourceId) of
+ [{ResourceId, LockReqId, PidRefs}]->
+ remove_lock(ResourceId, LockReqId, Pid, PidRefs, false, S0);
+ _ -> S0
+ end.
+
+remove_lock(ResourceId, LockRequesterId, Pid, [{Pid,RPid,Ref}], Down, S0) ->
+ ?trace({remove_lock_1, {id,ResourceId},{pid,Pid}}),
+ true = erlang:demonitor(Ref, [flush]),
+ kill_monitor_proc(RPid, Pid),
+ true = ets:delete(global_locks, ResourceId),
+ true = ets:delete_object(global_pid_ids, {Pid, ResourceId}),
+ true = ets:delete_object(global_pid_ids, {Ref, ResourceId}),
+ S = case ResourceId of
+ ?GLOBAL_RID -> S0#state{global_lock_down = Down};
+ _ -> S0
+ end,
+ trace_message(S, {rem_lock, node(Pid)},
+ [{ResourceId, LockRequesterId}, Pid]);
+remove_lock(ResourceId, LockRequesterId, Pid, PidRefs0, _Down, S) ->
+ ?trace({remove_lock_2, {id,ResourceId},{pid,Pid}}),
+ PidRefs = case lists:keyfind(Pid, 1, PidRefs0) of
+ {Pid, RPid, Ref} ->
+ true = erlang:demonitor(Ref, [flush]),
+ kill_monitor_proc(RPid, Pid),
+ true = ets:delete_object(global_pid_ids,
+ {Ref, ResourceId}),
+ lists:keydelete(Pid, 1, PidRefs0);
+ false ->
+ PidRefs0
+ end,
+ Lock = {ResourceId, LockRequesterId, PidRefs},
+ true = ets:insert(global_locks, Lock),
+ true = ets:delete_object(global_pid_ids, {Pid, ResourceId}),
+ trace_message(S, {rem_lock, node(Pid)},
+ [{ResourceId, LockRequesterId}, Pid]).
+
+kill_monitor_proc(Pid, Pid) ->
+ ok;
+kill_monitor_proc(RPid, _Pid) ->
+ exit(RPid, kill).
+
+do_ops(Ops, ConnNode, Names_ext, ExtraInfo, S0) ->
+ ?trace({do_ops, {ops,Ops}}),
+
+ XInserts = [{Name, Pid, RegNode, Method} ||
+ {Name2, Pid2, RegNode} <- Names_ext,
+ {insert, {Name, Pid, Method}} <- Ops,
+ Name =:= Name2, Pid =:= Pid2],
+ S1 = lists:foldl(fun({Name, Pid, RegNode, Method}, S1) ->
+ ins_name_ext(Name, Pid, Method, RegNode,
+ ConnNode, ExtraInfo, S1)
+ end, S0, XInserts),
+
+ XNames = [Name || {Name, _Pid, _RegNode, _Method} <- XInserts],
+ Inserts = [{Name, Pid, node(Pid), Method} ||
+ {insert, {Name, Pid, Method}} <- Ops,
+ not lists:member(Name, XNames)],
+ S2 = lists:foldl(fun({Name, Pid, _RegNode, Method}, S2) ->
+ ins_name(Name, Pid, Method, ConnNode,
+ ExtraInfo, S2)
+ end, S1, Inserts),
+
+ DelNames = [Name || {delete, Name} <- Ops],
+ lists:foldl(fun(Name, S) -> delete_global_name2(Name, S)
+ end, S2, DelNames).
+
+%% It is possible that a node that was up and running when the
+%% operations were assembled has since died. The final {in_sync,...}
+%% messages do not generate nodedown messages for such nodes. To
+%% compensate "artificial" nodedown messages are created. Since
+%% monitor_node may take some time processes are spawned to avoid
+%% locking up the global_name_server. Should somehow double nodedown
+%% messages occur (one of them artificial), nothing bad can happen
+%% (the second nodedown is a no-op). It is assumed that there cannot
+%% be a nodeup before the artificial nodedown.
+%%
+%% The extra nodedown messages generated here also take care of the
+%% case that a nodedown message is received _before_ the operations
+%% are run.
+sync_others(Nodes) ->
+ N = case application:get_env(kernel, ?N_CONNECT_RETRIES) of
+ {ok, NRetries} when is_integer(NRetries),
+ NRetries >= 0 -> NRetries;
+ _ -> ?DEFAULT_N_CONNECT_RETRIES
+ end,
+ lists:foreach(fun(Node) ->
+ spawn(fun() -> sync_other(Node, N) end)
+ end, Nodes).
+
+sync_other(Node, N) ->
+ erlang:monitor_node(Node, true, [allow_passive_connect]),
+ receive
+ {nodedown, Node} when N > 0 ->
+ sync_other(Node, N - 1);
+ {nodedown, Node} ->
+ ?trace({missing_nodedown, {node, Node}}),
+ error_logger:warning_msg("global: ~w failed to connect to ~w\n",
+ [node(), Node]),
+ global_name_server ! {extra_nodedown, Node}
+ after 0 ->
+ gen_server:cast({global_name_server,Node}, {in_sync,node(),true})
+ end.
+ % monitor_node(Node, false),
+ % exit(normal).
+
+insert_global_name(Name, Pid, Method, FromPidOrNode, ExtraInfo, S) ->
+ {RPid, Ref} = do_monitor(Pid),
+ true = ets:insert(global_names, {Name, Pid, Method, RPid, Ref}),
+ true = ets:insert(global_pid_names, {Pid, Name}),
+ true = ets:insert(global_pid_names, {Ref, Name}),
+ case lock_still_set(FromPidOrNode, ExtraInfo, S) of
+ true ->
+ S;
+ false ->
+ %% The node that took the lock has gone down and then up
+ %% again. The {register, ...} or {new_nodes, ...} message
+ %% was delayed and arrived after nodeup (maybe it caused
+ %% the nodeup). The DOWN signal from the monitor of the
+ %% lock has removed the lock.
+ %% Note: it is assumed here that the DOWN signal arrives
+ %% _before_ nodeup and any message that caused nodeup.
+ %% This is true of Erlang/OTP.
+ delete_global_name2(Name, S)
+ end.
+
+lock_still_set(PidOrNode, ExtraInfo, S) ->
+ case ets:lookup(global_locks, ?GLOBAL_RID) of
+ [{?GLOBAL_RID, _LockReqId, PidRefs}] when is_pid(PidOrNode) ->
+ %% Name registration.
+ lists:keymember(PidOrNode, 1, PidRefs);
+ [{?GLOBAL_RID, LockReqId, PidRefs}] when is_atom(PidOrNode) ->
+ case extra_info(lock, ExtraInfo) of
+ {?GLOBAL_RID, LockId} -> % R11B-4 or later
+ LockReqId =:= LockId;
+ undefined ->
+ lock_still_set_old(PidOrNode, LockReqId, PidRefs)
+ end;
+ [] ->
+ %% If the global lock was not removed by a DOWN message
+ %% then we have a node that do not monitor locking pids
+ %% (pre R11B-3), or an R11B-3 node (which does not ensure
+ %% that {new_nodes, ...} arrives before {del_lock, ...}).
+ not S#state.global_lock_down
+ end.
+
+%%% The following is probably overkill. It is possible that this node
+%%% has been locked again, but it is a rare occasion.
+lock_still_set_old(_Node, ReqId, _PidRefs) when is_pid(ReqId) ->
+ %% Cannot do better than return true.
+ true;
+lock_still_set_old(Node, ReqId, PidRefs) when is_list(ReqId) ->
+ %% Connection, version > 4, but before R11B-4.
+ [P || {P, _RPid, _Ref} <- PidRefs, node(P) =:= Node] =/= [].
+
+extra_info(Tag, ExtraInfo) ->
+ %% ExtraInfo used to be a list of nodes (vsn 2).
+ case catch lists:keyfind(Tag, 1, ExtraInfo) of
+ {Tag, Info} ->
+ Info;
+ _ ->
+ undefined
+ end.
+
+del_name(Ref, S) ->
+ NameL = [{Name, Pid} ||
+ {_, Name} <- ets:lookup(global_pid_names, Ref),
+ {_, Pid, _Method, _RPid, Ref1} <-
+ ets:lookup(global_names, Name),
+ Ref1 =:= Ref],
+ ?trace({async_del_name, self(), NameL, Ref}),
+ case NameL of
+ [{Name, Pid}] ->
+ _ = del_names(Name, Pid, S),
+ delete_global_name2(Name, S);
+ [] ->
+ S
+ end.
+
+%% Send {async_del_name, ...} to old nodes (pre R11B-3).
+del_names(Name, Pid, S) ->
+ Send = case ets:lookup(global_names_ext, Name) of
+ [{Name, Pid, RegNode}] ->
+ RegNode =:= node();
+ [] ->
+ node(Pid) =:= node()
+ end,
+ if
+ Send ->
+ ?trace({del_names, {pid,Pid}, {name,Name}}),
+ S#state.the_deleter ! {delete_name, self(), Name, Pid};
+ true ->
+ ok
+ end.
+
+%% Keeps the entry in global_names for whereis_name/1.
+delete_global_name_keep_pid(Name, S) ->
+ case ets:lookup(global_names, Name) of
+ [{Name, Pid, _Method, RPid, Ref}] ->
+ delete_global_name2(Name, Pid, RPid, Ref, S);
+ [] ->
+ S
+ end.
+
+delete_global_name2(Name, S) ->
+ case ets:lookup(global_names, Name) of
+ [{Name, Pid, _Method, RPid, Ref}] ->
+ true = ets:delete(global_names, Name),
+ delete_global_name2(Name, Pid, RPid, Ref, S);
+ [] ->
+ S
+ end.
+
+delete_global_name2(Name, Pid, RPid, Ref, S) ->
+ true = erlang:demonitor(Ref, [flush]),
+ kill_monitor_proc(RPid, Pid),
+ delete_global_name(Name, Pid),
+ ?trace({delete_global_name,{item,Name},{pid,Pid}}),
+ true = ets:delete_object(global_pid_names, {Pid, Name}),
+ true = ets:delete_object(global_pid_names, {Ref, Name}),
+ case ets:lookup(global_names_ext, Name) of
+ [{Name, Pid, RegNode}] ->
+ true = ets:delete(global_names_ext, Name),
+ ?trace({delete_global_name, {name,Name,{pid,Pid},{RegNode,Pid}}}),
+ dounlink_ext(Pid, RegNode);
+ [] ->
+ ?trace({delete_global_name,{name,Name,{pid,Pid},{node(Pid),Pid}}}),
+ ok
+ end,
+ trace_message(S, {del_name, node(Pid)}, [Name, Pid]).
+
+%% delete_global_name/2 is traced by the inviso application.
+%% Do not change.
+delete_global_name(_Name, _Pid) ->
+ ok.
+
+%%-----------------------------------------------------------------
+%% The locker is a satellite process to global_name_server. When a
+%% nodeup is received from a new node the global_name_server sends a
+%% message to the locker. The locker tries to set a lock in our
+%% partition, i.e. on all nodes known to us. When the lock is set, it
+%% tells global_name_server about it, and keeps the lock set.
+%% global_name_server sends a cancel message to the locker when the
+%% partitions are connected.
+
+%% There are two versions of the protocol between lockers on two nodes:
+%% Version 1: used by unpatched R7.
+%% Version 2: the messages exchanged between the lockers include the known
+%% nodes (see OTP-3576).
+%%-----------------------------------------------------------------
+
+-define(locker_vsn, 2).
+
+-record(multi,
+ {local = [], % Requests from nodes on the local host.
+ remote = [], % Other requests.
+ known = [], % Copy of global_name_server's known nodes. It's
+ % faster to keep a copy of known than asking
+ % for it when needed.
+ the_boss, % max([node() | 'known'])
+ just_synced = false, % true if node() synced just a moment ago
+ %% Statistics:
+ do_trace % bool()
+ }).
+
+-record(him, {node, locker, vsn, my_tag}).
+
+start_the_locker(DoTrace) ->
+ spawn_link(fun() -> init_the_locker(DoTrace) end).
+
+init_the_locker(DoTrace) ->
+ process_flag(trap_exit, true), % needed?
+ S0 = #multi{do_trace = DoTrace},
+ S1 = update_locker_known({add, get_known()}, S0),
+ loop_the_locker(S1),
+ erlang:error(locker_exited).
+
+loop_the_locker(S) ->
+ ?trace({loop_the_locker,S}),
+ receive
+ Message when element(1, Message) =/= nodeup ->
+ the_locker_message(Message, S)
+ after 0 ->
+ Timeout =
+ case {S#multi.local, S#multi.remote} of
+ {[],[]} ->
+ infinity;
+ _ ->
+ %% It is important that the timeout is greater
+ %% than zero, or the chance that some other node
+ %% in the partition sets the lock once this node
+ %% has failed after setting the lock is very slim.
+ if
+ S#multi.just_synced ->
+ 0; % no reason to wait after success
+ S#multi.known =:= [] ->
+ 200; % just to get started
+ true ->
+ erlang:min(1000 + 100*length(S#multi.known),
+ 3000)
+ end
+ end,
+ S1 = S#multi{just_synced = false},
+ receive
+ Message when element(1, Message) =/= nodeup ->
+ the_locker_message(Message, S1)
+ after Timeout ->
+ case is_global_lock_set() of
+ true ->
+ loop_the_locker(S1);
+ false ->
+ select_node(S1)
+ end
+ end
+ end.
+
+the_locker_message({his_the_locker, HisTheLocker, HisKnown0, _MyKnown}, S) ->
+ ?trace({his_the_locker, HisTheLocker, {node,node(HisTheLocker)}}),
+ {HisVsn, _HisKnown} = HisKnown0,
+ true = HisVsn > 4,
+ receive
+ {nodeup, Node, MyTag} when node(HisTheLocker) =:= Node ->
+ ?trace({the_locker_nodeup, {node,Node},{mytag,MyTag}}),
+ Him = #him{node = node(HisTheLocker), my_tag = MyTag,
+ locker = HisTheLocker, vsn = HisVsn},
+ loop_the_locker(add_node(Him, S));
+ {cancel, Node, _Tag, no_fun} when node(HisTheLocker) =:= Node ->
+ loop_the_locker(S)
+ after 60000 ->
+ ?trace({nodeupnevercame, node(HisTheLocker)}),
+ error_logger:error_msg("global: nodeup never came ~w ~w\n",
+ [node(), node(HisTheLocker)]),
+ loop_the_locker(S#multi{just_synced = false})
+ end;
+the_locker_message({cancel, _Node, undefined, no_fun}, S) ->
+ ?trace({cancel_the_locker, undefined, {node,_Node}}),
+ %% If we actually cancel something when a cancel message with the
+ %% tag 'undefined' arrives, we may be acting on an old nodedown,
+ %% to cancel a new nodeup, so we can't do that.
+ loop_the_locker(S);
+the_locker_message({cancel, Node, Tag, no_fun}, S) ->
+ ?trace({the_locker, cancel, {multi,S}, {tag,Tag},{node,Node}}),
+ receive
+ {nodeup, Node, Tag} ->
+ ?trace({cancelnodeup2, {node,Node},{tag,Tag}}),
+ ok
+ after 0 ->
+ ok
+ end,
+ loop_the_locker(remove_node(Node, S));
+the_locker_message({lock_set, _Pid, false, _}, S) ->
+ ?trace({the_locker, spurious, {node,node(_Pid)}}),
+ loop_the_locker(S);
+the_locker_message({lock_set, Pid, true, _HisKnown}, S) ->
+ Node = node(Pid),
+ ?trace({the_locker, self(), spontaneous, {node,Node}}),
+ case find_node_tag(Node, S) of
+ {true, MyTag, HisVsn} ->
+ LockId = locker_lock_id(Pid, HisVsn),
+ {IsLockSet, S1} = lock_nodes_safely(LockId, [], S),
+ Pid ! {lock_set, self(), IsLockSet, S1#multi.known},
+ Known2 = [node() | S1#multi.known],
+ ?trace({the_locker, spontaneous, {known2, Known2},
+ {node,Node}, {is_lock_set,IsLockSet}}),
+ case IsLockSet of
+ true ->
+ gen_server:cast(global_name_server,
+ {lock_is_set, Node, MyTag, LockId}),
+ ?trace({lock_sync_done, {pid,Pid},
+ {node,node(Pid)}, {me,self()}}),
+ %% Wait for global to tell us to remove lock.
+ %% Should the other locker's node die,
+ %% global_name_server will receive nodedown, and
+ %% then send {cancel, Node, Tag}.
+ receive
+ {cancel, Node, _Tag, Fun} ->
+ ?trace({cancel_the_lock,{node,Node}}),
+ call_fun(Fun),
+ delete_global_lock(LockId, Known2)
+ end,
+ S2 = S1#multi{just_synced = true},
+ loop_the_locker(remove_node(Node, S2));
+ false ->
+ loop_the_locker(S1#multi{just_synced = false})
+ end;
+ false ->
+ ?trace({the_locker, not_there, {node,Node}}),
+ Pid ! {lock_set, self(), false, S#multi.known},
+ loop_the_locker(S)
+ end;
+the_locker_message({add_to_known, Nodes}, S) ->
+ S1 = update_locker_known({add, Nodes}, S),
+ loop_the_locker(S1);
+the_locker_message({remove_from_known, Node}, S) ->
+ S1 = update_locker_known({remove, Node}, S),
+ loop_the_locker(S1);
+the_locker_message({do_trace, DoTrace}, S) ->
+ loop_the_locker(S#multi{do_trace = DoTrace});
+the_locker_message(Other, S) ->
+ unexpected_message(Other, locker),
+ ?trace({the_locker, {other_msg, Other}}),
+ loop_the_locker(S).
+
+%% Requests from nodes on the local host are chosen before requests
+%% from other nodes. This should be a safe optimization.
+select_node(S) ->
+ UseRemote = S#multi.local =:= [],
+ Others1 = if UseRemote -> S#multi.remote; true -> S#multi.local end,
+ Others2 = exclude_known(Others1, S#multi.known),
+ S1 = if
+ UseRemote -> S#multi{remote = Others2};
+ true -> S#multi{local = Others2}
+ end,
+ if
+ Others2 =:= [] ->
+ loop_the_locker(S1);
+ true ->
+ Him = random_element(Others2),
+ #him{locker = HisTheLocker, vsn = HisVsn,
+ node = Node, my_tag = MyTag} = Him,
+ HisNode = [Node],
+ Us = [node() | HisNode],
+ LockId = locker_lock_id(HisTheLocker, HisVsn),
+ ?trace({select_node, self(), {us, Us}}),
+ %% HisNode = [Node] prevents deadlock:
+ {IsLockSet, S2} = lock_nodes_safely(LockId, HisNode, S1),
+ case IsLockSet of
+ true ->
+ Known1 = Us ++ S2#multi.known,
+ ?trace({sending_lock_set, self(), {his,HisTheLocker}}),
+ HisTheLocker ! {lock_set, self(), true, S2#multi.known},
+ S3 = lock_is_set(S2, Him, MyTag, Known1, LockId),
+ loop_the_locker(S3);
+ false ->
+ loop_the_locker(S2)
+ end
+ end.
+
+%% Version 5: Both sides use the same requester id. Thereby the nodes
+%% common to both sides are locked by both locker processes. This
+%% means that the lock is still there when the 'new_nodes' message is
+%% received even if the other side has deleted the lock.
+locker_lock_id(Pid, Vsn) when Vsn > 4 ->
+ {?GLOBAL_RID, lists:sort([self(), Pid])}.
+
+lock_nodes_safely(LockId, Extra, S0) ->
+ %% Locking node() could stop some node that has already locked the
+ %% boss, so just check if it is possible to lock node().
+ First = delete_nonode([S0#multi.the_boss]),
+ case ([node()] =:= First) orelse (can_set_lock(LockId) =/= false) of
+ true ->
+ %% Locking the boss first is an optimization.
+ case set_lock(LockId, First, 0) of
+ true ->
+ S = update_locker_known(S0),
+ %% The boss may have changed, but don't bother.
+ Second = delete_nonode([node() | Extra] -- First),
+ case set_lock(LockId, Second, 0) of
+ true ->
+ Known = S#multi.known,
+ case set_lock(LockId, Known -- First, 0) of
+ true ->
+ _ = locker_trace(S, ok, {First, Known}),
+ {true, S};
+ false ->
+ %% Since the boss is locked we
+ %% should have gotten the lock, at
+ %% least if no one else is locking
+ %% 'global'. Calling set_lock with
+ %% Retries > 0 does not seem to
+ %% speed things up.
+ SoFar = First ++ Second,
+ del_lock(LockId, SoFar),
+ _ = locker_trace(S, not_ok, {Known,SoFar}),
+ {false, S}
+ end;
+ false ->
+ del_lock(LockId, First),
+ _ = locker_trace(S, not_ok, {Second, First}),
+ {false, S}
+ end;
+ false ->
+ _ = locker_trace(S0, not_ok, {First, []}),
+ {false, S0}
+ end;
+ false ->
+ {false, S0}
+ end.
+
+delete_nonode(L) ->
+ lists:delete(nonode@nohost, L).
+
+%% Let the server add timestamp.
+locker_trace(#multi{do_trace = false}, _, _Nodes) ->
+ ok;
+locker_trace(#multi{do_trace = true}, ok, Ns) ->
+ global_name_server ! {trace_message, {locker_succeeded, node()}, Ns};
+locker_trace(#multi{do_trace = true}, not_ok, Ns) ->
+ global_name_server ! {trace_message, {locker_failed, node()}, Ns};
+locker_trace(#multi{do_trace = true}, rejected, Ns) ->
+ global_name_server ! {trace_message, {lock_rejected, node()}, Ns}.
+
+update_locker_known(S) ->
+ receive
+ {add_to_known, Nodes} ->
+ S1 = update_locker_known({add, Nodes}, S),
+ update_locker_known(S1);
+ {remove_from_known, Node} ->
+ S1 = update_locker_known({remove, Node}, S),
+ update_locker_known(S1)
+ after 0 ->
+ S
+ end.
+
+update_locker_known(Upd, S) ->
+ Known = case Upd of
+ {add, Nodes} -> Nodes ++ S#multi.known;
+ {remove, Node} -> lists:delete(Node, S#multi.known)
+ end,
+ TheBoss = the_boss([node() | Known]),
+ S#multi{known = Known, the_boss = TheBoss}.
+
+random_element(L) ->
+ {A,B,C} = now(),
+ E = (A+B+C) rem length(L),
+ lists:nth(E+1, L).
+
+exclude_known(Others, Known) ->
+ [N || N <- Others, not lists:member(N#him.node, Known)].
+
+lock_is_set(S, Him, MyTag, Known1, LockId) ->
+ Node = Him#him.node,
+ receive
+ {lock_set, P, true, _} when node(P) =:= Node ->
+ gen_server:cast(global_name_server,
+ {lock_is_set, Node, MyTag, LockId}),
+ ?trace({lock_sync_done, {p,P, node(P)}, {me,self()}}),
+
+ %% Wait for global to tell us to remove lock. Should the
+ %% other locker's node die, global_name_server will
+ %% receive nodedown, and then send {cancel, Node, Tag, Fun}.
+ receive
+ {cancel, Node, _, Fun} ->
+ ?trace({lock_set_loop, {known1,Known1}}),
+ call_fun(Fun),
+ delete_global_lock(LockId, Known1)
+ end,
+ S#multi{just_synced = true,
+ local = lists:delete(Him, S#multi.local),
+ remote = lists:delete(Him, S#multi.remote)};
+ {lock_set, P, false, _} when node(P) =:= Node ->
+ ?trace({not_both_set, {node,Node},{p, P},{known1,Known1}}),
+ _ = locker_trace(S, rejected, Known1),
+ delete_global_lock(LockId, Known1),
+ S;
+ {cancel, Node, _, Fun} ->
+ ?trace({the_locker, cancel2, {node,Node}}),
+ call_fun(Fun),
+ _ = locker_trace(S, rejected, Known1),
+ delete_global_lock(LockId, Known1),
+ remove_node(Node, S);
+ {'EXIT', _, _} ->
+ ?trace({the_locker, exit, {node,Node}}),
+ _ = locker_trace(S, rejected, Known1),
+ delete_global_lock(LockId, Known1),
+ S
+ %% There used to be an 'after' clause (OTP-4902), but it is
+ %% no longer needed:
+ %% OTP-5770. Version 5 of the protocol. Deadlock can no longer
+ %% occur due to the fact that if a partition is locked, one
+ %% node in the other partition is also locked with the same
+ %% lock-id, which makes it impossible for any node in the
+ %% other partition to lock its partition unless it negotiates
+ %% with the first partition.
+ end.
+
+%% The locker does the {new_nodes, ...} call before removing the lock.
+call_fun(no_fun) ->
+ ok;
+call_fun(Fun) ->
+ Fun().
+
+%% The lock on the boss is removed last. The purpose is to reduce the
+%% risk of failing to lock the known nodes after having locked the
+%% boss. (Assumes the boss occurs only once.)
+delete_global_lock(LockId, Nodes) ->
+ TheBoss = the_boss(Nodes),
+ del_lock(LockId, lists:delete(TheBoss, Nodes)),
+ del_lock(LockId, [TheBoss]).
+
+the_boss(Nodes) ->
+ lists:max(Nodes).
+
+find_node_tag(Node, S) ->
+ case find_node_tag2(Node, S#multi.local) of
+ false ->
+ find_node_tag2(Node, S#multi.remote);
+ Reply ->
+ Reply
+ end.
+
+find_node_tag2(_Node, []) ->
+ false;
+find_node_tag2(Node, [#him{node = Node, my_tag = MyTag, vsn = HisVsn} | _]) ->
+ {true, MyTag, HisVsn};
+find_node_tag2(Node, [_E | Rest]) ->
+ find_node_tag2(Node, Rest).
+
+remove_node(Node, S) ->
+ S#multi{local = remove_node2(Node, S#multi.local),
+ remote = remove_node2(Node, S#multi.remote)}.
+
+remove_node2(_Node, []) ->
+ [];
+remove_node2(Node, [#him{node = Node} | Rest]) ->
+ Rest;
+remove_node2(Node, [E | Rest]) ->
+ [E | remove_node2(Node, Rest)].
+
+add_node(Him, S) ->
+ case is_node_local(Him#him.node) of
+ true ->
+ S#multi{local = [Him | S#multi.local]};
+ false ->
+ S#multi{remote = [Him | S#multi.remote]}
+ end.
+
+is_node_local(Node) ->
+ {ok, Host} = inet:gethostname(),
+ case catch split_node(atom_to_list(Node), $@, []) of
+ [_, Host] ->
+ true;
+ _ ->
+ false
+ end.
+
+split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])];
+split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]);
+split_node([], _, Ack) -> [lists:reverse(Ack)].
+
+cancel_locker(Node, S, Tag) ->
+ cancel_locker(Node, S, Tag, no_fun).
+
+cancel_locker(Node, S, Tag, ToBeRunOnLockerF) ->
+ S#state.the_locker ! {cancel, Node, Tag, ToBeRunOnLockerF},
+ Resolvers = S#state.resolvers,
+ ?trace({cancel_locker, {node,Node},{tag,Tag},
+ {sync_tag_my, get({sync_tag_my, Node})},{resolvers,Resolvers}}),
+ case lists:keyfind(Node, 1, Resolvers) of
+ {_, Tag, Resolver} ->
+ ?trace({{resolver, Resolver}}),
+ exit(Resolver, kill),
+ S1 = trace_message(S, {kill_resolver, Node}, [Tag, Resolver]),
+ S1#state{resolvers = lists:keydelete(Node, 1, Resolvers)};
+ _ ->
+ S
+ end.
+
+reset_node_state(Node) ->
+ ?trace({{node,Node}, reset_node_state, get()}),
+ erase({wait_lock, Node}),
+ erase({save_ops, Node}),
+ erase({pre_connect, Node}),
+ erase({prot_vsn, Node}),
+ erase({sync_tag_my, Node}),
+ erase({sync_tag_his, Node}),
+ erase({lock_id, Node}).
+
+%% Some node sent us his names. When a name clash is found, the resolve
+%% function is called from the smaller node => all resolve funcs are called
+%% from the same partition.
+exchange_names([{Name, Pid, Method} | Tail], Node, Ops, Res) ->
+ case ets:lookup(global_names, Name) of
+ [{Name, Pid, _Method, _RPid2, _Ref2}] ->
+ exchange_names(Tail, Node, Ops, Res);
+ [{Name, Pid2, Method2, _RPid2, _Ref2}] when node() < Node ->
+ %% Name clash! Add the result of resolving to Res(olved).
+ %% We know that node(Pid) =/= node(), so we don't
+ %% need to link/unlink to Pid.
+ Node2 = node(Pid2), %% Node2 is connected to node().
+ case rpc:call(Node2, ?MODULE, resolve_it,
+ [Method2, Name, Pid, Pid2]) of
+ Pid ->
+ Op = {insert, {Name, Pid, Method}},
+ exchange_names(Tail, Node, [Op | Ops], Res);
+ Pid2 ->
+ Op = {insert, {Name, Pid2, Method2}},
+ exchange_names(Tail, Node, Ops, [Op | Res]);
+ none ->
+ Op = {delete, Name},
+ exchange_names(Tail, Node, [Op | Ops], [Op | Res]);
+ {badrpc, Badrpc} ->
+ error_logger:info_msg("global: badrpc ~w received when "
+ "conflicting name ~w was found\n",
+ [Badrpc, Name]),
+ Op = {insert, {Name, Pid, Method}},
+ exchange_names(Tail, Node, [Op | Ops], Res);
+ Else ->
+ error_logger:info_msg("global: Resolve method ~w for "
+ "conflicting name ~w returned ~w\n",
+ [Method, Name, Else]),
+ Op = {delete, Name},
+ exchange_names(Tail, Node, [Op | Ops], [Op | Res])
+ end;
+ [{Name, _Pid2, _Method, _RPid, _Ref}] ->
+ %% The other node will solve the conflict.
+ exchange_names(Tail, Node, Ops, Res);
+ _ ->
+ %% Entirely new name.
+ exchange_names(Tail, Node,
+ [{insert, {Name, Pid, Method}} | Ops], Res)
+ end;
+exchange_names([], _, Ops, Res) ->
+ ?trace({exchange_names_finish,{ops,Ops},{res,Res}}),
+ {Ops, Res}.
+
+resolve_it(Method, Name, Pid1, Pid2) ->
+ catch Method(Name, Pid1, Pid2).
+
+minmax(P1,P2) ->
+ if node(P1) < node(P2) -> {P1, P2}; true -> {P2, P1} end.
+
+-spec random_exit_name(term(), pid(), pid()) -> pid().
+random_exit_name(Name, Pid, Pid2) ->
+ {Min, Max} = minmax(Pid, Pid2),
+ error_logger:info_msg("global: Name conflict terminating ~w\n",
+ [{Name, Max}]),
+ exit(Max, kill),
+ Min.
+
+random_notify_name(Name, Pid, Pid2) ->
+ {Min, Max} = minmax(Pid, Pid2),
+ Max ! {global_name_conflict, Name},
+ Min.
+
+-spec notify_all_name(term(), pid(), pid()) -> 'none'.
+notify_all_name(Name, Pid, Pid2) ->
+ Pid ! {global_name_conflict, Name, Pid2},
+ Pid2 ! {global_name_conflict, Name, Pid},
+ none.
+
+dolink_ext(Pid, RegNode) when RegNode =:= node() ->
+ link(Pid);
+dolink_ext(_, _) ->
+ ok.
+
+dounlink_ext(Pid, RegNode) when RegNode =:= node() ->
+ unlink_pid(Pid);
+dounlink_ext(_Pid, _RegNode) ->
+ ok.
+
+unlink_pid(Pid) ->
+ case ets:member(global_pid_names, Pid) of
+ false ->
+ case ets:member(global_pid_ids, Pid) of
+ false ->
+ unlink(Pid);
+ true ->
+ ok
+ end;
+ true ->
+ ok
+ end.
+
+pid_is_locking(Pid, PidRefs) ->
+ lists:keyfind(Pid, 1, PidRefs) =/= false.
+
+delete_lock(Ref, S0) ->
+ Locks = pid_locks(Ref),
+ del_locks(Locks, Ref, S0#state.known),
+ F = fun({ResourceId, LockRequesterId, PidRefs}, S) ->
+ {Pid, _RPid, Ref} = lists:keyfind(Ref, 3, PidRefs),
+ remove_lock(ResourceId, LockRequesterId, Pid, PidRefs, true,S)
+ end,
+ lists:foldl(F, S0, Locks).
+
+pid_locks(Ref) ->
+ L = lists:flatmap(fun({_, ResourceId}) ->
+ ets:lookup(global_locks, ResourceId)
+ end, ets:lookup(global_pid_ids, Ref)),
+ [Lock || Lock = {_Id, _Req, PidRefs} <- L,
+ rpid_is_locking(Ref, PidRefs)].
+
+rpid_is_locking(Ref, PidRefs) ->
+ lists:keyfind(Ref, 3, PidRefs) =/= false.
+
+%% Send {async_del_lock, ...} to old nodes (pre R11B-3).
+del_locks([{ResourceId, _LockReqId, PidRefs} | Tail], Ref, KnownNodes) ->
+ {Pid, _RPid, Ref} = lists:keyfind(Ref, 3, PidRefs),
+ case node(Pid) =:= node() of
+ true ->
+ gen_server:abcast(KnownNodes, global_name_server,
+ {async_del_lock, ResourceId, Pid});
+ false ->
+ ok
+ end,
+ del_locks(Tail, Ref, KnownNodes);
+del_locks([], _Ref, _KnownNodes) ->
+ ok.
+
+handle_nodedown(Node, S) ->
+ %% DOWN signals from monitors have removed locks and registered names.
+ #state{known = Known, synced = Syncs} = S,
+ NewS = cancel_locker(Node, S, get({sync_tag_my, Node})),
+ NewS#state.the_locker ! {remove_from_known, Node},
+ reset_node_state(Node),
+ NewS#state{known = lists:delete(Node, Known),
+ synced = lists:delete(Node, Syncs)}.
+
+get_names() ->
+ ets:select(global_names,
+ ets:fun2ms(fun({Name, Pid, Method, _RPid, _Ref}) ->
+ {Name, Pid, Method}
+ end)).
+
+get_names_ext() ->
+ ets:tab2list(global_names_ext).
+
+get_known() ->
+ gen_server:call(global_name_server, get_known, infinity).
+
+random_sleep(Times) ->
+ case (Times rem 10) of
+ 0 -> erase(random_seed);
+ _ -> ok
+ end,
+ case get(random_seed) of
+ undefined ->
+ {A1, A2, A3} = now(),
+ random:seed(A1, A2, A3 + erlang:phash(node(), 100000));
+ _ -> ok
+ end,
+ %% First time 1/4 seconds, then doubling each time up to 8 seconds max.
+ Tmax = if Times > 5 -> 8000;
+ true -> ((1 bsl Times) * 1000) div 8
+ end,
+ T = random:uniform(Tmax),
+ ?trace({random_sleep, {me,self()}, {times,Times}, {t,T}, {tmax,Tmax}}),
+ receive after T -> ok end.
+
+dec(infinity) -> infinity;
+dec(N) -> N - 1.
+
+send_again(Msg) ->
+ Me = self(),
+ spawn(fun() -> timer(Me, Msg) end).
+
+timer(Pid, Msg) ->
+ random_sleep(5),
+ Pid ! Msg.
+
+change_our_node_name(NewNode, S) ->
+ S1 = trace_message(S, {new_node_name, NewNode}, []),
+ S1#state{node_name = NewNode}.
+
+trace_message(#state{trace = no_trace}=S, _M, _X) ->
+ S;
+trace_message(S, M, X) ->
+ S#state{trace = [trace_message(M, X) | S#state.trace]}.
+
+trace_message(M, X) ->
+ {node(), now(), M, nodes(), X}.
+
+%%-----------------------------------------------------------------
+%% Each sync process corresponds to one call to sync. Each such
+%% process asks the global_name_server on all Nodes if it is in sync
+%% with Nodes. If not, that (other) node spawns a syncer process that
+%% waits for global to get in sync with all Nodes. When it is in
+%% sync, the syncer process tells the original sync process about it.
+%%-----------------------------------------------------------------
+start_sync(Nodes, From) ->
+ spawn_link(fun() -> sync_init(Nodes, From) end).
+
+sync_init(Nodes, From) ->
+ lists:foreach(fun(Node) -> monitor_node(Node, true) end, Nodes),
+ sync_loop(Nodes, From).
+
+sync_loop([], From) ->
+ gen_server:reply(From, ok);
+sync_loop(Nodes, From) ->
+ receive
+ {nodedown, Node} ->
+ monitor_node(Node, false),
+ sync_loop(lists:delete(Node, Nodes), From);
+ {synced, SNodes} ->
+ lists:foreach(fun(N) -> monitor_node(N, false) end, SNodes),
+ sync_loop(Nodes -- SNodes, From)
+ end.
+
+%%%=======================================================================
+%%% Get the current global_groups definition
+%%%=======================================================================
+check_sync_nodes() ->
+ case get_own_nodes() of
+ {ok, all} ->
+ nodes();
+ {ok, NodesNG} ->
+ %% global_groups parameter is defined, we are not allowed to sync
+ %% with nodes not in our own global group.
+ intersection(nodes(), NodesNG);
+ {error, _} = Error ->
+ Error
+ end.
+
+check_sync_nodes(SyncNodes) ->
+ case get_own_nodes() of
+ {ok, all} ->
+ SyncNodes;
+ {ok, NodesNG} ->
+ %% global_groups parameter is defined, we are not allowed to sync
+ %% with nodes not in our own global group.
+ OwnNodeGroup = intersection(nodes(), NodesNG),
+ IllegalSyncNodes = (SyncNodes -- [node() | OwnNodeGroup]),
+ case IllegalSyncNodes of
+ [] -> SyncNodes;
+ _ -> {error, {"Trying to sync nodes not defined in "
+ "the own global group", IllegalSyncNodes}}
+ end;
+ {error, _} = Error ->
+ Error
+ end.
+
+get_own_nodes() ->
+ case global_group:get_own_nodes_with_errors() of
+ {error, Error} ->
+ {error, {"global_groups definition error", Error}};
+ OkTup ->
+ OkTup
+ end.
+
+%%-----------------------------------------------------------------
+%% The deleter process is a satellite process to global_name_server
+%% that does background batch deleting of names when a process
+%% that had globally registered names dies. It is started by and
+%% linked to global_name_server.
+%%-----------------------------------------------------------------
+
+start_the_deleter(Global) ->
+ spawn_link(fun() -> loop_the_deleter(Global) end).
+
+loop_the_deleter(Global) ->
+ Deletions = collect_deletions(Global, []),
+ ?trace({loop_the_deleter, self(), {deletions,Deletions},
+ {names,get_names()}}),
+ %% trans_all_known is called rather than trans/3 with nodes() as
+ %% third argument. The reason is that known gets updated by
+ %% new_nodes when the lock is still set. nodes() on the other hand
+ %% could be updated later (if in_sync is received after the lock
+ %% is gone). It is not likely that in_sync would be received after
+ %% the lock has been taken here, but using trans_all_known makes it
+ %% even less likely.
+ trans_all_known(
+ fun(Known) ->
+ lists:map(
+ fun({Name,Pid}) ->
+ gen_server:abcast(Known, global_name_server,
+ {async_del_name, Name, Pid})
+ end, Deletions)
+ end),
+ loop_the_deleter(Global).
+
+collect_deletions(Global, Deletions) ->
+ receive
+ {delete_name, Global, Name, Pid} ->
+ collect_deletions(Global, [{Name,Pid} | Deletions]);
+ Other ->
+ unexpected_message(Other, deleter),
+ collect_deletions(Global, Deletions)
+ after case Deletions of
+ [] -> infinity;
+ _ -> 0
+ end ->
+ lists:reverse(Deletions)
+ end.
+
+%% The registrar is a helper process that registers and unregisters
+%% names. Since it never dies it assures that names are registered and
+%% unregistered on all known nodes. It is started by and linked to
+%% global_name_server.
+
+start_the_registrar() ->
+ spawn_link(fun() -> loop_the_registrar() end).
+
+loop_the_registrar() ->
+ receive
+ {trans_all_known, Fun, From} ->
+ ?trace({loop_the_registrar, self(), Fun, From}),
+ gen_server:reply(From, trans_all_known(Fun));
+ Other ->
+ unexpected_message(Other, register)
+ end,
+ loop_the_registrar().
+
+unexpected_message({'EXIT', _Pid, _Reason}, _What) ->
+ %% global_name_server died
+ ok;
+unexpected_message(Message, What) ->
+ error_logger:warning_msg("The global_name_server ~w process "
+ "received an unexpected message:\n~p\n",
+ [What, Message]).
+
+%%% Utilities
+
+%% When/if erlang:monitor() returns before trying to connect to the
+%% other node this function can be removed.
+do_monitor(Pid) ->
+ case (node(Pid) =:= node()) orelse lists:member(node(Pid), nodes()) of
+ true ->
+ %% Assume the node is still up
+ {Pid, erlang:monitor(process, Pid)};
+ false ->
+ F = fun() ->
+ Ref = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', Ref, process, Pid, _Info} ->
+ exit(normal)
+ end
+ end,
+ erlang:spawn_monitor(F)
+ end.
+
+intersection(_, []) ->
+ [];
+intersection(L1, L2) ->
+ L1 -- (L1 -- L2).
diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl
new file mode 100644
index 0000000000..7e141ac5c7
--- /dev/null
+++ b/lib/kernel/src/global_group.erl
@@ -0,0 +1,1347 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(global_group).
+
+%% Groups nodes into global groups with an own global name space.
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start/0, start_link/0, stop/0, init/1]).
+-export([handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-export([global_groups/0]).
+-export([monitor_nodes/1]).
+-export([own_nodes/0]).
+-export([registered_names/1]).
+-export([send/2]).
+-export([send/3]).
+-export([whereis_name/1]).
+-export([whereis_name/2]).
+-export([global_groups_changed/1]).
+-export([global_groups_added/1]).
+-export([global_groups_removed/1]).
+-export([sync/0]).
+-export([ng_add_check/2, ng_add_check/3]).
+
+-export([info/0]).
+-export([registered_names_test/1]).
+-export([send_test/2]).
+-export([whereis_name_test/1]).
+-export([get_own_nodes/0, get_own_nodes_with_errors/0]).
+-export([publish_on_nodes/0]).
+
+-export([config_scan/1, config_scan/2]).
+
+%% Internal exports
+-export([sync_init/4]).
+
+
+-define(cc_vsn, 2).
+
+%%%====================================================================================
+
+-type publish_type() :: 'hidden' | 'normal'.
+-type sync_state() :: 'no_conf' | 'synced'.
+
+-type group_name() :: atom().
+-type group_tuple() :: {group_name(), [node()]}
+ | {group_name(), publish_type(), [node()]}.
+
+
+%%%====================================================================================
+%%% The state of the global_group process
+%%%
+%%% sync_state = no_conf (global_groups not defined, inital state) |
+%%% synced
+%%% group_name = Own global group name
+%%% nodes = Nodes in the own global group
+%%% no_contact = Nodes which we haven't had contact with yet
+%%% sync_error = Nodes which we haven't had contact with yet
+%%% other_grps = list of other global group names and nodes, [{otherName, [Node]}]
+%%% node_name = Own node
+%%% monitor = List of Pids requesting nodeup/nodedown
+%%%====================================================================================
+
+-record(state, {sync_state = no_conf :: sync_state(),
+ connect_all :: boolean(),
+ group_name = [] :: group_name() | [],
+ nodes = [] :: [node()],
+ no_contact = [] :: [node()],
+ sync_error = [],
+ other_grps = [],
+ node_name = node() :: node(),
+ monitor = [],
+ publish_type = normal :: publish_type(),
+ group_publish_type = normal :: publish_type()}).
+
+
+%%%====================================================================================
+%%% External exported
+%%%====================================================================================
+
+-spec global_groups() -> {group_name(), [group_name()]} | 'undefined'.
+global_groups() ->
+ request(global_groups).
+
+-spec monitor_nodes(boolean()) -> 'ok'.
+monitor_nodes(Flag) ->
+ case Flag of
+ true -> request({monitor_nodes, Flag});
+ false -> request({monitor_nodes, Flag});
+ _ -> {error, not_boolean}
+ end.
+
+-spec own_nodes() -> [node()].
+own_nodes() ->
+ request(own_nodes).
+
+-type name() :: atom().
+-type where() :: {'node', node()} | {'group', group_name()}.
+
+-spec registered_names(where()) -> [name()].
+registered_names(Arg) ->
+ request({registered_names, Arg}).
+
+-spec send(name(), term()) -> pid() | {'badarg', {name(), term()}}.
+send(Name, Msg) ->
+ request({send, Name, Msg}).
+
+-spec send(where(), name(), term()) -> pid() | {'badarg', {name(), term()}}.
+send(Group, Name, Msg) ->
+ request({send, Group, Name, Msg}).
+
+-spec whereis_name(name()) -> pid() | 'undefined'.
+whereis_name(Name) ->
+ request({whereis_name, Name}).
+
+-spec whereis_name(where(), name()) -> pid() | 'undefined'.
+whereis_name(Group, Name) ->
+ request({whereis_name, Group, Name}).
+
+global_groups_changed(NewPara) ->
+ request({global_groups_changed, NewPara}).
+
+global_groups_added(NewPara) ->
+ request({global_groups_added, NewPara}).
+
+global_groups_removed(NewPara) ->
+ request({global_groups_removed, NewPara}).
+
+-spec sync() -> 'ok'.
+sync() ->
+ request(sync).
+
+ng_add_check(Node, OthersNG) ->
+ ng_add_check(Node, normal, OthersNG).
+
+ng_add_check(Node, PubType, OthersNG) ->
+ request({ng_add_check, Node, PubType, OthersNG}).
+
+-type info_item() :: {'state', sync_state()}
+ | {'own_group_name', group_name()}
+ | {'own_group_nodes', [node()]}
+ | {'synched_nodes', [node()]}
+ | {'sync_error', [node()]}
+ | {'no_contact', [node()]}
+ | {'other_groups', [group_tuple()]}
+ | {'monitoring', [pid()]}.
+
+-spec info() -> [info_item()].
+info() ->
+ request(info, 3000).
+
+%% ==== ONLY for test suites ====
+registered_names_test(Arg) ->
+ request({registered_names_test, Arg}).
+send_test(Name, Msg) ->
+ request({send_test, Name, Msg}).
+whereis_name_test(Name) ->
+ request({whereis_name_test, Name}).
+%% ==== ONLY for test suites ====
+
+
+request(Req) ->
+ request(Req, infinity).
+
+request(Req, Time) ->
+ case whereis(global_group) of
+ P when is_pid(P) ->
+ gen_server:call(global_group, Req, Time);
+ _Other ->
+ {error, global_group_not_runnig}
+ end.
+
+%%%====================================================================================
+%%% gen_server start
+%%%
+%%% The first thing to happen is to read if the global_groups key is defined in the
+%%% .config file. If not defined, the whole system is started as one global_group,
+%%% and the services of global_group are superfluous.
+%%% Otherwise a sync process is started to check that all nodes in the own global
+%%% group have the same configuration. This is done by sending 'conf_check' to all
+%%% other nodes and requiring 'conf_check_result' back.
+%%% If the nodes are not in agreement of the configuration the global_group process
+%%% will remove these nodes from the #state.nodes list. This can be a normal case
+%%% at release upgrade when all nodes are not yet upgraded.
+%%%
+%%% It is possible to manually force a sync of the global_group. This is done for
+%%% instance after a release upgrade, after all nodes in the group beeing upgraded.
+%%% The nodes are not synced automatically because it would cause the node to be
+%%% disconnected from those not yet beeing upgraded.
+%%%
+%%% The three process dictionary variables (registered_names, send, and whereis_name)
+%%% are used to store information needed if the search process crashes.
+%%% The search process is a help process to find registered names in the system.
+%%%====================================================================================
+start() -> gen_server:start({local, global_group}, global_group, [], []).
+start_link() -> gen_server:start_link({local, global_group}, global_group,[],[]).
+stop() -> gen_server:call(global_group, stop, infinity).
+
+init([]) ->
+ process_flag(priority, max),
+ ok = net_kernel:monitor_nodes(true),
+ put(registered_names, [undefined]),
+ put(send, [undefined]),
+ put(whereis_name, [undefined]),
+ process_flag(trap_exit, true),
+ Ca = case init:get_argument(connect_all) of
+ {ok, [["false"]]} ->
+ false;
+ _ ->
+ true
+ end,
+ PT = publish_arg(),
+ case application:get_env(kernel, global_groups) of
+ undefined ->
+ update_publish_nodes(PT),
+ {ok, #state{publish_type = PT,
+ connect_all = Ca}};
+ {ok, []} ->
+ update_publish_nodes(PT),
+ {ok, #state{publish_type = PT,
+ connect_all = Ca}};
+ {ok, NodeGrps} ->
+ {DefGroupName, PubTpGrp, DefNodes, DefOther} =
+ case catch config_scan(NodeGrps, publish_type) of
+ {error, _Error2} ->
+ update_publish_nodes(PT),
+ exit({error, {'invalid global_groups definition', NodeGrps}});
+ {DefGroupNameT, PubType, DefNodesT, DefOtherT} ->
+ update_publish_nodes(PT, {PubType, DefNodesT}),
+ %% First disconnect any nodes not belonging to our own group
+ disconnect_nodes(nodes(connected) -- DefNodesT),
+ lists:foreach(fun(Node) ->
+ erlang:monitor_node(Node, true)
+ end,
+ DefNodesT),
+ {DefGroupNameT, PubType, lists:delete(node(), DefNodesT), DefOtherT}
+ end,
+ {ok, #state{publish_type = PT, group_publish_type = PubTpGrp,
+ sync_state = synced, group_name = DefGroupName,
+ no_contact = lists:sort(DefNodes),
+ other_grps = DefOther}}
+ end.
+
+
+%%%====================================================================================
+%%% sync() -> ok
+%%%
+%%% An operator ordered sync of the own global group. This must be done after
+%%% a release upgrade. It can also be ordered if somthing has made the nodes
+%%% to disagree of the global_groups definition.
+%%%====================================================================================
+handle_call(sync, _From, S) ->
+% io:format("~p sync ~p~n",[node(), application:get_env(kernel, global_groups)]),
+ case application:get_env(kernel, global_groups) of
+ undefined ->
+ update_publish_nodes(S#state.publish_type),
+ {reply, ok, S};
+ {ok, []} ->
+ update_publish_nodes(S#state.publish_type),
+ {reply, ok, S};
+ {ok, NodeGrps} ->
+ {DefGroupName, PubTpGrp, DefNodes, DefOther} =
+ case catch config_scan(NodeGrps, publish_type) of
+ {error, _Error2} ->
+ exit({error, {'invalid global_groups definition', NodeGrps}});
+ {DefGroupNameT, PubType, DefNodesT, DefOtherT} ->
+ update_publish_nodes(S#state.publish_type, {PubType, DefNodesT}),
+ %% First inform global on all nodes not belonging to our own group
+ disconnect_nodes(nodes(connected) -- DefNodesT),
+ %% Sync with the nodes in the own group
+ kill_global_group_check(),
+ Pid = spawn_link(?MODULE, sync_init,
+ [sync, DefGroupNameT, PubType, DefNodesT]),
+ register(global_group_check, Pid),
+ {DefGroupNameT, PubType, lists:delete(node(), DefNodesT), DefOtherT}
+ end,
+ {reply, ok, S#state{sync_state = synced, group_name = DefGroupName,
+ no_contact = lists:sort(DefNodes),
+ other_grps = DefOther, group_publish_type = PubTpGrp}}
+ end;
+
+
+
+%%%====================================================================================
+%%% global_groups() -> {OwnGroupName, [OtherGroupName]} | undefined
+%%%
+%%% Get the names of the global groups
+%%%====================================================================================
+handle_call(global_groups, _From, S) ->
+ Result = case S#state.sync_state of
+ no_conf ->
+ undefined;
+ synced ->
+ Other = lists:foldl(fun({N,_L}, Acc) -> Acc ++ [N]
+ end,
+ [], S#state.other_grps),
+ {S#state.group_name, Other}
+ end,
+ {reply, Result, S};
+
+
+
+%%%====================================================================================
+%%% monitor_nodes(bool()) -> ok
+%%%
+%%% Monitor nodes in the own global group.
+%%% True => send nodeup/nodedown to the requesting Pid
+%%% False => stop sending nodeup/nodedown to the requesting Pid
+%%%====================================================================================
+handle_call({monitor_nodes, Flag}, {Pid, _}, StateIn) ->
+% io:format("***** handle_call ~p~n",[monitor_nodes]),
+ {Res, State} = monitor_nodes(Flag, Pid, StateIn),
+ {reply, Res, State};
+
+
+%%%====================================================================================
+%%% own_nodes() -> [Node]
+%%%
+%%% Get a list of nodes in the own global group
+%%%====================================================================================
+handle_call(own_nodes, _From, S) ->
+ Nodes = case S#state.sync_state of
+ no_conf ->
+ [node() | nodes()];
+ synced ->
+ get_own_nodes()
+% S#state.nodes
+ end,
+ {reply, Nodes, S};
+
+
+
+%%%====================================================================================
+%%% registered_names({node, Node}) -> [Name] | {error, ErrorMessage}
+%%% registered_names({group, GlobalGroupName}) -> [Name] | {error, ErrorMessage}
+%%%
+%%% Get the registered names from a specified Node, or GlobalGroupName.
+%%%====================================================================================
+handle_call({registered_names, {group, Group}}, _From, S) when Group =:= S#state.group_name ->
+ Res = global:registered_names(),
+ {reply, Res, S};
+handle_call({registered_names, {group, Group}}, From, S) ->
+ case lists:keysearch(Group, 1, S#state.other_grps) of
+ false ->
+ {reply, [], S};
+ {value, {Group, []}} ->
+ {reply, [], S};
+ {value, {Group, Nodes}} ->
+ Pid = global_search:start(names, {group, Nodes, From}),
+ Wait = get(registered_names),
+ put(registered_names, [{Pid, From} | Wait]),
+ {noreply, S}
+ end;
+handle_call({registered_names, {node, Node}}, _From, S) when Node =:= node() ->
+ Res = global:registered_names(),
+ {reply, Res, S};
+handle_call({registered_names, {node, Node}}, From, S) ->
+ Pid = global_search:start(names, {node, Node, From}),
+% io:format(">>>>> registered_names Pid ~p~n",[Pid]),
+ Wait = get(registered_names),
+ put(registered_names, [{Pid, From} | Wait]),
+ {noreply, S};
+
+
+
+%%%====================================================================================
+%%% send(Name, Msg) -> Pid | {badarg, {Name, Msg}}
+%%% send({node, Node}, Name, Msg) -> Pid | {badarg, {Name, Msg}}
+%%% send({group, GlobalGroupName}, Name, Msg) -> Pid | {badarg, {Name, Msg}}
+%%%
+%%% Send the Msg to the specified globally registered Name in own global group,
+%%% in specified Node, or GlobalGroupName.
+%%% But first the receiver is to be found, the thread is continued at
+%%% handle_cast(send_res)
+%%%====================================================================================
+%% Search in the whole known world, but check own node first.
+handle_call({send, Name, Msg}, From, S) ->
+ case global:whereis_name(Name) of
+ undefined ->
+ Pid = global_search:start(send, {any, S#state.other_grps, Name, Msg, From}),
+ Wait = get(send),
+ put(send, [{Pid, From, Name, Msg} | Wait]),
+ {noreply, S};
+ Found ->
+ Found ! Msg,
+ {reply, Found, S}
+ end;
+%% Search in the specified global group, which happens to be the own group.
+handle_call({send, {group, Grp}, Name, Msg}, _From, S) when Grp =:= S#state.group_name ->
+ case global:whereis_name(Name) of
+ undefined ->
+ {reply, {badarg, {Name, Msg}}, S};
+ Pid ->
+ Pid ! Msg,
+ {reply, Pid, S}
+ end;
+%% Search in the specified global group.
+handle_call({send, {group, Group}, Name, Msg}, From, S) ->
+ case lists:keysearch(Group, 1, S#state.other_grps) of
+ false ->
+ {reply, {badarg, {Name, Msg}}, S};
+ {value, {Group, []}} ->
+ {reply, {badarg, {Name, Msg}}, S};
+ {value, {Group, Nodes}} ->
+ Pid = global_search:start(send, {group, Nodes, Name, Msg, From}),
+ Wait = get(send),
+ put(send, [{Pid, From, Name, Msg} | Wait]),
+ {noreply, S}
+ end;
+%% Search on the specified node.
+handle_call({send, {node, Node}, Name, Msg}, From, S) ->
+ Pid = global_search:start(send, {node, Node, Name, Msg, From}),
+ Wait = get(send),
+ put(send, [{Pid, From, Name, Msg} | Wait]),
+ {noreply, S};
+
+
+
+%%%====================================================================================
+%%% whereis_name(Name) -> Pid | undefined
+%%% whereis_name({node, Node}, Name) -> Pid | undefined
+%%% whereis_name({group, GlobalGroupName}, Name) -> Pid | undefined
+%%%
+%%% Get the Pid of a globally registered Name in own global group,
+%%% in specified Node, or GlobalGroupName.
+%%% But first the process is to be found,
+%%% the thread is continued at handle_cast(find_name_res)
+%%%====================================================================================
+%% Search in the whole known world, but check own node first.
+handle_call({whereis_name, Name}, From, S) ->
+ case global:whereis_name(Name) of
+ undefined ->
+ Pid = global_search:start(whereis, {any, S#state.other_grps, Name, From}),
+ Wait = get(whereis_name),
+ put(whereis_name, [{Pid, From} | Wait]),
+ {noreply, S};
+ Found ->
+ {reply, Found, S}
+ end;
+%% Search in the specified global group, which happens to be the own group.
+handle_call({whereis_name, {group, Group}, Name}, _From, S)
+ when Group =:= S#state.group_name ->
+ Res = global:whereis_name(Name),
+ {reply, Res, S};
+%% Search in the specified global group.
+handle_call({whereis_name, {group, Group}, Name}, From, S) ->
+ case lists:keysearch(Group, 1, S#state.other_grps) of
+ false ->
+ {reply, undefined, S};
+ {value, {Group, []}} ->
+ {reply, undefined, S};
+ {value, {Group, Nodes}} ->
+ Pid = global_search:start(whereis, {group, Nodes, Name, From}),
+ Wait = get(whereis_name),
+ put(whereis_name, [{Pid, From} | Wait]),
+ {noreply, S}
+ end;
+%% Search on the specified node.
+handle_call({whereis_name, {node, Node}, Name}, From, S) ->
+ Pid = global_search:start(whereis, {node, Node, Name, From}),
+ Wait = get(whereis_name),
+ put(whereis_name, [{Pid, From} | Wait]),
+ {noreply, S};
+
+
+%%%====================================================================================
+%%% global_groups parameter changed
+%%% The node is not resynced automatically because it would cause this node to
+%%% be disconnected from those nodes not yet been upgraded.
+%%%====================================================================================
+handle_call({global_groups_changed, NewPara}, _From, S) ->
+ {NewGroupName, PubTpGrp, NewNodes, NewOther} =
+ case catch config_scan(NewPara, publish_type) of
+ {error, _Error2} ->
+ exit({error, {'invalid global_groups definition', NewPara}});
+ {DefGroupName, PubType, DefNodes, DefOther} ->
+ update_publish_nodes(S#state.publish_type, {PubType, DefNodes}),
+ {DefGroupName, PubType, DefNodes, DefOther}
+ end,
+
+ %% #state.nodes is the common denominator of previous and new definition
+ NN = NewNodes -- (NewNodes -- S#state.nodes),
+ %% rest of the nodes in the new definition are marked as not yet contacted
+ NNC = (NewNodes -- S#state.nodes) -- S#state.sync_error,
+ %% remove sync_error nodes not belonging to the new group
+ NSE = NewNodes -- (NewNodes -- S#state.sync_error),
+
+ %% Disconnect the connection to nodes which are not in our old global group.
+ %% This is done because if we already are aware of new nodes (to our global
+ %% group) global is not going to be synced to these nodes. We disconnect instead
+ %% of connect because upgrades can be done node by node and we cannot really
+ %% know what nodes these new nodes are synced to. The operator can always
+ %% manually force a sync of the nodes after all nodes beeing uppgraded.
+ %% We must disconnect also if some nodes to which we have a connection
+ %% will not be in any global group at all.
+ force_nodedown(nodes(connected) -- NewNodes),
+
+ NewS = S#state{group_name = NewGroupName,
+ nodes = lists:sort(NN),
+ no_contact = lists:sort(lists:delete(node(), NNC)),
+ sync_error = lists:sort(NSE),
+ other_grps = NewOther,
+ group_publish_type = PubTpGrp},
+ {reply, ok, NewS};
+
+
+%%%====================================================================================
+%%% global_groups parameter added
+%%% The node is not resynced automatically because it would cause this node to
+%%% be disconnected from those nodes not yet been upgraded.
+%%%====================================================================================
+handle_call({global_groups_added, NewPara}, _From, S) ->
+% io:format("### global_groups_changed, NewPara ~p ~n",[NewPara]),
+ {NewGroupName, PubTpGrp, NewNodes, NewOther} =
+ case catch config_scan(NewPara, publish_type) of
+ {error, _Error2} ->
+ exit({error, {'invalid global_groups definition', NewPara}});
+ {DefGroupName, PubType, DefNodes, DefOther} ->
+ update_publish_nodes(S#state.publish_type, {PubType, DefNodes}),
+ {DefGroupName, PubType, DefNodes, DefOther}
+ end,
+
+ %% disconnect from those nodes which are not going to be in our global group
+ force_nodedown(nodes(connected) -- NewNodes),
+
+ %% Check which nodes are already updated
+ OwnNG = get_own_nodes(),
+ NGACArgs = case S#state.group_publish_type of
+ normal ->
+ [node(), OwnNG];
+ _ ->
+ [node(), S#state.group_publish_type, OwnNG]
+ end,
+ {NN, NNC, NSE} =
+ lists:foldl(fun(Node, {NN_acc, NNC_acc, NSE_acc}) ->
+ case rpc:call(Node, global_group, ng_add_check, NGACArgs) of
+ {badrpc, _} ->
+ {NN_acc, [Node | NNC_acc], NSE_acc};
+ agreed ->
+ {[Node | NN_acc], NNC_acc, NSE_acc};
+ not_agreed ->
+ {NN_acc, NNC_acc, [Node | NSE_acc]}
+ end
+ end,
+ {[], [], []}, lists:delete(node(), NewNodes)),
+ NewS = S#state{sync_state = synced, group_name = NewGroupName, nodes = lists:sort(NN),
+ sync_error = lists:sort(NSE), no_contact = lists:sort(NNC),
+ other_grps = NewOther, group_publish_type = PubTpGrp},
+ {reply, ok, NewS};
+
+
+%%%====================================================================================
+%%% global_groups parameter removed
+%%%====================================================================================
+handle_call({global_groups_removed, _NewPara}, _From, S) ->
+% io:format("### global_groups_removed, NewPara ~p ~n",[_NewPara]),
+ update_publish_nodes(S#state.publish_type),
+ NewS = S#state{sync_state = no_conf, group_name = [], nodes = [],
+ sync_error = [], no_contact = [],
+ other_grps = []},
+ {reply, ok, NewS};
+
+
+%%%====================================================================================
+%%% global_groups parameter added to some other node which thinks that we
+%%% belong to the same global group.
+%%% It could happen that our node is not yet updated with the new node_group parameter
+%%%====================================================================================
+handle_call({ng_add_check, Node, PubType, OthersNG}, _From, S) ->
+ %% Check which nodes are already updated
+ OwnNG = get_own_nodes(),
+ case S#state.group_publish_type =:= PubType of
+ true ->
+ case OwnNG of
+ OthersNG ->
+ NN = [Node | S#state.nodes],
+ NSE = lists:delete(Node, S#state.sync_error),
+ NNC = lists:delete(Node, S#state.no_contact),
+ NewS = S#state{nodes = lists:sort(NN),
+ sync_error = NSE,
+ no_contact = NNC},
+ {reply, agreed, NewS};
+ _ ->
+ {reply, not_agreed, S}
+ end;
+ _ ->
+ {reply, not_agreed, S}
+ end;
+
+
+
+%%%====================================================================================
+%%% Misceleaneous help function to read some variables
+%%%====================================================================================
+handle_call(info, _From, S) ->
+ Reply = [{state, S#state.sync_state},
+ {own_group_name, S#state.group_name},
+ {own_group_nodes, get_own_nodes()},
+% {"nodes()", lists:sort(nodes())},
+ {synced_nodes, S#state.nodes},
+ {sync_error, S#state.sync_error},
+ {no_contact, S#state.no_contact},
+ {other_groups, S#state.other_grps},
+ {monitoring, S#state.monitor}],
+
+ {reply, Reply, S};
+
+handle_call(get, _From, S) ->
+ {reply, get(), S};
+
+
+%%%====================================================================================
+%%% Only for test suites. These tests when the search process exits.
+%%%====================================================================================
+handle_call({registered_names_test, {node, 'test3844zty'}}, From, S) ->
+ Pid = global_search:start(names_test, {node, 'test3844zty'}),
+ Wait = get(registered_names),
+ put(registered_names, [{Pid, From} | Wait]),
+ {noreply, S};
+handle_call({registered_names_test, {node, _Node}}, _From, S) ->
+ {reply, {error, illegal_function_call}, S};
+handle_call({send_test, Name, 'test3844zty'}, From, S) ->
+ Pid = global_search:start(send_test, 'test3844zty'),
+ Wait = get(send),
+ put(send, [{Pid, From, Name, 'test3844zty'} | Wait]),
+ {noreply, S};
+handle_call({send_test, _Name, _Msg }, _From, S) ->
+ {reply, {error, illegal_function_call}, S};
+handle_call({whereis_name_test, 'test3844zty'}, From, S) ->
+ Pid = global_search:start(whereis_test, 'test3844zty'),
+ Wait = get(whereis_name),
+ put(whereis_name, [{Pid, From} | Wait]),
+ {noreply, S};
+handle_call({whereis_name_test, _Name}, _From, S) ->
+ {reply, {error, illegal_function_call}, S};
+
+handle_call(Call, _From, S) ->
+% io:format("***** handle_call ~p~n",[Call]),
+ {reply, {illegal_message, Call}, S}.
+
+
+
+
+
+%%%====================================================================================
+%%% registered_names({node, Node}) -> [Name] | {error, ErrorMessage}
+%%% registered_names({group, GlobalGroupName}) -> [Name] | {error, ErrorMessage}
+%%%
+%%% Get a list of nodes in the own global group
+%%%====================================================================================
+handle_cast({registered_names, User}, S) ->
+% io:format(">>>>> registered_names User ~p~n",[User]),
+ Res = global:registered_names(),
+ User ! {registered_names_res, Res},
+ {noreply, S};
+
+handle_cast({registered_names_res, Result, Pid, From}, S) ->
+% io:format(">>>>> registered_names_res Result ~p~n",[Result]),
+ unlink(Pid),
+ exit(Pid, normal),
+ Wait = get(registered_names),
+ NewWait = lists:delete({Pid, From},Wait),
+ put(registered_names, NewWait),
+ gen_server:reply(From, Result),
+ {noreply, S};
+
+
+
+%%%====================================================================================
+%%% send(Name, Msg) -> Pid | {error, ErrorMessage}
+%%% send({node, Node}, Name, Msg) -> Pid | {error, ErrorMessage}
+%%% send({group, GlobalGroupName}, Name, Msg) -> Pid | {error, ErrorMessage}
+%%%
+%%% The registered Name is found; send the message to it, kill the search process,
+%%% and return to the requesting process.
+%%%====================================================================================
+handle_cast({send_res, Result, Name, Msg, Pid, From}, S) ->
+% io:format("~p>>>>> send_res Result ~p~n",[node(), Result]),
+ case Result of
+ {badarg,{Name, Msg}} ->
+ continue;
+ ToPid ->
+ ToPid ! Msg
+ end,
+ unlink(Pid),
+ exit(Pid, normal),
+ Wait = get(send),
+ NewWait = lists:delete({Pid, From, Name, Msg},Wait),
+ put(send, NewWait),
+ gen_server:reply(From, Result),
+ {noreply, S};
+
+
+
+%%%====================================================================================
+%%% A request from a search process to check if this Name is registered at this node.
+%%%====================================================================================
+handle_cast({find_name, User, Name}, S) ->
+ Res = global:whereis_name(Name),
+% io:format(">>>>> find_name Name ~p Res ~p~n",[Name, Res]),
+ User ! {find_name_res, Res},
+ {noreply, S};
+
+%%%====================================================================================
+%%% whereis_name(Name) -> Pid | undefined
+%%% whereis_name({node, Node}, Name) -> Pid | undefined
+%%% whereis_name({group, GlobalGroupName}, Name) -> Pid | undefined
+%%%
+%%% The registered Name is found; kill the search process
+%%% and return to the requesting process.
+%%%====================================================================================
+handle_cast({find_name_res, Result, Pid, From}, S) ->
+% io:format(">>>>> find_name_res Result ~p~n",[Result]),
+% io:format(">>>>> find_name_res get() ~p~n",[get()]),
+ unlink(Pid),
+ exit(Pid, normal),
+ Wait = get(whereis_name),
+ NewWait = lists:delete({Pid, From},Wait),
+ put(whereis_name, NewWait),
+ gen_server:reply(From, Result),
+ {noreply, S};
+
+
+%%%====================================================================================
+%%% The node is synced successfully
+%%%====================================================================================
+handle_cast({synced, NoContact}, S) ->
+% io:format("~p>>>>> synced ~p ~n",[node(), NoContact]),
+ kill_global_group_check(),
+ Nodes = get_own_nodes() -- [node() | NoContact],
+ {noreply, S#state{nodes = lists:sort(Nodes),
+ sync_error = [],
+ no_contact = NoContact}};
+
+
+%%%====================================================================================
+%%% The node could not sync with some other nodes.
+%%%====================================================================================
+handle_cast({sync_error, NoContact, ErrorNodes}, S) ->
+% io:format("~p>>>>> sync_error ~p ~p ~n",[node(), NoContact, ErrorNodes]),
+ Txt = io_lib:format("Global group: Could not synchronize with these nodes ~p~n"
+ "because global_groups were not in agreement. ~n", [ErrorNodes]),
+ error_logger:error_report(Txt),
+ kill_global_group_check(),
+ Nodes = (get_own_nodes() -- [node() | NoContact]) -- ErrorNodes,
+ {noreply, S#state{nodes = lists:sort(Nodes),
+ sync_error = ErrorNodes,
+ no_contact = NoContact}};
+
+
+%%%====================================================================================
+%%% Another node is checking this node's group configuration
+%%%====================================================================================
+handle_cast({conf_check, Vsn, Node, From, sync, CCName, CCNodes}, S) ->
+ handle_cast({conf_check, Vsn, Node, From, sync, CCName, normal, CCNodes}, S);
+
+handle_cast({conf_check, Vsn, Node, From, sync, CCName, PubType, CCNodes}, S) ->
+ CurNodes = S#state.nodes,
+% io:format(">>>>> conf_check,sync Node ~p~n",[Node]),
+ %% Another node is syncing,
+ %% done for instance after upgrade of global_groups parameter
+ NS =
+ case application:get_env(kernel, global_groups) of
+ undefined ->
+ %% We didn't have any node_group definition
+ update_publish_nodes(S#state.publish_type),
+ disconnect_nodes([Node]),
+ {global_group_check, Node} ! {config_error, Vsn, From, node()},
+ S;
+ {ok, []} ->
+ %% Our node_group definition was empty
+ update_publish_nodes(S#state.publish_type),
+ disconnect_nodes([Node]),
+ {global_group_check, Node} ! {config_error, Vsn, From, node()},
+ S;
+ %%---------------------------------
+ %% global_groups defined
+ %%---------------------------------
+ {ok, NodeGrps} ->
+ case catch config_scan(NodeGrps, publish_type) of
+ {error, _Error2} ->
+ %% Our node_group definition was erroneous
+ disconnect_nodes([Node]),
+ {global_group_check, Node} ! {config_error, Vsn, From, node()},
+ S#state{nodes = lists:delete(Node, CurNodes)};
+
+ {CCName, PubType, CCNodes, _OtherDef} ->
+ %% OK, add the node to the #state.nodes if it isn't there
+ update_publish_nodes(S#state.publish_type, {PubType, CCNodes}),
+ global_name_server ! {nodeup, Node},
+ {global_group_check, Node} ! {config_ok, Vsn, From, node()},
+ case lists:member(Node, CurNodes) of
+ false ->
+ NewNodes = lists:sort([Node | CurNodes]),
+ NSE = lists:delete(Node, S#state.sync_error),
+ NNC = lists:delete(Node, S#state.no_contact),
+ S#state{nodes = NewNodes,
+ sync_error = NSE,
+ no_contact = NNC};
+ true ->
+ S
+ end;
+ _ ->
+ %% node_group definitions were not in agreement
+ disconnect_nodes([Node]),
+ {global_group_check, Node} ! {config_error, Vsn, From, node()},
+ NN = lists:delete(Node, S#state.nodes),
+ NSE = lists:delete(Node, S#state.sync_error),
+ NNC = lists:delete(Node, S#state.no_contact),
+ S#state{nodes = NN,
+ sync_error = NSE,
+ no_contact = NNC}
+ end
+ end,
+ {noreply, NS};
+
+
+handle_cast(_Cast, S) ->
+% io:format("***** handle_cast ~p~n",[_Cast]),
+ {noreply, S}.
+
+
+
+%%%====================================================================================
+%%% A node went down. If no global group configuration inform global;
+%%% if global group configuration inform global only if the node is one in
+%%% the own global group.
+%%%====================================================================================
+handle_info({nodeup, Node}, S) when S#state.sync_state =:= no_conf ->
+% io:format("~p>>>>> nodeup, Node ~p ~n",[node(), Node]),
+ send_monitor(S#state.monitor, {nodeup, Node}, S#state.sync_state),
+ global_name_server ! {nodeup, Node},
+ {noreply, S};
+handle_info({nodeup, Node}, S) ->
+% io:format("~p>>>>> nodeup, Node ~p ~n",[node(), Node]),
+ OthersNG = case S#state.sync_state of
+ synced ->
+ X = (catch rpc:call(Node, global_group, get_own_nodes, [])),
+ case X of
+ X when is_list(X) ->
+ lists:sort(X);
+ _ ->
+ []
+ end;
+ no_conf ->
+ []
+ end,
+
+ NNC = lists:delete(Node, S#state.no_contact),
+ NSE = lists:delete(Node, S#state.sync_error),
+ OwnNG = get_own_nodes(),
+ case OwnNG of
+ OthersNG ->
+ send_monitor(S#state.monitor, {nodeup, Node}, S#state.sync_state),
+ global_name_server ! {nodeup, Node},
+ case lists:member(Node, S#state.nodes) of
+ false ->
+ NN = lists:sort([Node | S#state.nodes]),
+ {noreply, S#state{nodes = NN,
+ no_contact = NNC,
+ sync_error = NSE}};
+ true ->
+ {noreply, S#state{no_contact = NNC,
+ sync_error = NSE}}
+ end;
+ _ ->
+ case {lists:member(Node, get_own_nodes()),
+ lists:member(Node, S#state.sync_error)} of
+ {true, false} ->
+ NSE2 = lists:sort([Node | S#state.sync_error]),
+ {noreply, S#state{no_contact = NNC,
+ sync_error = NSE2}};
+ _ ->
+ {noreply, S}
+ end
+ end;
+
+%%%====================================================================================
+%%% A node has crashed.
+%%% nodedown must always be sent to global; this is a security measurement
+%%% because during release upgrade the global_groups parameter is upgraded
+%%% before the node is synced. This means that nodedown may arrive from a
+%%% node which we are not aware of.
+%%%====================================================================================
+handle_info({nodedown, Node}, S) when S#state.sync_state =:= no_conf ->
+% io:format("~p>>>>> nodedown, no_conf Node ~p~n",[node(), Node]),
+ send_monitor(S#state.monitor, {nodedown, Node}, S#state.sync_state),
+ global_name_server ! {nodedown, Node},
+ {noreply, S};
+handle_info({nodedown, Node}, S) ->
+% io:format("~p>>>>> nodedown, Node ~p ~n",[node(), Node]),
+ send_monitor(S#state.monitor, {nodedown, Node}, S#state.sync_state),
+ global_name_server ! {nodedown, Node},
+ NN = lists:delete(Node, S#state.nodes),
+ NSE = lists:delete(Node, S#state.sync_error),
+ NNC = case {lists:member(Node, get_own_nodes()),
+ lists:member(Node, S#state.no_contact)} of
+ {true, false} ->
+ [Node | S#state.no_contact];
+ _ ->
+ S#state.no_contact
+ end,
+ {noreply, S#state{nodes = NN, no_contact = NNC, sync_error = NSE}};
+
+
+%%%====================================================================================
+%%% A node has changed its global_groups definition, and is telling us that we are not
+%%% included in his group any more. This could happen at release upgrade.
+%%%====================================================================================
+handle_info({disconnect_node, Node}, S) ->
+% io:format("~p>>>>> disconnect_node Node ~p CN ~p~n",[node(), Node, S#state.nodes]),
+ case {S#state.sync_state, lists:member(Node, S#state.nodes)} of
+ {synced, true} ->
+ send_monitor(S#state.monitor, {nodedown, Node}, S#state.sync_state);
+ _ ->
+ cont
+ end,
+ global_name_server ! {nodedown, Node}, %% nodedown is used to inform global of the
+ %% disconnected node
+ NN = lists:delete(Node, S#state.nodes),
+ NNC = lists:delete(Node, S#state.no_contact),
+ NSE = lists:delete(Node, S#state.sync_error),
+ {noreply, S#state{nodes = NN, no_contact = NNC, sync_error = NSE}};
+
+
+
+
+handle_info({'EXIT', ExitPid, Reason}, S) ->
+ check_exit(ExitPid, Reason),
+ {noreply, S};
+
+
+handle_info(_Info, S) ->
+% io:format("***** handle_info = ~p~n",[_Info]),
+ {noreply, S}.
+
+
+
+terminate(_Reason, _S) ->
+ ok.
+
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+
+
+
+
+%%%====================================================================================
+%%% Check the global group configuration.
+%%%====================================================================================
+
+config_scan(NodeGrps) ->
+ config_scan(NodeGrps, original).
+
+config_scan(NodeGrps, original) ->
+ case config_scan(NodeGrps, publish_type) of
+ {DefGroupName, _, DefNodes, DefOther} ->
+ {DefGroupName, DefNodes, DefOther};
+ Error ->
+ Error
+ end;
+config_scan(NodeGrps, publish_type) ->
+ config_scan(node(), normal, NodeGrps, no_name, [], []).
+
+config_scan(_MyNode, PubType, [], Own_name, OwnNodes, OtherNodeGrps) ->
+ {Own_name, PubType, lists:sort(OwnNodes), lists:reverse(OtherNodeGrps)};
+config_scan(MyNode, PubType, [GrpTuple|NodeGrps], Own_name, OwnNodes, OtherNodeGrps) ->
+ {Name, PubTypeGroup, Nodes} = grp_tuple(GrpTuple),
+ case lists:member(MyNode, Nodes) of
+ true ->
+ case Own_name of
+ no_name ->
+ config_scan(MyNode, PubTypeGroup, NodeGrps, Name, Nodes, OtherNodeGrps);
+ _ ->
+ {error, {'node defined twice', {Own_name, Name}}}
+ end;
+ false ->
+ config_scan(MyNode,PubType,NodeGrps,Own_name,OwnNodes,
+ [{Name, Nodes}|OtherNodeGrps])
+ end.
+
+grp_tuple({Name, Nodes}) ->
+ {Name, normal, Nodes};
+grp_tuple({Name, hidden, Nodes}) ->
+ {Name, hidden, Nodes};
+grp_tuple({Name, normal, Nodes}) ->
+ {Name, normal, Nodes}.
+
+
+%%%====================================================================================
+%%% The special process which checks that all nodes in the own global group
+%%% agrees on the configuration.
+%%%====================================================================================
+sync_init(Type, Cname, PubType, Nodes) ->
+ {Up, Down} = sync_check_node(lists:delete(node(), Nodes), [], []),
+ sync_check_init(Type, Up, Cname, Nodes, Down, PubType).
+
+sync_check_node([], Up, Down) ->
+ {Up, Down};
+sync_check_node([Node|Nodes], Up, Down) ->
+ case net_adm:ping(Node) of
+ pang ->
+ sync_check_node(Nodes, Up, [Node|Down]);
+ pong ->
+ sync_check_node(Nodes, [Node|Up], Down)
+ end.
+
+
+
+%%%-------------------------------------------------------------
+%%% Check that all nodes are in agreement of the global
+%%% group configuration.
+%%%-------------------------------------------------------------
+sync_check_init(Type, Up, Cname, Nodes, Down, PubType) ->
+ sync_check_init(Type, Up, Cname, Nodes, 3, [], Down, PubType).
+
+sync_check_init(_Type, NoContact, _Cname, _Nodes, 0, ErrorNodes, Down, _PubType) ->
+ case ErrorNodes of
+ [] ->
+ gen_server:cast(global_group, {synced, lists:sort(NoContact ++ Down)});
+ _ ->
+ gen_server:cast(global_group, {sync_error, lists:sort(NoContact ++ Down),
+ ErrorNodes})
+ end,
+ receive
+ kill ->
+ exit(normal)
+ after 5000 ->
+ exit(normal)
+ end;
+
+sync_check_init(Type, Up, Cname, Nodes, N, ErrorNodes, Down, PubType) ->
+ ConfCheckMsg = case PubType of
+ normal ->
+ {conf_check, ?cc_vsn, node(), self(), Type, Cname, Nodes};
+ _ ->
+ {conf_check, ?cc_vsn, node(), self(), Type, Cname, PubType, Nodes}
+ end,
+ lists:foreach(fun(Node) ->
+ gen_server:cast({global_group, Node}, ConfCheckMsg)
+ end, Up),
+ case sync_check(Up) of
+ {ok, synced} ->
+ sync_check_init(Type, [], Cname, Nodes, 0, ErrorNodes, Down, PubType);
+ {error, NewErrorNodes} ->
+ sync_check_init(Type, [], Cname, Nodes, 0, ErrorNodes ++ NewErrorNodes, Down, PubType);
+ {more, Rem, NewErrorNodes} ->
+ %% Try again to reach the global_group,
+ %% obviously the node is up but not the global_group process.
+ sync_check_init(Type, Rem, Cname, Nodes, N-1, ErrorNodes ++ NewErrorNodes, Down, PubType)
+ end.
+
+sync_check(Up) ->
+ sync_check(Up, Up, []).
+
+sync_check([], _Up, []) ->
+ {ok, synced};
+sync_check([], _Up, ErrorNodes) ->
+ {error, ErrorNodes};
+sync_check(Rem, Up, ErrorNodes) ->
+ receive
+ {config_ok, ?cc_vsn, Pid, Node} when Pid =:= self() ->
+ global_name_server ! {nodeup, Node},
+ sync_check(Rem -- [Node], Up, ErrorNodes);
+ {config_error, ?cc_vsn, Pid, Node} when Pid =:= self() ->
+ sync_check(Rem -- [Node], Up, [Node | ErrorNodes]);
+ {no_global_group_configuration, ?cc_vsn, Pid, Node} when Pid =:= self() ->
+ sync_check(Rem -- [Node], Up, [Node | ErrorNodes]);
+ %% Ignore, illegal vsn or illegal Pid
+ _ ->
+ sync_check(Rem, Up, ErrorNodes)
+ after 2000 ->
+ %% Try again, the previous conf_check message
+ %% apparently disapared in the magic black hole.
+ {more, Rem, ErrorNodes}
+ end.
+
+
+%%%====================================================================================
+%%% A process wants to toggle monitoring nodeup/nodedown from nodes.
+%%%====================================================================================
+monitor_nodes(true, Pid, State) ->
+ link(Pid),
+ Monitor = State#state.monitor,
+ {ok, State#state{monitor = [Pid|Monitor]}};
+monitor_nodes(false, Pid, State) ->
+ Monitor = State#state.monitor,
+ State1 = State#state{monitor = delete_all(Pid,Monitor)},
+ do_unlink(Pid, State1),
+ {ok, State1};
+monitor_nodes(_, _, State) ->
+ {error, State}.
+
+delete_all(From, [From |Tail]) -> delete_all(From, Tail);
+delete_all(From, [H|Tail]) -> [H|delete_all(From, Tail)];
+delete_all(_, []) -> [].
+
+%% do unlink if we have no more references to Pid.
+do_unlink(Pid, State) ->
+ case lists:member(Pid, State#state.monitor) of
+ true ->
+ false;
+ _ ->
+% io:format("unlink(Pid) ~p~n",[Pid]),
+ unlink(Pid)
+ end.
+
+
+
+%%%====================================================================================
+%%% Send a nodeup/down messages to monitoring Pids in the own global group.
+%%%====================================================================================
+send_monitor([P|T], M, no_conf) -> safesend_nc(P, M), send_monitor(T, M, no_conf);
+send_monitor([P|T], M, SyncState) -> safesend(P, M), send_monitor(T, M, SyncState);
+send_monitor([], _, _) -> ok.
+
+safesend(Name, {Msg, Node}) when is_atom(Name) ->
+ case lists:member(Node, get_own_nodes()) of
+ true ->
+ case whereis(Name) of
+ undefined ->
+ {Msg, Node};
+ P when is_pid(P) ->
+ P ! {Msg, Node}
+ end;
+ false ->
+ not_own_group
+ end;
+safesend(Pid, {Msg, Node}) ->
+ case lists:member(Node, get_own_nodes()) of
+ true ->
+ Pid ! {Msg, Node};
+ false ->
+ not_own_group
+ end.
+
+safesend_nc(Name, {Msg, Node}) when is_atom(Name) ->
+ case whereis(Name) of
+ undefined ->
+ {Msg, Node};
+ P when is_pid(P) ->
+ P ! {Msg, Node}
+ end;
+safesend_nc(Pid, {Msg, Node}) ->
+ Pid ! {Msg, Node}.
+
+
+
+
+
+
+%%%====================================================================================
+%%% Check which user is associated to the crashed process.
+%%%====================================================================================
+check_exit(ExitPid, Reason) ->
+% io:format("===EXIT=== ~p ~p ~n~p ~n~p ~n~p ~n~n",[ExitPid, Reason, get(registered_names), get(send), get(whereis_name)]),
+ check_exit_reg(get(registered_names), ExitPid, Reason),
+ check_exit_send(get(send), ExitPid, Reason),
+ check_exit_where(get(whereis_name), ExitPid, Reason).
+
+
+check_exit_reg(undefined, _ExitPid, _Reason) ->
+ ok;
+check_exit_reg(Reg, ExitPid, Reason) ->
+ case lists:keysearch(ExitPid, 1, lists:delete(undefined, Reg)) of
+ {value, {ExitPid, From}} ->
+ NewReg = lists:delete({ExitPid, From}, Reg),
+ put(registered_names, NewReg),
+ gen_server:reply(From, {error, Reason});
+ false ->
+ not_found_ignored
+ end.
+
+
+check_exit_send(undefined, _ExitPid, _Reason) ->
+ ok;
+check_exit_send(Send, ExitPid, _Reason) ->
+ case lists:keysearch(ExitPid, 1, lists:delete(undefined, Send)) of
+ {value, {ExitPid, From, Name, Msg}} ->
+ NewSend = lists:delete({ExitPid, From, Name, Msg}, Send),
+ put(send, NewSend),
+ gen_server:reply(From, {badarg, {Name, Msg}});
+ false ->
+ not_found_ignored
+ end.
+
+
+check_exit_where(undefined, _ExitPid, _Reason) ->
+ ok;
+check_exit_where(Where, ExitPid, Reason) ->
+ case lists:keysearch(ExitPid, 1, lists:delete(undefined, Where)) of
+ {value, {ExitPid, From}} ->
+ NewWhere = lists:delete({ExitPid, From}, Where),
+ put(whereis_name, NewWhere),
+ gen_server:reply(From, {error, Reason});
+ false ->
+ not_found_ignored
+ end.
+
+
+
+%%%====================================================================================
+%%% Kill any possible global_group_check processes
+%%%====================================================================================
+kill_global_group_check() ->
+ case whereis(global_group_check) of
+ undefined ->
+ ok;
+ Pid ->
+ unlink(Pid),
+ global_group_check ! kill,
+ unregister(global_group_check)
+ end.
+
+
+%%%====================================================================================
+%%% Disconnect nodes not belonging to own global_groups
+%%%====================================================================================
+disconnect_nodes(DisconnectNodes) ->
+ lists:foreach(fun(Node) ->
+ {global_group, Node} ! {disconnect_node, node()},
+ global:node_disconnected(Node)
+ end,
+ DisconnectNodes).
+
+
+%%%====================================================================================
+%%% Disconnect nodes not belonging to own global_groups
+%%%====================================================================================
+force_nodedown(DisconnectNodes) ->
+ lists:foreach(fun(Node) ->
+ erlang:disconnect_node(Node),
+ global:node_disconnected(Node)
+ end,
+ DisconnectNodes).
+
+
+%%%====================================================================================
+%%% Get the current global_groups definition
+%%%====================================================================================
+get_own_nodes_with_errors() ->
+ case application:get_env(kernel, global_groups) of
+ undefined ->
+ {ok, all};
+ {ok, []} ->
+ {ok, all};
+ {ok, NodeGrps} ->
+ case catch config_scan(NodeGrps, publish_type) of
+ {error, Error} ->
+ {error, Error};
+ {_, _, NodesDef, _} ->
+ {ok, lists:sort(NodesDef)}
+ end
+ end.
+
+get_own_nodes() ->
+ case get_own_nodes_with_errors() of
+ {ok, all} ->
+ [];
+ {error, _} ->
+ [];
+ {ok, Nodes} ->
+ Nodes
+ end.
+
+%%%====================================================================================
+%%% -hidden command line argument
+%%%====================================================================================
+publish_arg() ->
+ case init:get_argument(hidden) of
+ {ok,[[]]} ->
+ hidden;
+ {ok,[["true"]]} ->
+ hidden;
+ _ ->
+ normal
+ end.
+
+
+%%%====================================================================================
+%%% Own group publication type and nodes
+%%%====================================================================================
+own_group() ->
+ case application:get_env(kernel, global_groups) of
+ undefined ->
+ no_group;
+ {ok, []} ->
+ no_group;
+ {ok, NodeGrps} ->
+ case catch config_scan(NodeGrps, publish_type) of
+ {error, _} ->
+ no_group;
+ {_, PubTpGrp, NodesDef, _} ->
+ {PubTpGrp, NodesDef}
+ end
+ end.
+
+
+%%%====================================================================================
+%%% Help function which computes publication list
+%%%====================================================================================
+publish_on_nodes(normal, no_group) ->
+ all;
+publish_on_nodes(hidden, no_group) ->
+ [];
+publish_on_nodes(normal, {normal, _}) ->
+ all;
+publish_on_nodes(hidden, {_, Nodes}) ->
+ Nodes;
+publish_on_nodes(_, {hidden, Nodes}) ->
+ Nodes.
+
+%%%====================================================================================
+%%% Update net_kernels publication list
+%%%====================================================================================
+update_publish_nodes(PubArg) ->
+ update_publish_nodes(PubArg, no_group).
+update_publish_nodes(PubArg, MyGroup) ->
+ net_kernel:update_publish_nodes(publish_on_nodes(PubArg, MyGroup)).
+
+
+%%%====================================================================================
+%%% Fetch publication list
+%%%====================================================================================
+publish_on_nodes() ->
+ publish_on_nodes(publish_arg(), own_group()).
diff --git a/lib/kernel/src/global_search.erl b/lib/kernel/src/global_search.erl
new file mode 100644
index 0000000000..b723e18a1b
--- /dev/null
+++ b/lib/kernel/src/global_search.erl
@@ -0,0 +1,279 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(global_search).
+
+%% Search for globally registered names in the global groups.
+%% This is a help module to the global_group.erl
+
+
+%% External exports
+-export([start/2]).
+-export([init_send/1]).
+-export([init_whereis/1]).
+-export([init_names/1]).
+
+
+%% ONLY for test purpose
+-export([send_test/1]).
+-export([whereis_test/1]).
+-export([names_test/1]).
+
+
+
+
+%%%====================================================================================
+%%% The search is done in a process separate from the global_group process
+%%%====================================================================================
+start(Flag, Arg) ->
+ case Flag of
+ send ->
+ spawn_link(?MODULE, init_send, [Arg]);
+ whereis ->
+ spawn_link(?MODULE, init_whereis, [Arg]);
+ names ->
+ spawn_link(?MODULE, init_names, [Arg]);
+ %% ONLY for test suites, tests what happens when this process exits.
+ send_test ->
+ spawn_link(?MODULE, send_test, [Arg]);
+ whereis_test ->
+ spawn_link(?MODULE, whereis_test, [Arg]);
+ names_test ->
+ spawn_link(?MODULE, names_test, [Arg])
+ end.
+
+
+%%%====================================================================================
+%%%====================================================================================
+%%%====================================================================================
+%%% Search after a registered global Name anywhere (any), in a specified group or
+%%% in a specified node.
+%%% Return the result to the global_group process in own node and wait for
+%%% this process to be killed.
+%%%====================================================================================
+%%%====================================================================================
+%%%====================================================================================
+
+init_send({any, NodesList, Name, Msg, From}) ->
+ case whereis_any_loop(NodesList, Name) of
+ undefined ->
+ Res = {badarg,{Name, Msg}},
+ gen_server:cast(global_group, {send_res, Res, Name, Msg, self(), From});
+ Pid ->
+ gen_server:cast(global_group, {send_res, Pid, Name, Msg, self(), From})
+ end,
+ end_loop();
+init_send({group, Nodes, Name, Msg, From}) ->
+ case whereis_group_loop(Nodes, Name) of
+ group_down ->
+ Res = {badarg,{Name, Msg}},
+ gen_server:cast(global_group, {send_res, Res, Name, Msg, self(), From});
+ undefined ->
+ Res = {badarg,{Name, Msg}},
+ gen_server:cast(global_group, {send_res, Res, Name, Msg, self(), From});
+ Pid ->
+ gen_server:cast(global_group, {send_res, Pid, Name, Msg, self(), From})
+ end,
+ end_loop();
+init_send({node, Node, Name, Msg, From}) ->
+ case whereis_check_node(Node, Name) of
+ node_down ->
+ Res = {badarg,{Name, Msg}},
+ gen_server:cast(global_group, {send_res, Res, Name, Msg, self(), From});
+ undefined ->
+ Res = {badarg,{Name, Msg}},
+ gen_server:cast(global_group, {send_res, Res, Name, Msg, self(), From});
+ Pid ->
+ gen_server:cast(global_group, {send_res, Pid, Name, Msg, self(), From})
+ end,
+ end_loop().
+
+
+%%%====================================================================================
+%%%====================================================================================
+%%%====================================================================================
+%%% Search after a registered global Name anywhere (any), in a specified group or
+%%% in a specified node.
+%%% Return the result to the global_group process in own node and wait for
+%%% this process to be killed.
+%%%====================================================================================
+%%%====================================================================================
+%%%====================================================================================
+
+init_whereis({any, NodesList, Name, From}) ->
+ R = whereis_any_loop(NodesList, Name),
+ gen_server:cast(global_group, {find_name_res, R, self(), From}),
+ end_loop();
+init_whereis({group, Nodes, Name, From}) ->
+ case whereis_group_loop(Nodes, Name) of
+ group_down ->
+ gen_server:cast(global_group, {find_name_res, undefined, self(), From});
+ R ->
+ gen_server:cast(global_group, {find_name_res, R, self(), From})
+ end,
+ end_loop();
+init_whereis({node, Node, Name, From}) ->
+ case whereis_check_node(Node, Name) of
+ node_down ->
+ gen_server:cast(global_group, {find_name_res, undefined, self(), From});
+ R ->
+ gen_server:cast(global_group, {find_name_res, R, self(), From})
+ end,
+ end_loop().
+
+
+%%%====================================================================================
+%%%====================================================================================
+%%%====================================================================================
+%%% Get the registered names, in a specified group or in a specified node.
+%%% Return the result to the global_group process in own node and wait for
+%%% this process to be killed.
+%%%====================================================================================
+%%%====================================================================================
+%%%====================================================================================
+init_names({group, Nodes, From}) ->
+ case names_group_loop(Nodes) of
+ group_down ->
+ gen_server:cast(global_group, {registered_names_res, [], self(), From});
+ R ->
+ gen_server:cast(global_group, {registered_names_res, R, self(), From})
+ end,
+ end_loop();
+init_names({node, Node, From}) ->
+ case names_check_node(Node) of
+ node_down ->
+ gen_server:cast(global_group, {registered_names_res, [], self(), From});
+ R ->
+ gen_server:cast(global_group, {registered_names_res, R, self(), From})
+ end,
+ end_loop().
+
+%%%====================================================================================
+%%% Wait for the kill message.
+%%%====================================================================================
+
+-spec end_loop() -> no_return().
+
+end_loop() ->
+ receive
+ kill ->
+ exit(normal)
+ end.
+
+%%%====================================================================================
+%%% Search for the globally registered name in the whole known world.
+%%%====================================================================================
+whereis_any_loop([], _Name) ->
+ undefined;
+whereis_any_loop([{_Group_name, Nodes}|T], Name) ->
+ case whereis_group_loop(Nodes, Name) of
+ group_down ->
+ whereis_any_loop(T, Name);
+ undefined ->
+ whereis_any_loop(T, Name);
+ R ->
+ R
+ end.
+
+%%%====================================================================================
+%%% Search for the globally registered name in a specified global group.
+%%%====================================================================================
+whereis_group_loop([], _Name) ->
+ group_down;
+whereis_group_loop([Node|T], Name) ->
+ case whereis_check_node(Node, Name) of
+ node_down ->
+ whereis_group_loop(T, Name);
+ R ->
+ R
+ end.
+%%%====================================================================================
+%%% Search for the globally registered name on a specified node.
+%%%====================================================================================
+whereis_check_node(Node, Name) ->
+ case net_adm:ping(Node) of
+ pang ->
+ node_down;
+ pong ->
+ monitor_node(Node, true),
+ gen_server:cast({global_group, Node},{find_name, self(), Name}),
+ receive
+ {nodedown, Node} ->
+ node_down;
+ {find_name_res, Result} ->
+ monitor_node(Node, false),
+ Result
+ end
+ end.
+
+
+
+
+%%%====================================================================================
+%%% Search for all globally registered name in a specified global group.
+%%%====================================================================================
+names_group_loop([]) ->
+ group_down;
+names_group_loop([Node|T]) ->
+ case names_check_node(Node) of
+ node_down ->
+ names_group_loop(T);
+ R ->
+ R
+ end.
+%%%====================================================================================
+%%% Search for all globally registered name on a specified node.
+%%%====================================================================================
+names_check_node(Node) ->
+ case net_adm:ping(Node) of
+ pang ->
+ node_down;
+ pong ->
+ monitor_node(Node, true),
+ gen_server:cast({global_group, Node},{registered_names, self()}),
+ receive
+ {nodedown, Node} ->
+ node_down;
+ {registered_names_res, Result} ->
+ monitor_node(Node, false),
+ Result
+ end
+ end.
+
+
+
+
+
+
+%%%====================================================================================
+%%% Test what happens when this process exits.
+%%%====================================================================================
+send_test(_Args) ->
+ timer:sleep(5000),
+ exit(testing_exit).
+
+whereis_test(_Args) ->
+ timer:sleep(5000),
+ exit(testing_exit).
+
+names_test(_Args) ->
+ timer:sleep(5000),
+ exit(testing_exit).
+
+
+
diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl
new file mode 100644
index 0000000000..a45ba34eae
--- /dev/null
+++ b/lib/kernel/src/group.erl
@@ -0,0 +1,689 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(group).
+
+%% A group leader process for user io.
+
+-export([start/2, start/3, server/3]).
+-export([interfaces/1]).
+
+start(Drv, Shell) ->
+ start(Drv, Shell, []).
+
+start(Drv, Shell, Options) ->
+ spawn_link(group, server, [Drv, Shell, Options]).
+
+server(Drv, Shell, Options) ->
+ process_flag(trap_exit, true),
+ edlin:init(),
+ put(line_buffer, proplists:get_value(line_buffer, Options, [])),
+ put(read_mode, list),
+ put(user_drv, Drv),
+ put(expand_fun,
+ proplists:get_value(expand_fun, Options,
+ fun(B) -> edlin_expand:expand(B) end)),
+ put(echo, proplists:get_value(echo, Options, true)),
+
+ start_shell(Shell),
+ server_loop(Drv, get(shell), []).
+
+%% Return the pid of user_drv and the shell process.
+%% Note: We can't ask the group process for this info since it
+%% may be busy waiting for data from the driver.
+interfaces(Group) ->
+ case process_info(Group, dictionary) of
+ {dictionary,Dict} ->
+ get_pids(Dict, [], false);
+ _ ->
+ []
+ end.
+
+get_pids([Drv = {user_drv,_} | Rest], Found, _) ->
+ get_pids(Rest, [Drv | Found], true);
+get_pids([Sh = {shell,_} | Rest], Found, Active) ->
+ get_pids(Rest, [Sh | Found], Active);
+get_pids([_ | Rest], Found, Active) ->
+ get_pids(Rest, Found, Active);
+get_pids([], Found, true) ->
+ Found;
+get_pids([], _Found, false) ->
+ [].
+
+%% start_shell(Shell)
+%% Spawn a shell with its group_leader from the beginning set to ourselves.
+%% If Shell a pid the set its group_leader.
+
+start_shell({Mod,Func,Args}) ->
+ start_shell1(Mod, Func, Args);
+start_shell({Node,Mod,Func,Args}) ->
+ start_shell1(net, call, [Node,Mod,Func,Args]);
+start_shell(Shell) when is_atom(Shell) ->
+ start_shell1(Shell, start, []);
+start_shell(Shell) when is_function(Shell) ->
+ start_shell1(Shell);
+start_shell(Shell) when is_pid(Shell) ->
+ group_leader(self(), Shell), % we are the shells group leader
+ link(Shell), % we're linked to it.
+ put(shell, Shell);
+start_shell(_Shell) ->
+ ok.
+
+start_shell1(M, F, Args) ->
+ G = group_leader(),
+ group_leader(self(), self()),
+ case catch apply(M, F, Args) of
+ Shell when is_pid(Shell) ->
+ group_leader(G, self()),
+ link(Shell), % we're linked to it.
+ put(shell, Shell);
+ Error -> % start failure
+ exit(Error) % let the group process crash
+ end.
+
+start_shell1(Fun) ->
+ G = group_leader(),
+ group_leader(self(), self()),
+ case catch Fun() of
+ Shell when is_pid(Shell) ->
+ group_leader(G, self()),
+ link(Shell), % we're linked to it.
+ put(shell, Shell);
+ Error -> % start failure
+ exit(Error) % let the group process crash
+ end.
+
+server_loop(Drv, Shell, Buf0) ->
+ receive
+ {io_request,From,ReplyAs,Req} when is_pid(From) ->
+ Buf = io_request(Req, From, ReplyAs, Drv, Buf0),
+ server_loop(Drv, Shell, Buf);
+ {driver_id,ReplyTo} ->
+ ReplyTo ! {self(),driver_id,Drv},
+ server_loop(Drv, Shell, Buf0);
+ {Drv, echo, Bool} ->
+ put(echo, Bool),
+ server_loop(Drv, Shell, Buf0);
+ {'EXIT',Drv,interrupt} ->
+ %% Send interrupt to the shell.
+ exit_shell(interrupt),
+ server_loop(Drv, Shell, Buf0);
+ {'EXIT',Drv,R} ->
+ exit(R);
+ {'EXIT',Shell,R} ->
+ exit(R);
+ %% We want to throw away any term that we don't handle (standard
+ %% practice in receive loops), but not any {Drv,_} tuples which are
+ %% handled in io_request/5.
+ NotDrvTuple when (not is_tuple(NotDrvTuple)) orelse
+ (tuple_size(NotDrvTuple) =/= 2) orelse
+ (element(1, NotDrvTuple) =/= Drv) ->
+ %% Ignore this unknown message.
+ server_loop(Drv, Shell, Buf0)
+ end.
+
+exit_shell(Reason) ->
+ case get(shell) of
+ undefined -> true;
+ Pid -> exit(Pid, Reason)
+ end.
+
+get_tty_geometry(Drv) ->
+ Drv ! {self(),tty_geometry},
+ receive
+ {Drv,tty_geometry,Geometry} ->
+ Geometry
+ after 2000 ->
+ timeout
+ end.
+get_unicode_state(Drv) ->
+ Drv ! {self(),get_unicode_state},
+ receive
+ {Drv,get_unicode_state,UniState} ->
+ UniState;
+ {Drv,get_unicode_state,error} ->
+ {error, internal}
+ after 2000 ->
+ {error,timeout}
+ end.
+set_unicode_state(Drv,Bool) ->
+ Drv ! {self(),set_unicode_state,Bool},
+ receive
+ {Drv,set_unicode_state,_OldUniState} ->
+ ok
+ after 2000 ->
+ timeout
+ end.
+
+
+io_request(Req, From, ReplyAs, Drv, Buf0) ->
+ case io_request(Req, Drv, Buf0) of
+ {ok,Reply,Buf} ->
+ io_reply(From, ReplyAs, Reply),
+ Buf;
+ {error,Reply,Buf} ->
+ io_reply(From, ReplyAs, Reply),
+ Buf;
+ {exit,R} ->
+ %% 'kill' instead of R, since the shell is not always in
+ %% a state where it is ready to handle a termination
+ %% message.
+ exit_shell(kill),
+ exit(R)
+ end.
+
+
+%% Put_chars, unicode is the normal message, characters are always in
+%%standard unicode
+%% format.
+%% You might be tempted to send binaries unchecked, but the driver
+%% expects unicode, so that is what we should send...
+%% io_request({put_chars,unicode,Binary}, Drv, Buf) when is_binary(Binary) ->
+%% send_drv(Drv, {put_chars,Binary}),
+%% {ok,ok,Buf};
+io_request({put_chars,unicode,Chars}, Drv, Buf) ->
+ case catch unicode:characters_to_binary(Chars,utf8) of
+ Binary when is_binary(Binary) ->
+ send_drv(Drv, {put_chars, unicode, Binary}),
+ {ok,ok,Buf};
+ _ ->
+ {error,{error,{put_chars, unicode,Chars}},Buf}
+ end;
+io_request({put_chars,unicode,M,F,As}, Drv, Buf) ->
+ case catch apply(M, F, As) of
+ Binary when is_binary(Binary) ->
+ send_drv(Drv, {put_chars, unicode,Binary}),
+ {ok,ok,Buf};
+ Chars ->
+ case catch unicode:characters_to_binary(Chars,utf8) of
+ B when is_binary(B) ->
+ send_drv(Drv, {put_chars, unicode,B}),
+ {ok,ok,Buf};
+ _ ->
+ {error,{error,F},Buf}
+ end
+ end;
+io_request({put_chars,latin1,Binary}, Drv, Buf) when is_binary(Binary) ->
+ send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}),
+ {ok,ok,Buf};
+io_request({put_chars,latin1,Chars}, Drv, Buf) ->
+ case catch unicode:characters_to_binary(Chars,latin1) of
+ Binary when is_binary(Binary) ->
+ send_drv(Drv, {put_chars, unicode,Binary}),
+ {ok,ok,Buf};
+ _ ->
+ {error,{error,{put_chars,Chars}},Buf}
+ end;
+io_request({put_chars,latin1,M,F,As}, Drv, Buf) ->
+ case catch apply(M, F, As) of
+ Binary when is_binary(Binary) ->
+ send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}),
+ {ok,ok,Buf};
+ Chars ->
+ case catch unicode:characters_to_binary(Chars,latin1) of
+ B when is_binary(B) ->
+ send_drv(Drv, {put_chars, unicode,B}),
+ {ok,ok,Buf};
+ _ ->
+ {error,{error,F},Buf}
+ end
+ end;
+
+io_request({get_chars,Encoding,Prompt,N}, Drv, Buf) ->
+ get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding);
+io_request({get_line,Encoding,Prompt}, Drv, Buf) ->
+ get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding);
+io_request({get_until,Encoding, Prompt,M,F,As}, Drv, Buf) ->
+ get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding);
+io_request({get_password,_Encoding},Drv,Buf) ->
+ get_password_chars(Drv, Buf);
+io_request({setopts,Opts}, Drv, Buf) when is_list(Opts) ->
+ setopts(Opts, Drv, Buf);
+io_request(getopts, Drv, Buf) ->
+ getopts(Drv, Buf);
+io_request({requests,Reqs}, Drv, Buf) ->
+ io_requests(Reqs, {ok,ok,Buf}, Drv);
+
+%% New in R12
+io_request({get_geometry,columns},Drv,Buf) ->
+ case get_tty_geometry(Drv) of
+ {W,_H} ->
+ {ok,W,Buf};
+ _ ->
+ {error,{error,enotsup},Buf}
+ end;
+io_request({get_geometry,rows},Drv,Buf) ->
+ case get_tty_geometry(Drv) of
+ {_W,H} ->
+ {ok,H,Buf};
+ _ ->
+ {error,{error,enotsup},Buf}
+ end;
+
+%% BC with pre-R13
+io_request({put_chars,Chars}, Drv, Buf) ->
+ io_request({put_chars,latin1,Chars}, Drv, Buf);
+io_request({put_chars,M,F,As}, Drv, Buf) ->
+ io_request({put_chars,latin1,M,F,As}, Drv, Buf);
+io_request({get_chars,Prompt,N}, Drv, Buf) ->
+ io_request({get_chars,latin1,Prompt,N}, Drv, Buf);
+io_request({get_line,Prompt}, Drv, Buf) ->
+ io_request({get_line,latin1,Prompt}, Drv, Buf);
+io_request({get_until, Prompt,M,F,As}, Drv, Buf) ->
+ io_request({get_until,latin1, Prompt,M,F,As}, Drv, Buf);
+io_request(get_password,Drv,Buf) ->
+ io_request({get_password,latin1},Drv,Buf);
+
+
+
+io_request(_, _Drv, Buf) ->
+ {error,{error,request},Buf}.
+
+%% Status = io_requests(RequestList, PrevStat, Drv)
+%% Process a list of output requests as long as the previous status is 'ok'.
+
+io_requests([R|Rs], {ok,ok,Buf}, Drv) ->
+ io_requests(Rs, io_request(R, Drv, Buf), Drv);
+io_requests([_|_], Error, _Drv) ->
+ Error;
+io_requests([], Stat, _) ->
+ Stat.
+
+%% io_reply(From, ReplyAs, Reply)
+%% The function for sending i/o command acknowledgement.
+%% The ACK contains the return value.
+
+io_reply(From, ReplyAs, Reply) ->
+ From ! {io_reply,ReplyAs,Reply}.
+
+%% send_drv(Drv, Message)
+%% send_drv_reqs(Drv, Requests)
+
+send_drv(Drv, Msg) ->
+ Drv ! {self(),Msg}.
+
+send_drv_reqs(_Drv, []) -> [];
+send_drv_reqs(Drv, Rs) ->
+ send_drv(Drv, {requests,Rs}).
+
+expand_encoding([]) ->
+ [];
+expand_encoding([latin1 | T]) ->
+ [{encoding,latin1} | expand_encoding(T)];
+expand_encoding([unicode | T]) ->
+ [{encoding,unicode} | expand_encoding(T)];
+expand_encoding([H|T]) ->
+ [H|expand_encoding(T)].
+%% setopts
+setopts(Opts0,Drv,Buf) ->
+ Opts = proplists:unfold(
+ proplists:substitute_negations(
+ [{list,binary}],
+ expand_encoding(Opts0))),
+ case check_valid_opts(Opts) of
+ true ->
+ do_setopts(Opts,Drv,Buf);
+ false ->
+ {error,{error,enotsup},Buf}
+ end.
+check_valid_opts([]) ->
+ true;
+check_valid_opts([{binary,_}|T]) ->
+ check_valid_opts(T);
+check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; Valid =:= utf8; Valid =:= latin1 ->
+ check_valid_opts(T);
+check_valid_opts([{echo,_}|T]) ->
+ check_valid_opts(T);
+check_valid_opts([{expand_fun,_}|T]) ->
+ check_valid_opts(T);
+check_valid_opts(_) ->
+ false.
+
+do_setopts(Opts, Drv, Buf) ->
+ put(expand_fun, proplists:get_value(expand_fun, Opts, get(expand_fun))),
+ put(echo, proplists:get_value(echo, Opts, get(echo))),
+ case proplists:get_value(encoding,Opts) of
+ Valid when Valid =:= unicode; Valid =:= utf8 ->
+ set_unicode_state(Drv,true);
+ latin1 ->
+ set_unicode_state(Drv,false);
+ _ ->
+ ok
+ end,
+ case proplists:get_value(binary, Opts, case get(read_mode) of
+ binary -> true;
+ _ -> false
+ end) of
+ true ->
+ put(read_mode, binary),
+ {ok,ok,Buf};
+ false ->
+ put(read_mode, list),
+ {ok,ok,Buf};
+ _ ->
+ {ok,ok,Buf}
+ end.
+
+getopts(Drv,Buf) ->
+ Exp = {expand_fun, case get(expand_fun) of
+ Func when is_function(Func) ->
+ Func;
+ _ ->
+ false
+ end},
+ Echo = {echo, case get(echo) of
+ Bool when Bool =:= true; Bool =:= false ->
+ Bool;
+ _ ->
+ false
+ end},
+ Bin = {binary, case get(read_mode) of
+ binary ->
+ true;
+ _ ->
+ false
+ end},
+ Uni = {encoding, case get_unicode_state(Drv) of
+ true -> unicode;
+ _ -> latin1
+ end},
+ {ok,[Exp,Echo,Bin,Uni],Buf}.
+
+
+%% get_chars(Prompt, Module, Function, XtraArgument, Drv, Buffer)
+%% Gets characters from the input Drv until as the applied function
+%% returns {stop,Result,Rest}. Does not block output until input has been
+%% received.
+%% Returns:
+%% {Result,NewSaveBuffer}
+%% {error,What,NewSaveBuffer}
+
+get_password_chars(Drv,Buf) ->
+ case get_password_line(Buf, Drv) of
+ {done, Line, Buf1} ->
+ {ok, Line, Buf1};
+ interrupted ->
+ {error, {error, interrupted}, []};
+ terminated ->
+ {exit, terminated}
+ end.
+
+get_chars(Prompt, M, F, Xa, Drv, Buf, Encoding) ->
+ Pbs = prompt_bytes(Prompt),
+ get_chars_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding).
+
+get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) ->
+ Result = case get(echo) of
+ true ->
+ get_line(Buf0, Pbs, Drv, Encoding);
+ false ->
+ % get_line_echo_off only deals with lists
+ % and does not need encoding...
+ get_line_echo_off(Buf0, Pbs, Drv)
+ end,
+ case Result of
+ {done,Line,Buf1} ->
+ get_chars_apply(Pbs, M, F, Xa, Drv, Buf1, State, Line, Encoding);
+ interrupted ->
+ {error,{error,interrupted},[]};
+ terminated ->
+ {exit,terminated}
+ end.
+
+get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State0, Line, Encoding) ->
+ id(M,F),
+ case catch M:F(State0, cast(Line,get(read_mode), Encoding), Encoding, Xa) of
+ {stop,Result,Rest} ->
+ {ok,Result,append(Rest, Buf, Encoding)};
+ {'EXIT',_} ->
+ {error,{error,err_func(M, F, Xa)},[]};
+ State1 ->
+ get_chars_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding)
+ end.
+
+id(M,F) ->
+ {M,F}.
+%% Convert error code to make it look as before
+err_func(io_lib, get_until, {_,F,_}) ->
+ F;
+err_func(_, F, _) ->
+ F.
+
+%% get_line(Chars, PromptBytes, Drv)
+%% Get a line with eventual line editing. Handle other io requests
+%% while getting line.
+%% Returns:
+%% {done,LineChars,RestChars}
+%% interrupted
+
+get_line(Chars, Pbs, Drv, Encoding) ->
+ {more_chars,Cont,Rs} = edlin:start(Pbs),
+ send_drv_reqs(Drv, Rs),
+ get_line1(edlin:edit_line(Chars, Cont), Drv, new_stack(get(line_buffer)),
+ Encoding).
+
+get_line1({done,Line,Rest,Rs}, Drv, _Ls, _Encoding) ->
+ send_drv_reqs(Drv, Rs),
+ put(line_buffer, [Line|lists:delete(Line, get(line_buffer))]),
+ {done,Line,Rest};
+get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding)
+ when ((Mode =:= none) and (Char =:= $\^P))
+ or ((Mode =:= meta_left_sq_bracket) and (Char =:= $A)) ->
+ send_drv_reqs(Drv, Rs),
+ case up_stack(Ls0) of
+ {none,_Ls} ->
+ send_drv(Drv, beep),
+ get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding);
+ {Lcs,Ls} ->
+ send_drv_reqs(Drv, edlin:erase_line(Cont)),
+ {more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)),
+ send_drv_reqs(Drv, Nrs),
+ get_line1(edlin:edit_line1(lists:sublist(Lcs, 1, length(Lcs)-1),
+ Ncont),
+ Drv,
+ Ls, Encoding)
+ end;
+get_line1({undefined,{_A,Mode,Char},_Cs,Cont,Rs}, Drv, Ls0, Encoding)
+ when ((Mode =:= none) and (Char =:= $\^N))
+ or ((Mode =:= meta_left_sq_bracket) and (Char =:= $B)) ->
+ send_drv_reqs(Drv, Rs),
+ case down_stack(Ls0) of
+ {none,Ls} ->
+ send_drv_reqs(Drv, edlin:erase_line(Cont)),
+ get_line1(edlin:start(edlin:prompt(Cont)), Drv, Ls, Encoding);
+ {Lcs,Ls} ->
+ send_drv_reqs(Drv, edlin:erase_line(Cont)),
+ {more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)),
+ send_drv_reqs(Drv, Nrs),
+ get_line1(edlin:edit_line1(lists:sublist(Lcs, 1, length(Lcs)-1),
+ Ncont),
+ Drv,
+ Ls, Encoding)
+ end;
+get_line1({expand, Before, Cs0, Cont,Rs}, Drv, Ls0, Encoding) ->
+ send_drv_reqs(Drv, Rs),
+ ExpandFun = get(expand_fun),
+ {Found, Add, Matches} = ExpandFun(Before),
+ case Found of
+ no -> send_drv(Drv, beep);
+ yes -> ok
+ end,
+ Cs1 = append(Add, Cs0, Encoding), %%XXX:PaN should this always be unicode?
+ Cs = case Matches of
+ [] -> Cs1;
+ _ -> MatchStr = edlin_expand:format_matches(Matches),
+ send_drv(Drv, {put_chars, unicode, unicode:characters_to_binary(MatchStr,unicode)}),
+ [$\^L | Cs1]
+ end,
+ get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding);
+get_line1({undefined,_Char,Cs,Cont,Rs}, Drv, Ls, Encoding) ->
+ send_drv_reqs(Drv, Rs),
+ send_drv(Drv, beep),
+ get_line1(edlin:edit_line(Cs, Cont), Drv, Ls, Encoding);
+get_line1({What,Cont0,Rs}, Drv, Ls, Encoding) ->
+ send_drv_reqs(Drv, Rs),
+ receive
+ {Drv,{data,Cs}} ->
+ get_line1(edlin:edit_line(Cs, Cont0), Drv, Ls, Encoding);
+ {Drv,eof} ->
+ get_line1(edlin:edit_line(eof, Cont0), Drv, Ls, Encoding);
+ {io_request,From,ReplyAs,Req} when is_pid(From) ->
+ {more_chars,Cont,_More} = edlin:edit_line([], Cont0),
+ send_drv_reqs(Drv, edlin:erase_line(Cont)),
+ io_request(Req, From, ReplyAs, Drv, []), %WRONG!!!
+ send_drv_reqs(Drv, edlin:redraw_line(Cont)),
+ get_line1({more_chars,Cont,[]}, Drv, Ls, Encoding);
+ {'EXIT',Drv,interrupt} ->
+ interrupted;
+ {'EXIT',Drv,_} ->
+ terminated
+ after
+ get_line_timeout(What)->
+ get_line1(edlin:edit_line([], Cont0), Drv, Ls, Encoding)
+ end.
+
+
+get_line_echo_off(Chars, Pbs, Drv) ->
+ send_drv_reqs(Drv, [{put_chars, unicode,Pbs}]),
+ get_line_echo_off1(edit_line(Chars,[]), Drv).
+
+get_line_echo_off1({Chars,[]}, Drv) ->
+ receive
+ {Drv,{data,Cs}} ->
+ get_line_echo_off1(edit_line(Cs, Chars), Drv);
+ {Drv,eof} ->
+ get_line_echo_off1(edit_line(eof, Chars), Drv);
+ {io_request,From,ReplyAs,Req} when is_pid(From) ->
+ io_request(Req, From, ReplyAs, Drv, []),
+ get_line_echo_off1({Chars,[]}, Drv);
+ {'EXIT',Drv,interrupt} ->
+ interrupted;
+ {'EXIT',Drv,_} ->
+ terminated
+ end;
+get_line_echo_off1({Chars,Rest}, _Drv) ->
+ {done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}.
+
+%% We support line editing for the ICANON mode except the following
+%% line editing characters, which already has another meaning in
+%% echo-on mode (See Advanced Programming in the Unix Environment, 2nd ed,
+%% Stevens, page 638):
+%% - ^u in posix/icanon mode: erase-line, prefix-arg in edlin
+%% - ^t in posix/icanon mode: status, transpose-char in edlin
+%% - ^d in posix/icanon mode: eof, delete-forward in edlin
+%% - ^r in posix/icanon mode: reprint (silly in echo-off mode :-))
+%% - ^w in posix/icanon mode: word-erase (produces a beep in edlin)
+edit_line(eof, Chars) ->
+ {Chars,done};
+edit_line([],Chars) ->
+ {Chars,[]};
+edit_line([$\r,$\n|Cs],Chars) ->
+ {[$\n | Chars], remainder_after_nl(Cs)};
+edit_line([NL|Cs],Chars) when NL =:= $\r; NL =:= $\n ->
+ {[$\n | Chars], remainder_after_nl(Cs)};
+edit_line([Erase|Cs],[]) when Erase =:= $\177; Erase =:= $\^H ->
+ edit_line(Cs,[]);
+edit_line([Erase|Cs],[_|Chars]) when Erase =:= $\177; Erase =:= $\^H ->
+ edit_line(Cs,Chars);
+edit_line([Char|Cs],Chars) ->
+ edit_line(Cs,[Char|Chars]).
+
+remainder_after_nl("") -> done;
+remainder_after_nl(Cs) -> Cs.
+
+
+
+get_line_timeout(blink) -> 1000;
+get_line_timeout(more_chars) -> infinity.
+
+new_stack(Ls) -> {stack,Ls,{},[]}.
+
+up_stack({stack,[L|U],{},D}) ->
+ {L,{stack,U,L,D}};
+up_stack({stack,[],{},D}) ->
+ {none,{stack,[],{},D}};
+up_stack({stack,U,C,D}) ->
+ up_stack({stack,U,{},[C|D]}).
+
+down_stack({stack,U,{},[L|D]}) ->
+ {L,{stack,U,L,D}};
+down_stack({stack,U,{},[]}) ->
+ {none,{stack,U,{},[]}};
+down_stack({stack,U,C,D}) ->
+ down_stack({stack,[C|U],{},D}).
+
+%% This is get_line without line editing (except for backspace) and
+%% without echo.
+get_password_line(Chars, Drv) ->
+ get_password1(edit_password(Chars,[]),Drv).
+
+get_password1({Chars,[]}, Drv) ->
+ receive
+ {Drv,{data,Cs}} ->
+ get_password1(edit_password(Cs,Chars),Drv);
+ {io_request,From,ReplyAs,Req} when is_pid(From) ->
+ %send_drv_reqs(Drv, [{delete_chars, -length(Pbs)}]),
+ io_request(Req, From, ReplyAs, Drv, []), %WRONG!!!
+ %% I guess the reason the above line is wrong is that Buf is
+ %% set to []. But do we expect anything but plain output?
+
+ get_password1({Chars, []}, Drv);
+ {'EXIT',Drv,interrupt} ->
+ interrupted;
+ {'EXIT',Drv,_} ->
+ terminated
+ end;
+get_password1({Chars,Rest},Drv) ->
+ send_drv_reqs(Drv,[{put_chars, unicode, "\n"}]),
+ {done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}.
+
+edit_password([],Chars) ->
+ {Chars,[]};
+edit_password([$\r],Chars) ->
+ {Chars,done};
+edit_password([$\r|Cs],Chars) ->
+ {Chars,Cs};
+edit_password([$\177|Cs],[]) -> %% Being able to erase characters is
+ edit_password(Cs,[]); %% the least we should offer, but
+edit_password([$\177|Cs],[_|Chars]) ->%% is backspace enough?
+ edit_password(Cs,Chars);
+edit_password([Char|Cs],Chars) ->
+ edit_password(Cs,[Char|Chars]).
+
+%% prompt_bytes(Prompt)
+%% Return a flat list of bytes for the Prompt.
+prompt_bytes(Prompt) ->
+ lists:flatten(io_lib:format_prompt(Prompt)).
+
+cast(L, binary,latin1) when is_list(L) ->
+ list_to_binary(L);
+cast(L, list, latin1) when is_list(L) ->
+ binary_to_list(list_to_binary(L)); %% Exception if not bytes
+cast(L, binary,unicode) when is_list(L) ->
+ unicode:characters_to_binary(L,utf8);
+cast(Other, _, _) ->
+ Other.
+
+append(B, L, latin1) when is_binary(B) ->
+ binary_to_list(B)++L;
+append(B, L, unicode) when is_binary(B) ->
+ unicode:characters_to_list(B,utf8)++L;
+append(L1, L2, _) when is_list(L1) ->
+ L1++L2;
+append(_Eof, L, _) ->
+ L.
diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl
new file mode 100644
index 0000000000..bad0950fca
--- /dev/null
+++ b/lib/kernel/src/heart.erl
@@ -0,0 +1,271 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(heart).
+
+%%%--------------------------------------------------------------------
+%%% This is a rewrite of pre_heart from BS.3.
+%%%
+%%% The purpose of this process-module is to act as an supervisor
+%%% of the entire erlang-system. This 'heart' beats with a frequence
+%%% satisfying an external port program *not* reboot the entire
+%%% system. If however the erlang-emulator would hang, a reboot is
+%%% then needed.
+%%%
+%%% It recognizes the flag '-heart'
+%%%--------------------------------------------------------------------
+-export([start/0, init/2, set_cmd/1, clear_cmd/0, get_cmd/0, cycle/0]).
+
+-define(START_ACK, 1).
+-define(HEART_BEAT, 2).
+-define(SHUT_DOWN, 3).
+-define(SET_CMD, 4).
+-define(CLEAR_CMD, 5).
+-define(GET_CMD, 6).
+-define(HEART_CMD, 7).
+
+-define(TIMEOUT, 5000).
+-define(CYCLE_TIMEOUT, 10000).
+
+%%---------------------------------------------------------------------
+
+-spec start() -> 'ignore' | {'error', term()} | {'ok', pid()}.
+
+start() ->
+ case whereis(heart) of
+ undefined ->
+ %% As heart survives a init:restart/0 the Parent
+ %% of heart must be init.
+ %% The init process is responsible to create a link
+ %% to heart.
+ Pid = spawn(?MODULE, init, [self(), whereis(init)]),
+ wait_for_init_ack(Pid);
+ Pid ->
+ {ok, Pid}
+ end.
+
+wait_for_init_ack(From) ->
+ receive
+ {ok, From} ->
+ {ok, From};
+ {no_heart, From} ->
+ ignore;
+ {Error, From} ->
+ {error, Error}
+ end.
+
+-spec init(pid(), pid()) -> {'no_heart', pid()} | {'start_error', pid()}.
+
+init(Starter, Parent) ->
+ process_flag(trap_exit, true),
+ process_flag(priority, max),
+ register(heart, self()),
+ case catch start_portprogram() of
+ {ok, Port} ->
+ Starter ! {ok, self()},
+ loop(Parent, Port, "");
+ no_heart ->
+ Starter ! {no_heart, self()};
+ error ->
+ Starter ! {start_error, self()}
+ end.
+
+-spec set_cmd(string()) -> 'ok' | {'error', {'bad_cmd', string()}}.
+
+set_cmd(Cmd) ->
+ heart ! {self(), set_cmd, Cmd},
+ wait().
+
+-spec get_cmd() -> 'ok'.
+
+get_cmd() ->
+ heart ! {self(), get_cmd},
+ wait().
+
+-spec clear_cmd() -> {'ok', string()}.
+
+clear_cmd() ->
+ heart ! {self(), clear_cmd},
+ wait().
+
+
+%%% Should be used solely by the release handler!!!!!!!
+-spec cycle() -> 'ok' | {'error', term()}.
+
+cycle() ->
+ heart ! {self(), cycle},
+ wait().
+
+wait() ->
+ receive
+ {heart, Res} ->
+ Res
+ end.
+
+start_portprogram() ->
+ check_start_heart(),
+ HeartCmd = "heart -pid " ++ os:getpid() ++ " " ++
+ get_heart_timeouts(),
+ try open_port({spawn, HeartCmd}, [{packet, 2}]) of
+ Port when is_port(Port) ->
+ case wait_ack(Port) of
+ ok ->
+ {ok, Port};
+ {error, Reason} ->
+ report_problem({{port_problem, Reason},
+ {heart, start_portprogram, []}}),
+ error
+ end
+ catch
+ _:Reason ->
+ report_problem({{open_port, Reason},
+ {heart, start_portprogram, []}}),
+ error
+ end.
+
+get_heart_timeouts() ->
+ HeartOpts = case os:getenv("HEART_BEAT_TIMEOUT") of
+ false -> "";
+ H when is_list(H) ->
+ "-ht " ++ H
+ end,
+ HeartOpts ++ case os:getenv("HEART_BEAT_BOOT_DELAY") of
+ false -> "";
+ W when is_list(W) ->
+ " -wt " ++ W
+ end.
+
+check_start_heart() ->
+ case init:get_argument(heart) of
+ {ok, [[]]} ->
+ ok;
+ error ->
+ throw(no_heart);
+ {ok, [[X|_]|_]} ->
+ report_problem({{bad_heart_flag, list_to_atom(X)},
+ {heart, check_start_heart, []}}),
+ throw(error)
+ end.
+
+wait_ack(Port) ->
+ receive
+ {Port, {data, [?START_ACK]}} ->
+ ok;
+ {'EXIT', Port, badsig} -> % Since this is not synchronous, skip it!
+ wait_ack(Port);
+ {'EXIT', Port, Reason} -> % The port really terminated.
+ {error, Reason}
+ end.
+
+loop(Parent, Port, Cmd) ->
+ send_heart_beat(Port),
+ receive
+ {From, set_cmd, NewCmd} when is_list(NewCmd), length(NewCmd) < 2047 ->
+ send_heart_cmd(Port, NewCmd),
+ wait_ack(Port),
+ From ! {heart, ok},
+ loop(Parent, Port, NewCmd);
+ {From, set_cmd, NewCmd} ->
+ From ! {heart, {error, {bad_cmd, NewCmd}}},
+ loop(Parent, Port, Cmd);
+ {From, clear_cmd} ->
+ From ! {heart, ok},
+ send_heart_cmd(Port, ""),
+ wait_ack(Port),
+ loop(Parent, Port, "");
+ {From, get_cmd} ->
+ From ! {heart, get_heart_cmd(Port)},
+ loop(Parent, Port, Cmd);
+ {From, cycle} ->
+ %% Calls back to loop
+ do_cycle_port_program(From, Parent, Port, Cmd);
+ {'EXIT', Parent, shutdown} ->
+ no_reboot_shutdown(Port);
+ {'EXIT', Parent, Reason} ->
+ exit(Port, Reason),
+ exit(Reason);
+ {'EXIT', Port, badsig} -> % we can ignore badsig-messages!
+ loop(Parent, Port, Cmd);
+ {'EXIT', Port, _Reason} ->
+ exit({port_terminated, {heart, loop, [Parent, Port, Cmd]}});
+ _ ->
+ loop(Parent, Port, Cmd)
+ after
+ ?TIMEOUT ->
+ loop(Parent, Port, Cmd)
+ end.
+
+-spec no_reboot_shutdown(port()) -> no_return().
+
+no_reboot_shutdown(Port) ->
+ send_shutdown(Port),
+ receive
+ {'EXIT', Port, Reason} when Reason =/= badsig ->
+ exit(normal)
+ end.
+
+do_cycle_port_program(Caller, Parent, Port, Cmd) ->
+ case catch start_portprogram() of
+ {ok, NewPort} ->
+ send_shutdown(Port),
+ receive
+ {'EXIT', Port, _Reason} ->
+ send_heart_cmd(NewPort, Cmd),
+ Caller ! {heart, ok},
+ loop(Parent, NewPort, Cmd)
+ after
+ ?CYCLE_TIMEOUT ->
+ %% Huh! Two heart port programs running...
+ %% well, the old one has to be sick not to respond
+ %% so we'll settle for the new one...
+ send_heart_cmd(NewPort, Cmd),
+ Caller ! {heart, {error, stop_error}},
+ loop(Parent, NewPort, Cmd)
+ end;
+ no_heart ->
+ Caller ! {heart, {error, no_heart}},
+ loop(Parent, Port, Cmd);
+ error ->
+ Caller ! {heart, {error, start_error}},
+ loop(Parent, Port, Cmd)
+ end.
+
+
+%% "Beates" the heart once.
+send_heart_beat(Port) -> Port ! {self(), {command, [?HEART_BEAT]}}.
+
+%% Set a new HEART_COMMAND.
+send_heart_cmd(Port, []) ->
+ Port ! {self(), {command, [?CLEAR_CMD]}};
+send_heart_cmd(Port, Cmd) ->
+ Port ! {self(), {command, [?SET_CMD|Cmd]}}.
+
+get_heart_cmd(Port) ->
+ Port ! {self(), {command, [?GET_CMD]}},
+ receive
+ {Port, {data, [?HEART_CMD | Cmd]}} ->
+ {ok, Cmd}
+ end.
+
+%% Sends shutdown command to the port.
+send_shutdown(Port) -> Port ! {self(), {command, [?SHUT_DOWN]}}.
+
+%% We must report using erlang:display/1 since we don't know whether
+%% there is an error_logger available or not.
+report_problem(Error) ->
+ erlang:display(Error).
diff --git a/lib/kernel/src/hipe_ext_format.hrl b/lib/kernel/src/hipe_ext_format.hrl
new file mode 100644
index 0000000000..102cb49a2b
--- /dev/null
+++ b/lib/kernel/src/hipe_ext_format.hrl
@@ -0,0 +1,41 @@
+%% hipe_x86_ext_format.hrl
+%% Definitions for unified external object format
+%% Currently: sparc, x86, amd64
+%% Authors: Erik Johansson, Ulf Magnusson
+
+-define(LOAD_ATOM,0).
+-define(LOAD_ADDRESS,1).
+-define(CALL_REMOTE,2).
+-define(CALL_LOCAL,3).
+-define(SDESC,4).
+-define(X86ABSPCREL,5).
+
+-define(TERM,0).
+-define(BLOCK,1).
+-define(SORTEDBLOCK,2).
+
+-define(CONST_TYPE2EXT(T),
+ case T of
+ term -> ?TERM;
+ sorted_block -> ?SORTEDBLOCK;
+ block -> ?BLOCK
+ end).
+
+-define(EXT2CONST_TYPE(E),
+ case E of
+ ?TERM -> term;
+ ?SORTEDBLOCK -> sorted_block;
+ ?BLOCK -> block
+ end).
+
+-define(EXT2PATCH_TYPE(E),
+ case E of
+ ?LOAD_ATOM -> load_atom;
+ ?LOAD_ADDRESS -> load_address;
+ ?SDESC -> sdesc;
+ ?X86ABSPCREL -> x86_abs_pcrel;
+ ?CALL_REMOTE -> call_remote;
+ ?CALL_LOCAL -> call_local
+ end).
+
+-define(STACK_DESC(ExnRA, FSize, Arity, Live), {ExnRA, FSize, Arity, Live}).
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
new file mode 100644
index 0000000000..7e26d57ced
--- /dev/null
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -0,0 +1,894 @@
+%% -*- erlang-indent-level: 2 -*-
+%% =======================================================================
+%% Filename : hipe_unified_loader.erl
+%% Module : hipe_unified_loader
+%% Purpose : To load code into memory and link it to the system.
+%% Notes : See hipe_ext_format.hrl for description of the external
+%% format.
+%% =======================================================================
+%% TODO:
+%% Problems with the order in which things are done.
+%% export_funs should atomically patch references to make fe and
+%% make beam stubs. !!
+%%
+%% Each function should have two proper databases.
+%% Describe the patch algorithm:
+%% For each function MFA that is (re)compiled to Address:
+%% 1. For the old MFA
+%% a. RefsTo = MFA->refers_to
+%% b. for each {F,Adr} in RefsTo: remove Adr from F->is_referred
+%% c. RefsFrom = MFA->is_referred
+%% d. For each {Adr,Type} in RefsFrom:
+%% update instr at Adr to refer to Address instead.
+%% 2. For the new MFA
+%% a. MFA->is_referred=RefsFrom
+%% 3. For each function F referenced in the code at Offset:
+%% add {Address+Offset,Type} to F->is_referred
+%% add {F,Address+Offset} to MFA->refers_to
+%% 4. Make Address the entrypoint for MFA
+%%
+%% Add exporting of exported constants.
+%% Add freeing of old code.
+%% Inline hipe_sparc_ext_format somehow.
+%% =======================================================================
+
+-module(hipe_unified_loader).
+
+-export([chunk_name/1,
+ %% Only the code and code_server modules may call the entries below!
+ load_hipe_modules/0,
+ load_native_code/2,
+ post_beam_load/1,
+ load_module/3,
+ load/2]).
+
+%%-define(DEBUG,true).
+-define(DO_ASSERT,true).
+-define(HIPE_LOGGING,true).
+
+-include("../../hipe/main/hipe.hrl").
+-include("hipe_ext_format.hrl").
+
+%% Currently, there is no need to expose these to the outside world.
+-define(HS8P_TAG,"HS8P").
+-define(HPPC_TAG,"HPPC").
+-define(HP64_TAG,"HP64").
+-define(HARM_TAG,"HARM").
+-define(HX86_TAG,"HX86").
+-define(HA64_TAG,"HA64").
+
+%%========================================================================
+
+-spec chunk_name(hipe_architecture()) -> string().
+%% @doc
+%% Returns the native code chunk name of the Architecture.
+%% (On which presumably we are running.)
+
+chunk_name(Architecture) ->
+ case Architecture of
+ amd64 -> ?HA64_TAG; %% HiPE, x86_64, (implicit: 64-bit, Unix)
+ arm -> ?HARM_TAG; %% HiPE, arm, v5 (implicit: 32-bit, Linux)
+ powerpc -> ?HPPC_TAG; %% HiPE, PowerPC (implicit: 32-bit, Linux)
+ ppc64 -> ?HP64_TAG; %% HiPE, ppc64 (implicit: 64-bit, Linux)
+ ultrasparc -> ?HS8P_TAG; %% HiPE, SPARC, V8+ (implicit: 32-bit)
+ x86 -> ?HX86_TAG %% HiPE, x86, (implicit: Unix)
+ %% Future: HSV9 %% HiPE, SPARC, V9 (implicit: 64-bit)
+ %% HW32 %% HiPE, x86, Win32
+ end.
+
+%%========================================================================
+
+-spec load_hipe_modules() -> 'ok'.
+%% @doc
+%% Ensures HiPE's loader modules are loaded.
+%% Called from code.erl at start-up.
+
+load_hipe_modules() ->
+ ok.
+
+%%========================================================================
+
+-spec load_native_code(Mod, binary()) -> 'no_native' | {'module', Mod}
+ when is_subtype(Mod, atom()).
+%% @doc
+%% Loads the native code of a module Mod.
+%% Returns {module,Mod} on success (for compatibility with
+%% code:load_file/1) and the atom `no_native' on failure.
+
+load_native_code(Mod, Bin) when is_atom(Mod), is_binary(Bin) ->
+ Architecture = erlang:system_info(hipe_architecture),
+ try chunk_name(Architecture) of
+ ChunkTag ->
+ %% patch_to_emu(Mod),
+ case code:get_chunk(Bin, ChunkTag) of
+ undefined -> no_native;
+ NativeCode when is_binary(NativeCode) ->
+ OldReferencesToPatch = patch_to_emu_step1(Mod),
+ case load_module(Mod, NativeCode, Bin, OldReferencesToPatch) of
+ bad_crc -> no_native;
+ Result -> Result
+ end
+ end
+ catch
+ _:_ ->
+ %% Unknown HiPE architecture. Can't happen (in principle).
+ no_native
+ end.
+
+%%========================================================================
+
+-spec post_beam_load(atom()) -> 'ok'.
+
+post_beam_load(Mod) when is_atom(Mod) ->
+ Architecture = erlang:system_info(hipe_architecture),
+ try chunk_name(Architecture) of _ChunkTag -> patch_to_emu(Mod)
+ catch _:_ -> ok
+ end.
+
+%%========================================================================
+
+version_check(Version, Mod) when is_atom(Mod) ->
+ Ver = ?VERSION_STRING(),
+ case Version < Ver of
+ true ->
+ ?msg("WARNING: Module ~w was compiled with HiPE version ~s\n",
+ [Mod, Version]);
+ _ -> ok
+ end.
+
+%%========================================================================
+
+-spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module',Mod}
+ when is_subtype(Mod,atom()).
+load_module(Mod, Bin, Beam) ->
+ load_module(Mod, Bin, Beam, []).
+
+load_module(Mod, Bin, Beam, OldReferencesToPatch) ->
+ ?debug_msg("************ Loading Module ~w ************\n",[Mod]),
+ %% Loading a whole module, let the BEAM loader patch closures.
+ put(hipe_patch_closures, false),
+ load_common(Mod, Bin, Beam, OldReferencesToPatch).
+
+%%========================================================================
+
+-spec load(Mod, binary()) -> 'bad_crc' | {'module',Mod}
+ when is_subtype(Mod,atom()).
+load(Mod, Bin) ->
+ ?debug_msg("********* Loading funs in module ~w *********\n",[Mod]),
+ %% Loading just some functions in a module; patch closures separately.
+ put(hipe_patch_closures, true),
+ load_common(Mod, Bin, [], []).
+
+%%------------------------------------------------------------------------
+
+load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
+ %% Unpack the binary.
+ [{Version, CheckSum},
+ ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap,
+ CodeSize, CodeBinary, Refs,
+ 0,[] % ColdSize, CRrefs
+ ] = binary_to_term(Bin),
+ %% Check that we are loading up-to-date code.
+ version_check(Version, Mod),
+ case hipe_bifs:check_crc(CheckSum) of
+ false ->
+ ?msg("Warning: not loading native code for module ~w: "
+ "it was compiled for an incompatible runtime system; "
+ "please regenerate native code for this runtime system\n", [Mod]),
+ bad_crc;
+ true ->
+ %% Create data segment
+ {ConstAddr,ConstMap2} = create_data_segment(ConstAlign, ConstSize, ConstMap),
+ %% Find callees for which we may need trampolines.
+ CalleeMFAs = find_callee_mfas(Refs),
+ %% Write the code to memory.
+ {CodeAddress,Trampolines} = enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam),
+ %% Construct CalleeMFA-to-trampoline mapping.
+ TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines),
+ %% Patch references to code labels in data seg.
+ patch_consts(LabelMap, ConstAddr, CodeAddress),
+ %% Find out which functions are being loaded (and where).
+ %% Note: Addresses are sorted descending.
+ {MFAs,Addresses} = exports(ExportMap, CodeAddress),
+ %% Remove references to old versions of the module.
+ ReferencesToPatch = get_refs_from(MFAs, []),
+ remove_refs_from(MFAs),
+ %% Patch all dynamic references in the code.
+ %% Function calls, Atoms, Constants, System calls
+ patch(Refs, CodeAddress, ConstMap2, Addresses, TrampolineMap),
+ %% Tell the system where the loaded funs are.
+ %% (patches the BEAM code to redirect to native.)
+ case Beam of
+ [] ->
+ export_funs(Addresses);
+ BeamBinary when is_binary(BeamBinary) ->
+ %% Find all closures in the code.
+ ClosurePatches = find_closure_patches(Refs),
+ AddressesOfClosuresToPatch =
+ calculate_addresses(ClosurePatches, CodeAddress, Addresses),
+ export_funs(Addresses),
+ export_funs(Mod, BeamBinary, Addresses, AddressesOfClosuresToPatch)
+ end,
+ %% Redirect references to the old module to the new module's BEAM stub.
+ patch_to_emu_step2(OldReferencesToPatch),
+ %% Patch referring functions to call the new function
+ %% The call to export_funs/1 above updated the native addresses
+ %% for the targets, so passing 'Addresses' is not needed.
+ redirect(ReferencesToPatch),
+ ?debug_msg("****************Loader Finished****************\n", []),
+ {module,Mod} % for compatibility with code:load_file/1
+ end.
+
+%%----------------------------------------------------------------
+%% Scan the list of patches and build a set (returned as a tuple)
+%% of the callees for which we may need trampolines.
+%%
+find_callee_mfas(Patches) when is_list(Patches) ->
+ case erlang:system_info(hipe_architecture) of
+ amd64 -> [];
+ arm -> find_callee_mfas(Patches, gb_sets:empty(), false);
+ powerpc -> find_callee_mfas(Patches, gb_sets:empty(), true);
+ %% ppc64 -> find_callee_mfas(Patches, gb_sets:empty(), true);
+ ultrasparc -> [];
+ x86 -> []
+ end.
+
+find_callee_mfas([{Type,Data}|Patches], MFAs, SkipErtsSyms) ->
+ NewMFAs =
+ case ?EXT2PATCH_TYPE(Type) of
+ call_local -> add_callee_mfas(Data, MFAs, SkipErtsSyms);
+ call_remote -> add_callee_mfas(Data, MFAs, SkipErtsSyms);
+ %% load_address(function) deliberately ignored
+ _ -> MFAs
+ end,
+ find_callee_mfas(Patches, NewMFAs, SkipErtsSyms);
+find_callee_mfas([], MFAs, _SkipErtsSyms) ->
+ list_to_tuple(gb_sets:to_list(MFAs)).
+
+add_callee_mfas([{DestMFA,_Offsets}|Refs], MFAs, SkipErtsSyms) ->
+ NewMFAs =
+ case SkipErtsSyms of
+ true ->
+ %% On PowerPC we put the runtime system below the
+ %% 32M boundary, which allows BIFs and primops to
+ %% be called with ba/bla instructions. Hence we do
+ %% not need trampolines for BIFs or primops.
+ case bif_address(DestMFA) of
+ false -> gb_sets:add_element(DestMFA, MFAs);
+ BifAddress when is_integer(BifAddress) -> MFAs
+ end;
+ false ->
+ %% On ARM we also need trampolines for BIFs and primops.
+ gb_sets:add_element(DestMFA, MFAs)
+ end,
+ add_callee_mfas(Refs, NewMFAs, SkipErtsSyms);
+add_callee_mfas([], MFAs, _SkipErtsSyms) -> MFAs.
+
+%%----------------------------------------------------------------
+%%
+mk_trampoline_map([], []) -> []; % archs not using trampolines
+mk_trampoline_map(CalleeMFAs, Trampolines) ->
+ SizeofLong =
+ case erlang:system_info(hipe_architecture) of
+ amd64 -> 8;
+ _ -> 4
+ end,
+ mk_trampoline_map(tuple_size(CalleeMFAs), CalleeMFAs,
+ Trampolines, SizeofLong, gb_trees:empty()).
+
+mk_trampoline_map(I, CalleeMFAs, Trampolines, SizeofLong, Map) when I >= 1 ->
+ MFA = element(I, CalleeMFAs),
+ %% Trampoline = element(I, Trampolines),
+ Skip = (I-1)*SizeofLong,
+ <<_:Skip/binary-unit:8,
+ Trampoline:SizeofLong/integer-unsigned-native-unit:8,
+ _/binary>> = Trampolines,
+ NewMap = gb_trees:insert(MFA, Trampoline, Map),
+ mk_trampoline_map(I-1, CalleeMFAs, Trampolines, SizeofLong, NewMap);
+mk_trampoline_map(0, _, _, _, Map) -> Map.
+
+%%----------------------------------------------------------------
+%%
+trampoline_map_get(_, []) -> []; % archs not using trampolines
+trampoline_map_get(MFA, Map) -> gb_trees:get(MFA, Map).
+
+trampoline_map_lookup(_, []) -> []; % archs not using trampolines
+trampoline_map_lookup(Primop, Map) ->
+ case gb_trees:lookup(Primop, Map) of
+ {value,X} -> X;
+ _ -> []
+ end.
+
+%%------------------------------------------------------------------------
+
+-record(fundef, {address :: integer(),
+ mfa :: mfa(),
+ is_closure :: boolean(),
+ is_exported :: boolean()}).
+
+exports(ExportMap, BaseAddress) ->
+ exports(ExportMap, BaseAddress, [], []).
+
+exports([Offset,M,F,A,IsClosure,IsExported|Rest], BaseAddress, MFAs, Addresses) ->
+ MFA = {M,F,A},
+ Address = BaseAddress + Offset,
+ FunDef = #fundef{address=Address, mfa=MFA, is_closure=IsClosure,
+ is_exported=IsExported},
+ exports(Rest, BaseAddress, [MFA|MFAs], [FunDef|Addresses]);
+exports([], _, MFAs, Addresses) ->
+ {MFAs, Addresses}.
+
+mod({M,_F,_A}) -> M.
+
+%%------------------------------------------------------------------------
+
+calculate_addresses(PatchOffsets, Base, Addresses) ->
+ RemoteOrLocal = local, % closure code refs are local
+ [{Data,
+ offsets_to_addresses(Offsets, Base),
+ get_native_address(DestMFA, Addresses, RemoteOrLocal)} ||
+ {{DestMFA,_,_}=Data,Offsets} <- PatchOffsets].
+
+offsets_to_addresses(Os, Base) ->
+ [{O+Base,load_fe} || O <- Os].
+
+%%------------------------------------------------------------------------
+
+find_closure_patches([{Type,Refs} | Rest]) ->
+ case ?EXT2PATCH_TYPE(Type) of
+ load_address ->
+ find_closure_refs(Refs,Rest);
+ _ ->
+ find_closure_patches(Rest)
+ end;
+find_closure_patches([]) -> [].
+
+find_closure_refs([{Dest,Offsets} | Rest], Refs) ->
+ case Dest of
+ {closure,Data} ->
+ [{Data,Offsets}|find_closure_refs(Rest,Refs)];
+ _ ->
+ find_closure_refs(Rest,Refs)
+ end;
+find_closure_refs([], Refs) ->
+ find_closure_patches(Refs).
+
+%%------------------------------------------------------------------------
+
+export_funs([FunDef | Addresses]) ->
+ #fundef{address=Address, mfa=MFA, is_closure=IsClosure,
+ is_exported=IsExported} = FunDef,
+ ?IF_DEBUG({M,F,A} = MFA, no_debug),
+ ?IF_DEBUG(
+ case IsClosure of
+ false ->
+ ?debug_msg("LINKING: ~w:~w/~w to (0x~.16b)\n",
+ [M,F,A, Address]);
+ true ->
+ ?debug_msg("LINKING: ~w:~w/~w to closure (0x~.16b)\n",
+ [M,F,A, Address])
+ end, no_debug),
+ hipe_bifs:set_funinfo_native_address(MFA, Address, IsExported),
+ hipe_bifs:set_native_address(MFA, Address, IsClosure),
+ export_funs(Addresses);
+export_funs([]) ->
+ true.
+
+export_funs(Mod, Beam, Addresses, ClosuresToPatch) ->
+ Fs = [{F,A,Address} || #fundef{address=Address, mfa={_M,F,A}} <- Addresses],
+ code:make_stub_module(Mod, Beam, {Fs,ClosuresToPatch}).
+
+%%========================================================================
+%% Patching
+%% @spec patch(refs(), BaseAddress::integer(), ConstAndZone::term(),
+%% Addresses::term(), TrampolineMap::term()) -> term()
+%% @type refs()=[{RefType::integer(), Reflist::reflist()} | refs()]
+%%
+%% @type reflist()= [{Data::term(), Offsets::offests()}|reflist()]
+%% @type offsets()= [Offset::integer() | offsets()]
+%% @doc
+%% The patchlist is a list of lists of patches of a type.
+%% For each type the list of references is sorted so that several
+%% references to the same type of data come after each other
+%% (we use this to look up the address of a referred function only once).
+%%
+
+patch([{Type,SortedRefs}|Rest], CodeAddress, ConstMap2, Addresses, TrampolineMap) ->
+ ?debug_msg("Patching ~w at [~w+offset] with ~w\n",
+ [Type,CodeAddress,SortedRefs]),
+ case ?EXT2PATCH_TYPE(Type) of
+ call_local ->
+ patch_call(SortedRefs, CodeAddress, Addresses, 'local', TrampolineMap);
+ call_remote ->
+ patch_call(SortedRefs, CodeAddress, Addresses, 'remote', TrampolineMap);
+ Other ->
+ patch_all(Other, SortedRefs, CodeAddress, {ConstMap2,CodeAddress}, Addresses)
+ end,
+ patch(Rest, CodeAddress, ConstMap2, Addresses, TrampolineMap);
+patch([], _, _, _, _) -> true.
+
+%%----------------------------------------------------------------
+%% Handle a 'call_local' or 'call_remote' patch.
+%%
+patch_call([{DestMFA,Offsets}|SortedRefs], BaseAddress, Addresses, RemoteOrLocal, TrampolineMap) ->
+ case bif_address(DestMFA) of
+ false ->
+ %% Previous code used mfa_to_address(DestMFA, Addresses)
+ %% here for local calls. That is wrong because even local
+ %% destinations may not be present in Addresses: they may
+ %% not have been compiled yet, or they may be BEAM-only
+ %% functions (e.g. module_info).
+ DestAddress = get_native_address(DestMFA, Addresses, RemoteOrLocal),
+ Trampoline = trampoline_map_get(DestMFA, TrampolineMap),
+ patch_mfa_call_list(Offsets, BaseAddress, DestMFA, DestAddress, Addresses, RemoteOrLocal, Trampoline);
+ BifAddress when is_integer(BifAddress) ->
+ Trampoline = trampoline_map_lookup(DestMFA, TrampolineMap),
+ patch_bif_call_list(Offsets, BaseAddress, BifAddress, Trampoline)
+ end,
+ patch_call(SortedRefs, BaseAddress, Addresses, RemoteOrLocal, TrampolineMap);
+patch_call([], _, _, _, _) ->
+ true.
+
+patch_bif_call_list([Offset|Offsets], BaseAddress, BifAddress, Trampoline) ->
+ CallAddress = BaseAddress+Offset,
+ ?ASSERT(assert_local_patch(CallAddress)),
+ patch_call_insn(CallAddress, BifAddress, Trampoline),
+ patch_bif_call_list(Offsets, BaseAddress, BifAddress, Trampoline);
+patch_bif_call_list([], _, _, _) -> [].
+
+patch_mfa_call_list([Offset|Offsets], BaseAddress, DestMFA, DestAddress, Addresses, RemoteOrLocal, Trampoline) ->
+ CallAddress = BaseAddress+Offset,
+ add_ref(DestMFA, CallAddress, Addresses, 'call', Trampoline, RemoteOrLocal),
+ ?ASSERT(assert_local_patch(CallAddress)),
+ patch_call_insn(CallAddress, DestAddress, Trampoline),
+ patch_mfa_call_list(Offsets, BaseAddress, DestMFA, DestAddress, Addresses, RemoteOrLocal, Trampoline);
+patch_mfa_call_list([], _, _, _, _, _, _) -> [].
+
+patch_call_insn(CallAddress, DestAddress, Trampoline) ->
+ %% This assertion is false when we're called from redirect/2.
+ %% ?ASSERT(assert_local_patch(CallAddress)),
+ hipe_bifs:patch_call(CallAddress, DestAddress, Trampoline).
+
+%% ____________________________________________________________________
+%%
+
+patch_all(Type, [{Dest,Offsets}|Rest], BaseAddress, ConstAndZone, Addresses)->
+ patch_all_offsets(Type, Dest, Offsets, BaseAddress, ConstAndZone, Addresses),
+ patch_all(Type, Rest, BaseAddress, ConstAndZone, Addresses);
+patch_all(_, [], _, _, _) -> true.
+
+patch_all_offsets(Type, Data, [Offset|Offsets], BaseAddress,
+ ConstAndZone, Addresses) ->
+ ?debug_msg("Patching ~w at [~w+~w] with ~w\n",
+ [Type,BaseAddress,Offset, Data]),
+ Address = BaseAddress + Offset,
+ patch_offset(Type, Data, Address, ConstAndZone, Addresses),
+ ?debug_msg("Patching done\n",[]),
+ patch_all_offsets(Type, Data, Offsets, BaseAddress, ConstAndZone, Addresses);
+patch_all_offsets(_, _, [], _, _, _) -> true.
+
+%%----------------------------------------------------------------
+%% Handle any patch type except 'call_local' or 'call_remote'.
+%%
+patch_offset(Type, Data, Address, ConstAndZone, Addresses) ->
+ case Type of
+ load_address ->
+ patch_load_address(Data, Address, ConstAndZone, Addresses);
+ load_atom ->
+ Atom = Data,
+ patch_atom(Address, Atom);
+ sdesc ->
+ patch_sdesc(Data, Address, ConstAndZone);
+ x86_abs_pcrel ->
+ patch_instr(Address, Data, x86_abs_pcrel)
+ %% _ ->
+ %% ?error_msg("Unknown ref ~w ~w ~w\n", [Type, Address, Data]),
+ %% exit({unknown_reference, Type, Address, Data})
+ end.
+
+patch_atom(Address, Atom) ->
+ ?ASSERT(assert_local_patch(Address)),
+ patch_instr(Address, hipe_bifs:atom_to_word(Atom), atom).
+
+patch_sdesc(?STACK_DESC(SymExnRA, FSize, Arity, Live),
+ Address, {_ConstMap2,CodeAddress}) ->
+ ExnRA =
+ case SymExnRA of
+ [] -> 0; % No catch
+ LabelOffset -> CodeAddress + LabelOffset
+ end,
+ ?ASSERT(assert_local_patch(Address)),
+ hipe_bifs:enter_sdesc({Address, ExnRA, FSize, Arity, Live}).
+
+%%----------------------------------------------------------------
+%% Handle a 'load_address'-type patch.
+%%
+patch_load_address(Data, Address, ConstAndZone, Addresses) ->
+ case Data of
+ {local_function,DestMFA} ->
+ patch_load_mfa(Address, DestMFA, Addresses, 'local');
+ {remote_function,DestMFA} ->
+ patch_load_mfa(Address, DestMFA, Addresses, 'remote');
+ {constant,Name} ->
+ {ConstMap2,_CodeAddress} = ConstAndZone,
+ ConstAddress = find_const(Name, ConstMap2),
+ patch_instr(Address, ConstAddress, constant);
+ {closure,{DestMFA,Uniq,Index}} ->
+ patch_closure(DestMFA, Uniq, Index, Address, Addresses);
+ {c_const,CConst} ->
+ patch_instr(Address, bif_address(CConst), c_const)
+ end.
+
+patch_closure(DestMFA, Uniq, Index, Address, Addresses) ->
+ case get(hipe_patch_closures) of
+ false ->
+ []; % This is taken care of when registering the module.
+ true -> % We are not loading a module patch these closures
+ RemoteOrLocal = local, % closure code refs are local
+ DestAddress = get_native_address(DestMFA, Addresses, RemoteOrLocal),
+ BEAMAddress = hipe_bifs:fun_to_address(DestMFA),
+ FE = hipe_bifs:make_fe(DestAddress, mod(DestMFA),
+ {Uniq, Index, BEAMAddress}),
+ ?debug_msg("Patch FE(~w) to 0x~.16b->0x~.16b (emu:0x~.16b)\n",
+ [DestMFA, FE, DestAddress, BEAMAddress]),
+ ?ASSERT(assert_local_patch(Address)),
+ patch_instr(Address, FE, closure)
+ end.
+
+%%----------------------------------------------------------------
+%% Patch an instruction loading the address of an MFA.
+%% RemoteOrLocal ::= 'remote' | 'local'
+%%
+patch_load_mfa(CodeAddress, DestMFA, Addresses, RemoteOrLocal) ->
+ DestAddress =
+ case bif_address(DestMFA) of
+ false ->
+ NativeAddress = get_native_address(DestMFA, Addresses, RemoteOrLocal),
+ add_ref(DestMFA, CodeAddress, Addresses, 'load_mfa', [], RemoteOrLocal),
+ NativeAddress;
+ BifAddress when is_integer(BifAddress) ->
+ BifAddress
+ end,
+ ?ASSERT(assert_local_patch(CodeAddress)),
+ patch_instr(CodeAddress, DestAddress, 'load_mfa').
+
+%%----------------------------------------------------------------
+%% Patch references to code labels in the data segment.
+%%
+patch_consts(Labels, DataAddress, CodeAddress) ->
+ lists:foreach(fun (L) ->
+ patch_label_or_labels(L, DataAddress, CodeAddress)
+ end, Labels).
+
+patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress) ->
+ ?ASSERT(assert_local_patch(CodeAddress+Offset)),
+ write_word(DataAddress+Pos, CodeAddress+Offset);
+patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress) ->
+ sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress).
+
+sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress) ->
+ WriteAndInc =
+ fun ({_, Offset}, DataPos) ->
+ ?ASSERT(assert_local_patch(CodeAddress+Offset)),
+ write_word(DataPos, CodeAddress+Offset)
+ end,
+ lists:foldl(WriteAndInc, DataAddress+Base, sort_on_representation(UnOrderdList)).
+
+sort_on_representation(List) ->
+ lists:sort([{hipe_bifs:term_to_word(Term), Offset} ||
+ {Term, Offset} <- List]).
+
+%%--------------------------------------------------------------------
+%% Update an instruction to refer to a value of a given type.
+%%
+%% Type ::= 'call' | 'load_mfa' | 'x86_abs_pcrel' | 'atom'
+%% | 'constant' | 'c_const' | 'closure'
+%%
+%% Note: the values of this Type are hard-coded in file erl_bif_types.erl
+%%
+patch_instr(Address, Value, Type) ->
+ hipe_bifs:patch_insn(Address, Value, Type).
+
+%%--------------------------------------------------------------------
+%% Write a data word of the machine's natural word size.
+%% Returns the address of the next word.
+%%
+%% XXX: It appears this is used for inserting both code addresses
+%% and other data. In HiPE, code addresses are still 32-bit on
+%% 64-bit machines.
+write_word(DataAddress, DataWord) ->
+ case erlang:system_info(hipe_architecture) of
+ amd64 ->
+ hipe_bifs:write_u64(DataAddress, DataWord),
+ DataAddress+8;
+ %% ppc64 ->
+ %% hipe_bifs:write_u64(DataAddress, DataWord),
+ %% DataAddress+8;
+ _ ->
+ hipe_bifs:write_u32(DataAddress, DataWord),
+ DataAddress+4
+ end.
+
+%%--------------------------------------------------------------------
+
+bif_address({M,F,A}) ->
+ hipe_bifs:bif_address(M,F,A);
+bif_address(Name) when is_atom(Name) ->
+ hipe_bifs:primop_address(Name).
+
+%%--------------------------------------------------------------------
+%% create_data_segment/3 takes an object file ConstMap, as produced by
+%% hipe_pack_constants:slim_constmap/1, loads the constants into
+%% memory, and produces a ConstMap2 mapping each constant's ConstNo to
+%% its runtime address, tagged if the constant is a term.
+%%
+create_data_segment(DataAlign, DataSize, DataList) ->
+ %%io:format("create_data_segment: \nDataAlign: ~p\nDataSize: ~p\nDataList: ~p\n",[DataAlign,DataSize,DataList]),
+ DataAddress = hipe_bifs:alloc_data(DataAlign, DataSize),
+ enter_data(DataList, [], DataAddress, DataSize).
+
+enter_data(List, ConstMap2, DataAddress, DataSize) ->
+ case List of
+ [ConstNo,Offset,Type,Data|Rest] when is_integer(Offset) ->
+ %%?msg("Const ~w\n",[[ConstNo,Offset,Type,Data]]),
+ ?ASSERT((Offset >= 0) and (Offset =< DataSize)),
+ Res = enter_datum(Type, Data, DataAddress+Offset),
+ enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize);
+ [] ->
+ {DataAddress, ConstMap2}
+ end.
+
+enter_datum(Type, Data, Address) ->
+ case ?EXT2CONST_TYPE(Type) of
+ term ->
+ %% Address is unused for terms
+ hipe_bifs:term_to_word(hipe_bifs:merge_term(Data));
+ sorted_block ->
+ L = lists:sort([hipe_bifs:term_to_word(Term) || Term <- Data]),
+ write_words(L, Address),
+ Address;
+ block ->
+ case Data of
+ {Lbls, []} ->
+ write_bytes(Lbls, Address);
+ {Lbls, SortOrder} ->
+ SortedLbls = [Lbl || {_,Lbl} <- lists:sort(group(Lbls, SortOrder))],
+ write_words(SortedLbls, Address);
+ Lbls ->
+ write_bytes(Lbls, Address)
+ end,
+ Address
+ end.
+
+group([], []) ->
+ [];
+group([B1,B2,B3,B4|Ls], [O|Os]) ->
+ [{hipe_bifs:term_to_word(O),bytes_to_32(B4,B3,B2,B1)}|group(Ls,Os)].
+
+bytes_to_32(B4,B3,B2,B1) ->
+ (B4 bsl 24) bor (B3 bsl 16) bor (B2 bsl 8) bor B1.
+
+write_words([W|Rest], Addr) ->
+ write_words(Rest, write_word(Addr, W));
+write_words([], Addr) when is_integer(Addr) -> true.
+
+write_bytes([B|Rest], Addr) ->
+ hipe_bifs:write_u8(Addr, B),
+ write_bytes(Rest, Addr+1);
+write_bytes([], Addr) when is_integer(Addr) -> true.
+
+%%% lists:keysearch/3 conses a useless wrapper around the found tuple :-(
+%%% otherwise it would have been a good replacement for this loop
+find_const(ConstNo, [{ConstNo,Addr}|_ConstMap2]) ->
+ Addr;
+find_const(ConstNo, [_|ConstMap2]) ->
+ find_const(ConstNo, ConstMap2);
+find_const(ConstNo, []) ->
+ ?error_msg("Constant not found ~w\n",[ConstNo]),
+ exit({constant_not_found,ConstNo}).
+
+
+%%----------------------------------------------------------------
+%% Record that the code at address 'Address' has a reference
+%% of type 'RefType' ('call' or 'load_mfa') to 'CalleeMFA'.
+%% 'Addresses' must be an address-descending list from exports/2.
+%%
+%% If 'RefType' is 'call', then 'Trampoline' may be the address
+%% of a stub branching to 'CalleeMFA', where the stub is reachable
+%% from 'Address' via a normal call or tailcall instruction.
+%%
+%% RemoteOrLocal ::= 'remote' | 'local'.
+%%
+
+%%
+%% -record(ref, {caller_mfa, address, ref_type, trampoline, remote_or_local}).
+%%
+
+add_ref(CalleeMFA, Address, Addresses, RefType, Trampoline, RemoteOrLocal) ->
+ CallerMFA = address_to_mfa(Address, Addresses),
+ %% just a sanity assertion below
+ true = case RemoteOrLocal of
+ local ->
+ {M1,_,_} = CalleeMFA,
+ {M2,_,_} = CallerMFA,
+ M1 =:= M2;
+ remote ->
+ true
+ end,
+ %% io:format("Adding ref ~w\n",[{CallerMFA, CalleeMFA, Address, RefType}]),
+ hipe_bifs:add_ref(CalleeMFA, {CallerMFA,Address,RefType,Trampoline,RemoteOrLocal}).
+
+address_to_mfa(Address, [#fundef{address=Adr, mfa=MFA}|_Rest]) when Address >= Adr -> MFA;
+address_to_mfa(Address, [_ | Rest]) -> address_to_mfa(Address, Rest);
+address_to_mfa(Address, []) ->
+ ?error_msg("Local adddress not found ~w\n",[Address]),
+ exit({?MODULE, local_address_not_found}).
+
+%%----------------------------------------------------------------
+%% Change callers of the given module to instead trap to BEAM.
+%% load_native_code/2 calls this just before loading native code.
+%%
+patch_to_emu(Mod) ->
+ patch_to_emu_step2(patch_to_emu_step1(Mod)).
+
+%% Step 1 must occur before the loading of native code updates
+%% references information or creates a new BEAM stub module.
+patch_to_emu_step1(Mod) ->
+ case is_loaded(Mod) of
+ true ->
+ %% Get exported functions
+ MFAs = [{Mod,Fun,Arity} || {Fun,Arity} <- Mod:module_info(exports)],
+ %% get_refs_from/2 only finds references from compiled static
+ %% call sites to the module, but some native address entries
+ %% were added as the result of dynamic apply calls. We must
+ %% purge them too, but we have no explicit record of them.
+ %% Therefore invalidate all native addresses for the module.
+ %% emu_make_stubs/1 will repair the ones for compiled static calls.
+ hipe_bifs:invalidate_funinfo_native_addresses(MFAs),
+ %% Find all call sites that call these MFAs. As a side-effect,
+ %% create native stubs for any MFAs that are referred.
+ ReferencesToPatch = get_refs_from(MFAs, []),
+ remove_refs_from(MFAs),
+ ReferencesToPatch;
+ false ->
+ %% The first time we load the module, no redirection needs to be done.
+ []
+ end.
+
+%% Step 2 must occur after the new BEAM stub module is created.
+patch_to_emu_step2(ReferencesToPatch) ->
+ emu_make_stubs(ReferencesToPatch),
+ redirect(ReferencesToPatch).
+
+-spec is_loaded(Module::atom()) -> boolean().
+%% @doc Checks whether a module is loaded or not.
+is_loaded(M) when is_atom(M) ->
+ try hipe_bifs:fun_to_address({M,module_info,0}) of
+ I when is_integer(I) -> true
+ catch _:_ -> false
+ end.
+
+-ifdef(notdef).
+emu_make_stubs([{MFA,_Refs}|Rest]) ->
+ make_stub(MFA),
+ emu_make_stubs(Rest);
+emu_make_stubs([]) ->
+ [].
+
+make_stub({_,_,A} = MFA) ->
+ EmuAddress = hipe_bifs:get_emu_address(MFA),
+ StubAddress = hipe_bifs:make_native_stub(EmuAddress, A),
+ hipe_bifs:set_funinfo_native_address(MFA, StubAddress).
+-else.
+emu_make_stubs(_) -> [].
+-endif.
+
+%%--------------------------------------------------------------------
+%% Given a list of MFAs, tag them with their referred_from references.
+%% The resulting {MFA,Refs} list is later passed to redirect/1, once
+%% the MFAs have been bound to (possibly new) native-code addresses.
+%%
+get_refs_from(MFAs, []) ->
+ mark_referred_from(MFAs),
+ MFAs.
+
+mark_referred_from([MFA|MFAs]) ->
+ hipe_bifs:mark_referred_from(MFA),
+ mark_referred_from(MFAs);
+mark_referred_from([]) ->
+ [].
+
+%%--------------------------------------------------------------------
+%% Given a list of MFAs with referred_from references, update their
+%% callers to refer to their new native-code addresses.
+%%
+%% The {MFA,Refs} list must come from get_refs_from/2.
+%%
+redirect([MFA|Rest]) ->
+ hipe_bifs:redirect_referred_from(MFA),
+ redirect(Rest);
+redirect([]) ->
+ ok.
+
+%%--------------------------------------------------------------------
+%% Given a list of MFAs, remove all referred_from references having
+%% any of them as CallerMFA.
+%%
+%% This is the only place using refers_to. Whenever a reference is
+%% added from CallerMFA to CalleeMFA, CallerMFA is added to CalleeMFA's
+%% referred_from list, and CalleeMFA is added to CallerMFA's refers_to
+%% list. The refers_to list is used here to find the CalleeMFAs whose
+%% referred_from lists should be updated.
+%%
+remove_refs_from([CallerMFA|CallerMFAs]) ->
+ hipe_bifs:remove_refs_from(CallerMFA),
+ remove_refs_from(CallerMFAs);
+remove_refs_from([]) ->
+ [].
+
+%%--------------------------------------------------------------------
+
+%% To find the native code of an MFA we need to look in 3 places:
+%% 1. If it is compiled now look in the Addresses data structure.
+%% 2. Then look in native_addresses from module info.
+%% 3. Then (the function might have been singled compiled) look in
+%% hipe_funinfo
+%% If all else fails create a native stub for the MFA
+get_native_address(MFA, Addresses, RemoteOrLocal) ->
+ case mfa_to_address(MFA, Addresses, RemoteOrLocal) of
+ Adr when is_integer(Adr) -> Adr;
+ false ->
+ IsRemote =
+ case RemoteOrLocal of
+ remote -> true;
+ local -> false
+ end,
+ hipe_bifs:find_na_or_make_stub(MFA, IsRemote)
+ end.
+
+mfa_to_address(MFA, [#fundef{address=Adr, mfa=MFA,
+ is_exported=IsExported}|_Rest], RemoteOrLocal) ->
+ case RemoteOrLocal of
+ local ->
+ Adr;
+ remote ->
+ case IsExported of
+ true ->
+ Adr;
+ false ->
+ false
+ end
+ end;
+mfa_to_address(MFA, [_|Rest], RemoteOrLocal) ->
+ mfa_to_address(MFA, Rest, RemoteOrLocal);
+mfa_to_address(_, [], _) -> false.
+
+%% ____________________________________________________________________
+%%
+
+-ifdef(DO_ASSERT).
+
+-define(init_assert_patch(Base, Size), put(hipe_assert_code_area,{Base,Base+Size})).
+
+assert_local_patch(Address) when is_integer(Address) ->
+ {First,Last} = get(hipe_assert_code_area),
+ Address >= First andalso Address < (Last).
+
+-else.
+
+-define(init_assert_patch(Base, Size), ok).
+
+-endif.
+
+%% ____________________________________________________________________
+%%
+
+%% Beam: nil() | binary() (used as a flag)
+
+enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam) ->
+ true = byte_size(CodeBinary) =:= CodeSize,
+ hipe_bifs:update_code_size(Mod, Beam, CodeSize),
+ {CodeAddress,Trampolines} = hipe_bifs:enter_code(CodeBinary, CalleeMFAs),
+ ?init_assert_patch(CodeAddress, byte_size(CodeBinary)),
+ {CodeAddress,Trampolines}.
+
diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl
new file mode 100644
index 0000000000..b86aa1839e
--- /dev/null
+++ b/lib/kernel/src/inet.erl
@@ -0,0 +1,1342 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet).
+
+-include("inet.hrl").
+-include("inet_int.hrl").
+-include("inet_sctp.hrl").
+
+%% socket
+-export([peername/1, sockname/1, port/1, send/2,
+ setopts/2, getopts/2,
+ getif/1, getif/0, getiflist/0, getiflist/1,
+ ifget/3, ifget/2, ifset/3, ifset/2,
+ getstat/1, getstat/2,
+ ip/1, stats/0, options/0,
+ pushf/3, popf/1, close/1, gethostname/0, gethostname/1]).
+
+-export([connect_options/2, listen_options/2, udp_options/2, sctp_options/2]).
+
+-export([i/0, i/1, i/2]).
+
+-export([getll/1, getfd/1, open/7, fdopen/5]).
+
+-export([tcp_controlling_process/2, udp_controlling_process/2,
+ tcp_close/1, udp_close/1]).
+%% used by socks5
+-export([setsockname/2, setpeername/2]).
+
+%% resolve
+-export([gethostbyname/1, gethostbyname/2, gethostbyname/3,
+ gethostbyname_tm/3]).
+-export([gethostbyaddr/1, gethostbyaddr/2,
+ gethostbyaddr_tm/2]).
+
+-export([getservbyname/2, getservbyport/2]).
+-export([getaddrs/2, getaddrs/3, getaddrs_tm/3,
+ getaddr/2, getaddr/3, getaddr_tm/3]).
+-export([translate_ip/2]).
+
+-export([get_rc/0]).
+
+%% format error
+-export([format_error/1]).
+
+%% timer interface
+-export([start_timer/1, timeout/1, timeout/2, stop_timer/1]).
+
+%% imports
+-import(lists, [append/1, duplicate/2, filter/2, foldl/3]).
+
+%% Record Signature
+-define(RS(Record),
+ {Record, record_info(size, Record)}).
+%% Record Signature Check (guard)
+-define(RSC(Record, RS),
+ element(1, Record) =:= element(1, RS),
+ tuple_size(Record) =:= element(2, RS)).
+
+%%% ---------------------------------
+%%% Contract type definitions
+
+-type socket() :: port().
+-type posix() :: atom().
+
+-type socket_setopt() ::
+ {'raw', non_neg_integer(), non_neg_integer(), binary()} |
+ %% TCP/UDP options
+ {'reuseaddr', boolean()} |
+ {'keepalive', boolean()} |
+ {'dontroute', boolean()} |
+ {'linger', {boolean(), non_neg_integer()}} |
+ {'broadcast', boolean()} |
+ {'sndbuf', non_neg_integer()} |
+ {'recbuf', non_neg_integer()} |
+ {'priority', non_neg_integer()} |
+ {'tos', non_neg_integer()} |
+ {'nodelay', boolean()} |
+ {'multicast_ttl', non_neg_integer()} |
+ {'multicast_loop', boolean()} |
+ {'multicast_if', ip_address()} |
+ {'add_membership', {ip_address(), ip_address()}} |
+ {'drop_membership', {ip_address(), ip_address()}} |
+ {'header', non_neg_integer()} |
+ {'buffer', non_neg_integer()} |
+ {'active', boolean() | 'once'} |
+ {'packet',
+ 0 | 1 | 2 | 4 | 'raw' | 'sunrm' | 'asn1' |
+ 'cdr' | 'fcgi' | 'line' | 'tpkt' | 'http' | 'httph' | 'http_bin' | 'httph_bin' } |
+ {'mode', list() | binary()} |
+ {'port', 'port', 'term'} |
+ {'exit_on_close', boolean()} |
+ {'low_watermark', non_neg_integer()} |
+ {'high_watermark', non_neg_integer()} |
+ {'bit8', 'clear' | 'set' | 'on' | 'off'} |
+ {'send_timeout', non_neg_integer() | 'infinity'} |
+ {'send_timeout_close', boolean()} |
+ {'delay_send', boolean()} |
+ {'packet_size', non_neg_integer()} |
+ {'read_packets', non_neg_integer()} |
+ %% SCTP options
+ {'sctp_rtoinfo', #sctp_rtoinfo{}} |
+ {'sctp_associnfo', #sctp_assocparams{}} |
+ {'sctp_initmsg', #sctp_initmsg{}} |
+ {'sctp_nodelay', boolean()} |
+ {'sctp_autoclose', non_neg_integer()} |
+ {'sctp_disable_fragments', boolean()} |
+ {'sctp_i_want_mapped_v4_addr', boolean()} |
+ {'sctp_maxseg', non_neg_integer()} |
+ {'sctp_primary_addr', #sctp_prim{}} |
+ {'sctp_set_peer_primary_addr', #sctp_setpeerprim{}} |
+ {'sctp_adaptation_layer', #sctp_setadaptation{}} |
+ {'sctp_peer_addr_params', #sctp_paddrparams{}} |
+ {'sctp_default_send_param', #sctp_sndrcvinfo{}} |
+ {'sctp_events', #sctp_event_subscribe{}} |
+ {'sctp_delayed_ack_time', #sctp_assoc_value{}}.
+
+-type socket_getopt() ::
+ {'raw',
+ non_neg_integer(), non_neg_integer(), binary()|non_neg_integer()} |
+ %% TCP/UDP options
+ 'reuseaddr' | 'keepalive' | 'dontroute' | 'linger' |
+ 'broadcast' | 'sndbuf' | 'recbuf' | 'priority' | 'tos' | 'nodelay' |
+ 'multicast_ttl' | 'multicast_loop' | 'multicast_if' |
+ 'add_membership' | 'drop_membership' |
+ 'header' | 'buffer' | 'active' | 'packet' | 'mode' | 'port' |
+ 'exit_on_close' | 'low_watermark' | 'high_watermark' | 'bit8' |
+ 'send_timeout' | 'send_timeout_close' |
+ 'delay_send' | 'packet_size' | 'read_packets' |
+ %% SCTP options
+ {'sctp_status', #sctp_status{}} |
+ 'sctp_get_peer_addr_info' |
+ {'sctp_get_peer_addr_info', #sctp_status{}} |
+ 'sctp_rtoinfo' |
+ {'sctp_rtoinfo', #sctp_rtoinfo{}} |
+ 'sctp_associnfo' |
+ {'sctp_associnfo', #sctp_assocparams{}} |
+ 'sctp_initmsg' |
+ {'sctp_initmsg', #sctp_initmsg{}} |
+ 'sctp_nodelay' | 'sctp_autoclose' | 'sctp_disable_fragments' |
+ 'sctp_i_want_mapped_v4_addr' | 'sctp_maxseg' |
+ {'sctp_primary_addr', #sctp_prim{}} |
+ {'sctp_set_peer_primary_addr', #sctp_setpeerprim{}} |
+ 'sctp_adaptation_layer' |
+ {'sctp_adaptation_layer', #sctp_setadaptation{}} |
+ {'sctp_peer_addr_params', #sctp_paddrparams{}} |
+ 'sctp_default_send_param' |
+ {'sctp_default_send_param', #sctp_sndrcvinfo{}} |
+ 'sctp_events' |
+ {'sctp_events', #sctp_event_subscribe{}} |
+ 'sctp_delayed_ack_time' |
+ {'sctp_delayed_ack_time', #sctp_assoc_value{}}.
+
+-type ether_address() :: [0..255].
+
+-type if_setopt() ::
+ {'addr', ip_address()} |
+ {'broadaddr', ip_address()} |
+ {'dstaddr', ip_address()} |
+ {'mtu', non_neg_integer()} |
+ {'netmask', ip_address()} |
+ {'flags', ['up' | 'down' | 'broadcast' | 'no_broadcast' |
+ 'pointtopoint' | 'no_pointtopoint' |
+ 'running' | 'multicast']} |
+ {'hwaddr', ether_address()}.
+
+-type if_getopt() ::
+ 'addr' | 'broadaddr' | 'dstaddr' |
+ 'mtu' | 'netmask' | 'flags' |'hwaddr'.
+
+-type family_option() :: 'inet' | 'inet6'.
+-type protocol_option() :: 'tcp' | 'udp' | 'sctp'.
+-type stat_option() ::
+ 'recv_cnt' | 'recv_max' | 'recv_avg' | 'recv_oct' | 'recv_dvi' |
+ 'send_cnt' | 'send_max' | 'send_avg' | 'send_oct' | 'send_pend'.
+
+%%% ---------------------------------
+
+-spec get_rc() -> [{any(),any()}].
+
+get_rc() ->
+ inet_db:get_rc().
+
+-spec close(Socket :: socket()) -> 'ok'.
+
+close(Socket) ->
+ prim_inet:close(Socket),
+ receive
+ {Closed, Socket} when Closed =:= tcp_closed; Closed =:= udp_closed ->
+ ok
+ after 0 ->
+ ok
+ end.
+
+-spec peername(Socket :: socket()) ->
+ {'ok', {ip_address(), non_neg_integer()}} | {'error', posix()}.
+
+peername(Socket) ->
+ prim_inet:peername(Socket).
+
+-spec setpeername(Socket :: socket(), Address :: {ip_address(), ip_port()}) ->
+ 'ok' | {'error', any()}.
+
+setpeername(Socket, {IP,Port}) ->
+ prim_inet:setpeername(Socket, {IP,Port});
+setpeername(Socket, undefined) ->
+ prim_inet:setpeername(Socket, undefined).
+
+
+-spec sockname(Socket :: socket()) ->
+ {'ok', {ip_address(), non_neg_integer()}} | {'error', posix()}.
+
+sockname(Socket) ->
+ prim_inet:sockname(Socket).
+
+-spec setsockname(Socket :: socket(), Address :: {ip_address(), ip_port()}) ->
+ 'ok' | {'error', any()}.
+
+setsockname(Socket, {IP,Port}) ->
+ prim_inet:setsockname(Socket, {IP,Port});
+setsockname(Socket, undefined) ->
+ prim_inet:setsockname(Socket, undefined).
+
+-spec port(Socket :: socket()) -> {'ok', ip_port()} | {'error', any()}.
+
+port(Socket) ->
+ case prim_inet:sockname(Socket) of
+ {ok, {_,Port}} -> {ok, Port};
+ Error -> Error
+ end.
+
+-spec send(Socket :: socket(), Packet :: iolist()) -> % iolist()?
+ 'ok' | {'error', posix()}.
+
+send(Socket, Packet) ->
+ prim_inet:send(Socket, Packet).
+
+-spec setopts(Socket :: socket(), Opts :: [socket_setopt()]) ->
+ 'ok' | {'error', posix()}.
+
+setopts(Socket, Opts) ->
+ prim_inet:setopts(Socket, Opts).
+
+-spec getopts(Socket :: socket(), Opts :: [socket_getopt()]) ->
+ {'ok', [socket_setopt()]} | {'error', posix()}.
+
+getopts(Socket, Opts) ->
+ prim_inet:getopts(Socket, Opts).
+
+-spec getiflist(Socket :: socket()) ->
+ {'ok', [string()]} | {'error', posix()}.
+
+getiflist(Socket) ->
+ prim_inet:getiflist(Socket).
+
+-spec getiflist() -> {'ok', [string()]} | {'error', posix()}.
+
+getiflist() ->
+ withsocket(fun(S) -> prim_inet:getiflist(S) end).
+
+-spec ifget(Socket :: socket(),
+ Name :: string() | atom(),
+ Opts :: [if_getopt()]) ->
+ {'ok', [if_setopt()]} | {'error', posix()}.
+
+ifget(Socket, Name, Opts) ->
+ prim_inet:ifget(Socket, Name, Opts).
+
+-spec ifget(Name :: string() | atom(), Opts :: [if_getopt()]) ->
+ {'ok', [if_setopt()]} | {'error', posix()}.
+
+ifget(Name, Opts) ->
+ withsocket(fun(S) -> prim_inet:ifget(S, Name, Opts) end).
+
+-spec ifset(Socket :: socket(),
+ Name :: string() | atom(),
+ Opts :: [if_setopt()]) ->
+ 'ok' | {'error', posix()}.
+
+ifset(Socket, Name, Opts) ->
+ prim_inet:ifset(Socket, Name, Opts).
+
+-spec ifset(Name :: string() | atom(), Opts :: [if_setopt()]) ->
+ 'ok' | {'error', posix()}.
+
+ifset(Name, Opts) ->
+ withsocket(fun(S) -> prim_inet:ifset(S, Name, Opts) end).
+
+-spec getif() ->
+ {'ok', [{ip_address(), ip_address() | 'undefined', ip_address()}]} |
+ {'error', posix()}.
+
+getif() ->
+ withsocket(fun(S) -> getif(S) end).
+
+%% backwards compatible getif
+-spec getif(Socket :: socket()) ->
+ {'ok', [{ip_address(), ip_address() | 'undefined', ip_address()}]} |
+ {'error', posix()}.
+
+getif(Socket) ->
+ case prim_inet:getiflist(Socket) of
+ {ok, IfList} ->
+ {ok, lists:foldl(
+ fun(Name,Acc) ->
+ case prim_inet:ifget(Socket,Name,
+ [addr,broadaddr,netmask]) of
+ {ok,[{addr,A},{broadaddr,B},{netmask,M}]} ->
+ [{A,B,M}|Acc];
+ %% Some interfaces does not have a b-addr
+ {ok,[{addr,A},{netmask,M}]} ->
+ [{A,undefined,M}|Acc];
+ _ ->
+ Acc
+ end
+ end, [], IfList)};
+ Error -> Error
+ end.
+
+withsocket(Fun) ->
+ case inet_udp:open(0,[]) of
+ {ok,Socket} ->
+ Res = Fun(Socket),
+ inet_udp:close(Socket),
+ Res;
+ Error ->
+ Error
+ end.
+
+pushf(_Socket, Fun, _State) when is_function(Fun) ->
+ {error, einval}.
+
+popf(_Socket) ->
+ {error, einval}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% the hostname is not cached any more because this
+% could cause troubles on at least windows with plug-and-play
+% and network-cards inserted and removed in conjunction with
+% use of the DHCP-protocol
+% should never fail
+
+-spec gethostname() -> {'ok', string()}.
+
+gethostname() ->
+ case inet_udp:open(0,[]) of
+ {ok,U} ->
+ {ok,Res} = gethostname(U),
+ inet_udp:close(U),
+ {Res2,_} = lists:splitwith(fun($.)->false;(_)->true end,Res),
+ {ok, Res2};
+ _ ->
+ {ok, "nohost.nodomain"}
+ end.
+
+-spec gethostname(Socket :: socket()) ->
+ {'ok', string()} | {'error', posix()}.
+
+gethostname(Socket) ->
+ prim_inet:gethostname(Socket).
+
+-spec getstat(Socket :: socket()) ->
+ {'ok', [{stat_option(), integer()}]} | {'error', posix()}.
+
+getstat(Socket) ->
+ prim_inet:getstat(Socket, stats()).
+
+-spec getstat(Socket :: socket(), Statoptions :: [stat_option()]) ->
+ {'ok', [{stat_option(), integer()}]} | {'error', posix()}.
+
+getstat(Socket,What) ->
+ prim_inet:getstat(Socket, What).
+
+-spec gethostbyname(Name :: string() | atom()) ->
+ {'ok', #hostent{}} | {'error', posix()}.
+
+gethostbyname(Name) ->
+ gethostbyname_tm(Name, inet, false).
+
+-spec gethostbyname(Name :: string() | atom(), Family :: family_option()) ->
+ {'ok', #hostent{}} | {'error', posix()}.
+
+gethostbyname(Name,Family) ->
+ gethostbyname_tm(Name, Family, false).
+
+-spec gethostbyname(Name :: string() | atom(),
+ Family :: family_option(),
+ Timeout :: non_neg_integer() | 'infinity') ->
+ {'ok', #hostent{}} | {'error', posix()}.
+
+gethostbyname(Name,Family,Timeout) ->
+ Timer = start_timer(Timeout),
+ Res = gethostbyname_tm(Name,Family,Timer),
+ stop_timer(Timer),
+ Res.
+
+gethostbyname_tm(Name,Family,Timer) ->
+ gethostbyname_tm(Name,Family,Timer,inet_db:res_option(lookup)).
+
+
+-spec gethostbyaddr(Address :: string() | ip_address()) ->
+ {'ok', #hostent{}} | {'error', posix()}.
+
+gethostbyaddr(Address) ->
+ gethostbyaddr_tm(Address, false).
+
+-spec gethostbyaddr(Address :: string() | ip_address(),
+ Timeout :: non_neg_integer() | 'infinity') ->
+ {'ok', #hostent{}} | {'error', posix()}.
+
+gethostbyaddr(Address,Timeout) ->
+ Timer = start_timer(Timeout),
+ Res = gethostbyaddr_tm(Address, Timer),
+ stop_timer(Timer),
+ Res.
+
+gethostbyaddr_tm(Address,Timer) ->
+ gethostbyaddr_tm(Address, Timer, inet_db:res_option(lookup)).
+
+-spec ip(Ip :: ip_address() | string() | atom()) ->
+ {'ok', ip_address()} | {'error', posix()}.
+
+ip({A,B,C,D}) when ?ip(A,B,C,D) ->
+ {ok, {A,B,C,D}};
+ip(Name) ->
+ case gethostbyname(Name) of
+ {ok, Ent} ->
+ {ok, hd(Ent#hostent.h_addr_list)};
+ Error -> Error
+ end.
+
+%% This function returns the erlang port used (with inet_drv)
+
+-spec getll(Socket :: socket()) -> {'ok', socket()}.
+
+getll(Socket) when is_port(Socket) ->
+ {ok, Socket}.
+
+%%
+%% Return the internal file descriptor number
+%%
+
+-spec getfd(Socket :: socket()) ->
+ {'ok', non_neg_integer()} | {'error', posix()}.
+
+getfd(Socket) ->
+ prim_inet:getfd(Socket).
+
+%%
+%% Lookup an ip address
+%%
+
+-spec getaddr(Host :: ip_address() | string() | atom(),
+ Family :: family_option()) ->
+ {'ok', ip_address()} | {'error', posix()}.
+
+getaddr(Address, Family) ->
+ getaddr(Address, Family, infinity).
+
+-spec getaddr(Host :: ip_address() | string() | atom(),
+ Family :: family_option(),
+ Timeout :: non_neg_integer() | 'infinity') ->
+ {'ok', ip_address()} | {'error', posix()}.
+
+getaddr(Address, Family, Timeout) ->
+ Timer = start_timer(Timeout),
+ Res = getaddr_tm(Address, Family, Timer),
+ stop_timer(Timer),
+ Res.
+
+getaddr_tm(Address, Family, Timer) ->
+ case getaddrs_tm(Address, Family, Timer) of
+ {ok, [IP|_]} -> {ok, IP};
+ Error -> Error
+ end.
+
+-spec getaddrs(Host :: ip_address() | string() | atom(),
+ Family :: family_option()) ->
+ {'ok', [ip_address()]} | {'error', posix()}.
+
+getaddrs(Address, Family) ->
+ getaddrs(Address, Family, infinity).
+
+-spec getaddrs(Host :: ip_address() | string() | atom(),
+ Family :: family_option(),
+ Timeout :: non_neg_integer() | 'infinity') ->
+ {'ok', [ip_address()]} | {'error', posix()}.
+
+getaddrs(Address, Family, Timeout) ->
+ Timer = start_timer(Timeout),
+ Res = getaddrs_tm(Address, Family, Timer),
+ stop_timer(Timer),
+ Res.
+
+-spec getservbyport(Port :: ip_port(), Protocol :: atom() | string()) ->
+ {'ok', string()} | {'error', posix()}.
+
+getservbyport(Port, Proto) ->
+ case inet_udp:open(0, []) of
+ {ok,U} ->
+ Res = prim_inet:getservbyport(U, Port, Proto),
+ inet_udp:close(U),
+ Res;
+ Error -> Error
+ end.
+
+-spec getservbyname(Name :: atom() | string(),
+ Protocol :: atom() | string()) ->
+ {'ok', ip_port()} | {'error', posix()}.
+
+getservbyname(Name, Protocol) when is_atom(Name) ->
+ case inet_udp:open(0, []) of
+ {ok,U} ->
+ Res = prim_inet:getservbyname(U, Name, Protocol),
+ inet_udp:close(U),
+ Res;
+ Error -> Error
+ end.
+
+%% Return a list of available options
+options() ->
+ [
+ tos, priority, reuseaddr, keepalive, dontroute, linger,
+ broadcast, sndbuf, recbuf, nodelay,
+ buffer, header, active, packet, deliver, mode,
+ multicast_if, multicast_ttl, multicast_loop,
+ exit_on_close, high_watermark, low_watermark,
+ bit8, send_timeout, send_timeout_close
+ ].
+
+%% Return a list of statistics options
+
+-spec stats() -> [stat_option(),...].
+
+stats() ->
+ [recv_oct, recv_cnt, recv_max, recv_avg, recv_dvi,
+ send_oct, send_cnt, send_max, send_avg, send_pend].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Available options for tcp:connect
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+connect_options() ->
+ [tos, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay,
+ header, active, packet, packet_size, buffer, mode, deliver,
+ exit_on_close, high_watermark, low_watermark, bit8, send_timeout,
+ send_timeout_close, delay_send,raw].
+
+connect_options(Opts, Family) ->
+ BaseOpts =
+ case application:get_env(kernel, inet_default_connect_options) of
+ {ok,List} when is_list(List) ->
+ NList = [{active, true} | lists:keydelete(active,1,List)],
+ #connect_opts{ opts = NList};
+ {ok,{active,_Bool}} ->
+ #connect_opts{ opts = [{active,true}]};
+ {ok,Option} ->
+ #connect_opts{ opts = [{active,true}, Option]};
+ _ ->
+ #connect_opts{ opts = [{active,true}]}
+ end,
+ case con_opt(Opts, BaseOpts, connect_options()) of
+ {ok, R} ->
+ {ok, R#connect_opts {
+ ifaddr = translate_ip(R#connect_opts.ifaddr, Family)
+ }};
+ Error -> Error
+ end.
+
+con_opt([{raw,A,B,C}|Opts],R,As) ->
+ con_opt([{raw,{A,B,C}}|Opts],R,As);
+con_opt([Opt | Opts], R, As) ->
+ case Opt of
+ {ip,IP} -> con_opt(Opts, R#connect_opts { ifaddr = IP }, As);
+ {ifaddr,IP} -> con_opt(Opts, R#connect_opts { ifaddr = IP }, As);
+ {port,P} -> con_opt(Opts, R#connect_opts { port = P }, As);
+ {fd,Fd} -> con_opt(Opts, R#connect_opts { fd = Fd }, As);
+ binary -> con_add(mode, binary, R, Opts, As);
+ list -> con_add(mode, list, R, Opts, As);
+ {tcp_module,_} -> con_opt(Opts, R, As);
+ inet -> con_opt(Opts, R, As);
+ inet6 -> con_opt(Opts, R, As);
+ {Name,Val} when is_atom(Name) -> con_add(Name, Val, R, Opts, As);
+ _ -> {error, badarg}
+ end;
+con_opt([], R, _) ->
+ {ok, R}.
+
+con_add(Name, Val, R, Opts, AllOpts) ->
+ case add_opt(Name, Val, R#connect_opts.opts, AllOpts) of
+ {ok, SOpts} ->
+ con_opt(Opts, R#connect_opts { opts = SOpts }, AllOpts);
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Available options for tcp:listen
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+listen_options() ->
+ [tos, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay,
+ header, active, packet, buffer, mode, deliver, backlog,
+ exit_on_close, high_watermark, low_watermark, bit8, send_timeout,
+ send_timeout_close, delay_send, packet_size,raw].
+
+listen_options(Opts, Family) ->
+ BaseOpts =
+ case application:get_env(kernel, inet_default_listen_options) of
+ {ok,List} when is_list(List) ->
+ NList = [{active, true} | lists:keydelete(active,1,List)],
+ #listen_opts{ opts = NList};
+ {ok,{active,_Bool}} ->
+ #listen_opts{ opts = [{active,true}]};
+ {ok,Option} ->
+ #listen_opts{ opts = [{active,true}, Option]};
+ _ ->
+ #listen_opts{ opts = [{active,true}]}
+ end,
+ case list_opt(Opts, BaseOpts, listen_options()) of
+ {ok, R} ->
+ {ok, R#listen_opts {
+ ifaddr = translate_ip(R#listen_opts.ifaddr, Family)
+ }};
+ Error -> Error
+ end.
+
+list_opt([{raw,A,B,C}|Opts], R, As) ->
+ list_opt([{raw,{A,B,C}}|Opts], R, As);
+list_opt([Opt | Opts], R, As) ->
+ case Opt of
+ {ip,IP} -> list_opt(Opts, R#listen_opts { ifaddr = IP }, As);
+ {ifaddr,IP} -> list_opt(Opts, R#listen_opts { ifaddr = IP }, As);
+ {port,P} -> list_opt(Opts, R#listen_opts { port = P }, As);
+ {fd,Fd} -> list_opt(Opts, R#listen_opts { fd = Fd }, As);
+ {backlog,BL} -> list_opt(Opts, R#listen_opts { backlog = BL }, As);
+ binary -> list_add(mode, binary, R, Opts, As);
+ list -> list_add(mode, list, R, Opts, As);
+ {tcp_module,_} -> list_opt(Opts, R, As);
+ inet -> list_opt(Opts, R, As);
+ inet6 -> list_opt(Opts, R, As);
+ {Name,Val} when is_atom(Name) -> list_add(Name, Val, R, Opts, As);
+ _ -> {error, badarg}
+ end;
+list_opt([], R, _SockOpts) ->
+ {ok, R}.
+
+list_add(Name, Val, R, Opts, As) ->
+ case add_opt(Name, Val, R#listen_opts.opts, As) of
+ {ok, SOpts} ->
+ list_opt(Opts, R#listen_opts { opts = SOpts }, As);
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Available options for udp:open
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+udp_options() ->
+ [tos, priority, reuseaddr, sndbuf, recbuf, header, active, buffer, mode,
+ deliver,
+ broadcast, dontroute, multicast_if, multicast_ttl, multicast_loop,
+ add_membership, drop_membership, read_packets,raw].
+
+
+udp_options(Opts, Family) ->
+ case udp_opt(Opts, #udp_opts { }, udp_options()) of
+ {ok, R} ->
+ {ok, R#udp_opts {
+ ifaddr = translate_ip(R#udp_opts.ifaddr, Family)
+ }};
+ Error -> Error
+ end.
+
+udp_opt([{raw,A,B,C}|Opts], R, As) ->
+ udp_opt([{raw,{A,B,C}}|Opts], R, As);
+udp_opt([Opt | Opts], R, As) ->
+ case Opt of
+ {ip,IP} -> udp_opt(Opts, R#udp_opts { ifaddr = IP }, As);
+ {ifaddr,IP} -> udp_opt(Opts, R#udp_opts { ifaddr = IP }, As);
+ {port,P} -> udp_opt(Opts, R#udp_opts { port = P }, As);
+ {fd,Fd} -> udp_opt(Opts, R#udp_opts { fd = Fd }, As);
+ binary -> udp_add(mode, binary, R, Opts, As);
+ list -> udp_add(mode, list, R, Opts, As);
+ {udp_module,_} -> udp_opt(Opts, R, As);
+ inet -> udp_opt(Opts, R, As);
+ inet6 -> udp_opt(Opts, R, As);
+ {Name,Val} when is_atom(Name) -> udp_add(Name, Val, R, Opts, As);
+ _ -> {error, badarg}
+ end;
+udp_opt([], R, _SockOpts) ->
+ {ok, R}.
+
+udp_add(Name, Val, R, Opts, As) ->
+ case add_opt(Name, Val, R#udp_opts.opts, As) of
+ {ok, SOpts} ->
+ udp_opt(Opts, R#udp_opts { opts = SOpts }, As);
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Available options for sctp:open
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% Currently supported options include:
+% (*) {mode, list|binary} or just list|binary
+% (*) {active, true|false|once}
+% (*) {sctp_module, inet_sctp|inet6_sctp} or just inet|inet6
+% (*) options set via setsockopt.
+% The full list is below in sctp_options/0 .
+% All other options are currently NOT supported. In particular:
+% (*) multicast on SCTP is not (yet) supported, as it may be incompatible
+% with automatic associations;
+% (*) passing of open FDs ("fdopen") is not supported.
+sctp_options() ->
+[ % The following are generic inet options supported for SCTP sockets:
+ mode, active, buffer, tos, priority, dontroute, reuseaddr, linger, sndbuf,
+ recbuf,
+
+ % Other options are SCTP-specific (though they may be similar to their
+ % TCP and UDP counter-parts):
+ sctp_rtoinfo, sctp_associnfo, sctp_initmsg,
+ sctp_autoclose, sctp_nodelay, sctp_disable_fragments,
+ sctp_i_want_mapped_v4_addr, sctp_maxseg, sctp_primary_addr,
+ sctp_set_peer_primary_addr, sctp_adaptation_layer, sctp_peer_addr_params,
+ sctp_default_send_param, sctp_events, sctp_delayed_ack_time,
+ sctp_status, sctp_get_peer_addr_info
+].
+
+sctp_options(Opts, Mod) ->
+ case sctp_opt(Opts, Mod, #sctp_opts{}, sctp_options()) of
+ {ok,#sctp_opts{ifaddr=undefined}=SO} ->
+ {ok,SO#sctp_opts{ifaddr=Mod:translate_ip(?SCTP_DEF_IFADDR)}};
+ {ok,_}=OK ->
+ OK;
+ Error -> Error
+ end.
+
+sctp_opt([Opt|Opts], Mod, R, As) ->
+ case Opt of
+ {ip,IP} ->
+ sctp_opt_ifaddr(Opts, Mod, R, As, IP);
+ {ifaddr,IP} ->
+ sctp_opt_ifaddr(Opts, Mod, R, As, IP);
+ {port,Port} ->
+ case Mod:getserv(Port) of
+ {ok,P} ->
+ sctp_opt(Opts, Mod, R#sctp_opts{port=P}, As);
+ Error -> Error
+ end;
+ binary -> sctp_opt (Opts, Mod, R, As, mode, binary);
+ list -> sctp_opt (Opts, Mod, R, As, mode, list);
+ {sctp_module,_} -> sctp_opt (Opts, Mod, R, As); % Done with
+ inet -> sctp_opt (Opts, Mod, R, As); % Done with
+ inet6 -> sctp_opt (Opts, Mod, R, As); % Done with
+ {Name,Val} -> sctp_opt (Opts, Mod, R, As, Name, Val);
+ _ -> {error,badarg}
+ end;
+sctp_opt([], _Mod, R, _SockOpts) ->
+ {ok, R}.
+
+sctp_opt(Opts, Mod, R, As, Name, Val) ->
+ case add_opt(Name, Val, R#sctp_opts.opts, As) of
+ {ok,SocketOpts} ->
+ sctp_opt(Opts, Mod, R#sctp_opts{opts=SocketOpts}, As);
+ Error -> Error
+ end.
+
+sctp_opt_ifaddr(Opts, Mod, #sctp_opts{ifaddr=IfAddr}=R, As, Addr) ->
+ IP = Mod:translate_ip(Addr),
+ sctp_opt(Opts, Mod,
+ R#sctp_opts{
+ ifaddr=case IfAddr of
+ undefined -> IP;
+ _ when is_list(IfAddr) -> [IP|IfAddr];
+ _ -> [IP,IfAddr]
+ end}, As).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Util to check and insert option in option list
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+add_opt(Name, Val, Opts, As) ->
+ case lists:member(Name, As) of
+ true ->
+ case prim_inet:is_sockopt_val(Name, Val) of
+ true ->
+ Opts1 = lists:keydelete(Name, 1, Opts),
+ {ok, [{Name,Val} | Opts1]};
+ false -> {error,badarg}
+ end;
+ false -> {error,badarg}
+ end.
+
+
+translate_ip(any, inet) -> {0,0,0,0};
+translate_ip(loopback, inet) -> {127,0,0,1};
+translate_ip(any, inet6) -> {0,0,0,0,0,0,0,0};
+translate_ip(loopback, inet6) -> {0,0,0,0,0,0,0,1};
+translate_ip(IP, _) -> IP.
+
+
+getaddrs_tm({A,B,C,D} = IP, Fam, _) ->
+ %% Only "syntactic" validation and check of family.
+ if
+ ?ip(A,B,C,D) ->
+ if
+ Fam =:= inet -> {ok,[IP]};
+ true -> {error,eafnosupport}
+ end;
+ true -> {error,einval}
+ end;
+getaddrs_tm({A,B,C,D,E,F,G,H} = IP, Fam, _) ->
+ %% Only "syntactic" validation; we assume that the address was
+ %% "semantically" validated when it was converted to a tuple.
+ if
+ ?ip6(A,B,C,D,E,F,G,H) ->
+ if
+ Fam =:= inet6 -> {ok,[IP]};
+ true -> {error,eafnosupport}
+ end;
+ true -> {error,einval}
+ end;
+getaddrs_tm(Address, Family, Timer) when is_atom(Address) ->
+ getaddrs_tm(atom_to_list(Address), Family, Timer);
+getaddrs_tm(Address, Family, Timer) ->
+ case inet_parse:visible_string(Address) of
+ false ->
+ {error,einval};
+ true ->
+ %% Address is a host name or a valid IP address,
+ %% either way check it with the resolver.
+ case gethostbyname_tm(Address, Family, Timer) of
+ {ok,Ent} -> {ok,Ent#hostent.h_addr_list};
+ Error -> Error
+ end
+ end.
+
+%%
+%% gethostbyname with option search
+%%
+gethostbyname_tm(Name, Type, Timer, [dns | Opts]) ->
+ Res = inet_res:gethostbyname_tm(Name, Type, Timer),
+ case Res of
+ {ok,_} -> Res;
+ {error,timeout} -> Res;
+ {error,formerr} -> {error,einval};
+ {error,_} -> gethostbyname_tm(Name,Type,Timer,Opts)
+ end;
+gethostbyname_tm(Name, Type, Timer, [file | Opts]) ->
+ case inet_hosts:gethostbyname(Name, Type) of
+ {error,formerr} -> {error,einval};
+ {error,_} -> gethostbyname_tm(Name,Type,Timer,Opts);
+ Result -> Result
+ end;
+gethostbyname_tm(Name, Type, Timer, [yp | Opts]) ->
+ gethostbyname_tm_native(Name, Type, Timer, Opts);
+gethostbyname_tm(Name, Type, Timer, [nis | Opts]) ->
+ gethostbyname_tm_native(Name, Type, Timer, Opts);
+gethostbyname_tm(Name, Type, Timer, [nisplus | Opts]) ->
+ gethostbyname_tm_native(Name, Type, Timer, Opts);
+gethostbyname_tm(Name, Type, Timer, [wins | Opts]) ->
+ gethostbyname_tm_native(Name, Type, Timer, Opts);
+gethostbyname_tm(Name, Type, Timer, [native | Opts]) ->
+ gethostbyname_tm_native(Name, Type, Timer, Opts);
+gethostbyname_tm(_, _, _, [no_default|_]) ->
+ %% If the native resolver has failed, we should not bother
+ %% to try to be smarter and parse the IP address here.
+ {error,nxdomain};
+gethostbyname_tm(Name, Type, Timer, [_ | Opts]) ->
+ gethostbyname_tm(Name, Type, Timer, Opts);
+%% Last resort - parse the hostname as address
+gethostbyname_tm(Name, inet, _Timer, []) ->
+ case inet_parse:ipv4_address(Name) of
+ {ok,IP4} ->
+ {ok,make_hostent(Name, [IP4], [], inet)};
+ _ ->
+ gethostbyname_self(Name)
+ end;
+gethostbyname_tm(Name, inet6, _Timer, []) ->
+ case inet_parse:ipv6_address(Name) of
+ {ok,IP6} ->
+ {ok,make_hostent(Name, [IP6], [], inet6)};
+ _ ->
+ %% Even if Name is a valid IPv4 address, we can't
+ %% assume it's correct to return it on a IPv6
+ %% format ( {0,0,0,0,0,16#ffff,?u16(A,B),?u16(C,D)} ).
+ %% This host might not support IPv6.
+ gethostbyname_self(Name)
+ end.
+
+gethostbyname_tm_native(Name, Type, Timer, Opts) ->
+ %% Fixme: add (global) timeout to gethost_native
+ case inet_gethost_native:gethostbyname(Name, Type) of
+ {error,formerr} -> {error,einval};
+ {error,timeout} -> {error,timeout};
+ {error,_} -> gethostbyname_tm(Name, Type, Timer, Opts++[no_default]);
+ Result -> Result
+ end.
+
+%% Make sure we always can look up our own hostname.
+gethostbyname_self(Name) ->
+ Type = case inet_db:res_option(inet6) of
+ true -> inet6;
+ false -> inet
+ end,
+ case inet_db:gethostname() of
+ Name ->
+ {ok,make_hostent(Name, [translate_ip(loopback, Type)],
+ [], Type)};
+ Self ->
+ case inet_db:res_option(domain) of
+ "" -> {error,nxdomain};
+ Domain ->
+ case lists:append([Self,".",Domain]) of
+ Name ->
+ {ok,make_hostent(Name,
+ [translate_ip(loopback, Type)],
+ [], Type)};
+ _ -> {error,nxdomain}
+ end
+ end
+ end.
+
+make_hostent(Name, Addrs, Aliases, Type) ->
+ #hostent{h_name = Name,
+ h_aliases = Aliases,
+ h_addrtype = Type,
+ h_length = case Type of inet -> 4; inet6 -> 16 end,
+ h_addr_list = Addrs}.
+
+%%
+%% gethostbyaddr with option search
+%%
+gethostbyaddr_tm(Addr, Timer, [dns | Opts]) ->
+ Res = inet_res:gethostbyaddr_tm(Addr,Timer),
+ case Res of
+ {ok,_} -> Res;
+ {error,timeout} -> Res;
+ {error,formerr} -> {error, einval};
+ {error,_} -> gethostbyaddr_tm(Addr,Timer,Opts)
+ end;
+gethostbyaddr_tm(Addr, Timer, [file | Opts]) ->
+ case inet_hosts:gethostbyaddr(Addr) of
+ {error,formerr} -> {error, einval};
+ {error,_} -> gethostbyaddr_tm(Addr,Timer,Opts);
+ Result -> Result
+ end;
+gethostbyaddr_tm(Addr, Timer, [yp | Opts]) ->
+ gethostbyaddr_tm_native(Addr, Timer, Opts);
+gethostbyaddr_tm(Addr, Timer, [nis | Opts]) ->
+ gethostbyaddr_tm_native(Addr, Timer, Opts);
+gethostbyaddr_tm(Addr, Timer, [nisplus | Opts]) ->
+ gethostbyaddr_tm_native(Addr, Timer, Opts);
+gethostbyaddr_tm(Addr, Timer, [wins | Opts]) ->
+ gethostbyaddr_tm_native(Addr, Timer, Opts);
+gethostbyaddr_tm(Addr, Timer, [native | Opts]) ->
+ gethostbyaddr_tm_native(Addr, Timer, Opts);
+gethostbyaddr_tm(Addr, Timer, [_ | Opts]) ->
+ gethostbyaddr_tm(Addr, Timer, Opts);
+gethostbyaddr_tm({127,0,0,1}=IP, _Timer, []) ->
+ gethostbyaddr_self(IP, inet);
+gethostbyaddr_tm({0,0,0,0,0,0,0,1}=IP, _Timer, []) ->
+ gethostbyaddr_self(IP, inet6);
+gethostbyaddr_tm(_Addr, _Timer, []) ->
+ {error, nxdomain}.
+
+gethostbyaddr_self(IP, Type) ->
+ Name = inet_db:gethostname(),
+ case inet_db:res_option(domain) of
+ "" ->
+ {ok,make_hostent(Name, [IP], [], Type)};
+ Domain ->
+ {ok,make_hostent(Name++"."++Domain, [IP], [Name], Type)}
+ end.
+
+gethostbyaddr_tm_native(Addr, Timer, Opts) ->
+ %% Fixme: user timer for timeoutvalue
+ case inet_gethost_native:gethostbyaddr(Addr) of
+ {error,formerr} -> {error, einval};
+ {error,_} -> gethostbyaddr_tm(Addr,Timer,Opts);
+ Result -> Result
+ end.
+
+-spec open(Fd :: integer(),
+ Addr :: ip_address(),
+ Port :: ip_port(),
+ Opts :: [socket_setopt()],
+ Protocol :: protocol_option(),
+ Family :: 'inet' | 'inet6',
+ Module :: atom()) ->
+ {'ok', socket()} | {'error', posix()}.
+
+open(Fd, Addr, Port, Opts, Protocol, Family, Module) when Fd < 0 ->
+ case prim_inet:open(Protocol, Family) of
+ {ok,S} ->
+ case prim_inet:setopts(S, Opts) of
+ ok ->
+ case if is_list(Addr) ->
+ prim_inet:bind(S, add,
+ [case A of
+ {_,_} -> A;
+ _ -> {A,Port}
+ end || A <- Addr]);
+ true ->
+ prim_inet:bind(S, Addr, Port)
+ end of
+ {ok, _} ->
+ inet_db:register_socket(S, Module),
+ {ok,S};
+ Error ->
+ prim_inet:close(S),
+ Error
+ end;
+ Error ->
+ prim_inet:close(S),
+ Error
+ end;
+ Error ->
+ Error
+ end;
+open(Fd, _Addr, _Port, Opts, Protocol, Family, Module) ->
+ fdopen(Fd, Opts, Protocol, Family, Module).
+
+-spec fdopen(Fd :: non_neg_integer(),
+ Opts :: [socket_setopt()],
+ Protocol :: protocol_option(),
+ Family :: family_option(),
+ Module :: atom()) ->
+ {'ok', socket()} | {'error', posix()}.
+
+fdopen(Fd, Opts, Protocol, Family, Module) ->
+ case prim_inet:fdopen(Protocol, Fd, Family) of
+ {ok, S} ->
+ case prim_inet:setopts(S, Opts) of
+ ok ->
+ inet_db:register_socket(S, Module),
+ {ok, S};
+ Error ->
+ prim_inet:close(S), Error
+ end;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% socket stat
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+i() -> i(tcp), i(udp).
+
+i(Proto) -> i(Proto, [port, module, recv, sent, owner,
+ local_address, foreign_address, state]).
+
+i(tcp, Fs) ->
+ ii(tcp_sockets(), Fs, tcp);
+i(udp, Fs) ->
+ ii(udp_sockets(), Fs, udp).
+
+ii(Ss, Fs, Proto) ->
+ LLs = [h_line(Fs) | info_lines(Ss, Fs, Proto)],
+ Maxs = foldl(
+ fun(Line,Max0) -> smax(Max0,Line) end,
+ duplicate(length(Fs),0),LLs),
+ Fmt = append(["~-" ++ integer_to_list(N) ++ "s " || N <- Maxs]) ++ "\n",
+ lists:foreach(fun(Line) -> io:format(Fmt, Line) end, LLs).
+
+smax([Max|Ms], [Str|Strs]) ->
+ N = length(Str),
+ [if N > Max -> N; true -> Max end | smax(Ms, Strs)];
+smax([], []) -> [].
+
+info_lines(Ss, Fs, Proto) -> [i_line(S, Fs,Proto) || S <- Ss].
+i_line(S, Fs, Proto) -> [info(S, F, Proto) || F <- Fs].
+
+h_line(Fs) -> [h_field(atom_to_list(F)) || F <- Fs].
+
+h_field([C|Cs]) -> [upper(C) | hh_field(Cs)].
+
+hh_field([$_,C|Cs]) -> [$\s,upper(C) | hh_field(Cs)];
+hh_field([C|Cs]) -> [C|hh_field(Cs)];
+hh_field([]) -> [].
+
+upper(C) when C >= $a, C =< $z -> (C-$a) + $A;
+upper(C) -> C.
+
+
+info(S, F, Proto) ->
+ case F of
+ owner ->
+ case erlang:port_info(S, connected) of
+ {connected, Owner} -> pid_to_list(Owner);
+ _ -> " "
+ end;
+ port ->
+ case erlang:port_info(S,id) of
+ {id, Id} -> integer_to_list(Id);
+ undefined -> " "
+ end;
+ sent ->
+ case prim_inet:getstat(S, [send_oct]) of
+ {ok,[{send_oct,N}]} -> integer_to_list(N);
+ _ -> " "
+ end;
+ recv ->
+ case prim_inet:getstat(S, [recv_oct]) of
+ {ok,[{recv_oct,N}]} -> integer_to_list(N);
+ _ -> " "
+ end;
+ local_address ->
+ fmt_addr(prim_inet:sockname(S), Proto);
+ foreign_address ->
+ fmt_addr(prim_inet:peername(S), Proto);
+ state ->
+ case prim_inet:getstatus(S) of
+ {ok,Status} -> fmt_status(Status);
+ _ -> " "
+ end;
+ packet ->
+ case prim_inet:getopt(S, packet) of
+ {ok,Type} when is_atom(Type) -> atom_to_list(Type);
+ {ok,Type} when is_integer(Type) -> integer_to_list(Type);
+ _ -> " "
+ end;
+ type ->
+ case prim_inet:gettype(S) of
+ {ok,{_,stream}} -> "STREAM";
+ {ok,{_,dgram}} -> "DGRAM";
+ _ -> " "
+ end;
+ fd ->
+ case prim_inet:getfd(S) of
+ {ok, Fd} -> integer_to_list(Fd);
+ _ -> " "
+ end;
+ module ->
+ case inet_db:lookup_socket(S) of
+ {ok,Mod} -> atom_to_list(Mod);
+ _ -> "prim_inet"
+ end
+ end.
+%% Possible flags: (sorted)
+%% [accepting,bound,busy,connected,connecting,listen,listening,open]
+%%
+fmt_status(Flags) ->
+ case lists:sort(Flags) of
+ [accepting | _] -> "ACCEPTING";
+ [bound,busy,connected|_] -> "CONNECTED*";
+ [bound,connected|_] -> "CONNECTED";
+ [bound,listen,listening | _] -> "LISTENING";
+ [bound,listen | _] -> "LISTEN";
+ [bound,connecting | _] -> "CONNECTING";
+ [bound,open] -> "BOUND";
+ [open] -> "IDLE";
+ [] -> "CLOSED";
+ _ -> "????"
+ end.
+
+fmt_addr({error,enotconn}, _) -> "*:*";
+fmt_addr({error,_}, _) -> " ";
+fmt_addr({ok,Addr}, Proto) ->
+ case Addr of
+ %%Dialyzer {0,0} -> "*:*";
+ {{0,0,0,0},Port} -> "*:" ++ fmt_port(Port, Proto);
+ {{0,0,0,0,0,0,0,0},Port} -> "*:" ++ fmt_port(Port, Proto);
+ {{127,0,0,1},Port} -> "localhost:" ++ fmt_port(Port, Proto);
+ {{0,0,0,0,0,0,0,1},Port} -> "localhost:" ++ fmt_port(Port, Proto);
+ {IP,Port} -> inet_parse:ntoa(IP) ++ ":" ++ fmt_port(Port, Proto)
+ end.
+
+fmt_port(N, Proto) ->
+ case inet:getservbyport(N, Proto) of
+ {ok, Name} -> Name;
+ _ -> integer_to_list(N)
+ end.
+
+%% Return a list of all tcp sockets
+tcp_sockets() -> port_list("tcp_inet").
+udp_sockets() -> port_list("udp_inet").
+
+%% Return all ports having the name 'Name'
+port_list(Name) ->
+ filter(
+ fun(Port) ->
+ case erlang:port_info(Port, name) of
+ {name, Name} -> true;
+ _ -> false
+ end
+ end, erlang:ports()).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% utils
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-spec format_error(posix()) -> string().
+
+format_error(exbadport) -> "invalid port state";
+format_error(exbadseq) -> "bad command sequence";
+format_error(Tag) ->
+ erl_posix_msg:message(Tag).
+
+%% Close a TCP socket.
+tcp_close(S) when is_port(S) ->
+ %% if exit_on_close is set we must force a close even if remotely closed!!!
+ prim_inet:close(S),
+ receive {tcp_closed, S} -> ok after 0 -> ok end.
+
+%% Close a UDP socket.
+udp_close(S) when is_port(S) ->
+ receive
+ {udp_closed, S} -> ok
+ after 0 ->
+ prim_inet:close(S),
+ receive {udp_closed, S} -> ok after 0 -> ok end
+ end.
+
+%% Set controlling process for TCP socket.
+tcp_controlling_process(S, NewOwner) when is_port(S), is_pid(NewOwner) ->
+ case erlang:port_info(S, connected) of
+ {connected, Pid} when Pid =/= self() ->
+ {error, not_owner};
+ undefined ->
+ {error, einval};
+ _ ->
+ case prim_inet:getopt(S, active) of
+ {ok, A0} ->
+ prim_inet:setopt(S, active, false),
+ case tcp_sync_input(S, NewOwner, false) of
+ true -> %% socket already closed,
+ ok;
+ false ->
+ try erlang:port_connect(S, NewOwner) of
+ true ->
+ unlink(S), %% unlink from port
+ prim_inet:setopt(S, active, A0),
+ ok
+ catch
+ error:Reason ->
+ {error, Reason}
+ end
+ end;
+ Error ->
+ Error
+ end
+ end.
+
+tcp_sync_input(S, Owner, Flag) ->
+ receive
+ {tcp, S, Data} ->
+ Owner ! {tcp, S, Data},
+ tcp_sync_input(S, Owner, Flag);
+ {tcp_closed, S} ->
+ Owner ! {tcp_closed, S},
+ tcp_sync_input(S, Owner, true);
+ {S, {data, Data}} ->
+ Owner ! {S, {data, Data}},
+ tcp_sync_input(S, Owner, Flag);
+ {inet_async, S, Ref, Status} ->
+ Owner ! {inet_async, S, Ref, Status},
+ tcp_sync_input(S, Owner, Flag);
+ {inet_reply, S, Status} ->
+ Owner ! {inet_reply, S, Status},
+ tcp_sync_input(S, Owner, Flag)
+ after 0 ->
+ Flag
+ end.
+
+%% Set controlling process for UDP or SCTP socket.
+udp_controlling_process(S, NewOwner) when is_port(S), is_pid(NewOwner) ->
+ case erlang:port_info(S, connected) of
+ {connected, Pid} when Pid =/= self() ->
+ {error, not_owner};
+ _ ->
+ {ok, A0} = prim_inet:getopt(S, active),
+ prim_inet:setopt(S, active, false),
+ udp_sync_input(S, NewOwner),
+ try erlang:port_connect(S, NewOwner) of
+ true ->
+ unlink(S),
+ prim_inet:setopt(S, active, A0),
+ ok
+ catch
+ error:Reason ->
+ {error, Reason}
+ end
+ end.
+
+udp_sync_input(S, Owner) ->
+ receive
+ {sctp, S, _, _, _}=Msg -> udp_sync_input(S, Owner, Msg);
+ {udp, S, _, _, _}=Msg -> udp_sync_input(S, Owner, Msg);
+ {udp_closed, S}=Msg -> udp_sync_input(S, Owner, Msg);
+ {S, {data,_}}=Msg -> udp_sync_input(S, Owner, Msg);
+ {inet_async, S, _, _}=Msg -> udp_sync_input(S, Owner, Msg);
+ {inet_reply, S, _}=Msg -> udp_sync_input(S, Owner, Msg)
+ after 0 ->
+ ok
+ end.
+
+udp_sync_input(S, Owner, Msg) ->
+ Owner ! Msg,
+ udp_sync_input(S, Owner).
+
+start_timer(infinity) -> false;
+start_timer(Timeout) ->
+ erlang:start_timer(Timeout, self(), inet).
+
+timeout(false) -> infinity;
+timeout(Timer) ->
+ case erlang:read_timer(Timer) of
+ false -> 0;
+ Time -> Time
+ end.
+
+timeout(Time, false) -> Time;
+timeout(Time, Timer) ->
+ TimerTime = timeout(Timer),
+ if TimerTime < Time -> TimerTime;
+ true -> Time
+ end.
+
+stop_timer(false) -> false;
+stop_timer(Timer) ->
+ case erlang:cancel_timer(Timer) of
+ false ->
+ receive
+ {timeout,Timer,_} -> false
+ after 0 ->
+ false
+ end;
+ T -> T
+ end.
diff --git a/lib/kernel/src/inet6_sctp.erl b/lib/kernel/src/inet6_sctp.erl
new file mode 100644
index 0000000000..5c49c4fec3
--- /dev/null
+++ b/lib/kernel/src/inet6_sctp.erl
@@ -0,0 +1,75 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% SCTP protocol contribution by Leonid Timochouk and Serge Aleynikov.
+%% See also: $ERL_TOP/lib/kernel/AUTHORS
+%%
+%%
+-module(inet6_sctp).
+
+%% This module provides functions for communicating with
+%% sockets using the SCTP protocol. The implementation assumes that
+%% the OS kernel supports SCTP providing user-level SCTP Socket API:
+%% http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13
+
+-include("inet_sctp.hrl").
+-include("inet_int.hrl").
+
+-define(FAMILY, inet6).
+-export([getserv/1,getaddr/1,getaddr/2,translate_ip/1]).
+-export([open/1,close/1,listen/2,connect/5,sendmsg/3,recv/2]).
+
+
+
+getserv(Port) when is_integer(Port) -> {ok, Port};
+getserv(Name) when is_atom(Name) ->
+ inet:getservbyname(Name, sctp);
+getserv(_) ->
+ {error,einval}.
+
+getaddr(Address) ->
+ inet:getaddr(Address, ?FAMILY).
+getaddr(Address, Timer) ->
+ inet:getaddr_tm(Address, ?FAMILY, Timer).
+
+translate_ip(IP) ->
+ inet:translate_ip(IP, ?FAMILY).
+
+
+
+open(Opts) ->
+ case inet:sctp_options(Opts, ?MODULE) of
+ {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,opts=SOs}} ->
+ inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, ?MODULE);
+ Error -> Error
+ end.
+
+close(S) ->
+ prim_inet:close(S).
+
+listen(S, Flag) ->
+ prim_inet:listen(S, Flag).
+
+connect(S, Addr, Port, Opts, Timer) ->
+ inet_sctp:connect(S, Addr, Port, Opts, Timer).
+
+sendmsg(S, SRI, Data) ->
+ prim_inet:sendmsg(S, SRI, Data).
+
+recv(S, Timeout) ->
+ prim_inet:recvfrom(S, 0, Timeout).
diff --git a/lib/kernel/src/inet6_tcp.erl b/lib/kernel/src/inet6_tcp.erl
new file mode 100644
index 0000000000..cc45f6c7f6
--- /dev/null
+++ b/lib/kernel/src/inet6_tcp.erl
@@ -0,0 +1,153 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet6_tcp).
+
+-export([connect/3, connect/4, listen/2, accept/1, accept/2, close/1]).
+-export([send/2, send/3, recv/2, recv/3, unrecv/2]).
+-export([shutdown/2]).
+-export([controlling_process/2]).
+-export([fdopen/2]).
+
+-export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]).
+
+-include("inet_int.hrl").
+
+%% inet_tcp port lookup
+getserv(Port) when is_integer(Port) -> {ok, Port};
+getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,tcp).
+
+%% inet_tcp address lookup
+getaddr(Address) -> inet:getaddr(Address, inet6).
+getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet6, Timer).
+
+%% inet_tcp address lookup
+getaddrs(Address) -> inet:getaddrs(Address, inet6).
+getaddrs(Address,Timer) -> inet:getaddrs_tm(Address,inet6,Timer).
+
+%%
+%% Send data on a socket
+%%
+send(Socket, Packet, Opts) -> prim_inet:send(Socket, Packet, Opts).
+send(Socket, Packet) -> prim_inet:send(Socket, Packet, []).
+
+%%
+%% Receive data from a socket (inactive only)
+%%
+recv(Socket, Length) -> prim_inet:recv(Socket, Length).
+recv(Socket, Length, Timeout) -> prim_inet:recv(Socket, Length, Timeout).
+
+unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data).
+%%
+%% Close a socket (async)
+%%
+close(Socket) ->
+ inet:tcp_close(Socket).
+
+%%
+%% Shutdown one end of a socket
+%%
+shutdown(Socket, How) ->
+ prim_inet:shutdown(Socket, How).
+
+%%
+%% Set controlling process
+%% FIXME: move messages to new owner!!!
+%%
+controlling_process(Socket, NewOwner) ->
+ inet:tcp_controlling_process(Socket, NewOwner).
+
+%%
+%% Connect
+%%
+connect(Address, Port, Opts) ->
+ do_connect(Address, Port, Opts, infinity).
+
+connect(Address, Port, Opts, infinity) ->
+ do_connect(Address, Port, Opts, infinity);
+connect(Address, Port, Opts, Timeout) when is_integer(Timeout),
+ Timeout >= 0 ->
+ do_connect(Address, Port, Opts, Timeout).
+
+do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) when
+ ?ip6(A,B,C,D,E,F,G,H), ?port(Port) ->
+ case inet:connect_options(Opts, inet6) of
+ {error, Reason} -> exit(Reason);
+ {ok, #connect_opts{fd=Fd,
+ ifaddr=BAddr={Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb},
+ port=BPort,
+ opts=SockOpts}}
+ when ?ip6(Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb), ?port(BPort) ->
+ case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet6,?MODULE) of
+ {ok, S} ->
+ case prim_inet:connect(S, Addr, Port, Time) of
+ ok -> {ok,S};
+ Error -> prim_inet:close(S), Error
+ end;
+ Error -> Error
+ end;
+ {ok, _} -> exit(badarg)
+ end.
+
+%%
+%% Listen
+%%
+listen(Port, Opts) ->
+ case inet:listen_options([{port,Port} | Opts], inet6) of
+ {error, Reason} -> exit(Reason);
+ {ok, #listen_opts{fd=Fd,
+ ifaddr=BAddr={A,B,C,D,E,F,G,H},
+ port=BPort,
+ opts=SockOpts}=R}
+ when ?ip6(A,B,C,D,E,F,G,H), ?port(BPort) ->
+ case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet6,?MODULE) of
+ {ok, S} ->
+ case prim_inet:listen(S, R#listen_opts.backlog) of
+ ok -> {ok, S};
+ Error -> prim_inet:close(S), Error
+ end;
+ Error -> Error
+ end;
+ {ok, _} -> exit(badarg)
+ end.
+
+%%
+%% Accept
+%%
+accept(L) ->
+ case prim_inet:accept(L) of
+ {ok, S} ->
+ inet_db:register_socket(S, ?MODULE),
+ {ok,S};
+ Error -> Error
+ end.
+
+accept(L,Timeout) ->
+ case prim_inet:accept(L,Timeout) of
+ {ok, S} ->
+ inet_db:register_socket(S, ?MODULE),
+ {ok,S};
+ Error -> Error
+ end.
+
+%%
+%% Create a port/socket from a file descriptor
+%%
+fdopen(Fd, Opts) ->
+ inet:fdopen(Fd, Opts, tcp, inet6, ?MODULE).
+
diff --git a/lib/kernel/src/inet6_tcp_dist.erl b/lib/kernel/src/inet6_tcp_dist.erl
new file mode 100644
index 0000000000..34cf582af7
--- /dev/null
+++ b/lib/kernel/src/inet6_tcp_dist.erl
@@ -0,0 +1,417 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet6_tcp_dist).
+
+%% Handles the connection setup phase with other Erlang nodes.
+
+-export([listen/1, accept/1, accept_connection/5,
+ setup/5, close/1, select/1, is_node_name/1]).
+
+%% internal exports
+
+-export([accept_loop/2,do_accept/6,do_setup/6, getstat/1,tick/1]).
+
+-import(error_logger,[error_msg/2]).
+
+-include("net_address.hrl").
+
+
+
+-define(to_port(Socket, Data, Opts),
+ case inet6_tcp:send(Socket, Data, Opts) of
+ {error, closed} ->
+ self() ! {tcp_closed, Socket},
+ {error, closed};
+ R ->
+ R
+ end).
+
+
+-include("dist.hrl").
+-include("dist_util.hrl").
+
+%% ------------------------------------------------------------
+%% Select this protocol based on node name
+%% select(Node) => Bool
+%% ------------------------------------------------------------
+
+select(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_, Host] ->
+ case inet:getaddr(Host,inet6) of
+ {ok,_} -> true;
+ _ -> false
+ end;
+ _ -> false
+ end.
+
+%% ------------------------------------------------------------
+%% Create the listen socket, i.e. the port that this erlang
+%% node is accessible through.
+%% ------------------------------------------------------------
+
+listen(Name) ->
+ case inet6_tcp:listen(0, [{active, false}, {packet,2}]) of
+ {ok, Socket} ->
+ TcpAddress = get_tcp_address(Socket),
+ {_,Port} = TcpAddress#net_address.address,
+ {ok, Creation} = erl_epmd:register_node(Name, Port),
+ {ok, {Socket, TcpAddress, Creation}};
+ Error ->
+ Error
+ end.
+
+%% ------------------------------------------------------------
+%% Accepts new connection attempts from other Erlang nodes.
+%% ------------------------------------------------------------
+
+accept(Listen) ->
+ spawn_opt(?MODULE, accept_loop, [self(), Listen], [link, {priority, max}]).
+
+accept_loop(Kernel, Listen) ->
+ case inet6_tcp:accept(Listen) of
+ {ok, Socket} ->
+ Kernel ! {accept,self(),Socket,inet,tcp},
+ controller(Kernel, Socket),
+ accept_loop(Kernel, Listen);
+ Error ->
+ exit(Error)
+ end.
+
+controller(Kernel, Socket) ->
+ receive
+ {Kernel, controller, Pid} ->
+ flush_controller(Pid, Socket),
+ inet6_tcp:controlling_process(Socket, Pid),
+ flush_controller(Pid, Socket),
+ Pid ! {self(), controller};
+ {Kernel, unsupported_protocol} ->
+ exit(unsupported_protocol)
+ end.
+
+flush_controller(Pid, Socket) ->
+ receive
+ {tcp, Socket, Data} ->
+ Pid ! {tcp, Socket, Data},
+ flush_controller(Pid, Socket);
+ {tcp_closed, Socket} ->
+ Pid ! {tcp_closed, Socket},
+ flush_controller(Pid, Socket)
+ after 0 ->
+ ok
+ end.
+
+%% ------------------------------------------------------------
+%% Accepts a new connection attempt from another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+ spawn_opt(?MODULE, do_accept,
+ [self(), AcceptPid, Socket, MyNode, Allowed, SetupTime],
+ [link, {priority, max}]).
+
+do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+ receive
+ {AcceptPid, controller} ->
+ Timer = dist_util:start_timer(SetupTime),
+ case check_ip(Socket) of
+ true ->
+ HSData = #hs_data{
+ kernel_pid = Kernel,
+ this_node = MyNode,
+ socket = Socket,
+ timer = Timer,
+ this_flags = 0,
+ allowed = Allowed,
+ f_send = fun(S,D) -> inet6_tcp:send(S,D) end,
+ f_recv = fun(S,N,T) -> inet6_tcp:recv(S,N,T)
+ end,
+ f_setopts_pre_nodeup =
+ fun(S) ->
+ inet:setopts(S,
+ [{active, false},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_setopts_post_nodeup =
+ fun(S) ->
+ inet:setopts(S,
+ [{active, true},
+ {deliver, port},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_getll = fun(S) ->
+ inet:getll(S)
+ end,
+ f_address = fun get_remote_id/2,
+ mf_tick = {?MODULE, tick},
+ mf_getstat = {?MODULE,getstat}
+ },
+ dist_util:handshake_other_started(HSData);
+ {false,IP} ->
+ error_msg("** Connection attempt from "
+ "disallowed IP ~w ** ~n", [IP]),
+ ?shutdown(no_node)
+ end
+ end.
+
+
+%% we may not always want the nodelay behaviour
+%% for performance reasons
+
+nodelay() ->
+ case application:get_env(kernel, dist_nodelay) of
+ undefined ->
+ {nodelay, true};
+ {ok, true} ->
+ {nodelay, true};
+ {ok, false} ->
+ {nodelay, false};
+ _ ->
+ {nodelay, true}
+ end.
+
+
+%% ------------------------------------------------------------
+%% Get remote information about a Socket.
+%% ------------------------------------------------------------
+
+get_remote_id(Socket, Node) ->
+ {ok, Address} = inet:peername(Socket),
+ [_, Host] = split_node(atom_to_list(Node), $@, []),
+ #net_address {
+ address = Address,
+ host = Host,
+ protocol = tcp,
+ family = inet6 }.
+
+%% ------------------------------------------------------------
+%% Setup a new connection to another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
+ spawn_opt(?MODULE, do_setup,
+ [self(), Node, Type, MyNode, LongOrShortNames, SetupTime],
+ [link, {priority, max}]).
+
+do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) ->
+ ?trace("~p~n",[{?MODULE,self(),setup,Node}]),
+ [Name, Address] = splitnode(Node, LongOrShortNames),
+ case inet:getaddr(Address, inet6) of
+ {ok, Ip} ->
+ Timer = dist_util:start_timer(SetupTime),
+ case erl_epmd:port_please(Name, Ip) of
+ {port, TcpPort, Version} ->
+ ?trace("port_please(~p) -> version ~p~n",
+ [Node,Version]),
+ dist_util:reset_timer(Timer),
+ case inet6_tcp:connect(Ip, TcpPort,
+ [{active, false},
+ {packet,2}]) of
+ {ok, Socket} ->
+ HSData = #hs_data{
+ kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = Socket,
+ timer = Timer,
+ this_flags = 0,
+ other_version = Version,
+ f_send = fun inet_tcp:send/2,
+ f_recv = fun inet_tcp:recv/3,
+ f_setopts_pre_nodeup =
+ fun(S) ->
+ inet:setopts
+ (S,
+ [{active, false},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_setopts_post_nodeup =
+ fun(S) ->
+ inet:setopts
+ (S,
+ [{active, true},
+ {deliver, port},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_getll = fun inet:getll/1,
+ f_address =
+ fun(_,_) ->
+ #net_address {
+ address = {Ip,TcpPort},
+ host = Address,
+ protocol = tcp,
+ family = inet}
+ end,
+ mf_tick = fun ?MODULE:tick/1,
+ mf_getstat = fun ?MODULE:getstat/1,
+ request_type = Type
+ },
+ dist_util:handshake_we_started(HSData);
+ _ ->
+ %% Other Node may have closed since
+ %% port_please !
+ ?trace("other node (~p) "
+ "closed since port_please.~n",
+ [Node]),
+ ?shutdown(Node)
+ end;
+ _ ->
+ ?trace("port_please (~p) "
+ "failed.~n", [Node]),
+ ?shutdown(Node)
+ end;
+ __Other ->
+ ?trace("inet_getaddr(~p) "
+ "failed (~p).~n", [Node,__Other]),
+ ?shutdown(Node)
+ end.
+
+%%
+%% Close a socket.
+%%
+close(Socket) ->
+ inet6_tcp:close(Socket).
+
+
+%% If Node is illegal terminate the connection setup!!
+splitnode(Node, LongOrShortNames) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [Name|Tail] when Tail =/= [] ->
+ Host = lists:append(Tail),
+ case split_node(Host, $., []) of
+ [_] when LongOrShortNames =:= longnames ->
+ error_msg("** System running to use "
+ "fully qualified "
+ "hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown(Node);
+ L when length(L) > 1, LongOrShortNames =:= shortnames ->
+ error_msg("** System NOT running to use fully qualified "
+ "hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown(Node);
+ _ ->
+ [Name, Host]
+ end;
+ [_] ->
+ error_msg("** Nodename ~p illegal, no '@' character **~n",
+ [Node]),
+ ?shutdown(Node);
+ _ ->
+ error_msg("** Nodename ~p illegal **~n", [Node]),
+ ?shutdown(Node)
+ end.
+
+split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])];
+split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]);
+split_node([], _, Ack) -> [lists:reverse(Ack)].
+
+%% ------------------------------------------------------------
+%% Fetch local information about a Socket.
+%% ------------------------------------------------------------
+get_tcp_address(Socket) ->
+ {ok, Address} = inet:sockname(Socket),
+ {ok, Host} = inet:gethostname(),
+ #net_address {
+ address = Address,
+ host = Host,
+ protocol = tcp,
+ family = inet6
+ }.
+
+%% ------------------------------------------------------------
+%% Do only accept new connection attempts from nodes at our
+%% own LAN, if the check_ip environment parameter is true.
+%% ------------------------------------------------------------
+check_ip(Socket) ->
+ case application:get_env(check_ip) of
+ {ok, true} ->
+ case get_ifs(Socket) of
+ {ok, IFs, IP} ->
+ check_ip(IFs, IP);
+ _ ->
+ ?shutdown(no_node)
+ end;
+ _ ->
+ true
+ end.
+
+get_ifs(Socket) ->
+ case inet:peername(Socket) of
+ {ok, {IP, _}} ->
+ case inet:getif(Socket) of
+ {ok, IFs} -> {ok, IFs, IP};
+ Error -> Error
+ end;
+ Error ->
+ Error
+ end.
+
+check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) ->
+ case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of
+ {M, M} -> true;
+ _ -> check_ip(IFs, PeerIP)
+ end;
+check_ip([], PeerIP) ->
+ {false, PeerIP}.
+
+mask({M1,M2,M3,M4,M5,M6,M7,M8}, {IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8}) ->
+ {M1 band IP1,
+ M2 band IP2,
+ M3 band IP3,
+ M4 band IP4,
+ M5 band IP5,
+ M6 band IP6,
+ M7 band IP7,
+ M8 band IP8 }.
+
+is_node_name(Node) when is_atom(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_,_Host] -> true;
+ _ -> false
+ end;
+is_node_name(_Node) ->
+ false.
+tick(Sock) ->
+ ?to_port(Sock,[],[force]).
+getstat(Socket) ->
+ case inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of
+ {ok, Stat} ->
+ split_stat(Stat,0,0,0);
+ Error ->
+ Error
+ end.
+
+split_stat([{recv_cnt, R}|Stat], _, W, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_cnt, W}|Stat], R, _, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_pend, P}|Stat], R, W, _) ->
+ split_stat(Stat, R, W, P);
+split_stat([], R, W, P) ->
+ {ok, R, W, P}.
+
diff --git a/lib/kernel/src/inet6_udp.erl b/lib/kernel/src/inet6_udp.erl
new file mode 100644
index 0000000000..e81d417151
--- /dev/null
+++ b/lib/kernel/src/inet6_udp.erl
@@ -0,0 +1,87 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet6_udp).
+
+-export([open/1, open/2, close/1]).
+-export([send/2, send/4, recv/2, recv/3, connect/3]).
+-export([controlling_process/2]).
+-export([fdopen/2]).
+
+-export([getserv/1, getaddr/1, getaddr/2]).
+
+-include("inet_int.hrl").
+
+%% inet_udp port lookup
+getserv(Port) when is_integer(Port) -> {ok, Port};
+getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,udp).
+
+%% inet_udp address lookup
+getaddr(Address) -> inet:getaddr(Address, inet6).
+getaddr(Address,Timer) -> inet:getaddr(Address, inet6, Timer).
+
+open(Port) -> open(Port, []).
+
+open(Port, Opts) ->
+ case inet:udp_options([{port,Port} | Opts], inet6) of
+ {error, Reason} -> exit(Reason);
+ {ok, #udp_opts{fd=Fd,
+ ifaddr=BAddr={A,B,C,D,E,F,G,H},
+ port=BPort,
+ opts=SockOpts}}
+ when ?ip6(A,B,C,D,E,F,G,H), ?port(BPort) ->
+ inet:open(Fd,BAddr,BPort,SockOpts,udp,inet6,?MODULE);
+ {ok, _} -> exit(badarg)
+ end.
+
+send(S, Addr = {A,B,C,D,E,F,G,H}, P, Data)
+ when ?ip6(A,B,C,D,E,F,G,H), ?port(P) ->
+ prim_inet:sendto(S, Addr, P, Data).
+
+send(S, Data) ->
+ prim_inet:sendto(S, {0,0,0,0,0,0,0,0}, 0, Data).
+
+connect(S, Addr = {A,B,C,D,E,F,G,H}, P)
+ when ?ip6(A,B,C,D,E,F,G,H), ?port(P) ->
+ prim_inet:connect(S, Addr, P).
+
+recv(S,Len) ->
+ prim_inet:recvfrom(S, Len).
+
+recv(S,Len,Time) ->
+ prim_inet:recvfrom(S, Len, Time).
+
+close(S) ->
+ inet:udp_close(S).
+
+%%
+%% Set controlling process:
+%% 1) First sync socket into a known state
+%% 2) Move all messages onto the new owners message queue
+%% 3) Commit the owner
+%% 4) Wait for ack of new Owner (since socket does some link and unlink)
+%%
+
+controlling_process(Socket, NewOwner) ->
+ inet:udp_controlling_process(Socket, NewOwner).
+
+%%
+%% Create a port/socket from a file descriptor
+%%
+fdopen(Fd, Opts) ->
+ inet:fdopen(Fd, Opts, udp, inet6, ?MODULE).
diff --git a/lib/kernel/src/inet_boot.hrl b/lib/kernel/src/inet_boot.hrl
new file mode 100644
index 0000000000..35501a0f9c
--- /dev/null
+++ b/lib/kernel/src/inet_boot.hrl
@@ -0,0 +1,32 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% Defines used for erlang boot/load protocol
+%%
+
+-define(EBOOT_PORT, 4368). %% same as epmd but for udp !
+
+-define(EBOOT_REQUEST, "EBOOTQ").
+-define(EBOOT_REPLY, "EBOOTR").
+
+-define(EBOOT_RETRY, 3). % number of retry before sleep
+-define(EBOOT_REQUEST_DELAY, 500). % delay between retry
+-define(EBOOT_SHORT_RETRY_SLEEP, 10000). % initial sleep time between boot attempt's
+-define(EBOOT_UNSUCCESSFUL_TRIES, 10). % retries before longer sleep
+-define(EBOOT_LONG_RETRY_SLEEP, 60000). % sleep time after a number of unsuccessful tries
diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl
new file mode 100644
index 0000000000..b5317f72f5
--- /dev/null
+++ b/lib/kernel/src/inet_config.erl
@@ -0,0 +1,638 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_config).
+
+-include("inet_config.hrl").
+-include("inet.hrl").
+
+-import(lists, [foreach/2, member/2, reverse/1]).
+
+-export([init/0]).
+
+-export([do_load_resolv/2]).
+
+%%
+%% Must be called after inet_db:start
+%%
+%% Order in which to load inet_db data:
+%% 1. Hostname (possibly derive domain and search)
+%% 2. OS default /etc/resolv.conf, Windows registry etc
+%% a) Hosts database
+%% b) Resolver options
+%% 3. Config (kernel app)
+%% 4. Root (otp root)
+%% 5. Home (user inetrc)
+%%
+%%
+-spec init() -> 'ok'.
+init() ->
+ OsType = os:type(),
+ case OsType of
+ {ose,_} ->
+ case init:get_argument(loader) of
+ {ok,[["ose_inet"]]} ->
+ %% port already started by prim_loader
+ ok;
+ _Other ->
+ %% Setup reserved port for ose_inet driver (only OSE)
+ case catch erlang:open_port({spawn,"ose_inet"}, [binary]) of
+ {'EXIT',Why} ->
+ error("can't open port for ose_inet: ~p", [Why]);
+ OseInetPort ->
+ erlang:display({ose_inet_port,OseInetPort})
+ end
+ end;
+ _ ->
+ ok
+ end,
+
+ set_hostname(),
+
+ %% Note: In shortnames (or non-distributed) mode we don't need to know
+ %% our own domain name. In longnames mode we do and we can't rely on
+ %% the user to provide it (by means of inetrc), so we need to look
+ %% for it ourselves.
+
+ do_load_resolv(OsType, erl_dist_mode()),
+
+ case OsType of
+ {unix,Type} ->
+ if Type =:= linux ->
+ %% It may be the case that the domain name was not set
+ %% because the hostname was short. But NOW we can look it
+ %% up and get the long name and the domain name from it.
+
+ %% FIXME: The second call to set_hostname will insert
+ %% a duplicate entry in the search list.
+
+ case inet_db:res_option(domain) of
+ "" ->
+ case inet:gethostbyname(inet_db:gethostname()) of
+ {ok,#hostent{h_name = []}} ->
+ ok;
+ {ok,#hostent{h_name = HostName}} ->
+ set_hostname({ok,HostName});
+ _ ->
+ ok
+ end;
+ _ ->
+ ok
+ end;
+ true -> ok
+ end,
+ add_dns_lookup(inet_db:res_option(lookup));
+ _ ->
+ ok
+ end,
+
+ %% Read inetrc file, if it exists.
+ {RcFile,CfgFiles,CfgList} = read_rc(),
+
+ %% Possibly read config files or system registry
+ lists:foreach(fun({file,hosts,File}) ->
+ load_hosts(File, unix);
+ ({file,Func,File}) ->
+ load_resolv(File, Func);
+ ({registry,win32}) ->
+ case OsType of
+ {win32,WinType} ->
+ win32_load_from_registry(WinType);
+ _ ->
+ error("can not read win32 system registry~n", [])
+ end
+ end, CfgFiles),
+
+ %% Add inetrc config entries
+ case inet_db:add_rc_list(CfgList) of
+ ok -> ok;
+ _ -> error("syntax error in ~s~n", [RcFile])
+ end,
+
+ %% Set up a resolver configuration file for inet_res,
+ %% unless that already has been done
+ case OsType of
+ {unix,_} ->
+ %% The Etc variable enables us to run tests with other
+ %% configuration files than the normal ones
+ Etc = case os:getenv("ERL_INET_ETC_DIR") of
+ false -> ?DEFAULT_ETC;
+ _EtcDir ->
+ _EtcDir
+ end,
+ case inet_db:res_option(resolv_conf) of
+ undefined ->
+ inet_db:set_resolv_conf(filename:join(Etc,
+ ?DEFAULT_RESOLV));
+ _ -> ok
+ end,
+ case inet_db:res_option(hosts_file) of
+ undefined ->
+ inet_db:set_hosts_file(filename:join(Etc,
+ ?DEFAULT_HOSTS));
+ _ -> ok
+ end;
+ _ -> ok
+ end.
+
+
+
+erl_dist_mode() ->
+ case init:get_argument(sname) of
+ {ok,[[_SName]]} -> shortnames;
+ _ ->
+ case init:get_argument(name) of
+ {ok,[[_Name]]} -> longnames;
+ _ -> nonames
+ end
+ end.
+
+do_load_resolv({unix,Type}, longnames) ->
+ %% The Etc variable enables us to run tests with other
+ %% configuration files than the normal ones
+ Etc = case os:getenv("ERL_INET_ETC_DIR") of
+ false -> ?DEFAULT_ETC;
+ _EtcDir ->
+ _EtcDir
+ end,
+ load_resolv(filename:join(Etc, ?DEFAULT_RESOLV), resolv),
+ case Type of
+ freebsd -> %% we may have to check version (2.2.2)
+ load_resolv(filename:join(Etc,"host.conf"), host_conf_freebsd);
+ 'bsd/os' ->
+ load_resolv(filename:join(Etc,"irs.conf"), host_conf_bsdos);
+ sunos ->
+ case os:version() of
+ {Major,_,_} when Major >= 5 ->
+ load_resolv(filename:join(Etc,"nsswitch.conf"),
+ nsswitch_conf);
+ _ ->
+ ok
+ end;
+ netbsd ->
+ case os:version() of
+ {Major,Minor,_} when Major >= 1, Minor >= 4 ->
+ load_resolv(filename:join(Etc,"nsswitch.conf"),
+ nsswitch_conf);
+ _ ->
+ ok
+ end;
+ linux ->
+ case load_resolv(filename:join(Etc,"host.conf"),
+ host_conf_linux) of
+ ok ->
+ ok;
+ _ ->
+ load_resolv(filename:join(Etc,"nsswitch.conf"),
+ nsswitch_conf)
+ end;
+ _ ->
+ ok
+ end,
+ inet_db:set_lookup([native]);
+
+do_load_resolv({win32,Type}, longnames) ->
+ win32_load_from_registry(Type),
+ inet_db:set_lookup([native]);
+
+do_load_resolv(vxworks, _) ->
+ vxworks_load_hosts(),
+ inet_db:set_lookup([file, dns]),
+ case os:getenv("ERLRESCONF") of
+ false ->
+ no_ERLRESCONF;
+ Resolv ->
+ load_resolv(Resolv, resolv)
+ end;
+
+do_load_resolv({ose,_Type}, _) ->
+ inet_db:set_lookup([file, dns]),
+ case os:getenv("NAMESERVER") of
+ false ->
+ case os:getenv("RESOLVFILE") of
+ false ->
+ erlang:display('Warning: No NAMESERVER or RESOLVFILE specified!'),
+ no_resolv;
+ Resolv ->
+ load_resolv(Resolv, resolv)
+ end;
+ Ns ->
+ {ok,IP} = inet_parse:address(Ns),
+ inet_db:add_rc_list([{nameserver,IP}])
+ end,
+ case os:getenv("DOMAIN") of
+ false ->
+ no_domain;
+ D ->
+ ok = inet_db:add_rc_list([{domain,D}])
+ end,
+ case os:getenv("HOSTSFILE") of
+ false ->
+ erlang:display('Warning: No HOSTSFILE specified!'),
+ no_hosts_file;
+ File ->
+ load_hosts(File, ose)
+ end;
+
+do_load_resolv(_, _) ->
+ inet_db:set_lookup([native]).
+
+add_dns_lookup(L) ->
+ case lists:member(dns,L) of
+ true -> ok;
+ _ ->
+ case application:get_env(kernel,inet_dns_when_nis) of
+ {ok,true} ->
+ add_dns_lookup(L,[]);
+ _ ->
+ ok
+ end
+ end.
+
+add_dns_lookup([yp|T],Acc) ->
+ add_dns_lookup(T,[yp,dns|Acc]);
+add_dns_lookup([H|T],Acc) ->
+ add_dns_lookup(T,[H|Acc]);
+add_dns_lookup([],Acc) ->
+ inet_db:set_lookup(reverse(Acc)).
+
+%%
+%% Set the hostname (SHORT)
+%% If hostname is long use the suffix as default domain
+%% and initalize the search option with the parts of domain
+%%
+set_hostname() ->
+ case inet_udp:open(0,[]) of
+ {ok,U} ->
+ Res = inet:gethostname(U),
+ inet_udp:close(U),
+ set_hostname(Res);
+ _ ->
+ set_hostname({ok, []})
+ end.
+
+set_hostname({ok,Name}) when length(Name) > 0 ->
+ {Host, Domain} = lists:splitwith(fun($.) -> false;
+ (_) -> true
+ end, Name),
+ inet_db:set_hostname(Host),
+ set_search_dom(Domain);
+set_hostname({ok,[]}) ->
+ inet_db:set_hostname("nohost"),
+ set_search_dom("nodomain").
+
+set_search_dom([$.|Domain]) ->
+ %% leading . not removed by dropwhile above.
+ inet_db:set_domain(Domain),
+ inet_db:ins_search(Domain),
+ ok;
+set_search_dom([]) ->
+ ok;
+set_search_dom(Domain) ->
+ inet_db:set_domain(Domain),
+ inet_db:ins_search(Domain),
+ ok.
+
+%%
+%% Load resolver data
+%%
+load_resolv(File, Func) ->
+ case get_file(File) of
+ {ok,Bin} ->
+ case inet_parse:Func(File, {chars, Bin}) of
+ {ok, Ls} ->
+ inet_db:add_rc_list(Ls);
+ {error, Reason} ->
+ error("parse error in file ~s: ~p", [File, Reason])
+ end;
+ Error ->
+ warning("file not found ~s: ~p~n", [File, Error])
+ end.
+
+%%
+%% Load a UNIX hosts file
+%%
+load_hosts(File,Os) ->
+ case get_file(File) of
+ {ok,Bin} ->
+ case inet_parse:hosts(File,{chars,Bin}) of
+ {ok, Ls} ->
+ foreach(
+ fun({IP, Name, Aliases}) ->
+ inet_db:add_host(IP, [Name|Aliases]) end,
+ Ls);
+ {error, Reason} ->
+ error("parse error in file ~s: ~p", [File, Reason])
+ end;
+ Error ->
+ case Os of
+ unix ->
+ error("file not found ~s: ~p~n", [File, Error]);
+ _ ->
+ %% for windows or nt the hosts file is not always there
+ %% and we don't require it
+ ok
+ end
+ end.
+
+%%
+%% Load resolver data from Windows registry
+%%
+win32_load_from_registry(Type) ->
+ %% The TcpReg variable enables us to run tests with other registry configurations than
+ %% the normal ones
+ TcpReg = case os:getenv("ERL_INET_ETC_DIR") of
+ false -> [];
+ _TReg -> _TReg
+ end,
+ {ok, Reg} = win32reg:open([read]),
+ {TcpIp,HFileKey} =
+ case Type of
+ nt ->
+ case TcpReg of
+ [] ->
+ {"\\hklm\\system\\CurrentControlSet\\Services\\TcpIp\\Parameters",
+ "DataBasePath" };
+ Other ->
+ {Other,"DataBasePath"}
+ end;
+ windows ->
+ case TcpReg of
+ [] ->
+ {"\\hklm\\system\\CurrentControlSet\\Services\\VxD\\MSTCP",
+ "LMHostFile" };
+ Other ->
+ {Other,"LMHostFile"}
+ end
+ end,
+ Result =
+ case win32reg:change_key(Reg,TcpIp) of
+ ok ->
+ win32_load1(Reg,Type,HFileKey);
+ {error, _Reason} ->
+ error("Failed to locate TCP/IP parameters (is TCP/IP installed)?",
+ [])
+ end,
+ win32reg:close(Reg),
+ Result.
+
+win32_load1(Reg,Type,HFileKey) ->
+ Names = [HFileKey, "Domain", "DhcpDomain",
+ "EnableDNS", "NameServer", "SearchList"],
+ case win32_get_strings(Reg, Names) of
+ [DBPath0, Domain, DhcpDomain,
+ _EnableDNS, NameServers0, Search] ->
+ inet_db:set_domain(
+ case Domain of "" -> DhcpDomain; _ -> Domain end),
+ NameServers = win32_split_line(NameServers0,Type),
+ AddNs = fun(Addr) ->
+ case inet_parse:address(Addr) of
+ {ok, Address} ->
+ inet_db:add_ns(Address);
+ {error, _} ->
+ error("Bad TCP/IP address in registry", [])
+ end
+ end,
+ foreach(AddNs, NameServers),
+ Searches0 = win32_split_line(Search,Type),
+ Searches = case member(Domain, Searches0) of
+ true -> Searches0;
+ false -> [Domain|Searches0]
+ end,
+ foreach(fun(D) -> inet_db:add_search(D) end, Searches),
+ if Type =:= nt ->
+ DBPath = win32reg:expand(DBPath0),
+ load_hosts(filename:join(DBPath, "hosts"),nt);
+ Type =:= windows ->
+ load_hosts(filename:join(DBPath0,""),windows)
+ end,
+%% Maybe activate this later as an optimization
+%% For now we use native always as the SAFE way
+%% case NameServers of
+%% [] -> inet_db:set_lookup([native, file]);
+%% _ -> inet_db:set_lookup([dns, file, native])
+%% end;
+ true;
+ {error, _Reason} ->
+ error("Failed to read TCP/IP parameters from registry", [])
+ end.
+
+win32_split_line(Line,nt) -> inet_parse:split_line(Line);
+win32_split_line(Line,windows) -> string:tokens(Line, ",").
+
+win32_get_strings(Reg, Names) ->
+ win32_get_strings(Reg, Names, []).
+
+win32_get_strings(Reg, [Name|Rest], Result) ->
+ case win32reg:value(Reg, Name) of
+ {ok, Value} when is_list(Value) ->
+ win32_get_strings(Reg, Rest, [Value|Result]);
+ {ok, _NotString} ->
+ {error, not_string};
+ {error, _Reason} ->
+ win32_get_strings(Reg, Rest, [""|Result])
+ end;
+win32_get_strings(_, [], Result) ->
+ lists:reverse(Result).
+
+%%
+%% Load host data from VxWorks hostShow command
+%%
+
+vxworks_load_hosts() ->
+ HostShow = os:cmd("hostShow"),
+ case check_hostShow(HostShow) of
+ Hosts when is_list(Hosts) ->
+ case inet_parse:hosts_vxworks({chars, Hosts}) of
+ {ok, Ls} ->
+ foreach(
+ fun({IP, Name, Aliases}) ->
+ inet_db:add_host(IP, [Name|Aliases])
+ end,
+ Ls);
+ {error,Reason} ->
+ error("parser error VxWorks hostShow ~s", [Reason])
+ end;
+ _Error ->
+ error("error in VxWorks hostShow~s~n", [HostShow])
+ end.
+
+%%
+%% Check if hostShow yields at least two line; the first one
+%% starting with "hostname", the second one starting with
+%% "--------".
+%% Returns: list of hosts in VxWorks notation
+%% rows of 'Name IP [Aliases] \n'
+%% if hostShow yielded these two lines, false otherwise.
+check_hostShow(HostShow) ->
+ check_hostShow(["hostname", "--------"], HostShow).
+
+check_hostShow([], HostShow) ->
+ HostShow;
+check_hostShow([String_match|Rest], HostShow) ->
+ case lists:prefix(String_match, HostShow) of
+ true ->
+ check_hostShow(Rest, next_line(HostShow));
+ false ->
+ false
+ end.
+
+next_line([]) ->
+ [];
+next_line([$\n|Rest]) ->
+ Rest;
+next_line([_First|Rest]) ->
+ next_line(Rest).
+
+read_rc() ->
+ {RcFile,CfgList} = read_inetrc(),
+ case extract_cfg_files(CfgList, [], []) of
+ {CfgFiles,CfgList1} ->
+ {RcFile,CfgFiles,CfgList1};
+ error ->
+ {error,[],[]}
+ end.
+
+
+
+extract_cfg_files([E = {file,Type,_File} | Es], CfgFiles, CfgList) ->
+ extract_cfg_files1(Type, E, Es, CfgFiles, CfgList);
+extract_cfg_files([E = {registry,Type} | Es], CfgFiles, CfgList) ->
+ extract_cfg_files1(Type, E, Es, CfgFiles, CfgList);
+extract_cfg_files([E | Es], CfgFiles, CfgList) ->
+ extract_cfg_files(Es, CfgFiles, [E | CfgList]);
+extract_cfg_files([], CfgFiles, CfgList) ->
+ {reverse(CfgFiles),reverse(CfgList)}.
+
+extract_cfg_files1(Type, E, Es, CfgFiles, CfgList) ->
+ case valid_type(Type) of
+ true ->
+ extract_cfg_files(Es, [E | CfgFiles], CfgList);
+ false ->
+ error("invalid config value ~w in inetrc~n", [Type]),
+ error
+ end.
+
+valid_type(resolv) -> true;
+valid_type(host_conf_freebsd) -> true;
+valid_type(host_conf_bsdos) -> true;
+valid_type(host_conf_linux) -> true;
+valid_type(nsswitch_conf) -> true;
+valid_type(hosts) -> true;
+valid_type(win32) -> true;
+valid_type(_) -> false.
+
+read_inetrc() ->
+ case application:get_env(inetrc) of
+ {ok,File} ->
+ try_get_rc(File);
+ _ ->
+ case os:getenv("ERL_INETRC") of
+ false ->
+ {nofile,[]};
+ File ->
+ try_get_rc(File)
+ end
+ end.
+
+try_get_rc(File) ->
+ case get_rc(File) of
+ error -> {nofile,[]};
+ Ls -> {File,Ls}
+ end.
+
+get_rc(File) ->
+ case get_file(File) of
+ {ok,Bin} ->
+ case parse_inetrc(Bin) of
+ {ok,Ls} ->
+ Ls;
+ _Error ->
+ error("parse error in ~s~n", [File]),
+ error
+ end;
+ _Error ->
+ error("file ~s not found~n", [File]),
+ error
+ end.
+
+%% XXX Check if we really need to prim load the stuff
+get_file(File) ->
+ case erl_prim_loader:get_file(File) of
+ {ok,Bin,_} -> {ok,Bin};
+ Error -> Error
+ end.
+
+error(Fmt, Args) ->
+ error_logger:error_msg("inet_config: " ++ Fmt, Args).
+
+warning(Fmt, Args) ->
+ case application:get_env(kernel,inet_warnings) of
+ %{ok,silent} -> ok;
+ {ok,on} ->
+ error_logger:info_msg("inet_config:" ++ Fmt, Args);
+ _ ->
+ ok
+ end.
+
+%%
+%% Parse inetrc, i.e. make a binary of a term list.
+%% The extra newline is to let the user ignore the whitespace !!!
+%% Ignore leading whitespace before a token (due to bug in erl_scan) !
+%%
+parse_inetrc(Bin) ->
+ Str = binary_to_list(Bin) ++ "\n",
+ parse_inetrc(Str, 1, []).
+
+parse_inetrc_skip_line([], _Line, Ack) ->
+ {ok, reverse(Ack)};
+parse_inetrc_skip_line([$\n|Str], Line, Ack) ->
+ parse_inetrc(Str, Line+1, Ack);
+parse_inetrc_skip_line([_|Str], Line, Ack) ->
+ parse_inetrc_skip_line(Str, Line, Ack).
+
+parse_inetrc([$%|Str], Line, Ack) ->
+ parse_inetrc_skip_line(Str, Line, Ack);
+parse_inetrc([$\s|Str], Line, Ack) ->
+ parse_inetrc(Str, Line, Ack);
+parse_inetrc([$\n |Str], Line, Ack) ->
+ parse_inetrc(Str, Line+1, Ack);
+parse_inetrc([$\t|Str], Line, Ack) ->
+ parse_inetrc(Str, Line, Ack);
+parse_inetrc([], _, Ack) ->
+ {ok, reverse(Ack)};
+
+
+%% The clauses above are here due to a bug in erl_scan (OTP-1449).
+
+parse_inetrc(Str, Line, Ack) ->
+ case erl_scan:tokens([], Str, Line) of
+ {done, {ok, Tokens, EndLine}, MoreChars} ->
+ case erl_parse:parse_term(Tokens) of
+ {ok, Term} ->
+ parse_inetrc(MoreChars, EndLine, [Term|Ack]);
+ Error ->
+ {error, {'parse_inetrc', Error}}
+ end;
+ {done, {eof, _}, _} ->
+ {ok, reverse(Ack)};
+ {done, Error, _} ->
+ {error, {'scan_inetrc', Error}};
+ {more, _} -> %% Bug in erl_scan !!
+ {error, {'scan_inetrc', {eof, Line}}}
+ end.
diff --git a/lib/kernel/src/inet_config.hrl b/lib/kernel/src/inet_config.hrl
new file mode 100644
index 0000000000..e9bb79f05d
--- /dev/null
+++ b/lib/kernel/src/inet_config.hrl
@@ -0,0 +1,34 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% Configuration constants
+
+-define(DEFAULT_ETC, "/etc").
+-define(DEFAULT_SERVICES, "services").
+-define(DEFAULT_RPC, "rpc").
+-define(DEFAULT_HOSTS, "hosts").
+-define(DEFAULT_RESOLV, "resolv.conf").
+-define(DEFAULT_PROTOCOLS, "protocols").
+-define(DEFAULT_NETMASKS, "netmasks").
+-define(DEFAULT_NETWORKS, "networks").
+
+-define(DEFAULT_UDP_MODULE, inet_udp).
+-define(DEFAULT_TCP_MODULE, inet_tcp).
+-define(DEFAULT_SCTP_MODULE, inet_sctp).
+
diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl
new file mode 100644
index 0000000000..211847014f
--- /dev/null
+++ b/lib/kernel/src/inet_db.erl
@@ -0,0 +1,1525 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(inet_db).
+
+%% Store info about ip addresses, names, aliases host files resolver
+%% options
+
+%% If the macro DEBUG is defined during compilation,
+%% debug printouts are done through erlang:display/1.
+%% Activate this feature by starting the compiler
+%% with> erlc -DDEBUG ...
+%% or by> setenv ERL_COMPILER_FLAGS DEBUG
+%% before running make (in the OTP make system)
+%% (the example is for tcsh)
+
+%% External exports
+-export([start/0, start_link/0, stop/0, reset/0, clear_cache/0]).
+-export([add_rr/1,add_rr/5,del_rr/4]).
+-export([add_ns/1,add_ns/2, ins_ns/1, ins_ns/2,
+ del_ns/2, del_ns/1, del_ns/0]).
+-export([add_alt_ns/1,add_alt_ns/2, ins_alt_ns/1, ins_alt_ns/2,
+ del_alt_ns/2, del_alt_ns/1, del_alt_ns/0]).
+-export([add_search/1,ins_search/1,del_search/1, del_search/0]).
+-export([set_lookup/1, set_recurse/1]).
+-export([set_socks_server/1, set_socks_port/1, add_socks_methods/1,
+ del_socks_methods/1, del_socks_methods/0,
+ add_socks_noproxy/1, del_socks_noproxy/1]).
+-export([set_cache_size/1, set_cache_refresh/1]).
+-export([set_timeout/1, set_retry/1, set_inet6/1, set_usevc/1]).
+-export([set_edns/1, set_udp_payload_size/1]).
+-export([set_resolv_conf/1, set_hosts_file/1, get_hosts_file/0]).
+-export([tcp_module/0, set_tcp_module/1]).
+-export([udp_module/0, set_udp_module/1]).
+-export([sctp_module/0,set_sctp_module/1]).
+-export([register_socket/2, unregister_socket/1, lookup_socket/1]).
+
+%% Host name & domain
+-export([set_hostname/1, set_domain/1]).
+-export([gethostname/0]).
+
+%% file interface
+-export([add_host/2, del_host/1, clear_hosts/0, add_hosts/1]).
+-export([add_resolv/1]).
+-export([add_rc/1, add_rc_bin/1, add_rc_list/1, get_rc/0]).
+
+-export([res_option/1, res_option/2, res_check_option/2]).
+-export([socks_option/1]).
+-export([getbyname/2, get_searchlist/0]).
+-export([gethostbyaddr/1]).
+-export([res_gethostbyaddr/2,res_hostent_by_domain/3]).
+-export([res_update_conf/0, res_update_hosts/0]).
+%% inet help functions
+-export([tolower/1]).
+-ifdef(DEBUG).
+-define(dbg(Fmt, Args), io:format(Fmt, Args)).
+-else.
+-define(dbg(Fmd, Args), ok).
+-endif.
+
+-include_lib("kernel/include/file.hrl").
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]).
+
+-record(state,
+ {db, %% resolver data
+ cache, %% bag of resource records
+ hosts_byname, %% hosts table
+ hosts_byaddr, %% hosts table
+ hosts_file_byname, %% hosts table from system file
+ hosts_file_byaddr, %% hosts table from system file
+ cache_timer %% timer reference for refresh
+ }).
+
+-include("inet.hrl").
+-include("inet_int.hrl").
+-include("inet_res.hrl").
+-include("inet_dns.hrl").
+-include("inet_config.hrl").
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+
+start() ->
+ case gen_server:start({local, inet_db}, inet_db, [], []) of
+ {ok,Pid} -> inet_config:init(), {ok,Pid};
+ Error -> Error
+ end.
+
+
+start_link() ->
+ case gen_server:start_link({local, inet_db}, inet_db, [], []) of
+ {ok,Pid} -> inet_config:init(), {ok,Pid};
+ Error -> Error
+ end.
+
+call(Req) ->
+ gen_server:call(inet_db, Req, infinity).
+
+stop() ->
+ call(stop).
+
+reset() ->
+ call(reset).
+
+
+%% insert all resolve options from this file (MAY GO)
+add_resolv(File) ->
+ case inet_parse:resolv(File) of
+ {ok, Res} -> add_rc_list(Res);
+ Error -> Error
+ end.
+
+%% add all aliases from this hosts file (MAY GO)
+add_hosts(File) ->
+ case inet_parse:hosts(File) of
+ {ok, Res} ->
+ lists:foreach(
+ fun({IP, Name, Aliases}) -> add_host(IP, [Name|Aliases]) end,
+ Res);
+ Error -> Error
+ end.
+
+
+add_host(IP, Names) -> call({add_host, IP, Names}).
+
+del_host(IP) -> call({del_host, IP}).
+
+clear_hosts() -> call(clear_hosts).
+
+%% add to the end of name server list
+add_ns(IP) ->
+ add_ns(IP,?NAMESERVER_PORT).
+add_ns(IP,Port) ->
+ call({listop, nameservers, add, {IP,Port}}).
+
+%% insert at head of name server list
+ins_ns(IP) ->
+ ins_ns(IP, ?NAMESERVER_PORT).
+ins_ns(IP,Port) ->
+ call({listop, nameservers, ins, {IP,Port}}).
+
+%% delete this name server entry (delete all ns having this ip)
+del_ns(IP) ->
+ del_ns(IP, ?NAMESERVER_PORT).
+del_ns(IP, Port) ->
+ call({listop, nameservers, del, {IP,Port}}).
+
+del_ns() ->
+ call({listdel, nameservers}).
+
+%% ALTERNATIVE NAME SERVER
+%% add to the end of name server list
+add_alt_ns(IP) ->
+ add_alt_ns(IP, ?NAMESERVER_PORT).
+add_alt_ns(IP,Port) ->
+ call({listop, alt_nameservers, add, {IP,Port}}).
+
+%% insert at head of name server list
+ins_alt_ns(IP) ->
+ ins_alt_ns(IP, ?NAMESERVER_PORT).
+ins_alt_ns(IP,Port) ->
+ call({listop, alt_nameservers, ins, {IP,Port}}).
+
+%% delete this name server entry
+del_alt_ns(IP) ->
+ del_alt_ns(IP, ?NAMESERVER_PORT).
+del_alt_ns(IP, Port) ->
+ call({listop, alt_nameservers, del, {IP,Port}}).
+
+del_alt_ns() ->
+ call({listdel, alt_nameservers}).
+
+%% add this domain to the search list
+add_search(Domain) when is_list(Domain) ->
+ call({listop, search, add, Domain}).
+
+ins_search(Domain) when is_list(Domain) ->
+ call({listop, search, ins, Domain}).
+
+del_search(Domain) ->
+ call({listop, search, del, Domain}).
+
+del_search() ->
+ call({listdel, search}).
+
+%% set host name used by inet
+%% Should only be used by inet_config at startup!
+set_hostname(Name) ->
+ call({set_hostname, Name}).
+
+%% set default domain
+set_domain(Domain) -> res_option(domain, Domain).
+
+%% set lookup methods
+set_lookup(Methods) -> res_option(lookup, Methods).
+
+%% resolver
+set_recurse(Flag) -> res_option(recurse, Flag).
+
+set_timeout(Time) -> res_option(timeout, Time).
+
+set_retry(N) -> res_option(retry, N).
+
+set_inet6(Bool) -> res_option(inet6, Bool).
+
+set_usevc(Bool) -> res_option(usevc, Bool).
+
+set_edns(Version) -> res_option(edns, Version).
+
+set_udp_payload_size(Size) -> res_option(udp_payload_size, Size).
+
+set_resolv_conf(Fname) -> res_option(resolv_conf, Fname).
+
+set_hosts_file(Fname) -> res_option(hosts_file, Fname).
+
+get_hosts_file() ->
+ get_rc_hosts([], [], inet_hosts_file_byname).
+
+%% set socks options
+set_socks_server(Server) -> call({set_socks_server, Server}).
+
+set_socks_port(Port) -> call({set_socks_port, Port}).
+
+add_socks_methods(Ms) -> call({add_socks_methods,Ms}).
+
+del_socks_methods(Ms) -> call({del_socks_methods,Ms}).
+
+del_socks_methods() -> call(del_socks_methods).
+
+add_socks_noproxy({Net,Mask}) -> call({add_socks_noproxy, {Net,Mask}}).
+
+del_socks_noproxy(Net) -> call({del_socks_noproxy, Net}).
+
+%% cache options
+set_cache_size(Limit) -> call({set_cache_size, Limit}).
+
+set_cache_refresh(Time) -> call({set_cache_refresh, Time}).
+
+clear_cache() -> call(clear_cache).
+
+
+set_tcp_module(Module) -> call({set_tcp_module, Module}).
+
+tcp_module() -> db_get(tcp_module).
+
+set_udp_module(Module) -> call({set_udp_module, Module}).
+
+udp_module() -> db_get(udp_module).
+
+set_sctp_module(Family)-> call({set_sctp_module,Family}).
+
+sctp_module()-> db_get(sctp_module).
+
+%% Add an inetrc file
+add_rc(File) ->
+ case file:consult(File) of
+ {ok, List} -> add_rc_list(List);
+ Error -> Error
+ end.
+
+%% Add an inetrc binary term must be a rc list
+add_rc_bin(Bin) ->
+ case catch binary_to_term(Bin) of
+ List when is_list(List) ->
+ add_rc_list(List);
+ _ ->
+ {error, badarg}
+ end.
+
+add_rc_list(List) -> call({add_rc_list, List}).
+
+
+
+%% All kind of flavors !
+translate_lookup(["bind" | Ls]) -> [dns | translate_lookup(Ls)];
+translate_lookup(["dns" | Ls]) -> [dns | translate_lookup(Ls)];
+translate_lookup(["hosts" | Ls]) -> [file | translate_lookup(Ls)];
+translate_lookup(["files" | Ls]) -> [file | translate_lookup(Ls)];
+translate_lookup(["file" | Ls]) -> [file | translate_lookup(Ls)];
+translate_lookup(["yp" | Ls]) -> [yp | translate_lookup(Ls)];
+translate_lookup(["nis" | Ls]) -> [nis | translate_lookup(Ls)];
+translate_lookup(["nisplus" | Ls]) -> [nisplus | translate_lookup(Ls)];
+translate_lookup(["native" | Ls]) -> [native | translate_lookup(Ls)];
+translate_lookup([M | Ls]) when is_atom(M) -> translate_lookup([atom_to_list(M) | Ls]);
+translate_lookup([_ | Ls]) -> translate_lookup(Ls);
+translate_lookup([]) -> [].
+
+valid_lookup() -> [dns, file, yp, nis, nisplus, native].
+
+
+%% Reconstruct an inetrc sturcture from inet_db
+get_rc() ->
+ get_rc([hosts, domain, nameservers, search, alt_nameservers,
+ timeout, retry, inet6, usevc,
+ edns, udp_payload_size, resolv_conf, hosts_file,
+ socks5_server, socks5_port, socks5_methods, socks5_noproxy,
+ udp, sctp, tcp, host, cache_size, cache_refresh, lookup], []).
+
+get_rc([K | Ks], Ls) ->
+ case K of
+ hosts -> get_rc_hosts(Ks, Ls, inet_hosts_byname);
+ domain -> get_rc(domain, res_domain, "", Ks, Ls);
+ nameservers -> get_rc_ns(db_get(res_ns),nameservers,Ks,Ls);
+ alt_nameservers -> get_rc_ns(db_get(res_alt_ns),alt_nameservers,Ks,Ls);
+ search -> get_rc(search, res_search, [], Ks, Ls);
+ timeout -> get_rc(timeout,res_timeout,?RES_TIMEOUT, Ks,Ls);
+ retry -> get_rc(retry, res_retry, ?RES_RETRY, Ks, Ls);
+ inet6 -> get_rc(inet6, res_inet6, false, Ks, Ls);
+ usevc -> get_rc(usevc, res_usevc, false, Ks, Ls);
+ edns -> get_rc(edns, res_edns, false, Ks, Ls);
+ udp_payload_size -> get_rc(udp_payload_size, res_udp_payload_size,
+ ?DNS_UDP_PAYLOAD_SIZE, Ks, Ls);
+ resolv_conf -> get_rc(resolv_conf, res_resolv_conf, undefined, Ks, Ls);
+ hosts_file -> get_rc(hosts_file, res_hosts_file, undefined, Ks, Ls);
+ tcp -> get_rc(tcp, tcp_module, ?DEFAULT_TCP_MODULE, Ks, Ls);
+ udp -> get_rc(udp, udp_module, ?DEFAULT_UDP_MODULE, Ks, Ls);
+ sctp -> get_rc(sctp, sctp_module, ?DEFAULT_SCTP_MODULE, Ks, Ls);
+ lookup -> get_rc(lookup, res_lookup, [native,file], Ks, Ls);
+ cache_size -> get_rc(cache_size, cache_size, ?CACHE_LIMIT, Ks, Ls);
+ cache_refresh ->
+ get_rc(cache_refresh, cache_refresh_interval,?CACHE_REFRESH,Ks,Ls);
+ socks5_server -> get_rc(socks5_server, socks5_server, "", Ks, Ls);
+ socks5_port -> get_rc(socks5_port,socks5_port,?IPPORT_SOCKS,Ks,Ls);
+ socks5_methods -> get_rc(socks5_methods,socks5_methods,[none],Ks,Ls);
+ socks5_noproxy ->
+ case db_get(socks5_noproxy) of
+ [] -> get_rc(Ks, Ls);
+ NoProxy -> get_rc_noproxy(NoProxy, Ks, Ls)
+ end;
+ _ ->
+ get_rc(Ks, Ls)
+ end;
+get_rc([], Ls) ->
+ lists:reverse(Ls).
+
+get_rc(Name, Key, Default, Ks, Ls) ->
+ case db_get(Key) of
+ Default -> get_rc(Ks, Ls);
+ Value -> get_rc(Ks, [{Name, Value} | Ls])
+ end.
+
+get_rc_noproxy([{Net,Mask} | Ms], Ks, Ls) ->
+ get_rc_noproxy(Ms, Ks, [{socks5_noproxy, Net, Mask} | Ls]);
+get_rc_noproxy([], Ks, Ls) -> get_rc(Ks, Ls).
+
+get_rc_ns([{IP,?NAMESERVER_PORT} | Ns], Tag, Ks, Ls) ->
+ get_rc_ns(Ns, Tag, Ks, [{Tag, IP} | Ls]);
+get_rc_ns([{IP,Port} | Ns], Tag, Ks, Ls) ->
+ get_rc_ns(Ns, Tag, Ks, [{Tag, IP, Port} | Ls]);
+get_rc_ns([], _Tag, Ks, Ls) ->
+ get_rc(Ks, Ls).
+
+get_rc_hosts(Ks, Ls, Tab) ->
+ case lists:keysort(3, ets:tab2list(Tab)) of
+ [] -> get_rc(Ks, Ls);
+ [{N,_,IP}|Hosts] -> get_rc_hosts(Ks, Ls, IP, Hosts, [N])
+ end.
+
+get_rc_hosts(Ks, Ls, IP, [], Ns) ->
+ get_rc(Ks, [{host,IP,lists:reverse(Ns)}|Ls]);
+get_rc_hosts(Ks, Ls, IP, [{N,_,IP}|Hosts], Ns) ->
+ get_rc_hosts(Ks, Ls, IP, Hosts, [N|Ns]);
+get_rc_hosts(Ks, Ls, IP, [{N,_,NewIP}|Hosts], Ns) ->
+ [{host,IP,lists:reverse(Ns)}|get_rc_hosts(Ks, Ls, NewIP, Hosts, [N])].
+
+%%
+%% Resolver options
+%%
+res_option(next_id) ->
+ Cnt = ets:update_counter(inet_db, res_id, 1),
+ case Cnt band 16#ffff of
+ 0 ->
+ ets:update_counter(inet_db, res_id, -Cnt),
+ 0;
+ Id ->
+ Id
+ end;
+res_option(Option) ->
+ case res_optname(Option) of
+ undefined ->
+ erlang:error(badarg, [Option]);
+ ResOptname ->
+ db_get(ResOptname)
+ end.
+
+res_option(Option, Value) ->
+ case res_optname(Option) of
+ undefined ->
+ erlang:error(badarg, [Option,Value]);
+ _ ->
+ call({res_set,Option,Value})
+ end.
+
+res_optname(nameserver) -> res_ns; %% Legacy
+res_optname(alt_nameserver) -> res_alt_ns; %% Legacy
+res_optname(nameservers) -> res_ns;
+res_optname(alt_nameservers) -> res_alt_ns;
+res_optname(domain) -> res_domain;
+res_optname(lookup) -> res_lookup;
+res_optname(recurse) -> res_recurse;
+res_optname(search) -> res_search;
+res_optname(retry) -> res_retry;
+res_optname(timeout) -> res_timeout;
+res_optname(inet6) -> res_inet6;
+res_optname(usevc) -> res_usevc;
+res_optname(edns) -> res_edns;
+res_optname(udp_payload_size) -> res_udp_payload_size;
+res_optname(resolv_conf) -> res_resolv_conf;
+res_optname(hosts_file) -> res_hosts_file;
+res_optname(_) -> undefined.
+
+res_check_option(nameserver, NSs) -> %% Legacy
+ res_check_list(NSs, fun res_check_ns/1);
+res_check_option(alt_nameserver, NSs) -> %% Legacy
+ res_check_list(NSs, fun res_check_ns/1);
+res_check_option(nameservers, NSs) ->
+ res_check_list(NSs, fun res_check_ns/1);
+res_check_option(alt_nameservers, NSs) ->
+ res_check_list(NSs, fun res_check_ns/1);
+res_check_option(domain, Dom) ->
+ inet_parse:visible_string(Dom);
+res_check_option(lookup, Methods) ->
+ try lists_subtract(Methods, valid_lookup()) of
+ [] -> true;
+ _ -> false
+ catch
+ error:_ -> false
+ end;
+res_check_option(recurse, R) when R =:= 0; R =:= 1 -> true; %% Legacy
+res_check_option(recurse, R) when is_boolean(R) -> true;
+res_check_option(search, SearchList) ->
+ res_check_list(SearchList, fun res_check_search/1);
+res_check_option(retry, N) when is_integer(N), N > 0 -> true;
+res_check_option(timeout, T) when is_integer(T), T > 0 -> true;
+res_check_option(inet6, Bool) when is_boolean(Bool) -> true;
+res_check_option(usevc, Bool) when is_boolean(Bool) -> true;
+res_check_option(edns, V) when V =:= false; V =:= 0 -> true;
+res_check_option(udp_payload_size, S) when is_integer(S), S >= 512 -> true;
+res_check_option(resolv_conf, "") -> true;
+res_check_option(resolv_conf, F) ->
+ res_check_option_absfile(F);
+res_check_option(hosts_file, "") -> true;
+res_check_option(hosts_file, F) ->
+ res_check_option_absfile(F);
+res_check_option(_, _) -> false.
+
+res_check_option_absfile(F) ->
+ try filename:pathtype(F) of
+ absolute -> true;
+ _ -> false
+ catch
+ _:_ -> false
+ end.
+
+res_check_list([], _Fun) -> true;
+res_check_list([H|T], Fun) ->
+ case Fun(H) of
+ true -> res_check_list(T, Fun);
+ false -> false
+ end;
+res_check_list(_, _Fun) -> false.
+
+res_check_ns({{A,B,C,D,E,F,G,H}, Port})
+ when ?ip6(A,B,C,D,E,F,G,H), Port band 65535 =:= Port -> true;
+res_check_ns({{A,B,C,D}, Port})
+ when ?ip(A,B,C,D), Port band 65535 =:= Port -> true;
+res_check_ns(_) -> false.
+
+res_check_search("") -> true;
+res_check_search(Dom) -> inet_parse:visible_string(Dom).
+
+socks_option(server) -> db_get(socks5_server);
+socks_option(port) -> db_get(socks5_port);
+socks_option(methods) -> db_get(socks5_methods);
+socks_option(noproxy) -> db_get(socks5_noproxy).
+
+gethostname() -> db_get(hostname).
+
+res_update_conf() ->
+ res_update(res_resolv_conf, res_resolv_conf_tm, res_resolv_conf_info,
+ set_resolv_conf_tm, fun set_resolv_conf/1).
+
+res_update_hosts() ->
+ res_update(res_hosts_file, res_hosts_file_tm, res_hosts_file_info,
+ set_hosts_file_tm, fun set_hosts_file/1).
+
+res_update(Tag, TagTm, TagInfo, CallTag, SetFun) ->
+ case db_get(TagTm) of
+ undefined -> ok;
+ TM ->
+ case times() of
+ Now when Now >= TM + ?RES_FILE_UPDATE_TM ->
+ case db_get(Tag) of
+ undefined ->
+ SetFun("");
+ "" ->
+ SetFun("");
+ File ->
+ case erl_prim_loader:read_file_info(File) of
+ {ok, Finfo0} ->
+ Finfo =
+ Finfo0#file_info{access = undefined,
+ atime = undefined},
+ case db_get(TagInfo) of
+ Finfo ->
+ call({CallTag, Now});
+ _ ->
+ SetFun(File)
+ end;
+ _ ->
+ call({CallTag, Now}),
+ error
+ end
+ end;
+ _ -> ok
+ end
+ end.
+
+db_get(Name) ->
+ case ets:lookup(inet_db, Name) of
+ [] -> undefined;
+ [{_,Val}] -> Val
+ end.
+
+add_rr(RR) ->
+ call({add_rr, RR}).
+
+add_rr(Domain, Class, Type, TTL, Data) ->
+ call({add_rr, #dns_rr { domain = Domain, class = Class,
+ type = Type, ttl = TTL, data = Data}}).
+
+del_rr(Domain, Class, Type, Data) ->
+ call({del_rr, #dns_rr { domain = Domain, class = Class,
+ type = Type, cnt = '_', tm = '_', ttl = '_',
+ bm = '_', func = '_', data = Data}}).
+
+res_cache_answer(Rec) ->
+ lists:foreach( fun(RR) -> add_rr(RR) end, Rec#dns_rec.anlist).
+
+
+
+
+%%
+%% getbyname (cache version)
+%%
+%% This function and inet_res:res_getbyname/3 must look up names
+%% in the same manner, but not from the same places.
+%%
+getbyname(Name, Type) ->
+ {EmbeddedDots, TrailingDot} = inet_parse:dots(Name),
+ Dot = if TrailingDot -> ""; true -> "." end,
+ if TrailingDot ->
+ hostent_by_domain(Name, Type);
+ EmbeddedDots =:= 0 ->
+ getbysearch(Name, Dot, get_searchlist(), Type, {error,nxdomain});
+ true ->
+ case hostent_by_domain(Name, Type) of
+ {error,_}=Error ->
+ getbysearch(Name, Dot, get_searchlist(), Type, Error);
+ Other -> Other
+ end
+ end.
+
+getbysearch(Name, Dot, [Dom | Ds], Type, _) ->
+ case hostent_by_domain(Name ++ Dot ++ Dom, Type) of
+ {ok, HEnt} -> {ok, HEnt};
+ Error ->
+ getbysearch(Name, Dot, Ds, Type, Error)
+ end;
+getbysearch(_Name, _Dot, [], _Type, Error) ->
+ Error.
+
+
+
+%%
+%% get_searchlist
+%%
+get_searchlist() ->
+ case res_option(search) of
+ [] -> [res_option(domain)];
+ L -> L
+ end.
+
+
+
+make_hostent(Name, Addrs, Aliases, ?S_A) ->
+ #hostent {
+ h_name = Name,
+ h_addrtype = inet,
+ h_length = 4,
+ h_addr_list = Addrs,
+ h_aliases = Aliases
+ };
+make_hostent(Name, Addrs, Aliases, ?S_AAAA) ->
+ #hostent {
+ h_name = Name,
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = Addrs,
+ h_aliases = Aliases
+ };
+make_hostent(Name, Datas, Aliases, Type) ->
+ %% Use #hostent{} for other Types as well !
+ #hostent {
+ h_name = Name,
+ h_addrtype = Type,
+ h_length = length(Datas),
+ h_addr_list = Datas,
+ h_aliases = Aliases
+ }.
+
+hostent_by_domain(Domain, Type) ->
+ ?dbg("hostent_by_domain: ~p~n", [Domain]),
+ hostent_by_domain(stripdot(Domain), [], Type).
+
+hostent_by_domain(Domain, Aliases, Type) ->
+ case lookup_type(Domain, Type) of
+ [] ->
+ case lookup_cname(Domain) of
+ [] ->
+ {error, nxdomain};
+ [CName | _] ->
+ case lists:member(CName, [Domain | Aliases]) of
+ true ->
+ {error, nxdomain};
+ false ->
+ hostent_by_domain(CName, [Domain | Aliases], Type)
+ end
+ end;
+ Addrs ->
+ {ok, make_hostent(Domain, Addrs, Aliases, Type)}
+ end.
+
+%% lookup address record
+lookup_type(Domain, Type) ->
+ [R#dns_rr.data || R <- lookup_rr(Domain, in, Type) ].
+
+%% lookup canonical name
+lookup_cname(Domain) ->
+ [R#dns_rr.data || R <- lookup_rr(Domain, in, ?S_CNAME) ].
+
+%% Have to do all lookups (changes to the db) in the
+%% process in order to make it possible to refresh the cache.
+lookup_rr(Domain, Class, Type) ->
+ call({lookup_rr, Domain, Class, Type}).
+
+%%
+%% hostent_by_domain (newly resolved version)
+%% match data field directly and cache RRs.
+%%
+res_hostent_by_domain(Domain, Type, Rec) ->
+ res_cache_answer(Rec),
+ RRs = Rec#dns_rec.anlist,
+ ?dbg("res_hostent_by_domain: ~p - ~p~n", [Domain, RRs]),
+ res_hostent_by_domain(stripdot(Domain), [], Type, RRs).
+
+res_hostent_by_domain(Domain, Aliases, Type, RRs) ->
+ case res_lookup_type(Domain, Type, RRs) of
+ [] ->
+ case res_lookup_type(Domain, ?S_CNAME, RRs) of
+ [] ->
+ {error, nxdomain};
+ [CName | _] ->
+ case lists:member(CName, [Domain | Aliases]) of
+ true ->
+ {error, nxdomain};
+ false ->
+ res_hostent_by_domain(CName, [Domain | Aliases],
+ Type, RRs)
+ end
+ end;
+ Addrs ->
+ {ok, make_hostent(Domain, Addrs, Aliases, Type)}
+ end.
+
+%% newly resolved lookup address record
+res_lookup_type(Domain,Type,RRs) ->
+ [R#dns_rr.data || R <- RRs,
+ R#dns_rr.domain =:= Domain,
+ R#dns_rr.type =:= Type].
+
+%%
+%% gethostbyaddr (cache version)
+%% match data field directly
+%%
+gethostbyaddr(IP) ->
+ case dnip(IP) of
+ {ok, {IP1, HType, HLen, DnIP}} ->
+ RRs = match_rr(#dns_rr { domain = DnIP, class = in, type = ptr,
+ cnt = '_', tm = '_', ttl = '_',
+ bm = '_', func = '_', data = '_' }),
+ ent_gethostbyaddr(RRs, IP1, HType, HLen);
+ Error -> Error
+ end.
+
+%%
+%% res_gethostbyaddr (newly resolved version)
+%% match data field directly and cache RRs.
+%%
+res_gethostbyaddr(IP, Rec) ->
+ {ok, {IP1, HType, HLen}} = dnt(IP),
+ res_cache_answer(Rec),
+ ent_gethostbyaddr(Rec#dns_rec.anlist, IP1, HType, HLen).
+
+ent_gethostbyaddr(RRs, IP, AddrType, Length) ->
+ case RRs of
+ [] -> {error, nxdomain};
+ [RR|TR] ->
+ %% debug
+ if TR =/= [] ->
+ ?dbg("gethostbyaddr found extra=~p~n", [TR]);
+ true -> ok
+ end,
+ Domain = RR#dns_rr.data,
+ H = #hostent { h_name = Domain,
+ h_aliases = lookup_cname(Domain),
+ h_addr_list = [IP],
+ h_addrtype = AddrType,
+ h_length = Length },
+ {ok, H}
+ end.
+
+dnip(IP) ->
+ case dnt(IP) of
+ {ok,{IP1 = {A,B,C,D}, inet, HLen}} ->
+ {ok,{IP1, inet, HLen, dn_in_addr_arpa(A,B,C,D)}};
+ {ok,{IP1 = {A,B,C,D,E,F,G,H}, inet6, HLen}} ->
+ {ok,{IP1, inet6, HLen, dn_ip6_int(A,B,C,D,E,F,G,H)}};
+ _ ->
+ {error, formerr}
+ end.
+
+
+dnt(IP = {A,B,C,D}) when ?ip(A,B,C,D) ->
+ {ok, {IP, inet, 4}};
+dnt({0,0,0,0,0,16#ffff,G,H}) when is_integer(G+H) ->
+ A = G div 256, B = G rem 256, C = H div 256, D = H rem 256,
+ {ok, {{A,B,C,D}, inet, 4}};
+dnt(IP = {A,B,C,D,E,F,G,H}) when ?ip6(A,B,C,D,E,F,G,H) ->
+ {ok, {IP, inet6, 16}};
+dnt(_) ->
+ {error, formerr}.
+
+%%
+%% Register socket Modules
+%%
+register_socket(Socket, Module) when is_port(Socket), is_atom(Module) ->
+ try erlang:port_set_data(Socket, Module)
+ catch
+ error:badarg -> false
+ end.
+
+unregister_socket(Socket) when is_port(Socket) ->
+ ok. %% not needed any more
+
+lookup_socket(Socket) when is_port(Socket) ->
+ try erlang:port_get_data(Socket) of
+ Module when is_atom(Module) -> {ok,Module};
+ _ -> {error,closed}
+ catch
+ error:badarg -> {error,closed}
+ end.
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from gen_server
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, State} |
+%% {ok, State, Timeout} |
+%% {stop, Reason}
+%%----------------------------------------------------------------------
+
+%% INET DB ENTRY TYPES:
+%%
+%% KEY VALUE - DESCRIPTION
+%%
+%% hostname String - SHORT host name
+%%
+%% Resolver options
+%% ----------------
+%% res_ns [Nameserver] - list of name servers
+%% res_alt_ns [AltNameServer] - list of alternate name servers (nxdomain)
+%% res_search [Domain] - list of domains for short names
+%% res_domain Domain - local domain for short names
+%% res_recurse Bool - recursive query
+%% res_usevc Bool - use tcp only
+%% res_id Integer - NS query identifier
+%% res_retry Integer - Retry count for UDP query
+%% res_timeout Integer - UDP query timeout before retry
+%% res_inet6 Bool - address family inet6 for gethostbyname/1
+%% res_usevc Bool - use Virtual Circuit (TCP)
+%% res_edns false|Integer - false or EDNS version
+%% res_udp_payload_size Integer - size for EDNS, both query and reply
+%% res_resolv_conf Filename - file to watch for resolver config i.e
+%% {res_ns, res_search}
+%% res_hosts_file Filename - file to watch for hosts config
+%%
+%% Socks5 options
+%% --------------
+%% socks5_server Server - IP address of the socks5 server
+%% socks5_port Port - TCP port of the socks5 server
+%% socks5_methods Ls - List of authentication methods
+%% socks5_noproxy IPs - List of {Net,Subnetmask}
+%%
+%% Generic tcp/udp options
+%% -----------------------
+%% tcp_module Module - The default gen_tcp module
+%% udp_module Module - The default gen_udp module
+%% sctp_module Module - The default gen_sctp module
+%%
+%% Distribution options
+%% --------------------
+%% {node_auth,N} Ls - List of authentication for node N
+%% {node_crypt,N} Ls - List of encryption methods for node N
+%% node_auth Ls - Default authenication
+%% node_crypt Ls - Default encryption
+%%
+init([]) ->
+ process_flag(trap_exit, true),
+ Db = ets:new(inet_db, [public, named_table]),
+ reset_db(Db),
+ Cache = ets:new(inet_cache, [public, bag, {keypos,2}, named_table]),
+ BynameOpts = [protected, bag, named_table, {keypos,1}],
+ ByaddrOpts = [protected, bag, named_table, {keypos,3}],
+ HostsByname = ets:new(inet_hosts_byname, BynameOpts),
+ HostsByaddr = ets:new(inet_hosts_byaddr, ByaddrOpts),
+ HostsFileByname = ets:new(inet_hosts_file_byname, BynameOpts),
+ HostsFileByaddr = ets:new(inet_hosts_file_byaddr, ByaddrOpts),
+ {ok, #state{db = Db,
+ cache = Cache,
+ hosts_byname = HostsByname,
+ hosts_byaddr = HostsByaddr,
+ hosts_file_byname = HostsFileByname,
+ hosts_file_byaddr = HostsFileByaddr,
+ cache_timer = init_timer() }}.
+
+reset_db(Db) ->
+ ets:insert(Db, {hostname, []}),
+ ets:insert(Db, {res_ns, []}),
+ ets:insert(Db, {res_alt_ns, []}),
+ ets:insert(Db, {res_search, []}),
+ ets:insert(Db, {res_domain, ""}),
+ ets:insert(Db, {res_lookup, []}),
+ ets:insert(Db, {res_recurse, true}),
+ ets:insert(Db, {res_usevc, false}),
+ ets:insert(Db, {res_id, 0}),
+ ets:insert(Db, {res_retry, ?RES_RETRY}),
+ ets:insert(Db, {res_timeout, ?RES_TIMEOUT}),
+ ets:insert(Db, {res_inet6, false}),
+ ets:insert(Db, {res_edns, false}),
+ ets:insert(Db, {res_udp_payload_size, ?DNS_UDP_PAYLOAD_SIZE}),
+ ets:insert(Db, {cache_size, ?CACHE_LIMIT}),
+ ets:insert(Db, {cache_refresh_interval,?CACHE_REFRESH}),
+ ets:insert(Db, {socks5_server, ""}),
+ ets:insert(Db, {socks5_port, ?IPPORT_SOCKS}),
+ ets:insert(Db, {socks5_methods, [none]}),
+ ets:insert(Db, {socks5_noproxy, []}),
+ ets:insert(Db, {tcp_module, ?DEFAULT_TCP_MODULE}),
+ ets:insert(Db, {udp_module, ?DEFAULT_UDP_MODULE}),
+ ets:insert(Db, {sctp_module, ?DEFAULT_SCTP_MODULE}).
+
+%%----------------------------------------------------------------------
+%% Func: handle_call/3
+%% Returns: {reply, Reply, State} |
+%% {reply, Reply, State, Timeout} |
+%% {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, Reply, State} | (terminate/2 is called)
+%% {stop, Reason, Reply, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_call(Request, From, #state{db=Db}=State) ->
+ case Request of
+ {load_hosts_file,IPNmAs} when is_list(IPNmAs) ->
+ NIPs = lists:flatten([ [{N,if tuple_size(IP) =:= 4 -> inet;
+ tuple_size(IP) =:= 8 -> inet6
+ end,IP} || N <- [Nm|As]]
+ || {IP,Nm,As} <- IPNmAs]),
+ Byname = State#state.hosts_file_byname,
+ Byaddr = State#state.hosts_file_byaddr,
+ ets:delete_all_objects(Byname),
+ ets:delete_all_objects(Byaddr),
+ ets:insert(Byname, NIPs),
+ ets:insert(Byaddr, NIPs),
+ {reply, ok, State};
+
+ {add_host,{A,B,C,D}=IP,[N|As]=Names}
+ when ?ip(A,B,C,D), is_list(N), is_list(As) ->
+ do_add_host(State#state.hosts_byname,
+ State#state.hosts_byaddr,
+ Names, inet, IP),
+ {reply, ok, State};
+ {add_host,{A,B,C,D,E,F,G,H}=IP,[N|As]=Names}
+ when ?ip6(A,B,C,D,E,F,G,H), is_list(N), is_list(As) ->
+ do_add_host(State#state.hosts_byname,
+ State#state.hosts_byaddr,
+ Names, inet6, IP),
+ {reply, ok, State};
+
+ {del_host,{A,B,C,D}=IP} when ?ip(A,B,C,D) ->
+ do_del_host(State#state.hosts_byname,
+ State#state.hosts_byaddr,
+ IP),
+ {reply, ok, State};
+ {del_host,{A,B,C,D,E,F,G,H}=IP} when ?ip6(A,B,C,D,E,F,G,H) ->
+ do_del_host(State#state.hosts_byname,
+ State#state.hosts_byaddr,
+ IP),
+ {reply, ok, State};
+
+ {add_rr, RR} when is_record(RR, dns_rr) ->
+ RR1 = lower_rr(RR),
+ ?dbg("add_rr: ~p~n", [RR1]),
+ do_add_rr(RR1, Db, State),
+ {reply, ok, State};
+
+ {del_rr, RR} when is_record(RR, dns_rr) ->
+ RR1 = lower_rr(RR),
+ %% note. del_rr will handle wildcards !!!
+ Cache = State#state.cache,
+ ets:match_delete(Cache, RR1),
+ {reply, ok, State};
+
+ {lookup_rr, Domain, Class, Type} ->
+ {reply, do_lookup_rr(Domain, Class, Type), State};
+
+ {listop, Opt, Op, E} ->
+ El = [E],
+ case res_check_option(Opt, El) of
+ true ->
+ Optname = res_optname(Opt),
+ [{_,Es}] = ets:lookup(Db, Optname),
+ NewEs = case Op of
+ ins -> [E | lists_delete(E, Es)];
+ add -> lists_delete(E, Es) ++ El;
+ del -> lists_delete(E, Es)
+ end,
+ ets:insert(Db, {Optname, NewEs}),
+ {reply,ok,State};
+ false ->
+ {reply,error,State}
+ end;
+
+ {listdel, Opt} ->
+ ets:insert(Db, {res_optname(Opt), []}),
+ {reply, ok, State};
+
+ {set_hostname, Name} ->
+ case inet_parse:visible_string(Name) of
+ true ->
+ ets:insert(Db, {hostname, Name}),
+ {reply, ok, State};
+ false ->
+ {reply, error, State}
+ end;
+
+ {res_set, hosts_file=Option, Fname} ->
+ handle_set_file(Option, Fname,
+ res_hosts_file_tm, res_hosts_file_info,
+ fun (Bin) ->
+ case inet_parse:hosts(Fname,
+ {chars,Bin}) of
+ {ok,Opts} ->
+ [{load_hosts_file,Opts}];
+ _ -> error
+ end
+ end,
+ From, State);
+ %%
+ {res_set, resolv_conf=Option, Fname} ->
+ handle_set_file(Option, Fname,
+ res_resolv_conf_tm, res_resolv_conf_info,
+ fun (Bin) ->
+ case inet_parse:resolv(Fname,
+ {chars,Bin}) of
+ {ok,Opts} ->
+ [del_ns,
+ clear_search,
+ clear_cache
+ |[Opt ||
+ {T,_}=Opt <- Opts,
+ (T =:= nameserver orelse
+ T =:= search)]];
+ _ -> error
+ end
+ end,
+ From, State);
+ %%
+ {res_set, Opt, Value} ->
+ case res_optname(Opt) of
+ undefined ->
+ {reply, error, State};
+ Optname ->
+ case res_check_option(Opt, Value) of
+ true ->
+ ets:insert(Db, {Optname, Value}),
+ {reply, ok, State};
+ false ->
+ {reply, error, State}
+ end
+ end;
+
+ {set_resolv_conf_tm, TM} ->
+ ets:insert(Db, {res_resolv_conf_tm, TM}),
+ {reply, ok, State};
+
+ {set_hosts_file_tm, TM} ->
+ ets:insert(Db, {res_hosts_file_tm, TM}),
+ {reply, ok, State};
+
+ {set_socks_server, {A,B,C,D}} when ?ip(A,B,C,D) ->
+ ets:insert(Db, {socks5_server, {A,B,C,D}}),
+ {reply, ok, State};
+
+ {set_socks_port, Port} when is_integer(Port) ->
+ ets:insert(Db, {socks5_port, Port}),
+ {reply, ok, State};
+
+ {add_socks_methods, Ls} ->
+ [{_,As}] = ets:lookup(Db, socks5_methods),
+ As1 = lists_subtract(As, Ls),
+ ets:insert(Db, {socks5_methods, As1 ++ Ls}),
+ {reply, ok, State};
+
+ {del_socks_methods, Ls} ->
+ [{_,As}] = ets:lookup(Db, socks5_methods),
+ As1 = lists_subtract(As, Ls),
+ case lists:member(none, As1) of
+ false -> ets:insert(Db, {socks5_methods, As1 ++ [none]});
+ true -> ets:insert(Db, {socks5_methods, As1})
+ end,
+ {reply, ok, State};
+
+ del_socks_methods ->
+ ets:insert(Db, {socks5_methods, [none]}),
+ {reply, ok, State};
+
+ {add_socks_noproxy, {{A,B,C,D},{MA,MB,MC,MD}}}
+ when ?ip(A,B,C,D), ?ip(MA,MB,MC,MD) ->
+ [{_,As}] = ets:lookup(Db, socks5_noproxy),
+ ets:insert(Db, {socks5_noproxy, As++[{{A,B,C,D},{MA,MB,MC,MD}}]}),
+ {reply, ok, State};
+
+ {del_socks_noproxy, {A,B,C,D}=IP} when ?ip(A,B,C,D) ->
+ [{_,As}] = ets:lookup(Db, socks5_noproxy),
+ ets:insert(Db, {socks5_noproxy, lists_keydelete(IP, 1, As)}),
+ {reply, ok, State};
+
+ {set_tcp_module, Mod} when is_atom(Mod) ->
+ ets:insert(Db, {tcp_module, Mod}), %% check/load module ?
+ {reply, ok, State};
+
+ {set_udp_module, Mod} when is_atom(Mod) ->
+ ets:insert(Db, {udp_module, Mod}), %% check/load module ?
+ {reply, ok, State};
+
+ {set_sctp_module, Fam} when is_atom(Fam) ->
+ ets:insert(Db, {sctp_module, Fam}), %% check/load module ?
+ {reply, ok, State};
+
+ {set_cache_size, Size} when is_integer(Size), Size >= 0 ->
+ ets:insert(Db, {cache_size, Size}),
+ {reply, ok, State};
+
+ {set_cache_refresh, Time} when is_integer(Time), Time > 0 ->
+ Time1 = ((Time+999) div 1000)*1000, %% round up
+ ets:insert(Db, {cache_refresh_interval, Time1}),
+ stop_timer(State#state.cache_timer),
+ {reply, ok, State#state{cache_timer = init_timer()}};
+
+ clear_hosts ->
+ ets:delete_all_objects(State#state.hosts_byname),
+ ets:delete_all_objects(State#state.hosts_byaddr),
+ {reply, ok, State};
+
+ clear_cache ->
+ ets:match_delete(State#state.cache, '_'),
+ {reply, ok, State};
+
+ reset ->
+ reset_db(Db),
+ stop_timer(State#state.cache_timer),
+ {reply, ok, State#state{cache_timer = init_timer()}};
+
+ {add_rc_list, List} ->
+ handle_rc_list(List, From, State);
+
+ stop ->
+ {stop, normal, ok, State};
+
+ _ ->
+ {reply, error, State}
+ end.
+
+
+%%----------------------------------------------------------------------
+%% Func: handle_cast/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_cast(_Msg, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: handle_info/2
+%% Returns: {noreply, State} |
+%% {noreply, State, Timeout} |
+%% {stop, Reason, State} (terminate/2 is called)
+%%----------------------------------------------------------------------
+handle_info(refresh_timeout, State) ->
+ do_refresh_cache(State#state.cache),
+ {noreply, State#state{cache_timer = init_timer()}};
+
+handle_info(_Info, State) ->
+ {noreply, State}.
+
+%%----------------------------------------------------------------------
+%% Func: terminate/2
+%% Purpose: Shutdown the server
+%% Returns: any (ignored by gen_server)
+%%----------------------------------------------------------------------
+terminate(_Reason, State) ->
+ stop_timer(State#state.cache_timer),
+ ok.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+handle_set_file(Option, Fname, TagTm, TagInfo, ParseFun, From,
+ #state{db=Db}=State) ->
+ case res_check_option(Option, Fname) of
+ true when Fname =:= "" ->
+ ets:insert(Db, {res_optname(Option), Fname}),
+ ets:delete(Db, TagInfo),
+ ets:delete(Db, TagTm),
+ handle_set_file(ParseFun, <<>>, From, State);
+ true ->
+ File = filename:flatten(Fname),
+ ets:insert(Db, {res_optname(Option), File}),
+ Bin =
+ case erl_prim_loader:read_file_info(File) of
+ {ok, Finfo0} ->
+ Finfo = Finfo0#file_info{access = undefined,
+ atime = undefined},
+ ets:insert(Db, {TagInfo, Finfo}),
+ ets:insert(Db, {TagTm, times()}),
+ case erl_prim_loader:get_file(File) of
+ {ok, B, _} -> B;
+ _ -> <<>>
+ end;
+ _ -> <<>>
+ end,
+ handle_set_file(ParseFun, Bin, From, State);
+ false -> {reply,error,State}
+ end.
+
+handle_set_file(ParseFun, Bin, From, State) ->
+ case ParseFun(Bin) of
+ error -> {reply,error,State};
+ Opts ->
+ handle_rc_list(Opts, From, State)
+ end.
+
+do_add_host(Byname, Byaddr, Names, Type, IP) ->
+ do_del_host(Byname, Byaddr, IP),
+ NIPs = [{tolower(N),Type,IP} || N <- Names],
+ ets:insert(Byname, NIPs),
+ ets:insert(Byaddr, NIPs),
+ ok.
+
+do_del_host(Byname, Byaddr, IP) ->
+ [ets:delete_object(Byname, NIP) || NIP <- ets:lookup(Byaddr, IP)],
+ ets:delete(Byaddr, IP),
+ ok.
+
+%% Loop over .inetrc option list and call handle_call/3 for each
+%%
+handle_rc_list([], _From, State) ->
+ {reply, ok, State};
+handle_rc_list([Opt|Opts], From, State) ->
+ case rc_opt_req(Opt) of
+ undefined ->
+ {reply, {error,{badopt,Opt}}, State};
+ Req ->
+ case handle_calls(Req, From, State) of
+ {reply, ok, NewState} ->
+ handle_rc_list(Opts, From, NewState);
+ Result -> Result
+ end
+ end;
+handle_rc_list(_, _From, State) ->
+ {reply, error, State}.
+
+handle_calls([], _From, State) ->
+ {reply, ok, State};
+handle_calls([Req|Reqs], From, State) ->
+ case handle_call(Req, From, State) of
+ {reply, ok, NewState} ->
+ handle_calls(Reqs, From, NewState);
+ {reply, _, NewState} ->
+ {reply, error, NewState}
+ %% {noreply,_} is currently not returned by handle_call/3
+ end;
+handle_calls(Req, From, State) ->
+ handle_call(Req, From, State).
+
+%% Translate .inetrc option into gen_server request
+%%
+rc_opt_req({nameserver, Ns}) ->
+ {listop,nameservers,add,{Ns,?NAMESERVER_PORT}};
+rc_opt_req({nameserver, Ns, Port}) ->
+ {listop,nameservers,add,{Ns,Port}};
+rc_opt_req({alt_nameserver, Ns}) ->
+ {listop,alt_nameservers,add,{Ns,?NAMESERVER_PORT}};
+rc_opt_req({alt_nameserver, Ns, Port}) ->
+ {listop,alt_nameservers,add,{Ns,Port}};
+rc_opt_req({socks5_noproxy, IP, Mask}) ->
+ {add_socks_noproxy, {IP, Mask}};
+rc_opt_req({search, Ds}) when is_list(Ds) ->
+ try [{listop,search,add,D} || D <- Ds]
+ catch error:_ -> undefined
+ end;
+rc_opt_req({host, IP, Aliases}) -> {add_host, IP, Aliases};
+rc_opt_req({load_hosts_file, _}=Req) -> Req;
+rc_opt_req({lookup, Ls}) ->
+ try {res_set, lookup, translate_lookup(Ls)}
+ catch error:_ -> undefined
+ end;
+rc_opt_req({Name,Arg}) ->
+ case rc_reqname(Name) of
+ undefined ->
+ case is_res_set(Name) of
+ true -> {res_set,Name,Arg};
+ false -> undefined
+ end;
+ Req -> {Req, Arg}
+ end;
+rc_opt_req(del_ns) ->
+ {listdel,nameservers};
+rc_opt_req(del_alt_ns) ->
+ {listdel,alt_nameservers};
+rc_opt_req(clear_ns) ->
+ [{listdel,nameservers},{listdel,alt_nameservers}];
+rc_opt_req(clear_search) ->
+ {listdel,search};
+rc_opt_req(Opt) when is_atom(Opt) ->
+ case is_reqname(Opt) of
+ true -> Opt;
+ false -> undefined
+ end;
+rc_opt_req(_) -> undefined.
+%%
+rc_reqname(socks5_server) -> set_socks_server;
+rc_reqname(socks5_port) -> set_socks_port;
+rc_reqname(socks5_methods) -> set_socks_methods;
+rc_reqname(cache_refresh) -> set_cache_refresh;
+rc_reqname(cache_size) -> set_cache_size;
+rc_reqname(udp) -> set_udp_module;
+rc_reqname(sctp) -> set_sctp_module;
+rc_reqname(tcp) -> set_tcp_module;
+rc_reqname(_) -> undefined.
+%%
+is_res_set(domain) -> true;
+is_res_set(lookup) -> true;
+is_res_set(timeout) -> true;
+is_res_set(retry) -> true;
+is_res_set(inet6) -> true;
+is_res_set(usevc) -> true;
+is_res_set(edns) -> true;
+is_res_set(udp_payload_size) -> true;
+is_res_set(resolv_conf) -> true;
+is_res_set(hosts_file) -> true;
+is_res_set(_) -> false.
+%%
+is_reqname(reset) -> true;
+is_reqname(clear_cache) -> true;
+is_reqname(clear_hosts) -> true;
+is_reqname(_) -> false.
+
+%% Add a resource record to the cache if there are space left.
+%% If the cache is full this function first deletes old entries,
+%% i.e. entries with oldest latest access time.
+%% #dns_rr.cnt is used to store the access time instead of number of
+%% accesses.
+do_add_rr(RR, Db, State) ->
+ CacheDb = State#state.cache,
+ TM = times(),
+ case alloc_entry(Db, CacheDb, TM) of
+ true ->
+ cache_rr(Db, CacheDb, RR#dns_rr { tm = TM,
+ cnt = TM });
+ _ ->
+ false
+ end.
+
+cache_rr(_Db, Cache, RR) ->
+ %% delete possible old entry
+ ets:match_delete(Cache, RR#dns_rr { cnt = '_', tm = '_', ttl = '_',
+ bm = '_', func = '_'}),
+ ets:insert(Cache, RR).
+
+times() ->
+ {Mega,Secs,_} = erlang:now(),
+ Mega*1000000 + Secs.
+
+%% lookup and remove old entries
+
+do_lookup_rr(Domain, Class, Type) ->
+ match_rr(#dns_rr { domain = tolower(Domain), class = Class,type = Type,
+ cnt = '_', tm = '_', ttl = '_',
+ bm = '_', func = '_', data = '_'}).
+
+match_rr(RR) ->
+ filter_rr(ets:match_object(inet_cache, RR), times()).
+
+
+%% filter old resource records and update access count
+
+filter_rr([RR | RRs], Time) when RR#dns_rr.ttl =:= 0 -> %% at least once
+ ets:match_delete(inet_cache, RR),
+ [RR | filter_rr(RRs, Time)];
+filter_rr([RR | RRs], Time) when RR#dns_rr.tm + RR#dns_rr.ttl < Time ->
+ ets:match_delete(inet_cache, RR),
+ filter_rr(RRs, Time);
+filter_rr([RR | RRs], Time) ->
+ ets:match_delete(inet_cache, RR),
+ ets:insert(inet_cache, RR#dns_rr { cnt = Time }),
+ [RR | filter_rr(RRs, Time)];
+filter_rr([], _Time) -> [].
+
+
+%%
+%% Lower case the domain name before storage
+%%
+lower_rr(RR) ->
+ Dn = RR#dns_rr.domain,
+ if is_list(Dn) ->
+ RR#dns_rr { domain = tolower(Dn) };
+ true -> RR
+ end.
+
+%%
+%% Map upper-case to lower-case
+%% NOTE: this code is in kernel and we don't want to relay
+%% to much on stdlib
+%%
+tolower([]) -> [];
+tolower([C|Cs]) when C >= $A, C =< $Z -> [(C-$A)+$a|tolower(Cs)];
+tolower([C|Cs]) -> [C|tolower(Cs)].
+
+dn_ip6_int(A,B,C,D,E,F,G,H) ->
+ dnib(H) ++ dnib(G) ++ dnib(F) ++ dnib(E) ++
+ dnib(D) ++ dnib(C) ++ dnib(B) ++ dnib(A) ++ "ip6.int".
+
+dn_in_addr_arpa(A,B,C,D) ->
+ integer_to_list(D) ++ "." ++
+ integer_to_list(C) ++ "." ++
+ integer_to_list(B) ++ "." ++
+ integer_to_list(A) ++ ".in-addr.arpa".
+
+dnib(X) ->
+ [ hex(X), $., hex(X bsr 4), $., hex(X bsr 8), $., hex(X bsr 12), $.].
+
+hex(X) ->
+ X4 = (X band 16#f),
+ if X4 < 10 -> X4 + $0;
+ true -> (X4-10) + $a
+ end.
+
+%% Strip trailing dot, do not produce garbage unless necessary.
+%%
+stripdot(Name) ->
+ case stripdot_1(Name) of
+ false -> Name;
+ N -> N
+ end.
+%%
+stripdot_1([$.]) -> [];
+stripdot_1([]) -> false;
+stripdot_1([H|T]) ->
+ case stripdot_1(T) of
+ false -> false;
+ N -> [H|N]
+ end.
+
+%% -------------------------------------------------------------------
+%% Refresh cache at regular intervals, i.e. delete expired #dns_rr's.
+%% -------------------------------------------------------------------
+init_timer() ->
+ erlang:send_after(cache_refresh(), self(), refresh_timeout).
+
+stop_timer(undefined) ->
+ undefined;
+stop_timer(Timer) ->
+ erlang:cancel_timer(Timer).
+
+cache_refresh() ->
+ case db_get(cache_refresh_interval) of
+ undefined -> ?CACHE_REFRESH;
+ Val -> Val
+ end.
+
+%% Delete all entries with expired TTL.
+%% Returns the access time of the entry with the oldest access time
+%% in the cache.
+do_refresh_cache(CacheDb) ->
+ Now = times(),
+ do_refresh_cache(ets:first(CacheDb), CacheDb, Now, Now).
+
+do_refresh_cache('$end_of_table', _, _, OldestT) ->
+ OldestT;
+do_refresh_cache(Key, CacheDb, Now, OldestT) ->
+ Fun = fun(RR, T) when RR#dns_rr.tm + RR#dns_rr.ttl < Now ->
+ ets:match_delete(CacheDb, RR),
+ T;
+ (#dns_rr{cnt = C}, T) when C < T ->
+ C;
+ (_, T) ->
+ T
+ end,
+ Next = ets:next(CacheDb, Key),
+ OldT = lists:foldl(Fun, OldestT, ets:lookup(CacheDb, Key)),
+ do_refresh_cache(Next, CacheDb, Now, OldT).
+
+%% -------------------------------------------------------------------
+%% Allocate room for a new entry in the cache.
+%% Deletes entries with expired TTL and all entries with latest
+%% access time older than
+%% trunc((TM - OldestTM) * 0.3) + OldestTM from the cache if it
+%% is full. Does not delete more than 10% of the entries in the cache
+%% though, unless they there deleted due to expired TTL.
+%% Returns: true if space for a new entry otherwise false.
+%% -------------------------------------------------------------------
+alloc_entry(Db, CacheDb, TM) ->
+ CurSize = ets:info(CacheDb, size),
+ case ets:lookup(Db, cache_size) of
+ [{cache_size, Size}] when Size =< CurSize, Size > 0 ->
+ alloc_entry(CacheDb, CurSize, TM, trunc(Size * 0.1) + 1);
+ [{cache_size, Size}] when Size =< 0 ->
+ false;
+ _ ->
+ true
+ end.
+
+alloc_entry(CacheDb, OldSize, TM, N) ->
+ OldestTM = do_refresh_cache(CacheDb), % Delete timedout entries
+ case ets:info(CacheDb, size) of
+ OldSize ->
+ %% No entrys timedout
+ delete_n_oldest(CacheDb, TM, OldestTM, N);
+ _ ->
+ true
+ end.
+
+delete_n_oldest(CacheDb, TM, OldestTM, N) ->
+ DelTM = trunc((TM - OldestTM) * 0.3) + OldestTM,
+ case delete_older(CacheDb, DelTM, N) of
+ 0 ->
+ false;
+ _ ->
+ true
+ end.
+
+%% Delete entries with latest access time older than TM.
+%% Delete max N number of entries.
+%% Returns the number of deleted entries.
+delete_older(CacheDb, TM, N) ->
+ delete_older(ets:first(CacheDb), CacheDb, TM, N, 0).
+
+delete_older('$end_of_table', _, _, _, M) ->
+ M;
+delete_older(_, _, _, N, M) when N =< M ->
+ M;
+delete_older(Domain, CacheDb, TM, N, M) ->
+ Next = ets:next(CacheDb, Domain),
+ Fun = fun(RR, MM) when RR#dns_rr.cnt =< TM ->
+ ets:match_delete(CacheDb, RR),
+ MM + 1;
+ (_, MM) ->
+ MM
+ end,
+ M1 = lists:foldl(Fun, M, ets:lookup(CacheDb, Domain)),
+ delete_older(Next, CacheDb, TM, N, M1).
+
+
+%% as lists:delete/2, but delete all exact matches
+%%
+lists_delete(_, []) -> [];
+lists_delete(E, [E|Es]) ->
+ lists_delete(E, Es);
+lists_delete(E, [X|Es]) ->
+ [X|lists_delete(E, Es)].
+
+%% as '--'/2 aka lists:subtract/2 but delete all exact matches
+lists_subtract(As0, Bs) ->
+ lists:foldl(fun (E, As) -> lists_delete(E, As) end, As0, Bs).
+
+%% as lists:keydelete/3, but delete all _exact_ key matches
+lists_keydelete(_, _, []) -> [];
+lists_keydelete(K, N, [T|Ts]) when element(N, T) =:= K ->
+ lists_keydelete(K, N, Ts);
+lists_keydelete(K, N, [X|Ts]) ->
+ [X|lists_keydelete(K, N, Ts)].
diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl
new file mode 100644
index 0000000000..669a361c9d
--- /dev/null
+++ b/lib/kernel/src/inet_dns.erl
@@ -0,0 +1,701 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_dns).
+
+%% Dns record encode/decode
+%%
+%% RFC 1035: Domain Names - Implementation and Specification
+%% RFC 2181: Clarifications to the DNS Specification
+%% RFC 2671: Extension Mechanisms for DNS (EDNS0)
+%% RFC 2782: A DNS RR for specifying the location of services (DNS SRV)
+%% RFC 2915: The Naming Authority Pointer (NAPTR) DNS Resource Rec
+
+-export([decode/1, encode/1]).
+
+-import(lists, [reverse/1, reverse/2, nthtail/2]).
+
+-include("inet_int.hrl").
+-include("inet_dns.hrl").
+
+-export([record_type/1, rr/1, rr/2]).
+-export([make_rr/0, make_rr/1, make_rr/2, make_rr/3]).
+%% ADTs exports. The make_* functions are undocumented.
+-export([msg/1, msg/2,
+ make_msg/0, make_msg/1, make_msg/2, make_msg/3]).
+-export([header/1, header/2,
+ make_header/0, make_header/1, make_header/2, make_header/3]).
+-export([dns_query/1, dns_query/2,
+ make_dns_query/0, make_dns_query/1,
+ make_dns_query/2, make_dns_query/3]).
+-include("inet_dns_record_adts.hrl").
+
+%% Function merge of #dns_rr{} and #dns_rr_opt{}
+%%
+
+record_type(#dns_rr{}) -> rr;
+record_type(#dns_rr_opt{}) -> rr;
+record_type(Rec) ->
+ record_adts(Rec).
+
+rr(#dns_rr{}=RR) -> dns_rr(RR);
+rr(#dns_rr_opt{}=RR) -> dns_rr_opt(RR).
+
+rr(#dns_rr{}=RR, L) -> dns_rr(RR, L);
+rr(#dns_rr_opt{}=RR, L) -> dns_rr_opt(RR, L).
+
+make_rr() -> make_dns_rr().
+
+make_rr(L) when is_list(L) ->
+ case rr_type(L, any) of
+ opt -> make_dns_rr_opt(L);
+ _ -> make_dns_rr(L)
+ end.
+
+make_rr(type, opt) -> make_dns_rr_opt();
+make_rr(F, V) when is_atom(F) -> make_dns_rr(F, V);
+make_rr(#dns_rr{}=RR, L) when is_list(L) ->
+ case rr_type(L, RR#dns_rr.type) of
+ opt ->
+ Ts = common_fields__rr__rr_opt(),
+ make_dns_rr_opt([Opt || {T,_}=Opt <- dns_rr(RR),
+ lists_member(T, Ts)] ++ L);
+ _ -> make_dns_rr(RR, L)
+ end;
+make_rr(#dns_rr_opt{}=RR, L) when is_list(L) ->
+ case rr_type(L, RR#dns_rr_opt.type) of
+ opt ->
+ make_dns_rr_opt(RR, L);
+ _ ->
+ Ts = common_fields__rr__rr_opt(),
+ make_dns_rr([Opt || {T,_}=Opt <- dns_rr_opt(RR),
+ lists_member(T, Ts)] ++ L)
+ end.
+
+make_rr(#dns_rr{}=RR, type, opt) -> make_rr(RR, [{type,opt}]);
+make_rr(#dns_rr{}=RR, F, V) -> make_dns_rr(RR, F, V);
+make_rr(#dns_rr_opt{}=RR, type, opt) -> RR;
+make_rr(#dns_rr_opt{}=RR, type, T) -> make_rr(RR, [{type,T}]);
+make_rr(#dns_rr_opt{}=RR, F, V) -> make_dns_rr_opt(RR, F, V).
+
+-compile({inline, [rr_type/2]}).
+rr_type([], T) -> T;
+rr_type([{type,T}|Opts], _) -> rr_type(Opts, T);
+rr_type([_|Opts], T) -> rr_type(Opts, T).
+
+common_fields__rr__rr_opt() ->
+ [T || T <- record_info(fields, dns_rr_opt),
+ lists_member(T, record_info(fields, dns_rr))].
+
+-compile({inline, [lists_member/2]}).
+lists_member(_, []) -> false;
+lists_member(H, [H|_]) -> true;
+lists_member(H, [_|T]) -> lists_member(H, T).
+
+
+
+-define(DECODE_ERROR, fmt). % must match a clause in inet_res:query_nss_e?dns
+
+%%
+%% Decode a dns buffer.
+%%
+
+decode(Buffer) when is_binary(Buffer) ->
+ try do_decode(Buffer) of
+ DnsRec ->
+ {ok,DnsRec}
+ catch
+ Reason ->
+ {error,Reason}
+ end.
+
+do_decode(<<Id:16,
+ QR:1,Opcode:4,AA:1,TC:1,RD:1,
+ RA:1,PR:1,_:2,Rcode:4,
+ QdCount:16,AnCount:16,NsCount:16,ArCount:16,
+ QdBuf/binary>>=Buffer) ->
+ {AnBuf,QdList} = decode_query_section(QdBuf,QdCount,Buffer),
+ {NsBuf,AnList} = decode_rr_section(AnBuf,AnCount,Buffer),
+ {ArBuf,NsList} = decode_rr_section(NsBuf,NsCount,Buffer),
+ {Rest,ArList} = decode_rr_section(ArBuf,ArCount,Buffer),
+ case Rest of
+ <<>> ->
+ DnsHdr =
+ #dns_header{id=Id,
+ qr=decode_boolean(QR),
+ opcode=decode_opcode(Opcode),
+ aa=decode_boolean(AA),
+ tc=decode_boolean(TC),
+ rd=decode_boolean(RD),
+ ra=decode_boolean(RA),
+ pr=decode_boolean(PR),
+ rcode=Rcode},
+ #dns_rec{header=DnsHdr,
+ qdlist=QdList,
+ anlist=AnList,
+ nslist=NsList,
+ arlist=ArList};
+ _ ->
+ %% Garbage data after DNS message
+ throw(?DECODE_ERROR)
+ end;
+do_decode(_) ->
+ %% DNS message does not even match header
+ throw(?DECODE_ERROR).
+
+decode_query_section(Bin, N, Buffer) ->
+ decode_query_section(Bin, N, Buffer, []).
+
+decode_query_section(Rest, 0, _Buffer, Qs) ->
+ {Rest,reverse(Qs)};
+decode_query_section(Bin, N, Buffer, Qs) ->
+ case decode_name(Bin, Buffer) of
+ {<<Type:16,Class:16,Rest/binary>>,Name} ->
+ DnsQuery =
+ #dns_query{domain=Name,
+ type=decode_type(Type),
+ class=decode_class(Class)},
+ decode_query_section(Rest, N-1, Buffer, [DnsQuery|Qs]);
+ _ ->
+ %% Broken question
+ throw(?DECODE_ERROR)
+ end.
+
+decode_rr_section(Bin, N, Buffer) ->
+ decode_rr_section(Bin, N, Buffer, []).
+
+decode_rr_section(Rest, 0, _Buffer, RRs) ->
+ {Rest,reverse(RRs)};
+decode_rr_section(Bin, N, Buffer, RRs) ->
+ case decode_name(Bin, Buffer) of
+ {<<T:16/unsigned,C:16/unsigned,TTL:4/binary,
+ Len:16,D:Len/binary,Rest/binary>>,
+ Name} ->
+ Type = decode_type(T),
+ Class = decode_class(C),
+ Data = decode_data(D, Class, Type, Buffer),
+ RR =
+ case Type of
+ opt ->
+ <<ExtRcode,Version,Z:16>> = TTL,
+ #dns_rr_opt{domain=Name,
+ type=Type,
+ udp_payload_size=C,
+ ext_rcode=ExtRcode,
+ version=Version,
+ z=Z,
+ data=Data};
+ _ ->
+ <<TimeToLive:32/signed>> = TTL,
+ #dns_rr{domain=Name,
+ type=Type,
+ class=Class,
+ ttl=if TimeToLive < 0 -> 0;
+ true -> TimeToLive end,
+ data=Data}
+ end,
+ decode_rr_section(Rest, N-1, Buffer, [RR|RRs]);
+ _ ->
+ %% Broken RR
+ throw(?DECODE_ERROR)
+ end.
+
+%%
+%% Encode a user query
+%%
+
+encode(Q) ->
+ QdCount = length(Q#dns_rec.qdlist),
+ AnCount = length(Q#dns_rec.anlist),
+ NsCount = length(Q#dns_rec.nslist),
+ ArCount = length(Q#dns_rec.arlist),
+ B0 = encode_header(Q#dns_rec.header, QdCount, AnCount, NsCount, ArCount),
+ C0 = gb_trees:empty(),
+ {B1,C1} = encode_query_section(B0, C0, Q#dns_rec.qdlist),
+ {B2,C2} = encode_res_section(B1, C1, Q#dns_rec.anlist),
+ {B3,C3} = encode_res_section(B2, C2, Q#dns_rec.nslist),
+ {B,_} = encode_res_section(B3, C3, Q#dns_rec.arlist),
+ B.
+
+
+%% RFC 1035: 4.1.1. Header section format
+%%
+encode_header(#dns_header{id=Id}=H, QdCount, AnCount, NsCount, ArCount) ->
+ QR = encode_boolean(H#dns_header.qr),
+ Opcode = encode_opcode(H#dns_header.opcode),
+ AA = encode_boolean(H#dns_header.aa),
+ TC = encode_boolean(H#dns_header.tc),
+ RD = encode_boolean(H#dns_header.rd),
+ RA = encode_boolean(H#dns_header.ra),
+ PR = encode_boolean(H#dns_header.pr),
+ Rcode = H#dns_header.rcode,
+ <<Id:16,
+ QR:1,Opcode:4,AA:1,TC:1,RD:1,
+ RA:1,PR:1,0:2,Rcode:4,
+ QdCount:16,AnCount:16,NsCount:16,ArCount:16>>.
+
+%% RFC 1035: 4.1.2. Question section format
+%%
+encode_query_section(Bin, Comp, []) -> {Bin,Comp};
+encode_query_section(Bin0, Comp0, [#dns_query{domain=DName}=Q | Qs]) ->
+ Type = encode_type(Q#dns_query.type),
+ Class = encode_class(Q#dns_query.class),
+ {Bin,Comp} = encode_name(Bin0, Comp0, byte_size(Bin0), DName),
+ encode_query_section(<<Bin/binary,Type:16,Class:16>>, Comp, Qs).
+
+%% RFC 1035: 4.1.3. Resource record format
+%% RFC 2671: 4.3, 4.4, 4.6 OPT RR format
+%%
+encode_res_section(Bin, Comp, []) -> {Bin,Comp};
+encode_res_section(Bin, Comp, [#dns_rr {domain = DName,
+ type = Type,
+ class = Class,
+ ttl = TTL,
+ data = Data} | Rs]) ->
+ encode_res_section_rr(Bin, Comp, Rs,
+ DName, Type, Class, <<TTL:32/signed>>, Data);
+encode_res_section(Bin, Comp, [#dns_rr_opt {domain = DName,
+ udp_payload_size = UdpPayloadSize,
+ ext_rcode = ExtRCode,
+ version = Version,
+ z = Z,
+ data = Data} | Rs]) ->
+ encode_res_section_rr(Bin, Comp, Rs,
+ DName, ?S_OPT, UdpPayloadSize,
+ <<ExtRCode,Version,Z:16>>, Data).
+
+encode_res_section_rr(Bin0, Comp0, Rs, DName, Type, Class, TTL, Data) ->
+ T = encode_type(Type),
+ C = encode_class(Class),
+ {Bin,Comp1} = encode_name(Bin0, Comp0, byte_size(Bin0), DName),
+ {DataBin,Comp} = encode_data(Comp1, byte_size(Bin)+2+2+byte_size(TTL)+2,
+ Type, Class, Data),
+ DataSize = byte_size(DataBin),
+ encode_res_section(<<Bin/binary,T:16,C:16,
+ TTL/binary,DataSize:16,DataBin/binary>>, Comp, Rs).
+
+%%
+%% Resource types
+%%
+decode_type(Type) ->
+ case Type of
+ ?T_A -> ?S_A;
+ ?T_NS -> ?S_NS;
+ ?T_MD -> ?S_MD;
+ ?T_MF -> ?S_MF;
+ ?T_CNAME -> ?S_CNAME;
+ ?T_SOA -> ?S_SOA;
+ ?T_MB -> ?S_MB;
+ ?T_MG -> ?S_MG;
+ ?T_MR -> ?S_MR;
+ ?T_NULL -> ?S_NULL;
+ ?T_WKS -> ?S_WKS;
+ ?T_PTR -> ?S_PTR;
+ ?T_HINFO -> ?S_HINFO;
+ ?T_MINFO -> ?S_MINFO;
+ ?T_MX -> ?S_MX;
+ ?T_TXT -> ?S_TXT;
+ ?T_AAAA -> ?S_AAAA;
+ ?T_SRV -> ?S_SRV;
+ ?T_NAPTR -> ?S_NAPTR;
+ ?T_OPT -> ?S_OPT;
+ ?T_SPF -> ?S_SPF;
+ %% non standard
+ ?T_UINFO -> ?S_UINFO;
+ ?T_UID -> ?S_UID;
+ ?T_GID -> ?S_GID;
+ ?T_UNSPEC -> ?S_UNSPEC;
+ %% Query type values which do not appear in resource records
+ ?T_AXFR -> ?S_AXFR;
+ ?T_MAILB -> ?S_MAILB;
+ ?T_MAILA -> ?S_MAILA;
+ ?T_ANY -> ?S_ANY;
+ _ -> Type %% raw unknown type
+ end.
+
+%%
+%% Resource types
+%%
+encode_type(Type) ->
+ case Type of
+ ?S_A -> ?T_A;
+ ?S_NS -> ?T_NS;
+ ?S_MD -> ?T_MD;
+ ?S_MF -> ?T_MF;
+ ?S_CNAME -> ?T_CNAME;
+ ?S_SOA -> ?T_SOA;
+ ?S_MB -> ?T_MB;
+ ?S_MG -> ?T_MG;
+ ?S_MR -> ?T_MR;
+ ?S_NULL -> ?T_NULL;
+ ?S_WKS -> ?T_WKS;
+ ?S_PTR -> ?T_PTR;
+ ?S_HINFO -> ?T_HINFO;
+ ?S_MINFO -> ?T_MINFO;
+ ?S_MX -> ?T_MX;
+ ?S_TXT -> ?T_TXT;
+ ?S_AAAA -> ?T_AAAA;
+ ?S_SRV -> ?T_SRV;
+ ?S_NAPTR -> ?T_NAPTR;
+ ?S_OPT -> ?T_OPT;
+ ?S_SPF -> ?T_SPF;
+ %% non standard
+ ?S_UINFO -> ?T_UINFO;
+ ?S_UID -> ?T_UID;
+ ?S_GID -> ?T_GID;
+ ?S_UNSPEC -> ?T_UNSPEC;
+ %% Query type values which do not appear in resource records
+ ?S_AXFR -> ?T_AXFR;
+ ?S_MAILB -> ?T_MAILB;
+ ?S_MAILA -> ?T_MAILA;
+ ?S_ANY -> ?T_ANY;
+ Type when is_integer(Type) -> Type %% raw unknown type
+ end.
+
+%%
+%% Resource clases
+%%
+
+decode_class(Class) ->
+ case Class of
+ ?C_IN -> in;
+ ?C_CHAOS -> chaos;
+ ?C_HS -> hs;
+ ?C_ANY -> any;
+ _ -> Class %% raw unknown class
+ end.
+
+encode_class(Class) ->
+ case Class of
+ in -> ?C_IN;
+ chaos -> ?C_CHAOS;
+ hs -> ?C_HS;
+ any -> ?C_ANY;
+ Class when is_integer(Class) -> Class %% raw unknown class
+ end.
+
+decode_opcode(Opcode) ->
+ case Opcode of
+ ?QUERY -> 'query';
+ ?IQUERY -> iquery;
+ ?STATUS -> status;
+ _ when is_integer(Opcode) -> Opcode %% non-standard opcode
+ end.
+
+encode_opcode(Opcode) ->
+ case Opcode of
+ 'query' -> ?QUERY;
+ iquery -> ?IQUERY;
+ status -> ?STATUS;
+ _ when is_integer(Opcode) -> Opcode %% non-standard opcode
+ end.
+
+
+encode_boolean(true) -> 1;
+encode_boolean(false) -> 0;
+encode_boolean(B) when is_integer(B) -> B.
+
+decode_boolean(0) -> false;
+decode_boolean(I) when is_integer(I) -> true.
+
+%%
+%% Data field -> term() content representation
+%%
+decode_data(<<A,B,C,D>>, in, ?S_A, _) -> {A,B,C,D};
+decode_data(<<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16>>, in, ?S_AAAA, _) ->
+ {A,B,C,D,E,F,G,H};
+decode_data(Dom, _, ?S_NS, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(Dom, _, ?S_MD, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(Dom, _, ?S_MF, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(Dom, _, ?S_CNAME, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(Data0, _, ?S_SOA, Buffer) ->
+ {Data1,MName} = decode_name(Data0, Buffer),
+ {Data,RName} = decode_name(Data1, Buffer),
+ case Data of
+ <<Serial:32,Refresh:32/signed,Retry:32/signed,
+ Expiry:32/signed,Minimum:32>> ->
+ {MName,RName,Serial,Refresh,Retry,Expiry,Minimum};
+ _ ->
+ %% Broken SOA RR data
+ throw(?DECODE_ERROR)
+ end;
+decode_data(Dom, _, ?S_MB, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(Dom, _, ?S_MG, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(Dom, _, ?S_MR, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(Data, _, ?S_NULL, _) -> Data;
+decode_data(<<A,B,C,D,Proto,BitMap/binary>>, in, ?S_WKS, _Buffer) ->
+ {{A,B,C,D},Proto,BitMap};
+decode_data(Dom, _, ?S_PTR, Buffer) -> decode_domain(Dom, Buffer);
+decode_data(<<CpuLen,CPU:CpuLen/binary,
+ OsLen,OS:OsLen/binary>>, _, ?S_HINFO, _) ->
+ {binary_to_list(CPU),binary_to_list(OS)};
+decode_data(Data0, _, ?S_MINFO, Buffer) ->
+ {Data1,RM} = decode_name(Data0, Buffer),
+ {Data,EM} = decode_name(Data1, Buffer),
+ case Data of
+ <<>> -> {RM,EM};
+ _ ->
+ %% Broken MINFO data
+ throw(?DECODE_ERROR)
+ end;
+decode_data(<<Prio:16,Dom/binary>>, _, ?S_MX, Buffer) ->
+ {Prio,decode_domain(Dom, Buffer)};
+decode_data(<<Prio:16,Weight:16,Port:16,Dom/binary>>, _, ?S_SRV, Buffer) ->
+ {Prio,Weight,Port,decode_domain(Dom, Buffer)};
+decode_data(<<Order:16,Preference:16,Data0/binary>>, _, ?S_NAPTR, Buffer) ->
+ {Data1,Flags} = decode_string(Data0),
+ {Data2,Services} = decode_string(Data1),
+ {Data,Regexp} = decode_characters(Data2, utf8),
+ Replacement = decode_domain(Data, Buffer),
+ {Order,Preference,string:to_lower(Flags),string:to_lower(Services),
+ Regexp,Replacement};
+%% ?S_OPT falls through to default
+decode_data(Data, _, ?S_TXT, _) ->
+ decode_txt(Data);
+decode_data(Data, _, ?S_SPF, _) ->
+ decode_txt(Data);
+%% sofar unknown or non standard
+decode_data(Data, _, _, _) ->
+ Data.
+
+%% Array of strings
+%%
+decode_txt(<<>>) -> [];
+decode_txt(Bin) ->
+ {Rest,String} = decode_string(Bin),
+ [String|decode_txt(Rest)].
+
+decode_string(<<Len,Bin:Len/binary,Rest/binary>>) ->
+ {Rest,binary_to_list(Bin)};
+decode_string(_) ->
+ %% Broken string
+ throw(?DECODE_ERROR).
+
+decode_characters(<<Len,Bin:Len/binary,Rest/binary>>, Encoding) ->
+ {Rest,unicode:characters_to_list(Bin, Encoding)};
+decode_characters(_, _) ->
+ %% Broken encoded string
+ throw(?DECODE_ERROR).
+
+%% One domain name only, there must be nothing after
+%%
+decode_domain(Bin, Buffer) ->
+ case decode_name(Bin, Buffer) of
+ {<<>>,Name} -> Name;
+ _ ->
+ %% Garbage after domain name
+ throw(?DECODE_ERROR)
+ end.
+
+%% Domain name -> {RestBin,Name}
+%%
+decode_name(Bin, Buffer) ->
+ decode_name(Bin, Buffer, [], Bin, 0).
+
+%% Tail advances with Rest until the first indirection is followed
+%% then it stays put at that Rest.
+decode_name(_, Buffer, _Labels, _Tail, Cnt) when Cnt > byte_size(Buffer) ->
+ throw(?DECODE_ERROR); %% Insantiy bailout - this must be a decode loop
+decode_name(<<0,Rest/binary>>, _Buffer, Labels, Tail, Cnt) ->
+ %% Root domain, we have all labels for the domain name
+ {if Cnt =/= 0 -> Tail; true -> Rest end,
+ decode_name_labels(Labels)};
+decode_name(<<0:2,Len:6,Label:Len/binary,Rest/binary>>,
+ Buffer, Labels, Tail, Cnt) ->
+ %% One plain label here
+ decode_name(Rest, Buffer, [Label|Labels],
+ if Cnt =/= 0 -> Tail; true -> Rest end,
+ Cnt);
+decode_name(<<3:2,Ptr:14,Rest/binary>>, Buffer, Labels, Tail, Cnt) ->
+ %% Indirection - reposition in buffer and recurse
+ case Buffer of
+ <<_:Ptr/binary,Bin/binary>> ->
+ decode_name(Bin, Buffer, Labels,
+ if Cnt =/= 0 -> Tail; true -> Rest end,
+ Cnt+2); % size of indirection pointer
+ _ ->
+ %% Indirection pointer outside buffer
+ throw(?DECODE_ERROR)
+ end;
+decode_name(_, _, _, _, _) -> throw(?DECODE_ERROR).
+
+%% Reverse list of labels (binaries) -> domain name (string)
+decode_name_labels([]) -> ".";
+decode_name_labels(Labels) ->
+ decode_name_labels(Labels, "").
+
+decode_name_labels([Label], Name) ->
+ decode_name_label(Label, Name);
+decode_name_labels([Label|Labels], Name) ->
+ decode_name_labels(Labels, "."++decode_name_label(Label, Name)).
+
+decode_name_label(<<>>, _Name) ->
+ %% Empty label is only allowed for the root domain,
+ %% and that is handled above.
+ throw(?DECODE_ERROR);
+decode_name_label(Label, Name) ->
+ decode_name_label(Label, Name, byte_size(Label)).
+
+%% Decode $. and $\\ to become $\\ escaped characters
+%% in the string representation.
+-compile({inline, [decode_name_label/3]}).
+decode_name_label(_, Name, 0) -> Name;
+decode_name_label(Label, Name, N) ->
+ M = N-1,
+ case Label of
+ <<_:M/binary,($\\),_/binary>> ->
+ decode_name_label(Label, "\\\\"++Name, M);
+ <<_:M/binary,($.),_/binary>> ->
+ decode_name_label(Label, "\\."++Name, M);
+ <<_:M/binary,C,_/binary>> ->
+ decode_name_label(Label, [C|Name], M);
+ _ ->
+ %% This should not happen but makes surrounding
+ %% programming errors easier to locate.
+ erlang:error(badarg, [Label,Name,N])
+ end.
+
+%%
+%% Data field -> {binary(),NewCompressionTable}
+%%
+encode_data(Comp, _, ?S_A, in, {A,B,C,D}) -> {<<A,B,C,D>>,Comp};
+encode_data(Comp, _, ?S_AAAA, in, {A,B,C,D,E,F,G,H}) ->
+ {<<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16>>,Comp};
+encode_data(Comp, Pos, ?S_NS, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_MD, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_MF, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_CNAME, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp0, Pos, ?S_SOA, in,
+ {MName,RName,Serial,Refresh,Retry,Expiry,Minimum}) ->
+ {B1,Comp1} = encode_name(Comp0, Pos, MName),
+ {B,Comp} = encode_name(B1, Comp1, Pos+byte_size(B1), RName),
+ {<<B/binary,Serial:32,Refresh:32/signed,Retry:32/signed,
+ Expiry:32/signed,Minimum:32>>,
+ Comp};
+encode_data(Comp, Pos, ?S_MB, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_MG, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, Pos, ?S_MR, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, _, ?S_NULL, in, Data) ->
+ {iolist_to_binary(Data),Comp};
+encode_data(Comp, _, ?S_WKS, in, {{A,B,C,D},Proto,BitMap}) ->
+ BitMapBin = iolist_to_binary(BitMap),
+ {<<A,B,C,D,Proto,BitMapBin/binary>>,Comp};
+encode_data(Comp, Pos, ?S_PTR, in, Domain) -> encode_name(Comp, Pos, Domain);
+encode_data(Comp, _, ?S_HINFO, in, {CPU,OS}) ->
+ Bin = encode_string(iolist_to_binary(CPU)),
+ {encode_string(Bin, iolist_to_binary(OS)),Comp};
+encode_data(Comp0, Pos, ?S_MINFO, in, {RM,EM}) ->
+ {Bin,Comp} = encode_name(Comp0, Pos, RM),
+ encode_name(Bin, Comp, Pos+byte_size(Bin), EM);
+encode_data(Comp, Pos, ?S_MX, in, {Pref,Exch}) ->
+ encode_name(<<Pref:16>>, Comp, Pos+2, Exch);
+encode_data(Comp, Pos, ?S_SRV, in, {Prio,Weight,Port,Target}) ->
+ encode_name(<<Prio:16,Weight:16,Port:16>>, Comp, Pos+2+2+2, Target);
+encode_data(Comp, Pos, ?S_NAPTR, in,
+ {Order,Preference,Flags,Services,Regexp,Replacement}) ->
+ B0 = <<Order:16,Preference:16>>,
+ B1 = encode_string(B0, iolist_to_binary(Flags)),
+ B2 = encode_string(B1, iolist_to_binary(Services)),
+ B3 = encode_string(B2, unicode:characters_to_binary(Regexp,
+ unicode, utf8)),
+ %% Bypass name compression (RFC 2915: section 2)
+ {B,_} = encode_name(B3, gb_trees:empty(), Pos+byte_size(B3), Replacement),
+ {B,Comp};
+%% ?S_OPT falls through to default
+encode_data(Comp, _, ?S_TXT, in, Data) -> {encode_txt(Data),Comp};
+encode_data(Comp, _, ?S_SPF, in, Data) -> {encode_txt(Data),Comp};
+encode_data(Comp, _Pos, _Type, _Class, Data) -> {iolist_to_binary(Data),Comp}.
+
+%% Array of strings
+%%
+encode_txt(Strings) ->
+ encode_txt(<<>>, Strings).
+%%
+encode_txt(Bin, []) -> Bin;
+encode_txt(Bin, [S|Ss]) ->
+ encode_txt(encode_string(Bin, iolist_to_binary(S)), Ss).
+
+%% Singular string
+%%
+encode_string(StringBin) ->
+ encode_string(<<>>, StringBin).
+%%
+encode_string(Bin, StringBin) ->
+ Size = byte_size(StringBin),
+ if Size =< 255 ->
+ <<Bin/binary,Size,StringBin/binary>>
+ end.
+
+%% Domain name
+%%
+encode_name(Comp, Pos, Name) ->
+ encode_name(<<>>, Comp, Pos, Name).
+%%
+%% Bin = target binary
+%% Comp = compression lookup table; label list -> buffer position
+%% Pos = position in DNS message
+%% Name = domain name to encode
+%%
+%% The name compression does not make the case conversions
+%% it could. This means case will be preserved at the cost
+%% of missed compression opportunities. But if the encoded
+%% message use the same case for different instances of
+%% the same domain name there is no problem, and if not it is
+%% only compression that suffers. Furthermore encode+decode
+%% this way becomes an identity operation for any decoded
+%% DNS message which is nice for testing encode.
+%%
+encode_name(Bin0, Comp0, Pos, Name) ->
+ case encode_labels(Bin0, Comp0, Pos, name2labels(Name)) of
+ {Bin,_}=Result when byte_size(Bin) - byte_size(Bin0) =< 255 -> Result;
+ _ ->
+ %% Fail on too long name
+ erlang:error(badarg, [Bin0,Comp0,Pos,Name])
+ end.
+
+name2labels("") -> [];
+name2labels(".") -> [];
+name2labels(Cs) -> name2labels(<<>>, Cs).
+%%
+-compile({inline, [name2labels/2]}).
+name2labels(Label, "") -> [Label];
+name2labels(Label, ".") -> [Label];
+name2labels(Label, "."++Cs) -> [Label|name2labels(<<>>, Cs)];
+name2labels(Label, "\\"++[C|Cs]) -> name2labels(<<Label/binary,C>>, Cs);
+name2labels(Label, [C|Cs]) -> name2labels(<<Label/binary,C>>, Cs).
+
+%% Fail on empty or too long labels.
+encode_labels(Bin, Comp, _Pos, []) ->
+ {<<Bin/binary,0>>,Comp};
+encode_labels(Bin, Comp0, Pos, [L|Ls]=Labels)
+ when 1 =< byte_size(L), byte_size(L) =< 63 ->
+ case gb_trees:lookup(Labels, Comp0) of
+ none ->
+ Comp = if Pos < (3 bsl 14) ->
+ %% Just in case - compression
+ %% pointers can not reach further
+ gb_trees:insert(Labels, Pos, Comp0);
+ true -> Comp0
+ end,
+ Size = byte_size(L),
+ encode_labels(<<Bin/binary,Size,L/binary>>,
+ Comp, Pos+1+Size, Ls);
+ {value,Ptr} ->
+ %% Name compression - point to already encoded name
+ {<<Bin/binary,3:2,Ptr:14>>,Comp0}
+ end.
diff --git a/lib/kernel/src/inet_dns.hrl b/lib/kernel/src/inet_dns.hrl
new file mode 100644
index 0000000000..1b69f31a4d
--- /dev/null
+++ b/lib/kernel/src/inet_dns.hrl
@@ -0,0 +1,208 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% Defintion for Domain Name System
+%%
+
+%%
+%% Currently defined opcodes
+%%
+-define(QUERY, 16#0). %% standard query
+-define(IQUERY, 16#1). %% inverse query
+-define(STATUS, 16#2). %% nameserver status query
+%% -define(xxx, 16#3) %% 16#3 reserved
+%% non standard
+-define(UPDATEA, 16#9). %% add resource record
+-define(UPDATED, 16#a). %% delete a specific resource record
+-define(UPDATEDA, 16#b). %% delete all nemed resource record
+-define(UPDATEM, 16#c). %% modify a specific resource record
+-define(UPDATEMA, 16#d). %% modify all named resource record
+
+-define(ZONEINIT, 16#e). %% initial zone transfer
+-define(ZONEREF, 16#f). %% incremental zone referesh
+
+
+%%
+%% Currently defined response codes
+%%
+-define(NOERROR, 0). %% no error
+-define(FORMERR, 1). %% format error
+-define(SERVFAIL, 2). %% server failure
+-define(NXDOMAIN, 3). %% non existent domain
+-define(NOTIMP, 4). %% not implemented
+-define(REFUSED, 5). %% query refused
+%% non standard
+-define(NOCHANGE, 16#f). %% update failed to change db
+-define(BADVERS, 16).
+
+%%
+%% Type values for resources and queries
+%%
+-define(T_A, 1). %% host address
+-define(T_NS, 2). %% authoritative server
+-define(T_MD, 3). %% mail destination
+-define(T_MF, 4). %% mail forwarder
+-define(T_CNAME, 5). %% connonical name
+-define(T_SOA, 6). %% start of authority zone
+-define(T_MB, 7). %% mailbox domain name
+-define(T_MG, 8). %% mail group member
+-define(T_MR, 9). %% mail rename name
+-define(T_NULL, 10). %% null resource record
+-define(T_WKS, 11). %% well known service
+-define(T_PTR, 12). %% domain name pointer
+-define(T_HINFO, 13). %% host information
+-define(T_MINFO, 14). %% mailbox information
+-define(T_MX, 15). %% mail routing information
+-define(T_TXT, 16). %% text strings
+-define(T_AAAA, 28). %% ipv6 address
+%% SRV (RFC 2052)
+-define(T_SRV, 33). %% services
+%% NAPTR (RFC 2915)
+-define(T_NAPTR, 35). %% naming authority pointer
+-define(T_OPT, 41). %% EDNS pseudo-rr RFC2671(7)
+%% SPF (RFC 4408)
+-define(T_SPF, 99). %% server policy framework
+%% non standard
+-define(T_UINFO, 100). %% user (finger) information
+-define(T_UID, 101). %% user ID
+-define(T_GID, 102). %% group ID
+-define(T_UNSPEC, 103). %% Unspecified format (binary data)
+%% Query type values which do not appear in resource records
+-define(T_AXFR, 252). %% transfer zone of authority
+-define(T_MAILB, 253). %% transfer mailbox records
+-define(T_MAILA, 254). %% transfer mail agent records
+-define(T_ANY, 255). %% wildcard match
+
+%%
+%% Symbolic Type values for resources and queries
+%%
+-define(S_A, a). %% host address
+-define(S_NS, ns). %% authoritative server
+-define(S_MD, md). %% mail destination
+-define(S_MF, mf). %% mail forwarder
+-define(S_CNAME, cname). %% connonical name
+-define(S_SOA, soa). %% start of authority zone
+-define(S_MB, mb). %% mailbox domain name
+-define(S_MG, mg). %% mail group member
+-define(S_MR, mr). %% mail rename name
+-define(S_NULL, null). %% null resource record
+-define(S_WKS, wks). %% well known service
+-define(S_PTR, ptr). %% domain name pointer
+-define(S_HINFO, hinfo). %% host information
+-define(S_MINFO, minfo). %% mailbox information
+-define(S_MX, mx). %% mail routing information
+-define(S_TXT, txt). %% text strings
+-define(S_AAAA, aaaa). %% ipv6 address
+%% SRV (RFC 2052)
+-define(S_SRV, srv). %% services
+%% NAPTR (RFC 2915)
+-define(S_NAPTR, naptr). %% naming authority pointer
+-define(S_OPT, opt). %% EDNS pseudo-rr RFC2671(7)
+%% SPF (RFC 4408)
+-define(S_SPF, spf). %% server policy framework
+%% non standard
+-define(S_UINFO, uinfo). %% user (finger) information
+-define(S_UID, uid). %% user ID
+-define(S_GID, gid). %% group ID
+-define(S_UNSPEC, unspec). %% Unspecified format (binary data)
+%% Query type values which do not appear in resource records
+-define(S_AXFR, axfr). %% transfer zone of authority
+-define(S_MAILB, mailb). %% transfer mailbox records
+-define(S_MAILA, maila). %% transfer mail agent records
+-define(S_ANY, any). %% wildcard match
+
+%%
+%% Values for class field
+%%
+
+-define(C_IN, 1). %% the arpa internet
+-define(C_CHAOS, 3). %% for chaos net at MIT
+-define(C_HS, 4). %% for Hesiod name server at MIT
+%% Query class values which do not appear in resource records
+-define(C_ANY, 255). %% wildcard match
+
+
+%% indirection mask for compressed domain names
+-define(INDIR_MASK, 16#c0).
+
+%%
+%% Structure for query header, the order of the fields is machine and
+%% compiler dependent, in our case, the bits within a byte are assignd
+%% least significant first, while the order of transmition is most
+%% significant first. This requires a somewhat confusing rearrangement.
+%%
+-record(dns_header,
+ {
+ id = 0, %% ushort query identification number
+ %% byte F0
+ qr = 0, %% :1 response flag
+ opcode = 0, %% :4 purpose of message
+ aa = 0, %% :1 authoritive answer
+ tc = 0, %% :1 truncated message
+ rd = 0, %% :1 recursion desired
+ %% byte F1
+ ra = 0, %% :1 recursion available
+ pr = 0, %% :1 primary server required (non standard)
+ %% :2 unused bits
+ rcode = 0 %% :4 response code
+ }).
+
+-record(dns_rec,
+ {
+ header, %% dns_header record
+ qdlist = [], %% list of question entries
+ anlist = [], %% list of answer entries
+ nslist = [], %% list of authority entries
+ arlist = [] %% list of resource entries
+ }).
+
+%% DNS resource record
+-record(dns_rr,
+ {
+ domain = "", %% resource domain
+ type = any, %% resource type
+ class = in, %% reource class
+ cnt = 0, %% access count
+ ttl = 0, %% time to live
+ data = [], %% raw data
+ %%
+ tm, %% creation time
+ bm = [], %% Bitmap storing domain character case information.
+ func = false %% Optional function calculating the data field.
+ }).
+
+-define(DNS_UDP_PAYLOAD_SIZE, 1280).
+
+-record(dns_rr_opt, %% EDNS RR OPT (RFC2671), dns_rr{type=opt}
+ {
+ domain = "", %% should be the root domain
+ type = opt,
+ udp_payload_size = ?DNS_UDP_PAYLOAD_SIZE, %% RFC2671(4.5 CLASS)
+ ext_rcode = 0, %% RFC2671(4.6 EXTENDED-RCODE)
+ version = 0, %% RFC2671(4.6 VERSION)
+ z = 0, %% RFC2671(4.6 Z)
+ data = [] %% RFC2671(4.4)
+ }).
+
+-record(dns_query,
+ {
+ domain, %% query domain
+ type, %% query type
+ class %% query class
+ }).
diff --git a/lib/kernel/src/inet_dns_record_adts.pl b/lib/kernel/src/inet_dns_record_adts.pl
new file mode 100644
index 0000000000..b1d8fab939
--- /dev/null
+++ b/lib/kernel/src/inet_dns_record_adts.pl
@@ -0,0 +1,180 @@
+#! /usr/bin/env perl
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+use strict;
+
+# Generate ADT (Abstract Data Type) access and generation functions
+# for internal records.
+#
+# The following defines which ADT function sets that will be generated
+# and which record fields that will be exponated.
+#
+# (FunctionBaseName => [RecordName, FieldName ...], ...)
+my %Names = ('msg' => ['dns_rec', 'header', 'qdlist',
+ 'anlist', 'nslist', 'arlist'],
+ 'dns_rr' => ['dns_rr', 'domain', 'type', 'class', 'ttl', 'data'],
+ 'dns_rr_opt' => ['dns_rr_opt', 'domain', 'type',
+ 'udp_payload_size', 'ext_rcode', 'version',
+ 'z', 'data'],
+ 'dns_query' => ['dns_query', 'domain', 'type', 'class'],
+ 'header' => ['dns_header', 'id', 'qr', 'opcode', 'aa', 'tc',
+ 'rd', 'ra', 'pr', 'rcode']);
+# The functions are defined in the __DATA__ section at the end.
+
+# Read in __DATA__ and merge lines.
+my $line = '';
+my @DATA;
+my @INDEX;
+while(<DATA>) {
+ chomp;
+ $line .= $_;
+ unless ($line =~ s/\\$//) {
+ if ($line =~ s/^[+]//) {
+ push(@INDEX, $line);
+ } else {
+ push(@DATA, $line);
+ }
+ $line = '';
+ }
+}
+
+$" = ',';
+$\ = "\n";
+while( my ($Name, $r) = each(%Names)) {
+ # Create substitutions for this Name
+ my ($Record, @Fields) = @{ $r };
+ my @FieldMatchValues;
+ my @FieldValueTuples;
+ my @Values;
+ my $n = $#{ $r };
+ for my $i ( 1 .. $n ) {
+ push(@FieldMatchValues, "$Fields[$i-1]=V$i");
+ push(@FieldValueTuples, "{$Fields[$i-1],V$i}");
+ push(@Values, "V$i");
+ }
+ # "@FieldMatchValues" = "field1=V1,field2=V2"...",fieldN=VN"
+ # "@FieldMatchTuples" = "{field1,V1},{field2,V2}"...",{fieldN,VN}"
+ # "@Values" = "V1,V2"...",VN"
+ my @D = @DATA;
+ foreach my $line (@D) {
+ my $m = 1;
+ # For leading * iterate $n times, otherwise once
+ $line =~ s/^\s*[*]// and $m = $n;
+ for my $i ( 1 .. $m ) {
+ # For this iteration - substitute and print
+ my $Value = "V$i";
+ my $SemicolonDot = ";";
+ $SemicolonDot = "." if $i == $m;
+ my @ValuesIgnoreValue = @Values;
+ $ValuesIgnoreValue[$i-1] = '_';
+ # "$Value" = "V1" or "V2" or ... "VN"
+ # "@ValuesIgnoreValue" = "_,V2"...",VN"
+ # or "V1,_"...",VN"
+ # or ... "V1,V2"...",_"
+ $_ = $line;
+ s/FieldMatchValues\b/@FieldMatchValues/g;
+ s/FieldValueTuples\b/@FieldValueTuples/g;
+ s/Field\b/$Fields[$i-1]/g;
+ s/Name\b/$Name/g;
+ s/Record\b/$Record/g;
+ s/ValuesIgnoreValue\b/@ValuesIgnoreValue/g;
+ s/Values\b/@Values/g;
+ s/Value\b/$Value/g;
+ s/[;][.]/$SemicolonDot/g;
+ s/->\s*/->\n /;
+ print;
+ }
+ }
+}
+for my $i ( 0 .. $#INDEX ) {
+ my $line = $INDEX[$i];
+ if ($line =~ s/^[*]//) {
+ while( my ($Name, $r) = each(%Names)) {
+ my ($Record) = @{ $r };
+ $_ = $line;
+ s/Name\b/$Name/g;
+ s/Record\b/$Record/g;
+ s/->\s*/->\n /;
+ print;
+ }
+ } else {
+ print $line;
+ }
+}
+
+# Trailing \ will merge line with the following.
+# Leading * will iterate the (merged) line over all field names.
+# Sub-words in the loop above are substituted.
+__DATA__
+
+%%
+%% Abstract Data Type functions for #Record{}
+%%
+%% -export([Name/1, Name/2,
+%% make_Name/0, make_Name/1, make_Name/2, make_Name/3]).
+
+%% Split #Record{} into property list
+%%
+Name(#Record{FieldMatchValues}) -> \
+ [FieldValueTuples].
+
+%% Get one field value from #Record{}
+%%
+*Name(#Record{Field=Value}, Field) -> \
+ Value;
+%% Map field name list to value list from #Record{}
+%%
+Name(#Record{}, []) -> \
+ [];
+*Name(#Record{Field=Value}=R, [Field|L]) -> \
+ [Value|Name(R, L)];.
+
+%% Generate default #Record{}
+%%
+make_Name() -> \
+ #Record{}.
+
+%% Generate #Record{} from property list
+%%
+make_Name(L) when is_list(L) -> \
+ make_Name(#Record{}, L).
+
+%% Generate #Record{} with one updated field
+%%
+*make_Name(Field, Value) -> \
+ #Record{Field=Value};
+%%
+%% Update #Record{} from property list
+%%
+make_Name(#Record{FieldMatchValues}, L) when is_list(L) -> \
+ do_make_Name(L, Values).
+do_make_Name([], Values) -> \
+ #Record{FieldMatchValues};
+*do_make_Name([{Field,Value}|L], ValuesIgnoreValue) -> \
+ do_make_Name(L, Values);.
+
+%% Update one field of #Record{}
+%%
+*make_Name(#Record{}=R, Field, Value) -> \
+ R#Record{Field=Value};.
+
++%% Record type index
++%%
++*record_adts(#Record{}) -> Name;
++record_adts(_) -> undefined.
diff --git a/lib/kernel/src/inet_gethost_native.erl b/lib/kernel/src/inet_gethost_native.erl
new file mode 100644
index 0000000000..abdbe2b8cf
--- /dev/null
+++ b/lib/kernel/src/inet_gethost_native.erl
@@ -0,0 +1,626 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_gethost_native).
+-behaviour(supervisor_bridge).
+
+%% Supervisor bridge exports
+-export([start_link/0, init/1, terminate/2, start_raw/0, run_once/0]).
+
+%% Server export
+-export([server_init/2, main_loop/1]).
+
+%% API exports
+-export([gethostbyname/1, gethostbyname/2, gethostbyaddr/1, control/1]).
+
+%%% Exports for sys:handle_system_msg/6
+-export([system_continue/3, system_terminate/4, system_code_change/4]).
+
+-include_lib("kernel/include/inet.hrl").
+
+-define(PROCNAME_SUP, inet_gethost_native_sup).
+
+-define(OP_GETHOSTBYNAME,1).
+-define(OP_GETHOSTBYADDR,2).
+-define(OP_CANCEL_REQUEST,3).
+-define(OP_CONTROL,4).
+
+-define(PROTO_IPV4,1).
+-define(PROTO_IPV6,2).
+
+%% OP_CONTROL
+-define(SETOPT_DEBUG_LEVEL, 0).
+
+-define(UNIT_ERROR,0).
+-define(UNIT_IPV4,4).
+-define(UNIT_IPV6,16).
+
+-define(PORT_PROGRAM, "inet_gethost").
+-define(DEFAULT_POOLSIZE, 4).
+-define(REQUEST_TIMEOUT, (inet_db:res_option(timeout)*4)).
+
+-define(MAX_TIMEOUT, 16#7FFFFFF).
+-define(INVALID_SERIAL, 16#FFFFFFFF).
+
+%-define(DEBUG,1).
+-ifdef(DEBUG).
+-define(dbg(A,B), io:format(A,B)).
+-else.
+-define(dbg(A,B), noop).
+-endif.
+
+-define(SEND_AFTER(A,B,C),erlang:send_after(A,B,C)).
+-define(CANCEL_TIMER(A),erlang:cancel_timer(A)).
+
+%% In erlang, IPV6 addresses are built as 8-tuples of 16bit values (not 16-tuples of octets).
+%% This macro, meant to be used in guards checks one such 16bit value in the 8-tuple.
+-define(VALID_V6(Part), is_integer(Part), Part < 65536).
+%% The regular IPV4 addresses are represented as 4-tuples of octets, this macro,
+%% meant to be used in guards, check one such octet.
+-define(VALID_V4(Part), is_integer(Part), Part < 256).
+
+% Requests, one per unbique request to the PORT program, may be more than one client!!!
+-record(request, {
+ rid, % Request id as sent to port
+ op,
+ proto,
+ rdata,
+ clients = [] % Can be more than one client per request (Pid's).
+}).
+
+
+% Statistics, not used yet.
+-record(statistics, {
+ netdb_timeout = 0,
+ netdb_internal = 0,
+ port_crash = 0,
+ notsup = 0,
+ host_not_found = 0,
+ try_again = 0,
+ no_recovery = 0,
+ no_data = 0
+}).
+
+% The main loopstate...
+-record(state, {
+ port = noport, % Port() connected to the port program
+ timeout = 8000, % Timeout value from inet_db:res_option
+ requests, % Table of request
+ req_index, % Table of {{op,proto,rdata},rid}
+ parent, % The supervisor bridge
+ pool_size = 4, % Number of C processes in pool.
+ statistics % Statistics record (records error causes).
+}).
+
+%% The supervisor bridge code
+init([]) -> % Called by supervisor_bridge:start_link
+ Ref = make_ref(),
+ SaveTE = process_flag(trap_exit,true),
+ Pid = spawn_link(?MODULE,server_init,[self(),Ref]),
+ receive
+ Ref ->
+ process_flag(trap_exit,SaveTE),
+ {ok, Pid, Pid};
+ {'EXIT', Pid, Message} ->
+ process_flag(trap_exit,SaveTE),
+ {error, Message}
+ after 10000 ->
+ process_flag(trap_exit,SaveTE),
+ {error, {timeout, ?MODULE}}
+ end.
+
+start_link() ->
+ supervisor_bridge:start_link({local, ?PROCNAME_SUP}, ?MODULE, []).
+
+%% Only used in fallback situations, no supervisor, no bridge, serve only until
+%% no requests present...
+start_raw() ->
+ spawn(?MODULE,run_once,[]).
+
+run_once() ->
+ Port = do_open_port(get_poolsize(), get_extra_args()),
+ Timeout = ?REQUEST_TIMEOUT,
+ {Pid, R, Request} =
+ receive
+ {{Pid0,R0}, {?OP_GETHOSTBYNAME, Proto0, Name0}} ->
+ {Pid0, R0,
+ [<<1:32, ?OP_GETHOSTBYNAME:8, Proto0:8>>,Name0,0]};
+ {{Pid1,R1}, {?OP_GETHOSTBYADDR, Proto1, Data1}} ->
+ {Pid1, R1,
+ <<1:32, ?OP_GETHOSTBYADDR:8, Proto1:8, Data1/binary>>}
+ after Timeout ->
+ exit(normal)
+ end,
+ (catch port_command(Port, Request)),
+ receive
+ {Port, {data, <<1:32, BinReply/binary>>}} ->
+ Pid ! {R, {ok, BinReply}}
+ after Timeout ->
+ Pid ! {R,{error,timeout}}
+ end.
+
+terminate(_Reason,Pid) ->
+ (catch exit(Pid,kill)),
+ ok.
+
+%%-----------------------------------------------------------------------
+%% Server API
+%%-----------------------------------------------------------------------
+server_init(Starter, Ref) ->
+ process_flag(trap_exit,true),
+ case whereis(?MODULE) of
+ undefined ->
+ case (catch register(?MODULE,self())) of
+ true ->
+ Starter ! Ref;
+ _->
+ exit({already_started,whereis(?MODULE)})
+ end;
+ Winner ->
+ exit({already_started,Winner})
+ end,
+ Poolsize = get_poolsize(),
+ Port = do_open_port(Poolsize, get_extra_args()),
+ Timeout = ?REQUEST_TIMEOUT,
+ put(rid,0),
+ put(num_requests,0),
+ RequestTab = ets:new(ign_requests,[{keypos,#request.rid},set,protected]),
+ RequestIndex = ets:new(ign_req_index,[set,protected]),
+ State = #state{port = Port, timeout = Timeout, requests = RequestTab,
+ req_index = RequestIndex,
+ pool_size = Poolsize,
+ statistics = #statistics{},
+ parent = Starter},
+ main_loop(State).
+
+main_loop(State) ->
+ receive
+ Any ->
+ handle_message(Any,State)
+ end.
+
+handle_message({{Pid,_} = Client, {?OP_GETHOSTBYNAME, Proto, Name} = R},
+ State) when is_pid(Pid) ->
+ NewState = do_handle_call(R,Client,State,
+ [<<?OP_GETHOSTBYNAME:8, Proto:8>>, Name,0]),
+ main_loop(NewState);
+
+handle_message({{Pid,_} = Client, {?OP_GETHOSTBYADDR, Proto, Data} = R},
+ State) when is_pid(Pid) ->
+ NewState = do_handle_call(R,Client,State,
+ <<?OP_GETHOSTBYADDR:8, Proto:8, Data/binary>>),
+ main_loop(NewState);
+
+handle_message({{Pid,Ref}, {?OP_CONTROL, Ctl, Data}}, State)
+ when is_pid(Pid) ->
+ catch port_command(State#state.port,
+ <<?INVALID_SERIAL:32, ?OP_CONTROL:8,
+ Ctl:8, Data/binary>>),
+ Pid ! {Ref, ok},
+ main_loop(State);
+
+handle_message({{Pid,Ref}, restart_port}, State)
+ when is_pid(Pid) ->
+ NewPort=restart_port(State),
+ Pid ! {Ref, ok},
+ main_loop(State#state{port=NewPort});
+
+handle_message({Port, {data, Data}}, State = #state{port = Port}) ->
+ NewState = case Data of
+ <<RID:32, BinReply/binary>> ->
+ case BinReply of
+ <<Unit, _/binary>> when Unit =:= ?UNIT_ERROR;
+ Unit =:= ?UNIT_IPV4;
+ Unit =:= ?UNIT_IPV6 ->
+ case pick_request(State,RID) of
+ false ->
+ State;
+ Req ->
+ lists:foreach(fun({P,R,TR}) ->
+ ?CANCEL_TIMER(TR),
+ P ! {R,
+ {ok,
+ BinReply}}
+ end,
+ Req#request.clients),
+ State
+ end;
+ _UnitError ->
+ %% Unexpected data, let's restart it,
+ %% it must be broken.
+ NewPort=restart_port(State),
+ State#state{port=NewPort}
+ end;
+ _BasicFormatError ->
+ NewPort=restart_port(State),
+ State#state{port=NewPort}
+ end,
+ main_loop(NewState);
+
+handle_message({'EXIT',Port,_Reason}, State = #state{port = Port}) ->
+ ?dbg("Port died.~n",[]),
+ NewPort=restart_port(State),
+ main_loop(State#state{port=NewPort});
+
+handle_message({Port,eof}, State = #state{port = Port}) ->
+ ?dbg("Port eof'ed.~n",[]),
+ NewPort=restart_port(State),
+ main_loop(State#state{port=NewPort});
+
+handle_message({timeout, Pid, RID}, State) ->
+ case pick_client(State,RID,Pid) of
+ false ->
+ false;
+ {more, {P,R,_}} ->
+ P ! {R,{error,timeout}};
+ {last, {LP,LR,_}} ->
+ LP ! {LR, {error,timeout}},
+ %% Remove the whole request structure...
+ pick_request(State, RID),
+ %% Also cancel the request to the port program...
+ (catch port_command(State#state.port,
+ <<RID:32,?OP_CANCEL_REQUEST>>))
+ end,
+ main_loop(State);
+
+handle_message({system, From, Req}, State) ->
+ sys:handle_system_msg(Req, From, State#state.parent, ?MODULE, [],
+ State);
+
+handle_message(_, State) -> % Stray messages from dying ports etc.
+ main_loop(State).
+
+
+do_handle_call(R,Client0,State,RData) ->
+ Req = find_request(State,R),
+ Timeout = State#state.timeout,
+ {P,Ref} = Client0,
+ TR = ?SEND_AFTER(Timeout,self(),{timeout, P, Req#request.rid}),
+ Client = {P,Ref,TR},
+ case Req#request.clients of
+ [] ->
+ RealRData = [<<(Req#request.rid):32>>|RData],
+ (catch port_command(State#state.port, RealRData)),
+ ets:insert(State#state.requests,Req#request{clients = [Client]});
+ Tail ->
+ ets:insert(State#state.requests,Req#request{clients = [Client | Tail]})
+ end,
+ State.
+
+find_request(State, R = {Op, Proto, Data}) ->
+ case ets:lookup(State#state.req_index,R) of
+ [{R, Rid}] ->
+ [Ret] = ets:lookup(State#state.requests,Rid),
+ Ret;
+ [] ->
+ NRid = get_rid(),
+ Req = #request{rid = NRid, op = Op, proto = Proto, rdata = Data},
+ ets:insert(State#state.requests, Req),
+ ets:insert(State#state.req_index,{R,NRid}),
+ put(num_requests,get(num_requests) + 1),
+ Req
+ end.
+
+pick_request(State, RID) ->
+ case ets:lookup(State#state.requests, RID) of
+ [] ->
+ false;
+ [#request{rid = RID, op = Op, proto = Proto, rdata = Data}=R] ->
+ ets:delete(State#state.requests,RID),
+ ets:delete(State#state.req_index,{Op,Proto,Data}),
+ put(num_requests,get(num_requests) - 1),
+ R
+ end.
+
+pick_client(State,RID,Clid) ->
+ case ets:lookup(State#state.requests, RID) of
+ [] ->
+ false;
+ [R] ->
+ case R#request.clients of
+ [SoleClient] ->
+ {last, SoleClient}; % Note, not removed, the caller
+ % should cleanup request data
+ CList ->
+ case lists:keysearch(Clid,1,CList) of
+ {value, Client} ->
+ NCList = lists:keydelete(Clid,1,CList),
+ ets:insert(State#state.requests,
+ R#request{clients = NCList}),
+ {more, Client};
+ false ->
+ false
+ end
+ end
+ end.
+
+get_rid () ->
+ New = (get(rid) + 1) rem 16#7FFFFFF,
+ put(rid,New),
+ New.
+
+
+foreach(Fun,Table) ->
+ foreach(Fun,Table,ets:first(Table)).
+
+foreach(_Fun,_Table,'$end_of_table') ->
+ ok;
+foreach(Fun,Table,Key) ->
+ [Object] = ets:lookup(Table,Key),
+ Fun(Object),
+ foreach(Fun,Table,ets:next(Table,Key)).
+
+restart_port(#state{port = Port, requests = Requests}) ->
+ (catch port_close(Port)),
+ NewPort = do_open_port(get_poolsize(), get_extra_args()),
+ foreach(fun(#request{rid = Rid, op = Op, proto = Proto, rdata = Rdata}) ->
+ case Op of
+ ?OP_GETHOSTBYNAME ->
+ port_command(NewPort,[<<Rid:32,?OP_GETHOSTBYNAME:8,
+ Proto:8>>,
+ Rdata,0]);
+ ?OP_GETHOSTBYADDR ->
+ port_command(NewPort,
+ <<Rid:32,?OP_GETHOSTBYADDR:8, Proto:8,
+ Rdata/binary>>)
+ end
+ end,
+ Requests),
+ NewPort.
+
+
+
+do_open_port(Poolsize, ExtraArgs) ->
+ try
+ open_port({spawn,
+ ?PORT_PROGRAM++" "++integer_to_list(Poolsize)++" "++
+ ExtraArgs},
+ [{packet,4},eof,binary,overlapped_io])
+ catch
+ error:_ ->
+ open_port({spawn,
+ ?PORT_PROGRAM++" "++integer_to_list(Poolsize)++
+ " "++ExtraArgs},
+ [{packet,4},eof,binary])
+ end.
+
+get_extra_args() ->
+ FirstPart = case application:get_env(kernel, gethost_prioritize) of
+ {ok, false} ->
+ " -ng";
+ _ ->
+ ""
+ end,
+ case application:get_env(kernel, gethost_extra_args) of
+ {ok, L} when is_list(L) ->
+ FirstPart++" "++L;
+ _ ->
+ FirstPart++""
+ end.
+
+get_poolsize() ->
+ case application:get_env(kernel, gethost_poolsize) of
+ {ok,I} when is_integer(I) ->
+ I;
+ _ ->
+ ?DEFAULT_POOLSIZE
+ end.
+
+%%------------------------------------------------------------------
+%% System messages callbacks
+%%------------------------------------------------------------------
+
+system_continue(_Parent, _, State) ->
+ main_loop(State).
+
+system_terminate(Reason, _Parent, _, _State) ->
+ exit(Reason).
+
+system_code_change(State, _Module, _OldVsn, _Extra) ->
+ {ok, State}. %% Nothing to do in this version.
+
+
+%%-----------------------------------------------------------------------
+%% Client API
+%%-----------------------------------------------------------------------
+
+gethostbyname(Name) ->
+ gethostbyname(Name, inet).
+
+gethostbyname(Name, inet) when is_list(Name) ->
+ getit(?OP_GETHOSTBYNAME, ?PROTO_IPV4, Name);
+gethostbyname(Name, inet6) when is_list(Name) ->
+ getit(?OP_GETHOSTBYNAME, ?PROTO_IPV6, Name);
+gethostbyname(Name, Type) when is_atom(Name) ->
+ gethostbyname(atom_to_list(Name), Type);
+gethostbyname(_, _) ->
+ {error, formerr}.
+
+gethostbyaddr({A,B,C,D}) when ?VALID_V4(A), ?VALID_V4(B), ?VALID_V4(C), ?VALID_V4(D) ->
+ getit(?OP_GETHOSTBYADDR, ?PROTO_IPV4, <<A,B,C,D>>);
+gethostbyaddr({A,B,C,D,E,F,G,H}) when ?VALID_V6(A), ?VALID_V6(B), ?VALID_V6(C), ?VALID_V6(D),
+ ?VALID_V6(E), ?VALID_V6(F), ?VALID_V6(G), ?VALID_V6(H) ->
+ getit(?OP_GETHOSTBYADDR, ?PROTO_IPV6, <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16>>);
+gethostbyaddr(Addr) when is_list(Addr) ->
+ case inet_parse:address(Addr) of
+ {ok, IP} -> gethostbyaddr(IP);
+ _Error -> {error, formerr}
+ end;
+gethostbyaddr(Addr) when is_atom(Addr) ->
+ gethostbyaddr(atom_to_list(Addr));
+gethostbyaddr(_) -> {error, formerr}.
+
+control({debug_level, Level}) when is_integer(Level) ->
+ getit(?OP_CONTROL, ?SETOPT_DEBUG_LEVEL, <<Level:32>>);
+control(soft_restart) ->
+ getit(restart_port);
+control(_) -> {error, formerr}.
+
+getit(Op, Proto, Data) ->
+ getit({Op, Proto, Data}).
+
+getit(Req) ->
+ Pid = ensure_started(),
+ Ref = make_ref(),
+ Pid ! {{self(),Ref}, Req},
+ receive
+ {Ref, {ok,BinHostent}} ->
+ parse_address(BinHostent);
+ {Ref, Error} ->
+ Error
+ after 5000 ->
+ Ref2 = erlang:monitor(process,Pid),
+ Res2 = receive
+ {Ref, {ok,BinHostent}} ->
+ parse_address(BinHostent);
+ {Ref, Error} ->
+ Error;
+ {'DOWN', Ref2, process,
+ Pid, Reason} ->
+ {error, Reason}
+ end,
+ catch erlang:demonitor(Ref2),
+ receive {'DOWN',Ref2,_,_,_} -> ok after 0 -> ok end,
+ Res2
+ end.
+
+do_start(Sup, C) ->
+ {Child,_,_,_,_,_} = C,
+ case supervisor:start_child(Sup,C) of
+ {ok,_} ->
+ ok;
+ {error, {already_started, Pid}} when is_pid(Pid) ->
+ ok;
+ {error, {{already_started, Pid}, _Child}} when is_pid(Pid) ->
+ ok;
+ {error, already_present} ->
+ supervisor:delete_child(Sup, Child),
+ do_start(Sup, C)
+ end.
+
+ensure_started() ->
+ case whereis(?MODULE) of
+ undefined ->
+ C = {?PROCNAME_SUP, {?MODULE, start_link, []}, temporary,
+ 1000, worker, [?MODULE]},
+ case whereis(kernel_safe_sup) of
+ undefined ->
+ case whereis(net_sup) of
+ undefined ->
+ %% Icky fallback, run once without supervisor
+ start_raw();
+ _ ->
+ do_start(net_sup,C),
+ case whereis(?MODULE) of
+ undefined ->
+ exit({could_not_start_server, ?MODULE});
+ Pid0 ->
+ Pid0
+ end
+ end;
+ _ ->
+ do_start(kernel_safe_sup,C),
+ case whereis(?MODULE) of
+ undefined ->
+ exit({could_not_start_server, ?MODULE});
+ Pid1 ->
+ Pid1
+ end
+ end;
+ Pid ->
+ Pid
+ end.
+
+parse_address(BinHostent) ->
+ case catch
+ begin
+ case BinHostent of
+ <<?UNIT_ERROR, Errstring/binary>> ->
+ {error, list_to_atom(listify(Errstring))};
+ <<?UNIT_IPV4, Naddr:32, T0/binary>> ->
+ {T1,Addresses} = pick_addresses_v4(Naddr, T0),
+ [Name | Names] = pick_names(T1),
+ {ok, #hostent{h_addr_list = Addresses, h_addrtype = inet,
+ h_aliases = Names, h_length = ?UNIT_IPV4,
+ h_name = Name}};
+ <<?UNIT_IPV6, Naddr:32, T0/binary>> ->
+ {T1,Addresses} = pick_addresses_v6(Naddr, T0),
+ [Name | Names] = pick_names(T1),
+ {ok, #hostent{h_addr_list = Addresses, h_addrtype = inet6,
+ h_aliases = Names, h_length = ?UNIT_IPV6,
+ h_name = Name}};
+ _Else ->
+ {error, {internal_error, {malformed_response, BinHostent}}}
+ end
+ end of
+ {'EXIT', Reason} ->
+ Reason;
+ Normal ->
+ Normal
+ end.
+
+listify(Bin) ->
+ N = byte_size(Bin) - 1,
+ <<Bin2:N/binary, Ch>> = Bin,
+ case Ch of
+ 0 ->
+ listify(Bin2);
+ _ ->
+ binary_to_list(Bin)
+ end.
+
+pick_addresses_v4(0,Tail) ->
+ {Tail,[]};
+pick_addresses_v4(N,<<A,B,C,D,Tail/binary>>) ->
+ {NTail, OList} = pick_addresses_v4(N-1,Tail),
+ {NTail, [{A,B,C,D} | OList]}.
+
+pick_addresses_v6(0,Tail) ->
+ {Tail,[]};
+pick_addresses_v6(Num,<<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,
+ Tail/binary>>) ->
+ {NTail, OList} = pick_addresses_v6(Num-1,Tail),
+ {NTail, [{A,B,C,D,E,F,G,H} | OList]}.
+
+ndx(Ch,Bin) ->
+ ndx(Ch,0,byte_size(Bin),Bin).
+
+ndx(_,N,N,_) ->
+ undefined;
+ndx(Ch,I,N,Bin) ->
+ case Bin of
+ <<_:I/binary,Ch,_/binary>> ->
+ I;
+ _ ->
+ ndx(Ch,I+1,N,Bin)
+ end.
+
+pick_names(<<Length:32,Namelist/binary>>) ->
+ pick_names(Length,Namelist).
+
+pick_names(0,<<>>) ->
+ [];
+pick_names(0,_) ->
+ exit({error,format_error});
+pick_names(_N,<<>>) ->
+ exit({error,format_error});
+pick_names(N,Bin) ->
+ Ndx = ndx(0,Bin),
+ <<Str:Ndx/binary,0,Rest/binary>> = Bin,
+ [binary_to_list(Str)|pick_names(N-1,Rest)].
+
diff --git a/lib/kernel/src/inet_hosts.erl b/lib/kernel/src/inet_hosts.erl
new file mode 100644
index 0000000000..df1d4fc0be
--- /dev/null
+++ b/lib/kernel/src/inet_hosts.erl
@@ -0,0 +1,123 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_hosts).
+
+%% Implement gethostbyname gethostbyaddr for inet_hosts table
+
+-export([gethostbyname/1, gethostbyname/2, gethostbyaddr/1]).
+
+-include("inet.hrl").
+-include("inet_int.hrl").
+
+gethostbyname(Name) when is_list(Name) ->
+ gethostbyname(Name,
+ case inet_db:res_option(inet6) of
+ true -> inet6;
+ false -> inet
+ end);
+gethostbyname(Name) when is_atom(Name) ->
+ gethostbyname(atom_to_list(Name));
+gethostbyname(_) -> {error, formerr}.
+
+
+
+gethostbyname(Name, Type) when is_list(Name), is_atom(Type) ->
+ case gethostbyname(Name, Type, inet_hosts_byname, inet_hosts_byaddr) of
+ false ->
+ case gethostbyname(Name, Type,
+ inet_hosts_file_byname,
+ inet_hosts_file_byaddr) of
+ false -> {error,nxdomain};
+ Hostent -> {ok,Hostent}
+ end;
+ Hostent -> {ok,Hostent}
+ end;
+gethostbyname(Name, Type) when is_atom(Name), is_atom(Type) ->
+ gethostbyname(atom_to_list(Name), Type);
+gethostbyname(_, _) -> {error, formerr}.
+
+gethostbyname(Name, Type, Byname, Byaddr) ->
+ inet_db:res_update_hosts(),
+ case [I || [I] <- ets:match(Byname, {Name,Type,'$1'})] of
+ [] -> false;
+ [IP|_]=IPs ->
+ %% Use the primary IP address to generate aliases
+ [Nm|As] = [N || [N] <- ets:match(Byaddr,
+ {'$1',Type,IP})],
+ make_hostent(Nm, IPs, As, Type)
+ end.
+
+
+
+
+gethostbyaddr({A,B,C,D}=IP) when ?ip(A,B,C,D) ->
+ gethostbyaddr(IP, inet);
+%% ipv4 only ipv6 address
+gethostbyaddr({0,0,0,0,0,16#ffff=F,G,H}) when ?ip6(0,0,0,0,0,F,G,H) ->
+ gethostbyaddr({G bsr 8, G band 255, H bsr 8, H band 255});
+gethostbyaddr({A,B,C,D,E,F,G,H}=IP) when ?ip6(A,B,C,D,E,F,G,H) ->
+ gethostbyaddr(IP, inet6);
+gethostbyaddr(Addr) when is_list(Addr) ->
+ case inet_parse:address(Addr) of
+ {ok,IP} -> gethostbyaddr(IP);
+ _Error -> {error, formerr}
+ end;
+gethostbyaddr(Addr) when is_atom(Addr) ->
+ gethostbyaddr(atom_to_list(Addr));
+gethostbyaddr(_) -> {error, formerr}.
+
+
+
+gethostbyaddr(IP, Type) ->
+ case gethostbyaddr(IP, Type, inet_hosts_byaddr) of
+ false ->
+ case gethostbyaddr(IP, Type, inet_hosts_file_byaddr) of
+ false -> {error,nxdomain};
+ Hostent -> {ok,Hostent}
+ end;
+ Hostent -> {ok,Hostent}
+ end.
+
+gethostbyaddr(IP, Type, Byaddr) ->
+ inet_db:res_update_hosts(),
+ case [N || [N] <- ets:match(Byaddr, {'$1',Type,IP})] of
+ [] -> false;
+ [Nm|As] -> make_hostent(Nm, [IP], As, Type)
+ end.
+
+
+
+make_hostent(Name, Addrs, Aliases, inet) ->
+ #hostent {
+ h_name = Name,
+ h_addrtype = inet,
+ h_length = 4,
+ h_addr_list = Addrs,
+ h_aliases = Aliases
+ };
+make_hostent(Name, Addrs, Aliases, inet6) ->
+ #hostent {
+ h_name = Name,
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = Addrs,
+ h_aliases = Aliases
+ }.
+
+
diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl
new file mode 100644
index 0000000000..cf357b7fba
--- /dev/null
+++ b/lib/kernel/src/inet_int.hrl
@@ -0,0 +1,414 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%----------------------------------------------------------------------------
+%% Interface constants.
+%%
+%% This section must be "identical" to the corresponding in inet_drv.c
+%%
+
+%% family codes to open
+-define(INET_AF_INET, 1).
+-define(INET_AF_INET6, 2).
+-define(INET_AF_ANY, 3). % Fake for ANY in any address family
+-define(INET_AF_LOOPBACK, 4). % Fake for LOOPBACK in any address family
+
+%% type codes (gettype, INET_REQ_GETTYPE)
+-define(INET_TYPE_STREAM, 1).
+-define(INET_TYPE_DGRAM, 2).
+-define(INET_TYPE_SEQPACKET, 3).
+
+%% socket modes, INET_LOPT_MODE
+-define(INET_MODE_LIST, 0).
+-define(INET_MODE_BINARY, 1).
+
+%% deliver mode, INET_LOPT_DELIVER
+-define(INET_DELIVER_PORT, 0).
+-define(INET_DELIVER_TERM, 1).
+
+%% active socket, INET_LOPT_ACTIVE
+-define(INET_PASSIVE, 0).
+-define(INET_ACTIVE, 1).
+-define(INET_ONCE, 2). % Active once then passive
+
+%% state codes (getstatus, INET_REQ_GETSTATUS)
+-define(INET_F_OPEN, 16#0001).
+-define(INET_F_BOUND, 16#0002).
+-define(INET_F_ACTIVE, 16#0004).
+-define(INET_F_LISTEN, 16#0008).
+-define(INET_F_CON, 16#0010).
+-define(INET_F_ACC, 16#0020).
+-define(INET_F_LST, 16#0040).
+-define(INET_F_BUSY, 16#0080).
+
+%% request codes (erlang:port_control/3)
+-define(INET_REQ_OPEN, 1).
+-define(INET_REQ_CLOSE, 2).
+-define(INET_REQ_CONNECT, 3).
+-define(INET_REQ_PEER, 4).
+-define(INET_REQ_NAME, 5).
+-define(INET_REQ_BIND, 6).
+-define(INET_REQ_SETOPTS, 7).
+-define(INET_REQ_GETOPTS, 8).
+-define(INET_REQ_GETIX, 9).
+%% -define(INET_REQ_GETIF, 10). OBSOLETE
+-define(INET_REQ_GETSTAT, 11).
+-define(INET_REQ_GETHOSTNAME, 12).
+-define(INET_REQ_FDOPEN, 13).
+-define(INET_REQ_GETFD, 14).
+-define(INET_REQ_GETTYPE, 15).
+-define(INET_REQ_GETSTATUS, 16).
+-define(INET_REQ_GETSERVBYNAME, 17).
+-define(INET_REQ_GETSERVBYPORT, 18).
+-define(INET_REQ_SETNAME, 19).
+-define(INET_REQ_SETPEER, 20).
+-define(INET_REQ_GETIFLIST, 21).
+-define(INET_REQ_IFGET, 22).
+-define(INET_REQ_IFSET, 23).
+-define(INET_REQ_SUBSCRIBE, 24).
+%% TCP requests
+-define(TCP_REQ_ACCEPT, 40).
+-define(TCP_REQ_LISTEN, 41).
+-define(TCP_REQ_RECV, 42).
+-define(TCP_REQ_UNRECV, 43).
+-define(TCP_REQ_SHUTDOWN, 44).
+%% UDP and SCTP requests
+-define(PACKET_REQ_RECV, 60).
+-define(SCTP_REQ_LISTEN, 61).
+-define(SCTP_REQ_BINDX, 62). %% Multi-home SCTP bind
+
+%% subscribe codes, INET_REQ_SUBSCRIBE
+-define(INET_SUBS_EMPTY_OUT_Q, 1).
+
+%% reply codes for *_REQ_*
+-define(INET_REP_ERROR, 0).
+-define(INET_REP_OK, 1).
+-define(INET_REP_SCTP, 2).
+
+%% INET, TCP and UDP options:
+-define(INET_OPT_REUSEADDR, 0).
+-define(INET_OPT_KEEPALIVE, 1).
+-define(INET_OPT_DONTROUTE, 2).
+-define(INET_OPT_LINGER, 3).
+-define(INET_OPT_BROADCAST, 4).
+-define(INET_OPT_OOBINLINE, 5).
+-define(INET_OPT_SNDBUF, 6).
+-define(INET_OPT_RCVBUF, 7).
+-define(INET_OPT_PRIORITY, 8).
+-define(INET_OPT_TOS, 9).
+-define(TCP_OPT_NODELAY, 10).
+-define(UDP_OPT_MULTICAST_IF, 11).
+-define(UDP_OPT_MULTICAST_TTL, 12).
+-define(UDP_OPT_MULTICAST_LOOP, 13).
+-define(UDP_OPT_ADD_MEMBERSHIP, 14).
+-define(UDP_OPT_DROP_MEMBERSHIP, 15).
+% "Local" options: codes start from 20:
+-define(INET_LOPT_BUFFER, 20).
+-define(INET_LOPT_HEADER, 21).
+-define(INET_LOPT_ACTIVE, 22).
+-define(INET_LOPT_PACKET, 23).
+-define(INET_LOPT_MODE, 24).
+-define(INET_LOPT_DELIVER, 25).
+-define(INET_LOPT_EXITONCLOSE, 26).
+-define(INET_LOPT_TCP_HIWTRMRK, 27).
+-define(INET_LOPT_TCP_LOWTRMRK, 28).
+-define(INET_LOPT_BIT8, 29).
+-define(INET_LOPT_TCP_SEND_TIMEOUT, 30).
+-define(INET_LOPT_TCP_DELAY_SEND, 31).
+-define(INET_LOPT_PACKET_SIZE, 32).
+-define(INET_LOPT_READ_PACKETS, 33).
+-define(INET_OPT_RAW, 34).
+-define(INET_LOPT_TCP_SEND_TIMEOUT_CLOSE, 35).
+% Specific SCTP options: separate range:
+-define(SCTP_OPT_RTOINFO, 100).
+-define(SCTP_OPT_ASSOCINFO, 101).
+-define(SCTP_OPT_INITMSG, 102).
+-define(SCTP_OPT_AUTOCLOSE, 103).
+-define(SCTP_OPT_NODELAY, 104).
+-define(SCTP_OPT_DISABLE_FRAGMENTS, 105).
+-define(SCTP_OPT_I_WANT_MAPPED_V4_ADDR, 106).
+-define(SCTP_OPT_MAXSEG, 107).
+-define(SCTP_OPT_SET_PEER_PRIMARY_ADDR, 108).
+-define(SCTP_OPT_PRIMARY_ADDR, 109).
+-define(SCTP_OPT_ADAPTATION_LAYER, 110).
+-define(SCTP_OPT_PEER_ADDR_PARAMS, 111).
+-define(SCTP_OPT_DEFAULT_SEND_PARAM, 112).
+-define(SCTP_OPT_EVENTS, 113).
+-define(SCTP_OPT_DELAYED_ACK_TIME, 114).
+-define(SCTP_OPT_STATUS, 115).
+-define(SCTP_OPT_GET_PEER_ADDR_INFO, 116).
+
+%% interface options, INET_REQ_IFGET and INET_REQ_IFSET
+-define(INET_IFOPT_ADDR, 1).
+-define(INET_IFOPT_BROADADDR, 2).
+-define(INET_IFOPT_DSTADDR, 3).
+-define(INET_IFOPT_MTU, 4).
+-define(INET_IFOPT_NETMASK, 5).
+-define(INET_IFOPT_FLAGS, 6).
+-define(INET_IFOPT_HWADDR, 7). %% where support (e.g linux)
+
+%% packet byte values, INET_LOPT_PACKET
+-define(TCP_PB_RAW, 0).
+-define(TCP_PB_1, 1).
+-define(TCP_PB_2, 2).
+-define(TCP_PB_4, 3).
+-define(TCP_PB_ASN1, 4).
+-define(TCP_PB_RM, 5).
+-define(TCP_PB_CDR, 6).
+-define(TCP_PB_FCGI, 7).
+-define(TCP_PB_LINE_LF, 8).
+-define(TCP_PB_TPKT, 9).
+-define(TCP_PB_HTTP, 10).
+-define(TCP_PB_HTTPH, 11).
+-define(TCP_PB_SSL_TLS, 12).
+-define(TCP_PB_HTTP_BIN,13).
+-define(TCP_PB_HTTPH_BIN,14).
+
+%% bit options, INET_LOPT_BIT8
+-define(INET_BIT8_CLEAR, 0).
+-define(INET_BIT8_SET, 1).
+-define(INET_BIT8_ON, 2).
+-define(INET_BIT8_OFF, 3).
+
+
+%% getstat, INET_REQ_GETSTAT
+-define(INET_STAT_RECV_CNT, 1).
+-define(INET_STAT_RECV_MAX, 2).
+-define(INET_STAT_RECV_AVG, 3).
+-define(INET_STAT_RECV_DVI, 4).
+-define(INET_STAT_SEND_CNT, 5).
+-define(INET_STAT_SEND_MAX, 6).
+-define(INET_STAT_SEND_AVG, 7).
+-define(INET_STAT_SEND_PEND, 8).
+-define(INET_STAT_RECV_OCT, 9).
+-define(INET_STAT_SEND_OCT, 10).
+
+%% interface stuff, INET_IFOPT_FLAGS
+-define(INET_IFNAMSIZ, 16).
+-define(INET_IFF_UP, 16#0001).
+-define(INET_IFF_BROADCAST, 16#0002).
+-define(INET_IFF_LOOPBACK, 16#0004).
+-define(INET_IFF_POINTTOPOINT, 16#0008).
+-define(INET_IFF_RUNNING, 16#0010).
+-define(INET_IFF_MULTICAST, 16#0020).
+%%
+-define(INET_IFF_DOWN, 16#0100).
+-define(INET_IFF_NBROADCAST, 16#0200).
+-define(INET_IFF_NPOINTTOPOINT, 16#0800).
+
+%% SCTP Flags for "sctp_sndrcvinfo":
+%% INET_REQ_SETOPTS:SCTP_OPT_DEFAULT_SEND_PARAM
+-define(SCTP_FLAG_UNORDERED, 1). % sctp_unordered
+-define(SCTP_FLAG_ADDR_OVER, 2). % sctp_addr_over
+-define(SCTP_FLAG_ABORT, 4). % sctp_abort
+-define(SCTP_FLAG_EOF, 8). % sctp_eof
+-define(SCTP_FLAG_SNDALL, 16). % sctp_sndall, NOT YET IMPLEMENTED.
+
+%% SCTP Flags for "sctp_paddrparams", and the corresp Atoms:
+-define(SCTP_FLAG_HB_ENABLE, 1). % sctp_hb_enable
+-define(SCTP_FLAG_HB_DISABLE, 2). % sctp_hb_disable
+-define(SCTP_FLAG_HB_DEMAND, 4). % sctp_hb_demand
+-define(SCTP_FLAG_PMTUD_ENABLE, 8). % sctp_pmtud_enable
+-define(SCTP_FLAG_PMTUD_DISABLE, 16). % sctp_pmtud_disable
+-define(SCTP_FLAG_SACKDELAY_ENABLE, 32). % sctp_sackdelay_enable
+-define(SCTP_FLAG_SACKDELAY_DISABLE, 64). % sctp_sackdelay_disable
+
+%%
+%% End of interface constants.
+%%----------------------------------------------------------------------------
+
+-define(LISTEN_BACKLOG, 5). %% default backlog
+
+%% 5 secs need more ???
+-define(INET_CLOSE_TIMEOUT, 5000).
+
+%%
+%% Port/socket numbers: network standard functions
+%%
+-define(IPPORT_ECHO, 7).
+-define(IPPORT_DISCARD, 9).
+-define(IPPORT_SYSTAT, 11).
+-define(IPPORT_DAYTIME, 13).
+-define(IPPORT_NETSTAT, 15).
+-define(IPPORT_FTP, 21).
+-define(IPPORT_TELNET, 23).
+-define(IPPORT_SMTP, 25).
+-define(IPPORT_TIMESERVER, 37).
+-define(IPPORT_NAMESERVER, 42).
+-define(IPPORT_WHOIS, 43).
+-define(IPPORT_MTP, 57).
+
+%%
+%% Port/socket numbers: host specific functions
+%%
+-define(IPPORT_TFTP, 69).
+-define(IPPORT_RJE, 77).
+-define(IPPORT_FINGER, 79).
+-define(IPPORT_TTYLINK, 87).
+-define(IPPORT_SUPDUP, 95).
+
+%%
+%% UNIX TCP sockets
+%%
+-define(IPPORT_EXECSERVER, 512).
+-define(IPPORT_LOGINSERVER, 513).
+-define(IPPORT_CMDSERVER, 514).
+-define(IPPORT_EFSSERVER, 520).
+
+%%
+%% UNIX UDP sockets
+%%
+-define(IPPORT_BIFFUDP, 512).
+-define(IPPORT_WHOSERVER, 513).
+-define(IPPORT_ROUTESERVER, 520). %% 520+1 also used
+
+
+%%
+%% Ports < IPPORT_RESERVED are reserved for
+%% privileged processes (e.g. root).
+%% Ports > IPPORT_USERRESERVED are reserved
+%% for servers, not necessarily privileged.
+%%
+-define(IPPORT_RESERVED, 1024).
+-define(IPPORT_USERRESERVED, 5000).
+
+%% standard port for socks
+-define(IPPORT_SOCKS, 1080).
+
+%%
+%% Int to bytes
+%%
+-define(int8(X), [(X) band 16#ff]).
+
+-define(int16(X), [((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(int24(X), [((X) bsr 16) band 16#ff,
+ ((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(int32(X),
+ [((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff,
+ ((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(intAID(X), % For SCTP AssocID
+ ?int32(X)).
+
+%% Bytes to unsigned
+-define(u64(X7,X6,X5,X4,X3,X2,X1,X0),
+ ( ((X7) bsl 56) bor ((X6) bsl 48) bor ((X5) bsl 40) bor
+ ((X4) bsl 32) bor ((X3) bsl 24) bor ((X2) bsl 16) bor
+ ((X1) bsl 8) bor (X0) )).
+
+-define(u32(X3,X2,X1,X0),
+ (((X3) bsl 24) bor ((X2) bsl 16) bor ((X1) bsl 8) bor (X0))).
+
+-define(u24(X2,X1,X0),
+ (((X2) bsl 16) bor ((X1) bsl 8) bor (X0))).
+
+-define(u16(X1,X0),
+ (((X1) bsl 8) bor (X0))).
+
+-define(u8(X0), (X0)).
+
+%% Bytes to signed
+-define(i32(X3,X2,X1,X0),
+ (?u32(X3,X2,X1,X0) -
+ (if (X3) > 127 -> 16#100000000; true -> 0 end))).
+
+-define(i24(X2,X1,X0),
+ (?u24(X2,X1,X0) -
+ (if (X2) > 127 -> 16#1000000; true -> 0 end))).
+
+-define(i16(X1,X0),
+ (?u16(X1,X0) -
+ (if (X1) > 127 -> 16#10000; true -> 0 end))).
+
+-define(i8(X0),
+ (?u8(X0) -
+ (if (X0) > 127 -> 16#100; true -> 0 end))).
+
+%% macro for use in guard for checking ip address {A,B,C,D}
+-define(ip(A,B,C,D),
+ (((A) bor (B) bor (C) bor (D)) band (bnot 16#ff)) =:= 0).
+
+-define(ip6(A,B,C,D,E,F,G,H),
+ (((A) bor (B) bor (C) bor (D) bor (E) bor (F) bor (G) bor (H))
+ band (bnot 16#ffff)) =:= 0).
+
+-define(ether(A,B,C,D,E,F),
+ (((A) bor (B) bor (C) bor (D) bor (E) bor (F))
+ band (bnot 16#ff)) =:= 0).
+
+-define(port(P), (((P) band bnot 16#ffff) =:= 0)).
+
+%% default options (when inet_drv port is started)
+%%
+%% bufsz = INET_MIN_BUFFER (8K)
+%% header = 0
+%% packet = 0 (raw)
+%% mode = list
+%% deliver = term
+%% active = false
+%%
+-record(connect_opts,
+ {
+ ifaddr = any, %% bind to interface address
+ port = 0, %% bind to port (default is dynamic port)
+ fd = -1, %% fd >= 0 => already bound
+ opts = [] %% [{active,true}] added in inet:connect_options
+ }).
+
+-record(listen_opts,
+ {
+ ifaddr = any, %% bind to interface address
+ port = 0, %% bind to port (default is dynamic port)
+ backlog = ?LISTEN_BACKLOG, %% backlog
+ fd = -1, %% %% fd >= 0 => already bound
+ opts = [] %% [{active,true}] added in
+ %% inet:listen_options
+ }).
+
+-record(udp_opts,
+ {
+ ifaddr = any,
+ port = 0,
+ fd = -1,
+ opts = [{active,true}]
+ }).
+
+-define(SCTP_DEF_BUFSZ, 65536).
+-define(SCTP_DEF_IFADDR, any).
+-record(sctp_opts,
+ {
+ ifaddr,
+ port = 0,
+ fd = -1,
+ opts = [{mode, binary},
+ {buffer, ?SCTP_DEF_BUFSZ},
+ {sndbuf, ?SCTP_DEF_BUFSZ},
+ {recbuf, 1024},
+ {sctp_events, undefined}%,
+ %%{active, true}
+ ]
+ }).
+
+%% The following Tags are purely internal, used for marking items in the
+%% send buffer:
+-define(SCTP_TAG_SEND_ANC_INITMSG, 0).
+-define(SCTP_TAG_SEND_ANC_PARAMS, 1).
+-define(SCTP_TAG_SEND_DATA, 2).
diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl
new file mode 100644
index 0000000000..62d44fb723
--- /dev/null
+++ b/lib/kernel/src/inet_parse.erl
@@ -0,0 +1,755 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_parse).
+
+%% Parser for all kinds of ineternet configuration files
+
+-export([hosts/1, hosts/2]).
+-export([hosts_vxworks/1]).
+-export([protocols/1, protocols/2]).
+-export([netmasks/1, netmasks/2]).
+-export([networks/1, networks/2]).
+-export([services/1, services/2]).
+-export([rpc/1, rpc/2]).
+-export([resolv/1, resolv/2]).
+-export([host_conf_linux/1, host_conf_linux/2]).
+-export([host_conf_freebsd/1, host_conf_freebsd/2]).
+-export([host_conf_bsdos/1, host_conf_bsdos/2]).
+-export([nsswitch_conf/1, nsswitch_conf/2]).
+
+-export([ipv4_address/1, ipv6_address/1]).
+-export([address/1]).
+-export([visible_string/1, domain/1]).
+-export([ntoa/1, dots/1]).
+-export([split_line/1]).
+
+-import(lists, [reverse/1]).
+
+-include_lib("kernel/include/file.hrl").
+
+%% --------------------------------------------------------------------------
+%% Parse services internet style
+%% Syntax:
+%% Name Port/Protocol [Aliases] \n
+%% # comment
+%% --------------------------------------------------------------------------
+
+services(File) ->
+ services(noname, File).
+
+services(Fname, File) ->
+ Fn = fun([Name, PortProto | Aliases]) ->
+ {Proto,Port} = port_proto(PortProto, 0),
+ {Name,Proto,Port,Aliases}
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%% Parse rpc program names
+%% Syntax:
+%% Name Program [Aliases] \n |
+%% # comment
+%% --------------------------------------------------------------------------
+
+rpc(File) ->
+ rpc(noname, File).
+
+rpc(Fname, File) ->
+ Fn = fun([Name,Program | Aliases]) ->
+ Prog = list_to_integer(Program),
+ {Name,Prog,Aliases}
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%% Parse hosts file unix style
+%% Syntax:
+%% IP Name [Aliases] \n |
+%% # comment
+%% --------------------------------------------------------------------------
+hosts(File) ->
+ hosts(noname,File).
+
+hosts(Fname,File) ->
+ Fn = fun([Address, Name | Aliases]) ->
+ %% XXX Fix for link-local IPv6 addresses that specify
+ %% interface with a %if suffix. These kind of
+ %% addresses maybe need to be gracefully handled
+ %% throughout inet* and inet_drv.
+ case string:tokens(Address, "%") of
+ [Addr,_] ->
+ {ok,_} = address(Addr),
+ skip;
+ _ ->
+ {ok,IP} = address(Address),
+ {IP, Name, Aliases}
+ end
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%% Parse hostShow vxworks style
+%% Syntax:
+%% Name IP [Aliases] \n
+%% --------------------------------------------------------------------------
+hosts_vxworks(Hosts) ->
+ Fn = fun([Name, Address | Aliases]) ->
+ {ok,IP} = address(Address),
+ {IP, Name, Aliases}
+ end,
+ parse_file(Hosts, Fn).
+
+%% --------------------------------------------------------------------------
+%% Parse resolv file unix style
+%% Syntax:
+%% domain Domain \n
+%% nameserver IP \n
+%% search Dom1 Dom2 ... \n
+%% lookup Method1 Method2 Method3 \n
+%% # comment
+%% --------------------------------------------------------------------------
+
+resolv(File) ->
+ resolv(noname,File).
+
+resolv(Fname, File) ->
+ Fn = fun(["domain", Domain]) ->
+ {domain, Domain};
+ (["nameserver", Address]) ->
+ {ok,IP} = address(Address),
+ {nameserver,IP};
+ (["search" | List]) ->
+ {search, List};
+ (["lookup" | Types]) ->
+ {lookup, Types};
+ (_) ->
+ skip %% there are too many local options, we MUST skip
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%%
+%% Parse Linux host.conf file
+%% find "order" only.
+%%
+%% --------------------------------------------------------------------------
+host_conf_linux(File) ->
+ host_conf_linux(noname,File).
+
+host_conf_linux(Fname, File) ->
+ Fn = fun(["order" | Order]) ->
+ %% XXX remove ',' between entries
+ {lookup, split_comma(Order)};
+ (_) ->
+ skip
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%%
+%% Parse Freebsd/Netbsd host.conf file
+%% find "order" only.
+%%
+%% --------------------------------------------------------------------------
+host_conf_freebsd(File) ->
+ host_conf_freebsd(noname,File).
+
+host_conf_freebsd(Fname, File) ->
+ Fn = fun([Type]) -> Type end,
+ case parse_file(Fname, File, Fn) of
+ {ok, Ls} -> {ok, [{lookup, Ls}]};
+ Error -> Error
+ end.
+
+
+
+%% --------------------------------------------------------------------------
+%%
+%% Parse BSD/OS irs.conf file
+%% find "hosts" only and ignore options.
+%%
+%% Syntax:
+%% Map AccessMethod [,AccessMethod] [continue|merge [,merge|,continue]] \n
+%% # comment
+
+%% --------------------------------------------------------------------------
+host_conf_bsdos(File) ->
+ host_conf_bsdos(noname,File).
+
+host_conf_bsdos(Fname, File) ->
+ Fn = fun(["hosts" | List]) ->
+ delete_options(split_comma(List));
+ (_) ->
+ skip
+ end,
+ case parse_file(Fname, File, Fn) of
+ {ok, Ls} ->
+ {ok, [{lookup, lists:append(Ls)}]};
+ Error -> Error
+ end.
+
+delete_options(["continue"|T]) ->
+ delete_options(T);
+delete_options(["merge"|T]) ->
+ delete_options(T);
+delete_options([H|T]) ->
+ [H|delete_options(T)];
+delete_options([]) ->
+ [].
+
+
+%% --------------------------------------------------------------------------
+%%
+%% Parse Solaris nsswitch.conf
+%% find "hosts:" only
+%%
+%% --------------------------------------------------------------------------
+
+nsswitch_conf(File) ->
+ nsswitch_conf(noname,File).
+
+nsswitch_conf(Fname, File) ->
+ Fn = fun(["hosts:" | Types]) ->
+ {lookup, Types};
+ (_) -> skip
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%% Parse protocol file unix style
+%% Syntax:
+%% name protocol number name \n
+%% # comment
+%% --------------------------------------------------------------------------
+
+protocols(File) ->
+ protocols(noname,File).
+
+protocols(Fname, File) ->
+ Fn = fun([Name, Number, DName]) ->
+ {list_to_atom(Name), list_to_integer(Number), DName}
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%% Parse netmasks file unix style
+%% Syntax:
+%% Network Subnetmask
+%% # comment
+%% --------------------------------------------------------------------------
+
+netmasks(File) ->
+ netmasks(noname, File).
+
+netmasks(Fname, File) ->
+ Fn = fun([Net, Subnetmask]) ->
+ {ok, NetIP} = address(Net),
+ {ok, Mask} = address(Subnetmask),
+ {NetIP, Mask}
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%% Parse networks file unix style
+%% Syntax:
+%% network-name network-number aliases ...
+%% # comment
+%% --------------------------------------------------------------------------
+
+networks(File) ->
+ networks(noname, File).
+
+networks(Fname, File) ->
+ Fn = fun([NetName, NetNumber]) ->
+ Number = list_to_integer(NetNumber),
+ {NetName, Number}
+ end,
+ parse_file(Fname, File, Fn).
+
+%% --------------------------------------------------------------------------
+%%
+%% Simple Line by Line parser
+%%
+%% --------------------------------------------------------------------------
+
+parse_file(File, Fn) ->
+ parse_file(noname, File, Fn).
+
+parse_file(Fname, {fd,Fd}, Fn) ->
+ parse_fd(Fname,Fd, 1, Fn, []);
+parse_file(Fname, {chars,Cs}, Fn) when is_list(Cs) ->
+ parse_cs(Fname, Cs, 1, Fn, []);
+parse_file(Fname, {chars,Cs}, Fn) when is_binary(Cs) ->
+ parse_cs(Fname, binary_to_list(Cs), 1, Fn, []);
+parse_file(_, File, Fn) ->
+ case file:open(File, [read]) of
+ {ok, Fd} ->
+ Result = parse_fd(File,Fd, 1, Fn, []),
+ file:close(Fd),
+ Result;
+ Error -> Error
+ end.
+
+parse_fd(Fname,Fd, Line, Fun, Ls) ->
+ case read_line(Fd) of
+ eof -> {ok, reverse(Ls)};
+ Cs ->
+ case split_line(Cs) of
+ [] -> parse_fd(Fname, Fd, Line+1, Fun, Ls);
+ Toks ->
+ case catch Fun(Toks) of
+ {'EXIT',_} ->
+ error("~p:~p: erroneous line, SKIPPED~n",[Fname,Line]),
+ parse_fd(Fname, Fd,Line+1,Fun,Ls);
+ {warning,Wlist,Val} ->
+ warning("~p:~p: warning! strange domain name(s) ~p ~n",[Fname,Line,Wlist]),
+ parse_fd(Fname, Fd,Line+1,Fun,[Val|Ls]);
+
+ skip ->
+ parse_fd(Fname, Fd, Line+1, Fun, Ls);
+ Val -> parse_fd(Fname, Fd, Line+1, Fun, [Val|Ls])
+ end
+ end
+ end.
+
+parse_cs(Fname, Chars, Line, Fun, Ls) ->
+ case get_line(Chars) of
+ eof -> {ok, reverse(Ls)};
+ {Cs,Chars1} ->
+ case split_line(Cs) of
+ [] -> parse_cs(Fname, Chars1, Line+1, Fun, Ls);
+ Toks ->
+ case catch Fun(Toks) of
+ {'EXIT',_} ->
+ error("~p:~p: erroneous line, SKIPPED~n",[Fname,Line]),
+ parse_cs(Fname, Chars1, Line+1, Fun, Ls);
+ {warning,Wlist,Val} ->
+ warning("~p:~p: warning! strange domain name(s) ~p ~n",[Fname,Line,Wlist]),
+ parse_cs(Fname, Chars1, Line+1, Fun, [Val|Ls]);
+
+ skip -> parse_cs(Fname, Chars1, Line+1, Fun, Ls);
+ Val -> parse_cs(Fname, Chars1, Line+1, Fun, [Val|Ls])
+ end
+ end
+ end.
+
+get_line([]) -> eof;
+get_line(Chars) -> get_line(Chars,[]).
+
+get_line([], Acc) -> {reverse(Acc), []};
+get_line([$\r, $\n | Cs], Acc) -> {reverse([$\n|Acc]), Cs};
+get_line([$\n | Cs], Acc) -> {reverse([$\n|Acc]), Cs};
+get_line([C | Cs], Acc) -> get_line(Cs, [C|Acc]).
+
+%%
+%% Read a line
+%%
+read_line(Fd) when is_pid(Fd) -> io:get_line(Fd, '');
+read_line(Fd = #file_descriptor{}) ->
+ collect_line(Fd, []).
+
+collect_line(Fd, Cs) ->
+ case file:read(Fd, 80) of
+ {ok, Line} when is_binary(Line) ->
+ collect_line(Fd, byte_size(Line), binary_to_list(Line), Cs);
+ {ok, Line} ->
+ collect_line(Fd, length(Line), Line, Cs);
+ eof when Cs =:= [] ->
+ eof;
+ eof -> reverse(Cs)
+ end.
+
+collect_line(Fd, N, [$\r, $\n|_], Cs) ->
+ {ok, _} = file:position(Fd, {cur,-(N-2)}),
+ reverse([$\n|Cs]);
+collect_line(Fd, N, [$\n|_], Cs) ->
+ {ok, _} = file:position(Fd, {cur,-(N-1)}),
+ reverse([$\n|Cs]);
+collect_line(Fd, _, [], Cs) ->
+ collect_line(Fd, Cs);
+collect_line(Fd, N, [X|Xs], Cs) ->
+ collect_line(Fd, N-1, Xs, [X|Cs]).
+
+
+%% split Port/Proto -> {Port, Proto}
+port_proto([X|Xs], N) when X >= $0, X =< $9 ->
+ port_proto(Xs, N*10 + (X - $0));
+port_proto([$/ | Proto], Port) when Port =/= 0 ->
+ {list_to_atom(Proto), Port}.
+
+%%
+%% Check if a String is a string with visible characters #21..#7E
+%% visible_string(String) -> Bool
+%%
+visible_string([H|T]) ->
+ is_vis1([H|T]);
+visible_string(_) ->
+ false.
+
+is_vis1([C | Cs]) when C >= 16#21, C =< 16#7e -> is_vis1(Cs);
+is_vis1([]) -> true;
+is_vis1(_) -> false.
+
+%%
+%% Check if a String is a domain name according to RFC XXX.
+%% domain(String) -> Bool
+%%
+domain([H|T]) ->
+ is_dom1([H|T]);
+domain(_) ->
+ false.
+
+is_dom1([C | Cs]) when C >= $a, C =< $z -> is_dom_ldh(Cs);
+is_dom1([C | Cs]) when C >= $A, C =< $Z -> is_dom_ldh(Cs);
+is_dom1([C | Cs]) when C >= $0, C =< $9 ->
+ case is_dom_ldh(Cs) of
+ true -> is_dom2(string:tokens([C | Cs],"."));
+ false -> false
+ end;
+is_dom1(_) -> false.
+
+is_dom_ldh([C | Cs]) when C >= $a, C =< $z -> is_dom_ldh(Cs);
+is_dom_ldh([C | Cs]) when C >= $A, C =< $Z -> is_dom_ldh(Cs);
+is_dom_ldh([C | Cs]) when C >= $0, C =< $9 -> is_dom_ldh(Cs);
+is_dom_ldh([$-,$. | _]) -> false;
+is_dom_ldh([$_,$. | _]) -> false;
+is_dom_ldh([$_ | Cs]) -> is_dom_ldh(Cs);
+is_dom_ldh([$- | Cs]) -> is_dom_ldh(Cs);
+is_dom_ldh([$. | Cs]) -> is_dom1(Cs);
+is_dom_ldh([]) -> true;
+is_dom_ldh(_) -> false.
+
+%%% Check that we don't get a IP-address as a domain name.
+
+-define(L2I(L), (catch list_to_integer(L))).
+
+is_dom2([A,B,C,D]) ->
+ case ?L2I(D) of
+ Di when is_integer(Di) ->
+ case {?L2I(A),?L2I(B),?L2I(C)} of
+ {Ai,Bi,Ci} when is_integer(Ai),
+ is_integer(Bi),
+ is_integer(Ci) -> false;
+ _ -> true
+ end;
+ _ -> true
+ end;
+is_dom2(_) ->
+ true.
+
+
+
+%%
+%% Test ipv4 address or ipv6 address
+%% Return {ok, Address} | {error, Reason}
+%%
+address(Cs) when is_list(Cs) ->
+ case ipv4_address(Cs) of
+ {ok,IP} -> {ok,IP};
+ _ ->
+ case ipv6_address(Cs) of
+ {ok, IP} -> {ok, IP};
+ Error -> Error
+ end
+ end;
+address(_) ->
+ {error, einval}.
+
+%%
+%% Parse IPv4 address:
+%% d1.d2.d3.d4
+%% d1.d2.d4
+%% d1.d4
+%% d4
+%%
+%% Return {ok, IP} | {error, einval}
+%%
+ipv4_address(Cs) ->
+ case catch ipv4_addr(Cs) of
+ {'EXIT',_} -> {error,einval};
+ Addr -> {ok,Addr}
+ end.
+
+ipv4_addr(Cs) ->
+ ipv4_addr(d3(Cs), []).
+
+ipv4_addr({Cs0,[]}, A) when length(A) =< 3 ->
+ case [tod(Cs0)|A] of
+ [D4,D3,D2,D1] ->
+ {D1,D2,D3,D4};
+ [D4,D2,D1] ->
+ {D1,D2,0,D4};
+ [D4,D1] ->
+ {D1,0,0,D4};
+ [D4] ->
+ {0,0,0,D4}
+ end;
+ipv4_addr({Cs0,"."++Cs1}, A) when length(A) =< 2 ->
+ ipv4_addr(d3(Cs1), [tod(Cs0)|A]).
+
+d3(Cs) -> d3(Cs, []).
+
+d3([C|Cs], R) when C >= $0, C =< $9, length(R) =< 2 ->
+ d3(Cs, [C|R]);
+d3(Cs, [_|_]=R) ->
+ {lists:reverse(R),Cs}.
+
+tod(Cs) ->
+ case erlang:list_to_integer(Cs) of
+ D when D >= 0, D =< 255 ->
+ D;
+ _ ->
+ erlang:error(badarg, [Cs])
+ end.
+
+%%
+%% Parse IPv6 address:
+%% x1:x2:x3:x4:x5:x6:x7:x8
+%% x1:x2::x7:x8
+%% ::x7:x8
+%% x1:x2::
+%% ::
+%% x1:x2:x3:x4:x5:x6:d7a.d7b.d8a.d8b
+%% x1:x2::x5:x6:d7a.d7b.d8a.d8b
+%% ::x5:x6:d7a.d7b.d8a.d8b
+%% x1:x2::d7a.d7b.d8a.d8b
+%% ::d7a.d7b.d8a.d8b
+%%
+%% Return {ok, IP} | {error, einval}
+%%
+ipv6_address(Cs) ->
+ case catch ipv6_addr(Cs) of
+ {'EXIT',_} -> {error,einval};
+ Addr -> {ok,Addr}
+ end.
+
+ipv6_addr("::") ->
+ ipv6_addr_done([], []);
+ipv6_addr("::"++Cs) ->
+ ipv6_addr(x4(Cs), [], []);
+ipv6_addr(Cs) ->
+ ipv6_addr(x4(Cs), []).
+
+%% Before "::"
+ipv6_addr({Cs0,[]}, A) when length(A) =:= 7 ->
+ ipv6_addr_done([tox(Cs0)|A]);
+ipv6_addr({Cs0,"::"}, A) when length(A) =< 6 ->
+ ipv6_addr_done([tox(Cs0)|A], []);
+ipv6_addr({Cs0,"::"++Cs1}, A) when length(A) =< 5 ->
+ ipv6_addr(x4(Cs1), [tox(Cs0)|A], []);
+ipv6_addr({Cs0,":"++Cs1}, A) when length(A) =< 6 ->
+ ipv6_addr(x4(Cs1), [tox(Cs0)|A]);
+ipv6_addr({Cs0,"."++Cs1}, A) when length(A) =:= 6 ->
+ ipv6_addr(d3(Cs1), A, [], [tod(Cs0)]).
+
+%% After "::"
+ipv6_addr({Cs0,[]}, A, B) when length(A)+length(B) =< 6 ->
+ ipv6_addr_done(A, [tox(Cs0)|B]);
+ipv6_addr({Cs0,":"++Cs1}, A, B) when length(A)+length(B) =< 5 ->
+ ipv6_addr(x4(Cs1), A, [tox(Cs0)|B]);
+ipv6_addr({Cs0,"."++Cs1}, A, B) when length(A)+length(B) =< 5 ->
+ ipv6_addr(x4(Cs1), A, B, [tod(Cs0)]).
+
+%% After "."
+ipv6_addr({Cs0,[]}, A, B, C) when length(C) =:= 3 ->
+ ipv6_addr_done(A, B, [tod(Cs0)|C]);
+ipv6_addr({Cs0,"."++Cs1}, A, B, C) when length(C) =< 2 ->
+ ipv6_addr(d3(Cs1), A, B, [tod(Cs0)|C]).
+
+ipv6_addr_done(Ar, Br, [D4,D3,D2,D1]) ->
+ ipv6_addr_done(Ar, [((D3 bsl 8) bor D4),((D1 bsl 8) bor D2)|Br]).
+
+ipv6_addr_done(Ar, Br) ->
+ ipv6_addr_done(Br++dup(8-length(Ar)-length(Br), 0, Ar)).
+
+ipv6_addr_done(Ar) ->
+ list_to_tuple(lists:reverse(Ar)).
+
+x4(Cs) -> x4(Cs, []).
+
+x4([C|Cs], R) when C >= $0, C =< $9, length(R) =< 3 ->
+ x4(Cs, [C|R]);
+x4([C|Cs], R) when C >= $a, C =< $f, length(R) =< 3 ->
+ x4(Cs, [C|R]);
+x4([C|Cs], R) when C >= $A, C =< $F, length(R) =< 3 ->
+ x4(Cs, [C|R]);
+x4(Cs, [_|_]=R) ->
+ {lists:reverse(R),Cs}.
+
+tox(Cs) ->
+ erlang:list_to_integer(Cs, 16).
+
+dup(0, _, L) ->
+ L;
+dup(N, E, L) when is_integer(N), N >= 1 ->
+ dup(N-1, E, [E|L]);
+dup(N, E, L) ->
+ erlang:error(badarg, [N,E,L]).
+
+%% Convert IPv4 adress to ascii
+%% Convert IPv6 / IPV4 adress to ascii (plain format)
+ntoa({A,B,C,D}) ->
+ integer_to_list(A) ++ "." ++ integer_to_list(B) ++ "." ++
+ integer_to_list(C) ++ "." ++ integer_to_list(D);
+%% ANY
+ntoa({0,0,0,0,0,0,0,0}) -> "::";
+%% LOOPBACK
+ntoa({0,0,0,0,0,0,0,1}) -> "::1";
+%% IPV4 ipv6 host address
+ntoa({0,0,0,0,0,0,A,B}) -> "::" ++ dig_to_dec(A) ++ "." ++ dig_to_dec(B);
+%% IPV4 non ipv6 host address
+ntoa({0,0,0,0,0,16#ffff,A,B}) ->
+ "::FFFF:" ++ dig_to_dec(A) ++ "." ++ dig_to_dec(B);
+ntoa({_,_,_,_,_,_,_,_}=T) ->
+ %% Find longest sequence of zeros, at least 2, to replace with "::"
+ ntoa(tuple_to_list(T), []).
+
+%% Find first double zero
+ntoa([], R) ->
+ ntoa_done(R);
+ntoa([0,0|T], R) ->
+ ntoa(T, R, 2);
+ntoa([D|T], R) ->
+ ntoa(T, [D|R]).
+
+%% Count consecutive zeros
+ntoa([], R, _) ->
+ ntoa_done(R, []);
+ntoa([0|T], R, N) ->
+ ntoa(T, R, N+1);
+ntoa([D|T], R, N) ->
+ ntoa(T, R, N, [D]).
+
+%% Find alternate double zero
+ntoa([], R1, _N1, R2) ->
+ ntoa_done(R1, R2);
+ntoa([0,0|T], R1, N1, R2) ->
+ ntoa(T, R1, N1, R2, 2);
+ntoa([D|T], R1, N1, R2) ->
+ ntoa(T, R1, N1, [D|R2]).
+
+%% Count consecutive alternate zeros
+ntoa(T, R1, N1, R2, N2) when N2 > N1 ->
+ %% Alternate zero sequence is longer - use it instead
+ ntoa(T, R2++dup(N1, 0, R1), N2);
+ntoa([], R1, _N1, R2, N2) ->
+ ntoa_done(R1, dup(N2, 0, R2));
+ntoa([0|T], R1, N1, R2, N2) ->
+ ntoa(T, R1, N1, R2, N2+1);
+ntoa([D|T], R1, N1, R2, N2) ->
+ ntoa(T, R1, N1, [D|dup(N2, 0, R2)]).
+
+ntoa_done(R1, R2) ->
+ lists:append(
+ separate(":", lists:map(fun dig_to_hex/1, lists:reverse(R1)))++
+ ["::"|separate(":", lists:map(fun dig_to_hex/1, lists:reverse(R2)))]).
+
+ntoa_done(R) ->
+ lists:append(separate(":", lists:map(fun dig_to_hex/1, lists:reverse(R)))).
+
+separate(_E, []) ->
+ [];
+separate(E, [_|_]=L) ->
+ separate(E, L, []).
+
+separate(E, [H|[_|_]=T], R) ->
+ separate(E, T, [E,H|R]);
+separate(_E, [H], R) ->
+ lists:reverse(R, [H]).
+
+%% convert to A.B decimal form
+dig_to_dec(0) -> [$0,$.,$0];
+dig_to_dec(X) ->
+ integer_to_list((X bsr 8) band 16#ff) ++ "." ++
+ integer_to_list(X band 16#ff).
+
+%% Convert a integer to hex string
+dig_to_hex(X) ->
+ erlang:integer_to_list(X, 16).
+
+%%
+%% Count number of '.' in a name
+%% return {Number of non-terminating dots, has-terminating dot?}
+%% {integer, bool}
+%%
+dots(Name) -> dots(Name, 0).
+
+dots([$.], N) -> {N, true};
+dots([$. | T], N) -> dots(T, N+1);
+dots([_C | T], N) -> dots(T, N);
+dots([], N) -> {N, false}.
+
+
+split_line(Line) ->
+ split_line(Line, []).
+
+split_line([$# | _], Tokens) -> reverse(Tokens);
+split_line([$\s| L], Tokens) -> split_line(L, Tokens);
+split_line([$\t | L], Tokens) -> split_line(L, Tokens);
+split_line([$\n | L], Tokens) -> split_line(L, Tokens);
+split_line([], Tokens) -> reverse(Tokens);
+split_line([C|Cs], Tokens) -> split_mid(Cs, [C], Tokens).
+
+split_mid([$# | _Cs], Acc, Tokens) -> split_end(Acc, Tokens);
+split_mid([$\s | Cs], Acc, Tokens) -> split_line(Cs, [reverse(Acc) | Tokens]);
+split_mid([$\t | Cs], Acc, Tokens) -> split_line(Cs, [reverse(Acc) | Tokens]);
+split_mid([$\r, $\n | Cs], Acc, Tokens) -> split_line(Cs, [reverse(Acc) | Tokens]);
+split_mid([$\n | Cs], Acc, Tokens) -> split_line(Cs, [reverse(Acc) | Tokens]);
+split_mid([], Acc, Tokens) -> split_end(Acc, Tokens);
+split_mid([C|Cs], Acc, Tokens) -> split_mid(Cs, [C|Acc], Tokens).
+
+split_end(Acc, Tokens) -> reverse([reverse(Acc) | Tokens]).
+
+
+%% Split a comma separated tokens. Because we already have split on
+%% spaces we may have the cases
+%%
+%% ",foo"
+%% "foo,"
+%% "foo,bar..."
+
+split_comma([]) ->
+ [];
+split_comma([Token | Tokens]) ->
+ split_comma(Token, []) ++ split_comma(Tokens).
+
+split_comma([], Tokens) -> reverse(Tokens);
+split_comma([$, | L], Tokens) -> split_comma(L, Tokens);
+split_comma([C|Cs], Tokens) -> split_mid_comma(Cs, [C], Tokens).
+
+split_mid_comma([$, | Cs], Acc, Tokens) ->
+ split_comma(Cs, [reverse(Acc) | Tokens]);
+split_mid_comma([], Acc, Tokens) ->
+ split_end(Acc, Tokens);
+split_mid_comma([C|Cs], Acc, Tokens) ->
+ split_mid_comma(Cs, [C|Acc], Tokens).
+
+%%
+
+warning(Fmt, Args) ->
+ case application:get_env(kernel,inet_warnings) of
+ {ok,on} ->
+ error_logger:info_msg("inet_parse:" ++ Fmt, Args);
+ _ ->
+ ok
+ end.
+
+error(Fmt, Args) ->
+ error_logger:info_msg("inet_parse:" ++ Fmt, Args).
+
diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl
new file mode 100644
index 0000000000..9b9e078898
--- /dev/null
+++ b/lib/kernel/src/inet_res.erl
@@ -0,0 +1,846 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% RFC 1035, 2671, 2782, 2915.
+%%
+-module(inet_res).
+
+%-compile(export_all).
+
+-export([gethostbyname/1, gethostbyname/2, gethostbyname/3,
+ gethostbyname_tm/3]).
+-export([gethostbyaddr/1, gethostbyaddr/2,
+ gethostbyaddr_tm/2]).
+-export([getbyname/2, getbyname/3,
+ getbyname_tm/3]).
+
+-export([resolve/3, resolve/4, resolve/5]).
+-export([lookup/3, lookup/4, lookup/5]).
+-export([dns_msg/1]).
+
+-export([nslookup/3, nslookup/4]).
+-export([nnslookup/4, nnslookup/5]).
+
+-include_lib("kernel/include/inet.hrl").
+-include("inet_res.hrl").
+-include("inet_dns.hrl").
+-include("inet_int.hrl").
+
+-define(verbose(Cond, Format, Args),
+ case begin Cond end of
+ true -> io:format(begin Format end, begin Args end);
+ false -> ok
+ end).
+
+%% --------------------------------------------------------------------------
+%% resolve:
+%%
+%% Nameserver query
+%%
+
+resolve(Name, Class, Type) ->
+ resolve(Name, Class, Type, [], infinity).
+
+resolve(Name, Class, Type, Opts) ->
+ resolve(Name, Class, Type, Opts, infinity).
+
+resolve(Name, Class, Type, Opts, Timeout) ->
+ case nsdname(Name) of
+ {ok, Nm} ->
+ Timer = inet:start_timer(Timeout),
+ Res = res_query(Nm, Class, Type, Opts, Timer),
+ inet:stop_timer(Timer),
+ Res;
+ Error ->
+ Error
+ end.
+
+%% --------------------------------------------------------------------------
+%% lookup:
+%%
+%% Convenience wrapper to resolve/3,4,5 that filters out all answer data
+%% fields of the class and type asked for.
+
+lookup(Name, Class, Type) ->
+ lookup(Name, Class, Type, []).
+
+lookup(Name, Class, Type, Opts) ->
+ lookup(Name, Class, Type, Opts, infinity).
+
+lookup(Name, Class, Type, Opts, Timeout) ->
+ lookup_filter(resolve(Name, Class, Type, Opts, Timeout),
+ Class, Type).
+
+lookup_filter({ok,#dns_rec{anlist=Answers}}, Class, Type) ->
+ [A#dns_rr.data || A <- Answers,
+ A#dns_rr.class =:= Class,
+ A#dns_rr.type =:= Type];
+lookup_filter({error,_}, _, _) -> [].
+
+%% --------------------------------------------------------------------------
+%% nslookup:
+%%
+%% Do a general nameserver lookup
+%%
+%% Perform nslookup on standard config !!
+%%
+%% To be deprecated
+
+nslookup(Name, Class, Type) ->
+ do_nslookup(Name, Class, Type, [], infinity).
+
+nslookup(Name, Class, Type, Timeout) when is_integer(Timeout), Timeout >= 0 ->
+ do_nslookup(Name, Class, Type, [], Timeout);
+nslookup(Name, Class, Type, NSs) -> % For backwards compatibility
+ nnslookup(Name, Class, Type, NSs). % with OTP R6B only
+
+nnslookup(Name, Class, Type, NSs) ->
+ nnslookup(Name, Class, Type, NSs, infinity).
+
+nnslookup(Name, Class, Type, NSs, Timeout) ->
+ do_nslookup(Name, Class, Type, [{nameservers,NSs}], Timeout).
+
+do_nslookup(Name, Class, Type, Opts, Timeout) ->
+ case resolve(Name, Class, Type, Opts, Timeout) of
+ {error,{qfmterror,_}} -> {error,einval};
+ {error,{Reason,_}} -> {error,Reason};
+ Result -> Result
+ end.
+
+%% --------------------------------------------------------------------------
+%% options record
+%%
+-record(options, { % These must be sorted!
+ alt_nameservers,edns,inet6,nameservers,recurse,
+ retry,timeout,udp_payload_size,usevc,
+ verbose}). % this is a local option, not in inet_db
+%%
+%% Opts when is_list(Opts) -> #options{}
+make_options(Opts0) ->
+ Opts = [if is_atom(Opt) ->
+ case atom_to_list(Opt) of
+ "no"++X -> {list_to_atom(X),false};
+ _ -> {Opt,true}
+ end;
+ true -> Opt
+ end || Opt <- Opts0],
+ %% If the caller gives the nameservers option, the inet_db
+ %% alt_nameservers option should be regarded as empty, i.e
+ %% use only the nameservers the caller supplies.
+ SortedOpts =
+ lists:ukeysort(1,
+ case lists:keymember(nameservers, 1, Opts) of
+ true ->
+ case lists:keymember(alt_nameservers, 1, Opts) of
+ false ->
+ [{alt_nameservers,[]}|Opts];
+ true ->
+ Opts
+ end;
+ false ->
+ Opts
+ end),
+ SortedNames = record_info(fields, options),
+ inet_db:res_update_conf(),
+ list_to_tuple([options|make_options(SortedOpts, SortedNames)]).
+
+make_options([_|_]=Opts0, []=Names0) ->
+ erlang:error(badarg, [Opts0,Names0]);
+make_options([], []) -> [];
+make_options([{verbose,Val}|Opts]=Opts0, [verbose|Names]=Names0) ->
+ if is_boolean(Val) ->
+ [Val|make_options(Opts, Names)];
+ true ->
+ erlang:error(badarg, [Opts0,Names0])
+ end;
+make_options([{Opt,Val}|Opts]=Opts0, [Opt|Names]=Names0) ->
+ case inet_db:res_check_option(Opt, Val) of
+ true ->
+ [Val|make_options(Opts, Names)];
+ false ->
+ erlang:error(badarg, [Opts0,Names0])
+ end;
+make_options(Opts, [verbose|Names]) ->
+ [false|make_options(Opts, Names)];
+make_options(Opts, [Name|Names]) ->
+ [inet_db:res_option(Name)|make_options(Opts, Names)].
+
+
+%% --------------------------------------------------------------------------
+%%
+%% gethostbyaddr(ip_address()) => {ok, hostent()} | {error, Reason}
+%%
+%% where ip_address() is {A,B,C,D} ipv4 address
+%% | {A,B,C,D,E,F,G,H} ipv6 address
+%% | string versions of the above
+%% | atom version
+%%
+%% --------------------------------------------------------------------------
+
+gethostbyaddr(IP) -> gethostbyaddr_tm(IP,false).
+
+gethostbyaddr(IP,Timeout) ->
+ Timer = inet:start_timer(Timeout),
+ Res = gethostbyaddr_tm(IP,Timer),
+ inet:stop_timer(Timer),
+ Res.
+
+gethostbyaddr_tm({A,B,C,D} = IP, Timer) when ?ip(A,B,C,D) ->
+ inet_db:res_update_conf(),
+ case inet_db:gethostbyaddr(IP) of
+ {ok, HEnt} -> {ok, HEnt};
+ _ -> res_gethostbyaddr(dn_in_addr_arpa(A,B,C,D), IP, Timer)
+ end;
+%% ipv4 only ipv6 address
+gethostbyaddr_tm({0,0,0,0,0,16#ffff,G,H},Timer) when is_integer(G+H) ->
+ gethostbyaddr_tm({G div 256, G rem 256, H div 256, H rem 256},Timer);
+gethostbyaddr_tm({A,B,C,D,E,F,G,H} = IP, Timer) when ?ip6(A,B,C,D,E,F,G,H) ->
+ inet_db:res_update_conf(),
+ case inet_db:gethostbyaddr(IP) of
+ {ok, HEnt} -> {ok, HEnt};
+ _ -> res_gethostbyaddr(dn_ip6_int(A,B,C,D,E,F,G,H), IP, Timer)
+ end;
+gethostbyaddr_tm(Addr,Timer) when is_list(Addr) ->
+ case inet_parse:address(Addr) of
+ {ok, IP} -> gethostbyaddr_tm(IP,Timer);
+ _Error -> {error, formerr}
+ end;
+gethostbyaddr_tm(Addr,Timer) when is_atom(Addr) ->
+ gethostbyaddr_tm(atom_to_list(Addr),Timer);
+gethostbyaddr_tm(_,_) -> {error, formerr}.
+
+%%
+%% Send the gethostbyaddr query to:
+%% 1. the list of normal names servers
+%% 2. the list of alternative name servers
+%%
+res_gethostbyaddr(Addr, IP, Timer) ->
+ case res_query(Addr, in, ptr, [], Timer) of
+ {ok, Rec} ->
+ inet_db:res_gethostbyaddr(IP, Rec);
+ {error,{qfmterror,_}} -> {error,einval};
+ {error,{Reason,_}} -> {error,Reason};
+ Error ->
+ Error
+ end.
+
+%% --------------------------------------------------------------------------
+%%
+%% gethostbyname(domain_name()[,family [,Timer])
+%% => {ok, hostent()} | {error, Reason}
+%%
+%% where domain_name() is domain string or atom
+%%
+%% Caches the answer.
+%% --------------------------------------------------------------------------
+
+gethostbyname(Name) ->
+ case inet_db:res_option(inet6) of
+ true ->
+ gethostbyname_tm(Name, inet6, false);
+ false ->
+ gethostbyname_tm(Name, inet, false)
+ end.
+
+gethostbyname(Name,Family) ->
+ gethostbyname_tm(Name,Family,false).
+
+gethostbyname(Name,Family,Timeout) ->
+ Timer = inet:start_timer(Timeout),
+ Res = gethostbyname_tm(Name,Family,Timer),
+ inet:stop_timer(Timer),
+ Res.
+
+gethostbyname_tm(Name,inet,Timer) ->
+ getbyname_tm(Name,?S_A,Timer);
+gethostbyname_tm(Name,inet6,Timer) ->
+ case getbyname_tm(Name,?S_AAAA,Timer) of
+ {ok,HEnt} -> {ok,HEnt};
+ {error,nxdomain} ->
+ case getbyname_tm(Name, ?S_A,Timer) of
+ {ok, HEnt} ->
+ %% rewrite to a ipv4 only ipv6 address
+ {ok,
+ HEnt#hostent {
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list =
+ lists:map(
+ fun({A,B,C,D}) ->
+ {0,0,0,0,0,16#ffff,A*256+B,C*256+D}
+ end, HEnt#hostent.h_addr_list)
+ }};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end;
+gethostbyname_tm(_Name, _Family, _Timer) ->
+ {error, einval}.
+
+%% --------------------------------------------------------------------------
+%%
+%% getbyname(domain_name(), Type) => {ok, hostent()} | {error, Reason}
+%%
+%% where domain_name() is domain string or atom and Type is ?S_A, ?S_MX ...
+%%
+%% Caches the answer.
+%% --------------------------------------------------------------------------
+
+getbyname(Name, Type) ->
+ getbyname_tm(Name,Type,false).
+
+getbyname(Name, Type, Timeout) ->
+ Timer = inet:start_timer(Timeout),
+ Res = getbyname_tm(Name, Type, Timer),
+ inet:stop_timer(Timer),
+ Res.
+
+getbyname_tm(Name, Type, Timer) when is_list(Name) ->
+ case type_p(Type) of
+ true ->
+ case inet_parse:visible_string(Name) of
+ false -> {error, formerr};
+ true ->
+ inet_db:res_update_conf(),
+ case inet_db:getbyname(Name, Type) of
+ {ok, HEnt} -> {ok, HEnt};
+ _ -> res_getbyname(Name, Type, Timer)
+ end
+ end;
+ false ->
+ {error, formerr}
+ end;
+getbyname_tm(Name,Type,Timer) when is_atom(Name) ->
+ getbyname_tm(atom_to_list(Name), Type,Timer);
+getbyname_tm(_, _, _) -> {error, formerr}.
+
+type_p(Type) ->
+ lists:member(Type, [?S_A, ?S_AAAA, ?S_MX, ?S_NS,
+ ?S_MD, ?S_MF, ?S_CNAME, ?S_SOA,
+ ?S_MB, ?S_MG, ?S_MR, ?S_NULL,
+ ?S_WKS, ?S_HINFO, ?S_TXT, ?S_SRV, ?S_NAPTR, ?S_SPF,
+ ?S_UINFO, ?S_UID, ?S_GID]).
+
+
+
+%% This function and inet_db:getbyname/2 must look up names
+%% in the same manner, but not from the same places.
+%%
+%% Assuming search path, i.e return value from inet_db:get_searchlist()
+%% to be ["dom1", "dom2"]:
+%%
+%% Old behaviour (not this code but the previous version):
+%% * For Name = "foo"
+%% Name = "foo." try "foo.dom1", "foo.dom2" at normal nameservers
+%% * For Name = "foo.bar"
+%% Name = "foo.bar." try "foo.bar" at normal then alt. nameservers
+%% then try "foo.bar.dom1", "foo.bar.dom2"
+%% at normal nameservers
+%%
+%% New behaviour (this code), honoring the old behaviour but
+%% doing better for absolute names:
+%% * For Name = "foo" try "foo.dom1", "foo.dom2" at normal nameservers
+%% * For Name = "foo.bar" try "foo.bar" at normal then alt. nameservers
+%% then try "foo.bar.dom1", "foo.bar.dom2"
+%% at normal nameservers
+%% * For Name = "foo." try "foo" at normal then alt. nameservers
+%% * For Name = "foo.bar." try "foo.bar" at normal then alt. nameservers
+%%
+%%
+%% FIXME This is probably how it should be done:
+%% Common behaviour (Solaris resolver) is:
+%% * For Name = "foo." try "foo"
+%% * For Name = "foo.bar." try "foo.bar"
+%% * For Name = "foo" try "foo.dom1", "foo.dom2", "foo"
+%% * For Name = "foo.bar" try "foo.bar.dom1", "foo.bar.dom2", "foo.bar"
+%% That is to try Name as it is as a last resort if it is not absolute.
+%%
+res_getbyname(Name, Type, Timer) ->
+ {EmbeddedDots, TrailingDot} = inet_parse:dots(Name),
+ Dot = if TrailingDot -> ""; true -> "." end,
+ if TrailingDot ->
+ res_getby_query(Name, Type, Timer);
+ EmbeddedDots =:= 0 ->
+ res_getby_search(Name, Dot,
+ inet_db:get_searchlist(),
+ nxdomain, Type, Timer);
+ true ->
+ case res_getby_query(Name, Type, Timer) of
+ {error,_Reason}=Error ->
+ res_getby_search(Name, Dot,
+ inet_db:get_searchlist(),
+ Error, Type, Timer);
+ Other -> Other
+ end
+ end.
+
+res_getby_search(Name, Dot, [Dom | Ds], _Reason, Type, Timer) ->
+ case res_getby_query(Name++Dot++Dom, Type, Timer,
+ inet_db:res_option(nameservers)) of
+ {ok, HEnt} -> {ok, HEnt};
+ {error, NewReason} ->
+ res_getby_search(Name, Dot, Ds, NewReason, Type, Timer)
+ end;
+res_getby_search(_Name, _, [], Reason,_,_) ->
+ {error, Reason}.
+
+res_getby_query(Name, Type, Timer) ->
+ case res_query(Name, in, Type, [], Timer) of
+ {ok, Rec} ->
+ inet_db:res_hostent_by_domain(Name, Type, Rec);
+ {error,{qfmterror,_}} -> {error,einval};
+ {error,{Reason,_}} -> {error,Reason};
+ Error -> Error
+ end.
+
+res_getby_query(Name, Type, Timer, NSs) ->
+ case res_query(Name, in, Type, [], Timer, NSs) of
+ {ok, Rec} ->
+ inet_db:res_hostent_by_domain(Name, Type, Rec);
+ {error,{qfmterror,_}} -> {error,einval};
+ {error,{Reason,_}} -> {error,Reason};
+ Error -> Error
+ end.
+
+
+
+%% --------------------------------------------------------------------------
+%% query record
+%%
+-record(q, {options,edns,dns}).
+
+
+
+%% Query first nameservers list then alt_nameservers list
+res_query(Name, Class, Type, Opts, Timer) ->
+ #q{options=#options{nameservers=NSs}}=Q =
+ make_query(Name, Class, Type, Opts),
+ case do_query(Q, NSs, Timer) of
+ {error,nxdomain}=Error ->
+ res_query_alt(Q, Error, Timer);
+ {error,{nxdomain,_}}=Error ->
+ res_query_alt(Q, Error, Timer);
+ {ok,#dns_rec{anlist=[]}}=Reply ->
+ res_query_alt(Q, Reply, Timer);
+ Reply -> Reply
+ end.
+
+%% Query just the argument nameservers list
+res_query(Name, Class, Type, Opts, Timer, NSs) ->
+ Q = make_query(Name, Class, Type, Opts),
+ do_query(Q, NSs, Timer).
+
+res_query_alt(#q{options=#options{alt_nameservers=NSs}}=Q, Reply, Timer) ->
+ case NSs of
+ [] -> Reply;
+ _ ->
+ do_query(Q, NSs, Timer)
+ end.
+
+make_query(Dname, Class, Type, Opts) ->
+ Options = make_options(Opts),
+ case Options#options.edns of
+ false ->
+ #q{options=Options,
+ edns=undefined,
+ dns=make_query(Dname, Class, Type, Options, false)};
+ Edns ->
+ #q{options=Options,
+ edns=make_query(Dname, Class, Type, Options, Edns),
+ dns=fun () ->
+ make_query(Dname, Class, Type, Options, false)
+ end}
+ end.
+
+%% XXX smarter would be to always construct both queries,
+%% but make the EDNS query point into the DNS query binary.
+%% It is only the header ARList length that need to be changed,
+%% and the OPT record appended.
+make_query(Dname, Class, Type, Options, Edns) ->
+ Id = inet_db:res_option(next_id),
+ Recurse = Options#options.recurse,
+ ARList = case Edns of
+ false -> [];
+ _ ->
+ PSz = Options#options.udp_payload_size,
+ [#dns_rr_opt{udp_payload_size=PSz,
+ version=Edns}]
+ end,
+ Msg = #dns_rec{header=#dns_header{id=Id,
+ opcode='query',
+ rd=Recurse,
+ rcode=?NOERROR},
+ qdlist=[#dns_query{domain=Dname,
+ type=Type,
+ class=Class}],
+ arlist=ARList},
+ ?verbose(Options#options.verbose, "Query: ~p~n", [dns_msg(Msg)]),
+ Buffer = inet_dns:encode(Msg),
+ {Id, Buffer}.
+
+%% --------------------------------------------------------------------------
+%% socket helpers
+%%
+-record(sock, {inet=undefined, inet6=undefined}).
+
+udp_open(#sock{inet6=I}=S, {A,B,C,D,E,F,G,H}) when ?ip6(A,B,C,D,E,F,G,H) ->
+ case I of
+ undefined ->
+ case gen_udp:open(0, [{active,false},binary,inet6]) of
+ {ok,J} ->
+ {ok,S#sock{inet6=J}};
+ Error ->
+ Error
+ end;
+ _ ->
+ {ok,S}
+ end;
+udp_open(#sock{inet=I}=S, {A,B,C,D}) when ?ip(A,B,C,D) ->
+ case I of
+ undefined ->
+ case gen_udp:open(0, [{active,false},binary,inet]) of
+ {ok,J} ->
+ {ok,S#sock{inet=J}};
+ Error ->
+ Error
+ end;
+ _ ->
+ {ok,S}
+ end.
+
+udp_connect(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port)
+ when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) ->
+ gen_udp:connect(I, IP, Port);
+udp_connect(#sock{inet=I}, {A,B,C,D}=IP, Port)
+ when ?ip(A,B,C,D) ->
+ gen_udp:connect(I, IP, Port).
+
+udp_send(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Buffer)
+ when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) ->
+ gen_udp:send(I, IP, Port, Buffer);
+udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer)
+ when ?ip(A,B,C,D), ?port(Port) ->
+ gen_udp:send(I, IP, Port, Buffer).
+
+udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout)
+ when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) ->
+ do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout);
+udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout)
+ when ?ip(A,B,C,D), ?port(Port) ->
+ do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout).
+
+do_udp_recv(Recv, IP, Port, Timeout) ->
+ do_udp_recv(Recv, IP, Port, Timeout,
+ if Timeout =/= 0 -> erlang:now(); true -> undefined end).
+
+do_udp_recv(Recv, IP, Port, Timeout, Then) ->
+ case Recv(Timeout) of
+ {ok,{IP,Port,Answer}} ->
+ {ok,Answer,erlang:max(0, Timeout - now_ms(erlang:now(), Then))};
+ {ok,_} when Timeout =:= 0 ->
+ {error,timeout};
+ {ok,_} ->
+ Now = erlang:now(),
+ T = erlang:max(0, Timeout - now_ms(Now, Then)),
+ do_udp_recv(Recv, IP, Port, T, Now);
+ Error -> Error
+ end.
+
+udp_close(#sock{inet=I,inet6=I6}) ->
+ if I =/= undefined -> gen_udp:close(I); true -> ok end,
+ if I6 =/= undefined -> gen_udp:close(I6); true -> ok end,
+ ok.
+
+%%
+%% Send a query to the nameserver and return a reply
+%% We first use socket server then we add the udp version
+%%
+%% Algorithm: (from manual page for dig)
+%% for i = 0 to retry - 1
+%% for j = 1 to num_servers
+%% send_query
+%% wait((time * (2**i)) / num_servers)
+%% end
+%% end
+%%
+
+do_query(_Q, [], _Timer) ->
+ {error,nxdomain};
+do_query(#q{options=#options{retry=Retry}}=Q, NSs, Timer) ->
+ query_retries(Q, NSs, Timer, Retry, 0, #sock{}).
+
+query_retries(_Q, _NSs, _Timer, Retry, Retry, S) ->
+ udp_close(S),
+ {error,timeout};
+query_retries(Q, NSs, Timer, Retry, I, S0) ->
+ Num = length(NSs),
+ if Num =:= 0 ->
+ {error,timeout};
+ true ->
+ case query_nss(Q, NSs, Timer, Retry, I, S0, []) of
+ {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers
+ query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S);
+ {S,Result} ->
+ udp_close(S),
+ Result
+ end
+ end.
+
+query_nss(_Q, [], _Timer, _Retry, _I, S, ErrNSs) ->
+ {S,{noanswer,ErrNSs}};
+query_nss(#q{edns=undefined}=Q, NSs, Timer, Retry, I, S, ErrNSs) ->
+ query_nss_dns(Q, NSs, Timer, Retry, I, S, ErrNSs);
+query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) ->
+ query_nss_edns(Q, NSs, Timer, Retry, I, S, ErrNSs).
+
+query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options,
+ edns={Id,Buffer}}=Q,
+ [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) ->
+ {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer,
+ Retry, I, Options, PSz),
+ case Res of
+ timeout -> {S,{error,timeout}};
+ {ok,_} -> Reply;
+ {error,{nxdomain,_}} -> Reply;
+ {error,{E,_}} when E =:= qfmterror; E =:= notimp; E =:= servfail;
+ E =:= badvers ->
+ query_nss_dns(Q, NSs0, Timer, Retry, I, S, ErrNSs);
+ {error,E} when E =:= fmt; E =:= enetunreach; E =:= econnrefused ->
+ query_nss(Q, NSs, Timer, Retry, I, S, [NS|ErrNSs]);
+ _Error ->
+ query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs)
+ end.
+
+query_nss_dns(#q{dns=Qdns}=Q0, [{IP,Port}=NS|NSs],
+ Timer, Retry, I, S0, ErrNSs) ->
+ #q{options=Options,dns={Id,Buffer}}=Q =
+ if
+ is_function(Qdns, 0) -> Q0#q{dns=Qdns()};
+ true -> Q0
+ end,
+ {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer,
+ Retry, I, Options, ?PACKETSZ),
+ case Res of
+ timeout -> {S,{error,timeout}};
+ {ok,_} -> Reply;
+ {error,{E,_}} when E =:= nxdomain; E =:= qfmterror -> Reply;
+ {error,E} when E =:= fmt; E =:= enetunreach; E =:= econnrefused ->
+ query_nss(Q, NSs, Timer, Retry, I, S, [NS|ErrNSs]);
+ _Error ->
+ query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs)
+ end.
+
+query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I,
+ #options{timeout=Tm,usevc=UseVC,verbose=Verbose},
+ PSz) ->
+ case UseVC orelse iolist_size(Buffer) > PSz of
+ true ->
+ {S0,query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose)};
+ false ->
+ case udp_open(S0, IP) of
+ {ok,S} ->
+ {S,case query_udp(S, Id, Buffer, IP, Port, Timer,
+ Retry, I, Tm, Verbose) of
+ {ok,#dns_rec{header=H}} when H#dns_header.tc ->
+ query_tcp(Tm, Id, Buffer,
+ IP, Port, Timer, Verbose);
+ Reply -> Reply
+ end};
+ Error ->
+ {S0,Error}
+ end
+ end.
+
+query_udp(S, Id, Buffer, IP, Port, Timer, Retry, I, Tm, Verbose) ->
+ Timeout = inet:timeout( (Tm * (1 bsl I)) div Retry, Timer),
+ ?verbose(Verbose, "Try UDP server : ~p:~p (timeout=~w)\n",
+ [IP, Port, Timeout]),
+ udp_connect(S, IP, Port),
+ udp_send(S, IP, Port, Buffer),
+ query_udp_recv(S, IP, Port, Id, Timeout, Verbose).
+
+query_udp_recv(S, IP, Port, Id, Timeout, Verbose) ->
+ case udp_recv(S, IP, Port, Timeout) of
+ {ok,Answer,T} ->
+ case decode_answer(Answer, Id, Verbose) of
+ {error, badid} ->
+ query_udp_recv(S, IP, Port, Id, T, Verbose);
+ Reply -> Reply
+ end;
+ {error, timeout} when Timeout =:= 0 ->
+ ?verbose(Verbose, "UDP server timeout\n", []),
+ timeout;
+ Error ->
+ ?verbose(Verbose, "UDP server error: ~p\n", [Error]),
+ Error
+ end.
+
+query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) ->
+ Timeout = inet:timeout(Tm*5, Timer),
+ ?verbose(Verbose, "Try TCP server : ~p:~p (timeout=~w)\n",
+ [IP, Port, Timeout]),
+ Family = case IP of
+ {A,B,C,D} when ?ip(A,B,C,D) -> inet;
+ {A,B,C,D,E,F,G,H} when ?ip6(A,B,C,D,E,F,G,H) -> inet6
+ end,
+ try gen_tcp:connect(IP, Port,
+ [{active,false},{packet,2},binary,Family],
+ Timeout) of
+ {ok, S} ->
+ gen_tcp:send(S, Buffer),
+ case gen_tcp:recv(S, 0, Timeout) of
+ {ok, Answer} ->
+ gen_tcp:close(S),
+ case decode_answer(Answer, Id, Verbose) of
+ {ok, _} = OK -> OK;
+ {error, badid} -> {error, servfail};
+ Error -> Error
+ end;
+ Error ->
+ gen_tcp:close(S),
+ case Error of
+ {error, timeout} when Timeout =:= 0 ->
+ ?verbose(Verbose, "TCP server recv timeout\n", []),
+ timeout;
+ _ ->
+ ?verbose(Verbose, "TCP server recv error: ~p\n",
+ [Error]),
+ Error
+ end
+ end;
+ {error, timeout} when Timeout =:= 0 ->
+ ?verbose(Verbose, "TCP server connect timeout\n", []),
+ timeout;
+ Error ->
+ ?verbose(Verbose, "TCP server error: ~p\n", [Error]),
+ Error
+ catch
+ _:_ -> {error, einval}
+ end.
+
+decode_answer(Answer, Id, Verbose) ->
+ case inet_dns:decode(Answer) of
+ {ok, Msg} ->
+ ?verbose(Verbose, "Got reply: ~p~n", [dns_msg(Msg)]),
+ E = case lists:keyfind(dns_rr_opt, 1, Msg#dns_rec.arlist) of
+ false -> 0;
+ #dns_rr_opt{ext_rcode=ExtRCode} -> ExtRCode
+ end,
+ H = Msg#dns_rec.header,
+ RCode = (E bsl 4) bor H#dns_header.rcode,
+ case RCode of
+ ?NOERROR ->
+ if H#dns_header.id =/= Id ->
+ {error,badid};
+ length(Msg#dns_rec.qdlist) =/= 1 ->
+ {error,{noquery,Msg}};
+ true ->
+ {ok, Msg}
+ end;
+ ?FORMERR -> {error,{qfmterror,Msg}};
+ ?SERVFAIL -> {error,{servfail,Msg}};
+ ?NXDOMAIN -> {error,{nxdomain,Msg}};
+ ?NOTIMP -> {error,{notimp,Msg}};
+ ?REFUSED -> {error,{refused,Msg}};
+ ?BADVERS -> {error,{badvers,Msg}};
+ _ -> {error,{unknown,Msg}}
+ end;
+ Error ->
+ ?verbose(Verbose, "Got reply: ~p~n", [Error]),
+ Error
+ end.
+
+%%
+%% Transform domain name or address
+%% 1. "a.b.c" =>
+%% "a.b.c"
+%% 2. "1.2.3.4" =>
+%% "4.3.2.1.IN-ADDR.ARPA"
+%% 3. "4321:0:1:2:3:4:567:89ab" =>
+%% "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.1.2.3.4.IP6.ARPA"
+%% 4. {1,2,3,4} => as 2.
+%% 5. {1,2,3,4,5,6,7,8} => as 3.
+%%
+nsdname({A,B,C,D}) ->
+ {ok, dn_in_addr_arpa(A,B,C,D)};
+nsdname({A,B,C,D,E,F,G,H}) ->
+ {ok, dn_ip6_int(A,B,C,D,E,F,G,H)};
+nsdname(Name) when is_list(Name) ->
+ case inet_parse:visible_string(Name) of
+ true ->
+ case inet_parse:address(Name) of
+ {ok, Addr} ->
+ nsdname(Addr);
+ _ ->
+ {ok, Name}
+ end;
+ _ -> {error, formerr}
+ end;
+nsdname(Name) when is_atom(Name) ->
+ nsdname(atom_to_list(Name));
+nsdname(_) -> {error, formerr}.
+
+dn_in_addr_arpa(A,B,C,D) ->
+ integer_to_list(D) ++
+ ("." ++ integer_to_list(C) ++
+ ("." ++ integer_to_list(B) ++
+ ("." ++ integer_to_list(A) ++ ".IN-ADDR.ARPA"))).
+
+dn_ip6_int(A,B,C,D,E,F,G,H) ->
+ dnib(H) ++
+ (dnib(G) ++
+ (dnib(F) ++
+ (dnib(E) ++
+ (dnib(D) ++
+ (dnib(C) ++
+ (dnib(B) ++
+ (dnib(A) ++ "IP6.ARPA"))))))).
+
+
+
+-compile({inline, [dnib/1, dnib/3]}).
+dnib(X) ->
+ L = erlang:integer_to_list(X, 16),
+ dnib(4-length(L), L, []).
+%%
+dnib(0, [], Acc) -> Acc;
+dnib(0, [C|Cs], Acc) ->
+ dnib(0, Cs, [C,$.|Acc]);
+dnib(N, Cs, Acc) ->
+ dnib(N-1, Cs, [$0,$.|Acc]).
+
+
+
+dns_msg([]) -> [];
+dns_msg([{Field,Msg}|Fields]) ->
+ [{Field,dns_msg(Msg)}|dns_msg(Fields)];
+dns_msg([Msg|Msgs]) ->
+ [dns_msg(Msg)|dns_msg(Msgs)];
+dns_msg(Msg) ->
+ case inet_dns:record_type(Msg) of
+ undefined -> Msg;
+ Type ->
+ Fields = inet_dns:Type(Msg),
+ {Type,dns_msg(Fields)}
+ end.
+
+-compile({inline, [now_ms/2]}).
+now_ms({Meg1,Sec1,Mic1}, {Meg0,Sec0,Mic0}) ->
+ ((Meg1-Meg0)*1000000 + (Sec1-Sec0))*1000 + ((Mic1-Mic0) div 1000).
diff --git a/lib/kernel/src/inet_res.hrl b/lib/kernel/src/inet_res.hrl
new file mode 100644
index 0000000000..bfaf32a1ba
--- /dev/null
+++ b/lib/kernel/src/inet_res.hrl
@@ -0,0 +1,42 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% Dns & resolver defintions
+%%
+
+-define(RES_TIMEOUT, 2000). %% milli second between retries
+-define(RES_RETRY, 3). %% number of retry
+-define(RES_FILE_UPDATE_TM, 5). %% seconds between file_info
+
+-define(CACHE_LIMIT, 100). %% number of cached dns_rr
+-define(CACHE_REFRESH, 60*60*1000). %% refresh interval
+
+-define(PACKETSZ, 512). %% maximum packet size
+-define(MAXDNAME, 256). %% maximum domain name
+-define(MAXCDNAME, 255). %% maximum compressed domain name
+-define(MAXLABEL, 63). %% maximum length of domain label
+%% Number of bytes of fixed size data in query structure
+-define(QFIXEDSZ, 4).
+%% number of bytes of fixed size data in resource record
+-define(RRFIXEDSZ, 10).
+
+%%
+%% Internet nameserver port number
+%%
+-define(NAMESERVER_PORT, 53).
diff --git a/lib/kernel/src/inet_sctp.erl b/lib/kernel/src/inet_sctp.erl
new file mode 100644
index 0000000000..30c0e85dd9
--- /dev/null
+++ b/lib/kernel/src/inet_sctp.erl
@@ -0,0 +1,139 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% SCTP protocol contribution by Leonid Timochouk and Serge Aleynikov.
+%% See also: $ERL_TOP/lib/kernel/AUTHORS
+%%
+-module(inet_sctp).
+
+%% This module provides functions for communicating with
+%% sockets using the SCTP protocol. The implementation assumes that
+%% the OS kernel supports SCTP providing user-level SCTP Socket API:
+%% http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13
+
+-include("inet_sctp.hrl").
+-include("inet_int.hrl").
+
+-define(FAMILY, inet).
+-export([getserv/1,getaddr/1,getaddr/2,translate_ip/1]).
+-export([open/1,close/1,listen/2,connect/5,sendmsg/3,recv/2]).
+
+
+
+getserv(Port) when is_integer(Port) -> {ok, Port};
+getserv(Name) when is_atom(Name) ->
+ inet:getservbyname(Name, sctp);
+getserv(_) ->
+ {error,einval}.
+
+getaddr(Address) ->
+ inet:getaddr(Address, ?FAMILY).
+getaddr(Address, Timer) ->
+ inet:getaddr_tm(Address, ?FAMILY, Timer).
+
+translate_ip(IP) ->
+ inet:translate_ip(IP, ?FAMILY).
+
+
+
+open(Opts) ->
+ case inet:sctp_options(Opts, ?MODULE) of
+ {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,opts=SOs}} ->
+ inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, ?MODULE);
+ Error -> Error
+ end.
+
+close(S) ->
+ prim_inet:close(S).
+
+listen(S, Flag) ->
+ prim_inet:listen(S, Flag).
+
+connect(S, Addr, Port, Opts, Timer) ->
+ case prim_inet:chgopts(S, Opts) of
+ ok ->
+ case prim_inet:getopt(S, active) of
+ {ok,Active} ->
+ Timeout = inet:timeout(Timer),
+ case prim_inet:connect(S, Addr, Port, Timeout) of
+ ok ->
+ connect_get_assoc(S, Addr, Port, Active, Timer);
+ Err1 -> Err1
+ end;
+ Err2 -> Err2
+ end;
+ Err3 -> Err3
+ end.
+
+%% XXX race condition problem
+%%
+%% If an incoming #sctp_assoc_change{} arrives after
+%% prim_inet:getopt(S, alive) above but before the
+%% #sctp_assoc_change{state=comm_up} originating from
+%% prim_inet:connect(S, Addr, Port, Timeout) above,
+%% connect_get_assoc/5 below mistakes it for an invalid response
+%% for a socket in {active,false} or {active,once} modes.
+%%
+%% In {active,true} mode it probably gets right, but it is
+%% a blocking connect that is implemented even for {active,true},
+%% and that may be a shortcoming. A non-blocking connect
+%% would be nice to have.
+
+connect_get_assoc(S, Addr, Port, false, Timer) ->
+ case recv(S, inet:timeout(Timer)) of
+ {ok, {Addr, Port, [], #sctp_assoc_change{state=St}=Ev}} ->
+ if St =:= comm_up ->
+ %% Yes, successfully connected, return the whole
+ %% sctp_assoc_change event (containing, in particular,
+ %% the AssocID).
+ %% NB: we consider the connection to be successful
+ %% even if the number of OutStreams is not the same
+ %% as requested by the user:
+ {ok,Ev};
+ true ->
+ {error,Ev}
+ end;
+ %% Any other event: Error:
+ {ok, Msg} ->
+ {error, Msg};
+ {error,_}=Error ->
+ Error
+ end;
+connect_get_assoc(S, Addr, Port, Active, Timer) ->
+ Timeout = inet:timeout(Timer),
+ receive
+ {sctp,S,Addr,Port,{[],#sctp_assoc_change{state=St}=Ev}} ->
+ case Active of
+ once ->
+ prim_inet:setopt(S, active, once);
+ _ -> ok
+ end,
+ if St =:= comm_up ->
+ {ok,Ev};
+ true ->
+ {error,Ev}
+ end
+ after Timeout ->
+ {error,timeout}
+ end.
+
+sendmsg(S, SRI, Data) ->
+ prim_inet:sendmsg(S, SRI, Data).
+
+recv(S, Timeout) ->
+ prim_inet:recvfrom(S, 0, Timeout).
diff --git a/lib/kernel/src/inet_tcp.erl b/lib/kernel/src/inet_tcp.erl
new file mode 100644
index 0000000000..6dadccd6a9
--- /dev/null
+++ b/lib/kernel/src/inet_tcp.erl
@@ -0,0 +1,153 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_tcp).
+
+%% Socket server for TCP/IP
+
+-export([connect/3, connect/4, listen/2, accept/1, accept/2, close/1]).
+-export([send/2, send/3, recv/2, recv/3, unrecv/2]).
+-export([shutdown/2]).
+-export([controlling_process/2]).
+-export([fdopen/2]).
+
+-export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]).
+
+
+-include("inet_int.hrl").
+
+%% inet_tcp port lookup
+getserv(Port) when is_integer(Port) -> {ok, Port};
+getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,tcp).
+
+%% inet_tcp address lookup
+getaddr(Address) -> inet:getaddr(Address, inet).
+getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet, Timer).
+
+%% inet_tcp address lookup
+getaddrs(Address) -> inet:getaddrs(Address, inet).
+getaddrs(Address,Timer) -> inet:getaddrs_tm(Address,inet,Timer).
+
+%%
+%% Send data on a socket
+%%
+send(Socket, Packet, Opts) -> prim_inet:send(Socket, Packet, Opts).
+send(Socket, Packet) -> prim_inet:send(Socket, Packet, []).
+
+%%
+%% Receive data from a socket (inactive only)
+%%
+recv(Socket, Length) -> prim_inet:recv(Socket, Length).
+recv(Socket, Length, Timeout) -> prim_inet:recv(Socket, Length, Timeout).
+
+unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data).
+
+%%
+%% Shutdown one end of a socket
+%%
+shutdown(Socket, How) ->
+ prim_inet:shutdown(Socket, How).
+
+%%
+%% Close a socket (async)
+%%
+close(Socket) ->
+ inet:tcp_close(Socket).
+
+%%
+%% Set controlling process
+%%
+controlling_process(Socket, NewOwner) ->
+ inet:tcp_controlling_process(Socket, NewOwner).
+
+%%
+%% Connect
+%%
+connect(Address, Port, Opts) ->
+ do_connect(Address, Port, Opts, infinity).
+
+connect(Address, Port, Opts, infinity) ->
+ do_connect(Address, Port, Opts, infinity);
+connect(Address, Port, Opts, Timeout) when is_integer(Timeout),
+ Timeout >= 0 ->
+ do_connect(Address, Port, Opts, Timeout).
+
+do_connect({A,B,C,D}, Port, Opts, Time) when ?ip(A,B,C,D), ?port(Port) ->
+ case inet:connect_options(Opts, inet) of
+ {error, Reason} -> exit(Reason);
+ {ok, #connect_opts{fd=Fd,
+ ifaddr=BAddr={Ab,Bb,Cb,Db},
+ port=BPort,
+ opts=SockOpts}}
+ when ?ip(Ab,Bb,Cb,Db), ?port(BPort) ->
+ case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet,?MODULE) of
+ {ok, S} ->
+ case prim_inet:connect(S, {A,B,C,D}, Port, Time) of
+ ok -> {ok,S};
+ Error -> prim_inet:close(S), Error
+ end;
+ Error -> Error
+ end;
+ {ok, _} -> exit(badarg)
+ end.
+
+%%
+%% Listen
+%%
+listen(Port, Opts) ->
+ case inet:listen_options([{port,Port} | Opts], inet) of
+ {error,Reason} -> exit(Reason);
+ {ok, #listen_opts{fd=Fd,
+ ifaddr=BAddr={A,B,C,D},
+ port=BPort,
+ opts=SockOpts}=R}
+ when ?ip(A,B,C,D), ?port(BPort) ->
+ case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet,?MODULE) of
+ {ok, S} ->
+ case prim_inet:listen(S, R#listen_opts.backlog) of
+ ok -> {ok, S};
+ Error -> prim_inet:close(S), Error
+ end;
+ Error -> Error
+ end;
+ {ok, _} -> exit(badarg)
+ end.
+
+%%
+%% Accept
+%%
+accept(L) ->
+ case prim_inet:accept(L) of
+ {ok, S} ->
+ inet_db:register_socket(S, ?MODULE),
+ {ok,S};
+ Error -> Error
+ end.
+
+accept(L,Timeout) ->
+ case prim_inet:accept(L,Timeout) of
+ {ok, S} ->
+ inet_db:register_socket(S, ?MODULE),
+ {ok,S};
+ Error -> Error
+ end.
+%%
+%% Create a port/socket from a file descriptor
+%%
+fdopen(Fd, Opts) ->
+ inet:fdopen(Fd, Opts, tcp, inet, ?MODULE).
diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl
new file mode 100644
index 0000000000..7f935c2b36
--- /dev/null
+++ b/lib/kernel/src/inet_tcp_dist.erl
@@ -0,0 +1,448 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_tcp_dist).
+
+%% Handles the connection setup phase with other Erlang nodes.
+
+-export([listen/1, accept/1, accept_connection/5,
+ setup/5, close/1, select/1, is_node_name/1]).
+
+%% internal exports
+
+-export([accept_loop/2,do_accept/6,do_setup/6,getstat/1,tick/1]).
+
+-import(error_logger,[error_msg/2]).
+
+-include("net_address.hrl").
+
+
+
+-define(to_port(Socket, Data, Opts),
+ case inet_tcp:send(Socket, Data, Opts) of
+ {error, closed} ->
+ self() ! {tcp_closed, Socket},
+ {error, closed};
+ R ->
+ R
+ end).
+
+
+-include("dist.hrl").
+-include("dist_util.hrl").
+
+%% ------------------------------------------------------------
+%% Select this protocol based on node name
+%% select(Node) => Bool
+%% ------------------------------------------------------------
+
+select(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_,_Host] -> true;
+ _ -> false
+ end.
+
+%% ------------------------------------------------------------
+%% Create the listen socket, i.e. the port that this erlang
+%% node is accessible through.
+%% ------------------------------------------------------------
+
+listen(Name) ->
+ case do_listen([{active, false}, {packet,2}, {reuseaddr, true}]) of
+ {ok, Socket} ->
+ TcpAddress = get_tcp_address(Socket),
+ {_,Port} = TcpAddress#net_address.address,
+ {ok, Creation} = erl_epmd:register_node(Name, Port),
+ {ok, {Socket, TcpAddress, Creation}};
+ Error ->
+ Error
+ end.
+
+do_listen(Options0) ->
+ {First,Last} = case application:get_env(kernel,inet_dist_listen_min) of
+ {ok,N} when is_integer(N) ->
+ case application:get_env(kernel,
+ inet_dist_listen_max) of
+ {ok,M} when is_integer(M) ->
+ {N,M};
+ _ ->
+ {N,N}
+ end;
+ _ ->
+ {0,0}
+ end,
+ Options = case application:get_env(kernel, inet_dist_use_interface) of
+ {ok, Ip} ->
+ [{ip, Ip} | Options0];
+ _ ->
+ Options0
+ end,
+ do_listen(First, Last, [{backlog,128}|Options]).
+
+do_listen(First,Last,_) when First > Last ->
+ {error,eaddrinuse};
+do_listen(First,Last,Options) ->
+ case inet_tcp:listen(First, Options) of
+ {error, eaddrinuse} ->
+ do_listen(First+1,Last,Options);
+ Other ->
+ Other
+ end.
+
+%% ------------------------------------------------------------
+%% Accepts new connection attempts from other Erlang nodes.
+%% ------------------------------------------------------------
+
+accept(Listen) ->
+ spawn_opt(?MODULE, accept_loop, [self(), Listen], [link, {priority, max}]).
+
+accept_loop(Kernel, Listen) ->
+ case inet_tcp:accept(Listen) of
+ {ok, Socket} ->
+ Kernel ! {accept,self(),Socket,inet,tcp},
+ controller(Kernel, Socket),
+ accept_loop(Kernel, Listen);
+ Error ->
+ exit(Error)
+ end.
+
+controller(Kernel, Socket) ->
+ receive
+ {Kernel, controller, Pid} ->
+ flush_controller(Pid, Socket),
+ inet_tcp:controlling_process(Socket, Pid),
+ flush_controller(Pid, Socket),
+ Pid ! {self(), controller};
+ {Kernel, unsupported_protocol} ->
+ exit(unsupported_protocol)
+ end.
+
+flush_controller(Pid, Socket) ->
+ receive
+ {tcp, Socket, Data} ->
+ Pid ! {tcp, Socket, Data},
+ flush_controller(Pid, Socket);
+ {tcp_closed, Socket} ->
+ Pid ! {tcp_closed, Socket},
+ flush_controller(Pid, Socket)
+ after 0 ->
+ ok
+ end.
+
+%% ------------------------------------------------------------
+%% Accepts a new connection attempt from another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+ spawn_opt(?MODULE, do_accept,
+ [self(), AcceptPid, Socket, MyNode, Allowed, SetupTime],
+ [link, {priority, max}]).
+
+do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
+ receive
+ {AcceptPid, controller} ->
+ Timer = dist_util:start_timer(SetupTime),
+ case check_ip(Socket) of
+ true ->
+ HSData = #hs_data{
+ kernel_pid = Kernel,
+ this_node = MyNode,
+ socket = Socket,
+ timer = Timer,
+ this_flags = 0,
+ allowed = Allowed,
+ f_send = fun(S,D) -> inet_tcp:send(S,D) end,
+ f_recv = fun(S,N,T) -> inet_tcp:recv(S,N,T)
+ end,
+ f_setopts_pre_nodeup =
+ fun(S) ->
+ inet:setopts(S,
+ [{active, false},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_setopts_post_nodeup =
+ fun(S) ->
+ inet:setopts(S,
+ [{active, true},
+ {deliver, port},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_getll = fun(S) ->
+ inet:getll(S)
+ end,
+ f_address = fun get_remote_id/2,
+ mf_tick = fun ?MODULE:tick/1,
+ mf_getstat = fun ?MODULE:getstat/1
+ },
+ dist_util:handshake_other_started(HSData);
+ {false,IP} ->
+ error_msg("** Connection attempt from "
+ "disallowed IP ~w ** ~n", [IP]),
+ ?shutdown(no_node)
+ end
+ end.
+
+
+%% we may not always want the nodelay behaviour
+%% for performance reasons
+
+nodelay() ->
+ case application:get_env(kernel, dist_nodelay) of
+ undefined ->
+ {nodelay, true};
+ {ok, true} ->
+ {nodelay, true};
+ {ok, false} ->
+ {nodelay, false};
+ _ ->
+ {nodelay, true}
+ end.
+
+
+%% ------------------------------------------------------------
+%% Get remote information about a Socket.
+%% ------------------------------------------------------------
+get_remote_id(Socket, Node) ->
+ case inet:peername(Socket) of
+ {ok,Address} ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_,Host] ->
+ #net_address{address=Address,host=Host,
+ protocol=tcp,family=inet};
+ _ ->
+ %% No '@' or more than one '@' in node name.
+ ?shutdown(no_node)
+ end;
+ {error, _Reason} ->
+ ?shutdown(no_node)
+ end.
+
+%% ------------------------------------------------------------
+%% Setup a new connection to another Erlang node.
+%% Performs the handshake with the other side.
+%% ------------------------------------------------------------
+
+setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
+ spawn_opt(?MODULE, do_setup,
+ [self(), Node, Type, MyNode, LongOrShortNames, SetupTime],
+ [link, {priority, max}]).
+
+do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) ->
+ ?trace("~p~n",[{inet_tcp_dist,self(),setup,Node}]),
+ [Name, Address] = splitnode(Node, LongOrShortNames),
+ case inet:getaddr(Address, inet) of
+ {ok, Ip} ->
+ Timer = dist_util:start_timer(SetupTime),
+ case erl_epmd:port_please(Name, Ip) of
+ {port, TcpPort, Version} ->
+ ?trace("port_please(~p) -> version ~p~n",
+ [Node,Version]),
+ dist_util:reset_timer(Timer),
+ case inet_tcp:connect(Ip, TcpPort,
+ [{active, false},
+ {packet,2}]) of
+ {ok, Socket} ->
+ HSData = #hs_data{
+ kernel_pid = Kernel,
+ other_node = Node,
+ this_node = MyNode,
+ socket = Socket,
+ timer = Timer,
+ this_flags = 0,
+ other_version = Version,
+ f_send = fun inet_tcp:send/2,
+ f_recv = fun inet_tcp:recv/3,
+ f_setopts_pre_nodeup =
+ fun(S) ->
+ inet:setopts
+ (S,
+ [{active, false},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_setopts_post_nodeup =
+ fun(S) ->
+ inet:setopts
+ (S,
+ [{active, true},
+ {deliver, port},
+ {packet, 4},
+ nodelay()])
+ end,
+ f_getll = fun inet:getll/1,
+ f_address =
+ fun(_,_) ->
+ #net_address{
+ address = {Ip,TcpPort},
+ host = Address,
+ protocol = tcp,
+ family = inet}
+ end,
+ mf_tick = fun ?MODULE:tick/1,
+ mf_getstat = fun ?MODULE:getstat/1,
+ request_type = Type
+ },
+ dist_util:handshake_we_started(HSData);
+ _ ->
+ %% Other Node may have closed since
+ %% port_please !
+ ?trace("other node (~p) "
+ "closed since port_please.~n",
+ [Node]),
+ ?shutdown(Node)
+ end;
+ _ ->
+ ?trace("port_please (~p) "
+ "failed.~n", [Node]),
+ ?shutdown(Node)
+ end;
+ _Other ->
+ ?trace("inet_getaddr(~p) "
+ "failed (~p).~n", [Node,_Other]),
+ ?shutdown(Node)
+ end.
+
+%%
+%% Close a socket.
+%%
+close(Socket) ->
+ inet_tcp:close(Socket).
+
+
+%% If Node is illegal terminate the connection setup!!
+splitnode(Node, LongOrShortNames) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [Name|Tail] when Tail =/= [] ->
+ Host = lists:append(Tail),
+ case split_node(Host, $., []) of
+ [_] when LongOrShortNames =:= longnames ->
+ error_msg("** System running to use "
+ "fully qualified "
+ "hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown(Node);
+ L when length(L) > 1, LongOrShortNames =:= shortnames ->
+ error_msg("** System NOT running to use fully qualified "
+ "hostnames **~n"
+ "** Hostname ~s is illegal **~n",
+ [Host]),
+ ?shutdown(Node);
+ _ ->
+ [Name, Host]
+ end;
+ [_] ->
+ error_msg("** Nodename ~p illegal, no '@' character **~n",
+ [Node]),
+ ?shutdown(Node);
+ _ ->
+ error_msg("** Nodename ~p illegal **~n", [Node]),
+ ?shutdown(Node)
+ end.
+
+split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])];
+split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]);
+split_node([], _, Ack) -> [lists:reverse(Ack)].
+
+%% ------------------------------------------------------------
+%% Fetch local information about a Socket.
+%% ------------------------------------------------------------
+get_tcp_address(Socket) ->
+ {ok, Address} = inet:sockname(Socket),
+ {ok, Host} = inet:gethostname(),
+ #net_address {
+ address = Address,
+ host = Host,
+ protocol = tcp,
+ family = inet
+ }.
+
+%% ------------------------------------------------------------
+%% Do only accept new connection attempts from nodes at our
+%% own LAN, if the check_ip environment parameter is true.
+%% ------------------------------------------------------------
+check_ip(Socket) ->
+ case application:get_env(check_ip) of
+ {ok, true} ->
+ case get_ifs(Socket) of
+ {ok, IFs, IP} ->
+ check_ip(IFs, IP);
+ _ ->
+ ?shutdown(no_node)
+ end;
+ _ ->
+ true
+ end.
+
+get_ifs(Socket) ->
+ case inet:peername(Socket) of
+ {ok, {IP, _}} ->
+ case inet:getif(Socket) of
+ {ok, IFs} -> {ok, IFs, IP};
+ Error -> Error
+ end;
+ Error ->
+ Error
+ end.
+
+check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) ->
+ case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of
+ {M, M} -> true;
+ _ -> check_ip(IFs, PeerIP)
+ end;
+check_ip([], PeerIP) ->
+ {false, PeerIP}.
+
+mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) ->
+ {M1 band IP1,
+ M2 band IP2,
+ M3 band IP3,
+ M4 band IP4}.
+
+is_node_name(Node) when is_atom(Node) ->
+ case split_node(atom_to_list(Node), $@, []) of
+ [_, _Host] -> true;
+ _ -> false
+ end;
+is_node_name(_Node) ->
+ false.
+
+tick(Sock) ->
+ ?to_port(Sock,[],[force]).
+
+getstat(Socket) ->
+ case inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of
+ {ok, Stat} ->
+ split_stat(Stat,0,0,0);
+ Error ->
+ Error
+ end.
+
+split_stat([{recv_cnt, R}|Stat], _, W, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_cnt, W}|Stat], R, _, P) ->
+ split_stat(Stat, R, W, P);
+split_stat([{send_pend, P}|Stat], R, W, _) ->
+ split_stat(Stat, R, W, P);
+split_stat([], R, W, P) ->
+ {ok, R, W, P}.
+
+
diff --git a/lib/kernel/src/inet_udp.erl b/lib/kernel/src/inet_udp.erl
new file mode 100644
index 0000000000..9a4089ab19
--- /dev/null
+++ b/lib/kernel/src/inet_udp.erl
@@ -0,0 +1,132 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_udp).
+
+-export([open/1, open/2, close/1]).
+-export([send/2, send/4, recv/2, recv/3, connect/3]).
+-export([controlling_process/2]).
+-export([fdopen/2]).
+
+-export([getserv/1, getaddr/1, getaddr/2]).
+
+-include("inet_int.hrl").
+
+-define(RECBUF, (8*1024)).
+
+
+
+%% inet_udp port lookup
+getserv(Port) when is_integer(Port) -> {ok, Port};
+getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,udp).
+
+%% inet_udp address lookup
+getaddr(Address) -> inet:getaddr(Address, inet).
+getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet, Timer).
+
+open(Port) -> open(Port, []).
+
+open(Port, Opts) ->
+ case inet:udp_options(
+ [{port,Port}, {recbuf, ?RECBUF} | Opts],
+ inet) of
+ {error, Reason} -> exit(Reason);
+ {ok, #udp_opts{fd=Fd,
+ ifaddr=BAddr={A,B,C,D},
+ port=BPort,
+ opts=SockOpts}} when ?ip(A,B,C,D), ?port(BPort) ->
+ inet:open(Fd,BAddr,BPort,SockOpts,udp,inet,?MODULE);
+ {ok, _} -> exit(badarg)
+ end.
+
+send(S,{A,B,C,D},P,Data) when ?ip(A,B,C,D), ?port(P) ->
+ prim_inet:sendto(S, {A,B,C,D}, P, Data).
+
+send(S, Data) ->
+ prim_inet:sendto(S, {0,0,0,0}, 0, Data).
+
+connect(S, {A,B,C,D}, P) when ?ip(A,B,C,D), ?port(P) ->
+ prim_inet:connect(S, {A,B,C,D}, P).
+
+recv(S,Len) ->
+ prim_inet:recvfrom(S, Len).
+
+recv(S,Len,Time) ->
+ prim_inet:recvfrom(S, Len, Time).
+
+close(S) ->
+ inet:udp_close(S).
+
+%%
+%% Set controlling process:
+%% 1) First sync socket into a known state
+%% 2) Move all messages onto the new owners message queue
+%% 3) Commit the owner
+%% 4) Wait for ack of new Owner (since socket does some link and unlink)
+%%
+
+controlling_process(Socket, NewOwner) ->
+ inet:udp_controlling_process(Socket, NewOwner).
+
+%%
+%% Create a port/socket from a file descriptor
+%%
+fdopen(Fd, Opts) ->
+ inet:fdopen(Fd,
+ optuniquify([{recbuf, ?RECBUF} | Opts]),
+ udp, inet, ?MODULE).
+
+
+%% Remove all duplicate options from an option list.
+%% The last occurring duplicate is used, and the order is preserved.
+%%
+%% Here's how:
+%% Reverse the list.
+%% For each head option go through the tail and remove
+%% all occurences of the same option from the tail.
+%% Store that head option and iterate using the new tail.
+%% Return the list of stored head options.
+optuniquify(List) ->
+ optuniquify(lists:reverse(List), []).
+
+optuniquify([], Result) ->
+ Result;
+optuniquify([Opt | Tail], Result) ->
+ %% Remove all occurences of Opt in Tail,
+ %% prepend Opt to Result,
+ %% then iterate back here.
+ optuniquify(Opt, Tail, [], Result).
+
+%% All duplicates of current option are now removed
+optuniquify(Opt, [], Rest, Result) ->
+ %% Store unique option
+ optuniquify(lists:reverse(Rest), [Opt | Result]);
+%% Duplicate option tuple
+optuniquify(Opt0, [Opt1 | Tail], Rest, Result)
+ when tuple_size(Opt0) =:= tuple_size(Opt1),
+ element(1, Opt0) =:= element(1, Opt1) ->
+ %% Waste duplicate
+ optuniquify(Opt0, Tail, Rest, Result);
+%% Duplicate option atom or other term
+optuniquify(Opt, [Opt | Tail], Rest, Result) ->
+ %% Waste duplicate
+ optuniquify(Opt, Tail, Rest, Result);
+%% Non-duplicate option
+optuniquify(Opt, [X | Tail], Rest, Result) ->
+ %% Keep non-duplicate
+ optuniquify(Opt, Tail, [X | Rest], Result).
diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src
new file mode 100644
index 0000000000..17ab84c177
--- /dev/null
+++ b/lib/kernel/src/kernel.app.src
@@ -0,0 +1,120 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% This is an -*- erlang -*- file.
+%%
+{application, kernel,
+ [
+ {description, "ERTS CXC 138 10"},
+ {vsn, "%VSN%"},
+ {modules, [application,
+ application_controller,
+ application_master,
+ application_starter,
+ auth,
+ code,
+ packages,
+ code_server,
+ dist_util,
+ erl_boot_server,
+ erl_distribution,
+ erl_reply,
+ error_handler,
+ error_logger,
+ file,
+ file_server,
+ file_io_server,
+ global,
+ global_group,
+ global_search,
+ group,
+ heart,
+ hipe_unified_loader,
+ inet6_tcp,
+ inet6_tcp_dist,
+ inet6_udp,
+ inet6_sctp,
+ inet_config,
+ inet_hosts,
+ inet_gethost_native,
+ inet_tcp_dist,
+ kernel,
+ kernel_config,
+ net,
+ net_adm,
+ net_kernel,
+ os,
+ ram_file,
+ rpc,
+ user,
+ user_drv,
+ user_sup,
+ disk_log,
+ disk_log_1,
+ disk_log_server,
+ disk_log_sup,
+ dist_ac,
+ erl_ddll,
+ erl_epmd,
+ erts_debug,
+ gen_tcp,
+ gen_udp,
+ gen_sctp,
+ inet,
+ inet_db,
+ inet_dns,
+ inet_parse,
+ inet_res,
+ inet_tcp,
+ inet_udp,
+ inet_sctp,
+ pg2,
+ seq_trace,
+ standard_error,
+ wrap_log_reader]},
+ {registered, [application_controller,
+ erl_reply,
+ auth,
+ boot_server,
+ code_server,
+ disk_log_server,
+ disk_log_sup,
+ erl_prim_loader,
+ error_logger,
+ file_server_2,
+ fixtable_server,
+ global_group,
+ global_name_server,
+ heart,
+ init,
+ kernel_config,
+ kernel_sup,
+ net_kernel,
+ net_sup,
+ rex,
+ user,
+ os_server,
+ ddll_server,
+ erl_epmd,
+ inet_db,
+ pg2]},
+ {applications, []},
+ {env, [{error_logger, tty}]},
+ {mod, {kernel, []}}
+ ]
+}.
diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src
new file mode 100644
index 0000000000..54a63833e6
--- /dev/null
+++ b/lib/kernel/src/kernel.appup.src
@@ -0,0 +1 @@
+{"%VSN%",[],[]}.
diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl
new file mode 100644
index 0000000000..92ee7b441a
--- /dev/null
+++ b/lib/kernel/src/kernel.erl
@@ -0,0 +1,292 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(kernel).
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2, init/1, stop/1]).
+-export([config_change/3]).
+
+%%%-----------------------------------------------------------------
+%%% The kernel is the first application started.
+%%% Callback functions for the kernel application.
+%%%-----------------------------------------------------------------
+start(_, []) ->
+ case supervisor:start_link({local, kernel_sup}, kernel, []) of
+ {ok, Pid} ->
+ Type = get_error_logger_type(),
+ error_logger:swap_handler(Type),
+ {ok, Pid, []};
+ Error -> Error
+ end.
+
+stop(_State) ->
+ ok.
+
+%%-------------------------------------------------------------------
+%% Some configuration parameters for kernel are changed
+%%-------------------------------------------------------------------
+config_change(Changed, New, Removed) ->
+ do_distribution_change(Changed, New, Removed),
+ do_global_groups_change(Changed, New, Removed),
+ ok.
+
+get_error_logger_type() ->
+ case application:get_env(kernel, error_logger) of
+ {ok, tty} -> tty;
+ {ok, {file, File}} when is_list(File) -> {logfile, File};
+ {ok, false} -> false;
+ {ok, silent} -> silent;
+ undefined -> tty; % default value
+ {ok, Bad} -> exit({bad_config, {kernel, {error_logger, Bad}}})
+ end.
+
+%%%-----------------------------------------------------------------
+%%% The process structure in kernel is as shown in the figure.
+%%%
+%%% ---------------
+%%% | kernel_sup (A)|
+%%% ---------------
+%%% |
+%%% -------------------------------
+%%% | | |
+%%% <std services> ------------- -------------
+%%% (file,code, | erl_dist (A)| | safe_sup (1)|
+%%% rpc, ...) ------------- -------------
+%%% | |
+%%% (net_kernel, (disk_log, pg2,
+%%% auth, ...) ...)
+%%%
+%%% The rectangular boxes are supervisors. All supervisors except
+%%% for kernel_safe_sup terminates the enitre erlang node if any of
+%%% their children dies. Any child that can't be restarted in case
+%%% of failure must be placed under one of these supervisors. Any
+%%% other child must be placed under safe_sup. These children may
+%%% be restarted. Be aware that if a child is restarted the old state
+%%% and all data will be lost.
+%%%-----------------------------------------------------------------
+%%% Callback functions for the kernel_sup supervisor.
+%%%-----------------------------------------------------------------
+
+init([]) ->
+ SupFlags = {one_for_all, 0, 1},
+
+ Config = {kernel_config,
+ {kernel_config, start_link, []},
+ permanent, 2000, worker, [kernel_config]},
+ Code = {code_server,
+ {code, start_link, get_code_args()},
+ permanent, 2000, worker, [code]},
+ File = {file_server_2,
+ {file_server, start_link, []},
+ permanent, 2000, worker,
+ [file, file_server, file_io_server, prim_file]},
+ StdError = {standard_error,
+ {standard_error, start_link, []},
+ temporary, 2000, supervisor, [user_sup]},
+ User = {user,
+ {user_sup, start, []},
+ temporary, 2000, supervisor, [user_sup]},
+
+ case init:get_argument(mode) of
+ {ok, [["minimal"]]} ->
+ SafeSupervisor = {kernel_safe_sup,
+ {supervisor, start_link,
+ [{local, kernel_safe_sup}, ?MODULE, safe]},
+ permanent, infinity, supervisor, [?MODULE]},
+ {ok, {SupFlags,
+ [File, Code, StdError, User,
+ Config, SafeSupervisor]}};
+ _ ->
+ Rpc = {rex, {rpc, start_link, []},
+ permanent, 2000, worker, [rpc]},
+ Global = {global_name_server, {global, start_link, []},
+ permanent, 2000, worker, [global]},
+ Glo_grp = {global_group, {global_group,start_link,[]},
+ permanent, 2000, worker, [global_group]},
+ InetDb = {inet_db, {inet_db, start_link, []},
+ permanent, 2000, worker, [inet_db]},
+ NetSup = {net_sup, {erl_distribution, start_link, []},
+ permanent, infinity, supervisor,[erl_distribution]},
+ DistAC = start_dist_ac(),
+
+ Timer = start_timer(),
+
+ SafeSupervisor = {kernel_safe_sup,
+ {supervisor, start_link,
+ [{local, kernel_safe_sup}, ?MODULE, safe]},
+ permanent, infinity, supervisor, [?MODULE]},
+ {ok, {SupFlags,
+ [Rpc, Global, InetDb | DistAC] ++
+ [NetSup, Glo_grp, File, Code,
+ StdError, User, Config, SafeSupervisor] ++ Timer}}
+ end;
+init(safe) ->
+ SupFlags = {one_for_one, 4, 3600},
+ Boot = start_boot_server(),
+ DiskLog = start_disk_log(),
+ Pg2 = start_pg2(),
+ {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}.
+
+get_code_args() ->
+ case init:get_argument(nostick) of
+ {ok, [[]]} -> [[nostick]];
+ _ -> []
+ end.
+
+start_dist_ac() ->
+ Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}],
+ case application:get_env(kernel, start_dist_ac) of
+ {ok, true} -> Spec;
+ {ok, false} -> [];
+ undefined ->
+ case application:get_env(kernel, distributed) of
+ {ok, _} -> Spec;
+ _ -> []
+ end
+ end.
+
+start_boot_server() ->
+ case application:get_env(kernel, start_boot_server) of
+ {ok, true} ->
+ Args = get_boot_args(),
+ [{boot_server, {erl_boot_server, start_link, [Args]}, permanent,
+ 1000, worker, [erl_boot_server]}];
+ _ ->
+ []
+ end.
+
+get_boot_args() ->
+ case application:get_env(kernel, boot_server_slaves) of
+ {ok, Slaves} -> Slaves;
+ _ -> []
+ end.
+
+start_disk_log() ->
+ case application:get_env(kernel, start_disk_log) of
+ {ok, true} ->
+ [{disk_log_server,
+ {disk_log_server, start_link, []},
+ permanent, 2000, worker, [disk_log_server]},
+ {disk_log_sup, {disk_log_sup, start_link, []}, permanent,
+ 1000, supervisor, [disk_log_sup]}];
+ _ ->
+ []
+ end.
+
+start_pg2() ->
+ case application:get_env(kernel, start_pg2) of
+ {ok, true} ->
+ [{pg2, {pg2, start_link, []}, permanent, 1000, worker, [pg2]}];
+ _ ->
+ []
+ end.
+
+start_timer() ->
+ case application:get_env(kernel, start_timer) of
+ {ok, true} ->
+ [{timer_server, {timer, start_link, []}, permanent, 1000, worker,
+ [timer]}];
+ _ ->
+ []
+ end.
+
+%%-----------------------------------------------------------------
+%% The change of the distributed parameter is taken care of here
+%%-----------------------------------------------------------------
+do_distribution_change(Changed, New, Removed) ->
+ %% check if the distributed parameter is changed. It is not allowed
+ %% to make a local application to a distributed one, or vice versa.
+ case is_dist_changed(Changed, New, Removed) of
+ %%{changed, new, removed}
+ {false, false, false} ->
+ ok;
+ {C, false, false} ->
+ %% At last, update the parameter.
+ gen_server:call(dist_ac, {distribution_changed, C}, infinity);
+ {false, _, false} ->
+ error_logger:error_report("Distribution not changed: "
+ "Not allowed to add the 'distributed' "
+ "parameter."),
+ {error, {distribution_not_changed, "Not allowed to add the "
+ "'distributed' parameter"}};
+ {false, false, _} ->
+ error_logger:error_report("Distribution not changed: "
+ "Not allowed to remove the "
+ "distribution parameter."),
+ {error, {distribution_not_changed, "Not allowed to remove the "
+ "'distributed' parameter"}}
+ end.
+
+%%-----------------------------------------------------------------
+%% Check if distribution is changed in someway.
+%%-----------------------------------------------------------------
+is_dist_changed(Changed, New, Removed) ->
+ C = case lists:keyfind(distributed, 1, Changed) of
+ false ->
+ false;
+ {distributed, NewDistC} ->
+ NewDistC
+ end,
+ N = case lists:keyfind(distributed, 1, New) of
+ false ->
+ false;
+ {distributed, NewDistN} ->
+ NewDistN
+ end,
+ R = lists:member(distributed, Removed),
+ {C, N, R}.
+
+%%-----------------------------------------------------------------
+%% The change of the global_groups parameter is taken care of here
+%%-----------------------------------------------------------------
+do_global_groups_change(Changed, New, Removed) ->
+ %% check if the global_groups parameter is changed.
+ case is_gg_changed(Changed, New, Removed) of
+ %%{changed, new, removed}
+ {false, false, false} ->
+ ok;
+ {C, false, false} ->
+ %% At last, update the parameter.
+ global_group:global_groups_changed(C);
+ {false, N, false} ->
+ global_group:global_groups_added(N);
+ {false, false, R} ->
+ global_group:global_groups_removed(R)
+ end.
+
+%%-----------------------------------------------------------------
+%% Check if global_groups is changed in someway.
+%%-----------------------------------------------------------------
+is_gg_changed(Changed, New, Removed) ->
+ C = case lists:keyfind(global_groups, 1, Changed) of
+ false ->
+ false;
+ {global_groups, NewDistC} ->
+ NewDistC
+ end,
+ N = case lists:keyfind(global_groups, 1, New) of
+ false ->
+ false;
+ {global_groups, NewDistN} ->
+ NewDistN
+ end,
+ R = lists:member(global_groups, Removed),
+ {C, N, R}.
diff --git a/lib/kernel/src/kernel_config.erl b/lib/kernel/src/kernel_config.erl
new file mode 100644
index 0000000000..e5e9a0498d
--- /dev/null
+++ b/lib/kernel/src/kernel_config.erl
@@ -0,0 +1,173 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(kernel_config).
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/0]).
+%% Internal exports
+-export([init/1, handle_info/2, terminate/2, send_timeout/2]).
+-export([handle_call/3, handle_cast/2, code_change/3]).
+
+%%%-----------------------------------------------------------------
+%%% This module implements a process that configures the kernel
+%%% application.
+%%% Its purpose is that in the init phase add an error_logger
+%%% and when it dies (when the kernel application dies) deleting the
+%%% previously installed error_logger.
+%%% Also, this process waits for other nodes at startup, if
+%%% specified.
+%%%-----------------------------------------------------------------
+start_link() -> gen_server:start_link(kernel_config, [], []).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ case sync_nodes() of
+ ok ->
+ case whereis(dist_ac) of
+ DAC when is_pid(DAC) ->
+ DAC ! {go, self()},
+ receive
+ dist_ac_took_control ->
+ ok
+ end;
+ _ ->
+ ok
+ end,
+ {ok, []};
+ {error, Error} ->
+ {stop, Error}
+ end.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+handle_call('__not_used', _From, State) ->
+ {reply, ok, State}.
+
+handle_cast('__not_used', State) ->
+ {noreply, State}.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+%%-----------------------------------------------------------------
+%% Internal functions
+%%-----------------------------------------------------------------
+sync_nodes() ->
+ case catch get_sync_data() of
+ {error, Reason} ->
+ error_logger:format("~p", [Reason]),
+ {error, Reason};
+ {infinity, MandatoryNodes, OptionalNodes} ->
+ case wait_nodes(MandatoryNodes, OptionalNodes) of
+ ok ->
+% sync(),
+ ok;
+ Error ->
+ Error
+ end;
+ {Timeout, MandatoryNodes, OptionalNodes} ->
+ spawn_link(kernel_config, send_timeout, [Timeout, self()]),
+ case wait_nodes(MandatoryNodes, OptionalNodes) of
+ ok ->
+% sync(),
+ ok;
+ Error ->
+ Error
+ end;
+ undefined -> ok
+ end.
+
+send_timeout(Timeout, Pid) ->
+ receive
+ after Timeout -> Pid ! timeout
+ end.
+
+wait_nodes(Mandatory, Optional) ->
+ net_kernel:monitor_nodes(true),
+ lists:foreach(fun(Node) ->
+ case net_adm:ping(Node) of
+ pong -> self() ! {nodeup, Node};
+ _ -> ok
+ end
+ end,
+ Mandatory ++ Optional),
+ rec_nodes(Mandatory, Optional).
+
+rec_nodes([], []) -> ok;
+rec_nodes(Mandatory, Optional) ->
+ receive
+ {nodeup, Node} -> check_up(Node, Mandatory, Optional);
+ timeout when Mandatory =:= [] -> ok;
+ timeout -> {error, {mandatory_nodes_down, Mandatory}}
+ end.
+
+check_up(Node, Mandatory, Optional) ->
+ case lists:member(Node, Mandatory) of
+ true ->
+ rec_nodes(lists:delete(Node, Mandatory), Optional);
+ false ->
+ case lists:member(Node, Optional) of
+ true ->
+ rec_nodes(Mandatory, lists:delete(Node, Optional));
+ false ->
+ rec_nodes(Mandatory, Optional)
+ end
+ end.
+
+%% Syncs standard servers
+%sync() ->
+% global:sync().
+
+get_sync_data() ->
+ Timeout = get_sync_timeout(),
+ MandatoryNodes = get_sync_mandatory_nodes(),
+ OptionalNodes = get_sync_optional_nodes(),
+ {Timeout, MandatoryNodes, OptionalNodes}.
+
+get_sync_timeout() ->
+ case application:get_env(sync_nodes_timeout) of
+ {ok, Timeout} when is_integer(Timeout), Timeout > 0 -> Timeout;
+ {ok, infinity} -> infinity;
+ undefined -> throw(undefined);
+ {ok, Else} -> throw({error, {badopt, {sync_nodes_timeout, Else}}})
+ end.
+
+get_sync_mandatory_nodes() ->
+ case application:get_env(sync_nodes_mandatory) of
+ {ok, Nodes} when is_list(Nodes) -> Nodes;
+ undefined -> [];
+ {ok, Else} -> throw({error, {badopt, {sync_nodes_mandatory, Else}}})
+ end.
+
+get_sync_optional_nodes() ->
+ case application:get_env(sync_nodes_optional) of
+ {ok, Nodes} when is_list(Nodes) -> Nodes;
+ undefined -> [];
+ {ok, Else} -> throw({error, {badopt, {sync_nodes_optional, Else}}})
+ end.
+
diff --git a/lib/kernel/src/net.erl b/lib/kernel/src/net.erl
new file mode 100644
index 0000000000..e8f4b6ba26
--- /dev/null
+++ b/lib/kernel/src/net.erl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(net).
+
+%% Various network functions, kept here for compatibility
+
+-export([call/4,
+ cast/4,
+ broadcast/3,
+ ping/1,
+ relay/1,
+ sleep/1]).
+
+-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).
+
+
diff --git a/lib/kernel/src/net_address.hrl b/lib/kernel/src/net_address.hrl
new file mode 100644
index 0000000000..5342076507
--- /dev/null
+++ b/lib/kernel/src/net_address.hrl
@@ -0,0 +1,28 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% Generic address format
+
+-record(net_address,
+ {
+ address, %% opaque address
+ host, %% host name
+ protocol, %% protocol
+ family %% address family
+ }).
diff --git a/lib/kernel/src/net_adm.erl b/lib/kernel/src/net_adm.erl
new file mode 100644
index 0000000000..737b1ecee9
--- /dev/null
+++ b/lib/kernel/src/net_adm.erl
@@ -0,0 +1,239 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(net_adm).
+-export([host_file/0,
+ localhost/0,
+ names/0, names/1,
+ ping_list/1,
+ world/0,world/1,
+ world_list/1, world_list/2,
+ dns_hostname/1,
+ ping/1]).
+
+%%------------------------------------------------------------------------
+
+-type verbosity() :: 'silent' | 'verbose'.
+
+%%------------------------------------------------------------------------
+
+%% Try to read .hosts.erlang file in
+%% 1. cwd , 2. $HOME 3. init:root_dir()
+
+-spec host_file() -> [atom()] | {'error',atom() | {integer(),atom(),_}}.
+
+host_file() ->
+ Home = case init:get_argument(home) of
+ {ok, [[H]]} -> [H];
+ _ -> []
+ end,
+ case file:path_consult(["."] ++ Home ++ [code:root_dir()], ".hosts.erlang") of
+ {ok, Hosts, _} -> Hosts;
+ Error -> Error
+ end.
+
+%% Check whether a node is up or down
+%% side effect: set up a connection to Node if there not yet is one.
+
+-spec ping(atom()) -> 'pang' | 'pong'.
+
+ping(Node) when is_atom(Node) ->
+ case catch gen:call({net_kernel, Node},
+ '$gen_call',
+ {is_auth, node()},
+ infinity) of
+ {ok, yes} -> pong;
+ _ ->
+ erlang:disconnect_node(Node),
+ pang
+ end.
+
+-spec localhost() -> string().
+
+localhost() ->
+ {ok, Host} = inet:gethostname(),
+ case inet_db:res_option(domain) of
+ "" -> Host;
+ Domain -> Host ++ "." ++ Domain
+ end.
+
+
+-spec names() -> {'ok', [{string(), integer()}]} | {'error', _}.
+
+names() ->
+ names(localhost()).
+
+-spec names(atom() | string()) -> {'ok', [{string(), integer()}]} | {'error', _}.
+
+names(Hostname) ->
+ case inet:gethostbyname(Hostname) of
+ {ok, {hostent, _Name, _ , _Af, _Size, [Addr | _]}} ->
+ erl_epmd:names(Addr);
+ Else ->
+ Else
+ end.
+
+-spec dns_hostname(atom() | string()) ->
+ {'ok', string()} | {'error', atom() | string()}.
+
+dns_hostname(Hostname) ->
+ case inet:gethostbyname(Hostname) of
+ {ok,{hostent, Name, _ , _Af, _Size, _Addr}} ->
+ {ok, Name};
+ _ ->
+ {error, Hostname}
+ end.
+
+%% A common situation in "life" is to have a configuration file with a list
+%% of nodes, and then at startup, all nodes in the list are ping'ed
+%% this can lead to no end of troubles if two disconnected nodes
+%% simultaneously ping each other.
+%% Use this function in order to do it safely.
+%% It assumes a working global.erl which ensures a fully
+%% connected network.
+%% Had the erlang runtime system been able to fully cope with
+%% the possibility of two simultaneous (unix) connects, this function would
+%% merley be lists:map({net_adm, ping}, [], Nodelist).
+%% It is also assumed, that the same (identical) Nodelist is given to all
+%% nodes which are to perform this call (possibly simultaneously).
+%% Even this code has a flaw, and that is the case where two
+%% nodes simultaneously and without *any* other already
+%% running nodes execute this code. :-(
+
+-spec ping_list([atom()]) -> [atom()].
+
+ping_list(Nodelist) ->
+ net_kernel:monitor_nodes(true),
+ Sofar = ping_first(Nodelist, nodes()),
+ collect_new(Sofar, Nodelist).
+
+ping_first([], _S) ->
+ [];
+ping_first([Node|Nodes], S) ->
+ case lists:member(Node, S) of
+ true -> [Node | ping_first(Nodes, S)];
+ false ->
+ case ping(Node) of
+ pong -> [Node];
+ pang -> ping_first(Nodes, S)
+ end
+ end.
+
+collect_new(Sofar, Nodelist) ->
+ receive
+ {nodeup, Node} ->
+ case lists:member(Node, Nodelist) of
+ true ->
+ collect_new(Sofar, Nodelist);
+ false ->
+ collect_new([Node | Sofar], Nodelist)
+ end
+ after 3000 ->
+ net_kernel:monitor_nodes(false),
+ Sofar
+ end.
+
+%% This function polls a set of hosts according to a file called
+%% .hosts.erlang that need to reside either in the current directory
+%% or in your home directory. (The current directory is tried first.)
+%% world() returns a list of all nodes on the network that can be
+%% found (including ourselves). Note: the $HOME variable is inspected.
+%%
+%% Added possibility to supply a list of hosts instead of reading
+%% the .hosts.erlang file. 971016 [email protected]
+%% e.g.
+%% net_adm:world_list(['elrond.du.etx.ericsson.se', 'thorin.du.etx.ericsson.se']).
+
+-spec world() -> [node()].
+
+world() ->
+ world(silent).
+
+-spec world(verbosity()) -> [node()].
+
+world(Verbose) ->
+ case net_adm:host_file() of
+ {error,R} -> exit({error, R});
+ Hosts -> expand_hosts(Hosts, Verbose)
+ end.
+
+-spec world_list([atom()]) -> [node()].
+
+world_list(Hosts) when is_list(Hosts) ->
+ expand_hosts(Hosts, silent).
+
+-spec world_list([atom()], verbosity()) -> [node()].
+
+world_list(Hosts, Verbose) when is_list(Hosts) ->
+ expand_hosts(Hosts, Verbose).
+
+expand_hosts(Hosts, Verbose) ->
+ lists:flatten(collect_nodes(Hosts, Verbose)).
+
+collect_nodes([], _) -> [];
+collect_nodes([Host|Tail], Verbose) ->
+ case collect_host_nodes(Host, Verbose) of
+ nil ->
+ collect_nodes(Tail, Verbose);
+ L ->
+ [L|collect_nodes(Tail, Verbose)]
+ end.
+
+collect_host_nodes(Host, Verbose) ->
+ case names(Host) of
+ {ok, Namelist} ->
+ do_ping(Namelist, atom_to_list(Host), Verbose);
+ _ ->
+ nil
+ end.
+
+do_ping(Names, Host0, Verbose) ->
+ case longshort(Host0) of
+ ignored -> [];
+ Host -> do_ping_1(Names, Host, Verbose)
+ end.
+
+do_ping_1([], _Host, _Verbose) ->
+ [];
+do_ping_1([{Name, _} | Rest], Host, Verbose) ->
+ Node = list_to_atom(Name ++ "@" ++ longshort(Host)),
+ verbose(Verbose, "Pinging ~w -> ", [Node]),
+ Result = ping(Node),
+ verbose(Verbose, "~p\n", [Result]),
+ case Result of
+ pong ->
+ [Node | do_ping_1(Rest, Host, Verbose)];
+ pang ->
+ do_ping_1(Rest, Host, Verbose)
+ end.
+
+verbose(verbose, Format, Args) ->
+ io:format(Format, Args);
+verbose(_, _, _) ->
+ ok.
+
+longshort(Host) ->
+ case net_kernel:longnames() of
+ false -> uptodot(Host);
+ true -> Host;
+ ignored -> ignored
+ end.
+
+uptodot([$.|_]) -> [];
+uptodot([])-> [];
+uptodot([H|T]) -> [H|uptodot(T)].
diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl
new file mode 100644
index 0000000000..3afaedf274
--- /dev/null
+++ b/lib/kernel/src/net_kernel.erl
@@ -0,0 +1,1513 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(net_kernel).
+
+-behaviour(gen_server).
+
+-define(nodedown(N, State), verbose({?MODULE, ?LINE, nodedown, N}, 1, State)).
+-define(nodeup(N, State), verbose({?MODULE, ?LINE, nodeup, N}, 1, State)).
+
+%%-define(dist_debug, true).
+
+%-define(DBG,erlang:display([?MODULE,?LINE])).
+
+-ifdef(dist_debug).
+-define(debug(Term), erlang:display(Term)).
+-else.
+-define(debug(Term), ok).
+-endif.
+
+-ifdef(DEBUG).
+-define(connect_failure(Node,Term),
+ io:format("Net Kernel 2: Failed connection to node ~p, reason ~p~n",
+ [Node,Term])).
+-else.
+-define(connect_failure(Node,Term),noop).
+-endif.
+
+%% Default ticktime change transition period in seconds
+-define(DEFAULT_TRANSITION_PERIOD, 60).
+
+%-define(TCKR_DBG, 1).
+
+-ifdef(TCKR_DBG).
+-define(tckr_dbg(X), erlang:display({?LINE, X})).
+-else.
+-define(tckr_dbg(X), ok).
+-endif.
+
+%% User Interface Exports
+-export([start/1, start_link/1, stop/0,
+ kernel_apply/3,
+ monitor_nodes/1,
+ monitor_nodes/2,
+ longnames/0,
+ allow/1,
+ protocol_childspecs/0,
+ epmd_module/0]).
+
+-export([connect/1, disconnect/1, hidden_connect/1, passive_cnct/1]).
+-export([connect_node/1, hidden_connect_node/1]). %% explicit connect
+-export([set_net_ticktime/1, set_net_ticktime/2, get_net_ticktime/0]).
+
+-export([node_info/1, node_info/2, nodes_info/0,
+ connecttime/0,
+ i/0, i/1, verbose/1]).
+
+-export([publish_on_node/1, update_publish_nodes/1]).
+
+%% Internal Exports
+-export([do_spawn/3,
+ spawn_func/6,
+ ticker/2,
+ ticker_loop/2,
+ aux_ticker/4]).
+
+-export([init/1,handle_call/3,handle_cast/2,handle_info/2,
+ terminate/2,code_change/3]).
+
+-export([passive_connect_monitor/2]).
+
+-import(error_logger,[error_msg/2]).
+
+-record(state, {
+ name, %% The node name
+ node, %% The node name including hostname
+ type, %% long or short names
+ tick, %% tick information
+ connecttime, %% the connection setuptime.
+ connections, %% table of connections
+ conn_owners = [], %% List of connection owner pids,
+ pend_owners = [], %% List of potential owners
+ listen, %% list of #listen
+ allowed, %% list of allowed nodes in a restricted system
+ verbose = 0, %% level of verboseness
+ publish_on_nodes = undefined
+ }).
+
+-record(listen, {
+ listen, %% listen pid
+ accept, %% accepting pid
+ address, %% #net_address
+ module %% proto module
+ }).
+
+-define(LISTEN_ID, #listen.listen).
+-define(ACCEPT_ID, #listen.accept).
+
+-record(connection, {
+ node, %% remote node name
+ state, %% pending | up | up_pending
+ owner, %% owner pid
+ pending_owner, %% possible new owner
+ address, %% #net_address
+ waiting = [], %% queued processes
+ type %% normal | hidden
+ }).
+
+-record(barred_connection, {
+ node %% remote node name
+ }).
+
+
+-record(tick, {ticker, %% ticker : pid()
+ time %% Ticktime in milli seconds : integer()
+ }).
+
+-record(tick_change, {ticker, %% Ticker : pid()
+ time, %% Ticktime in milli seconds : integer()
+ how %% What type of change : atom()
+ }).
+
+%% Default connection setup timeout in milliseconds.
+%% This timeout is set for every distributed action during
+%% the connection setup.
+-define(SETUPTIME, 7000).
+
+-include("net_address.hrl").
+
+%% Interface functions
+
+kernel_apply(M,F,A) -> request({apply,M,F,A}).
+allow(Nodes) -> request({allow, Nodes}).
+longnames() -> request(longnames).
+stop() -> erl_distribution:stop().
+
+node_info(Node) -> get_node_info(Node).
+node_info(Node, Key) -> get_node_info(Node, Key).
+nodes_info() -> get_nodes_info().
+i() -> print_info().
+i(Node) -> print_info(Node).
+
+verbose(Level) when is_integer(Level) ->
+ request({verbose, Level}).
+
+set_net_ticktime(T, TP) when is_integer(T), T > 0, is_integer(TP), TP >= 0 ->
+ ticktime_res(request({new_ticktime, T*250, TP*1000})).
+set_net_ticktime(T) when is_integer(T) ->
+ set_net_ticktime(T, ?DEFAULT_TRANSITION_PERIOD).
+get_net_ticktime() ->
+ ticktime_res(request(ticktime)).
+
+
+%% The monitor_nodes() feature has been moved into the emulator.
+%% The feature is reached via (intentionally) undocumented process
+%% flags (we may want to move it elsewhere later). In order to easily
+%% be backward compatible, errors are created here when process_flag()
+%% fails.
+monitor_nodes(Flag) ->
+ case catch process_flag(monitor_nodes, Flag) of
+ true -> ok;
+ false -> ok;
+ _ -> mk_monitor_nodes_error(Flag, [])
+ end.
+
+monitor_nodes(Flag, Opts) ->
+ case catch process_flag({monitor_nodes, Opts}, Flag) of
+ true -> ok;
+ false -> ok;
+ _ -> mk_monitor_nodes_error(Flag, Opts)
+ end.
+
+%% ...
+ticktime_res({A, I}) when is_atom(A), is_integer(I) -> {A, I div 250};
+ticktime_res(I) when is_integer(I) -> I div 250;
+ticktime_res(A) when is_atom(A) -> A.
+
+%% Called though BIF's
+
+connect(Node) -> do_connect(Node, normal, false).
+%%% Long timeout if blocked (== barred), only affects nodes with
+%%% {dist_auto_connect, once} set.
+passive_cnct(Node) -> do_connect(Node, normal, true).
+disconnect(Node) -> request({disconnect, Node}).
+
+%% connect but not seen
+hidden_connect(Node) -> do_connect(Node, hidden, false).
+
+%% Should this node publish itself on Node?
+publish_on_node(Node) when is_atom(Node) ->
+ request({publish_on_node, Node}).
+
+%% Update publication list
+update_publish_nodes(Ns) ->
+ request({update_publish_nodes, Ns}).
+
+%% explicit connects
+connect_node(Node) when is_atom(Node) ->
+ request({connect, normal, Node}).
+hidden_connect_node(Node) when is_atom(Node) ->
+ request({connect, hidden, Node}).
+
+do_connect(Node, Type, WaitForBarred) -> %% Type = normal | hidden
+ case catch ets:lookup(sys_dist, Node) of
+ {'EXIT', _} ->
+ ?connect_failure(Node,{table_missing, sys_dist}),
+ false;
+ [#barred_connection{}] ->
+ case WaitForBarred of
+ false ->
+ false;
+ true ->
+ Pid = spawn(?MODULE,passive_connect_monitor,[self(),Node]),
+ receive
+ {Pid, true} ->
+ %%io:format("Net Kernel: barred connection (~p) "
+ %% "connected from other end.~n",[Node]),
+ true;
+ {Pid, false} ->
+ ?connect_failure(Node,{barred_connection,
+ ets:lookup(sys_dist, Node)}),
+ %%io:format("Net Kernel: barred connection (~p) "
+ %% "- failure.~n",[Node]),
+ false
+ end
+ end;
+ Else ->
+ case application:get_env(kernel, dist_auto_connect) of
+ {ok, never} ->
+ ?connect_failure(Node,{dist_auto_connect,never}),
+ false;
+ % This might happen due to connection close
+ % not beeing propagated to user space yet.
+ % Save the day by just not connecting...
+ {ok, once} when Else =/= [],
+ (hd(Else))#connection.state =:= up ->
+ ?connect_failure(Node,{barred_connection,
+ ets:lookup(sys_dist, Node)}),
+ false;
+ _ ->
+ request({connect, Type, Node})
+ end
+ end.
+
+passive_connect_monitor(Parent, Node) ->
+ monitor_nodes(true,[{node_type,all}]),
+ case lists:member(Node,nodes([connected])) of
+ true ->
+ monitor_nodes(false,[{node_type,all}]),
+ Parent ! {self(),true};
+ _ ->
+ Ref = make_ref(),
+ Tref = erlang:send_after(connecttime(),self(),Ref),
+ receive
+ Ref ->
+ monitor_nodes(false,[{node_type,all}]),
+ Parent ! {self(), false};
+ {nodeup,Node,_} ->
+ monitor_nodes(false,[{node_type,all}]),
+ erlang:cancel_timer(Tref),
+ Parent ! {self(),true}
+ end
+ end.
+
+%% If the net_kernel isn't running we ignore all requests to the
+%% kernel, thus basically accepting them :-)
+request(Req) ->
+ case whereis(net_kernel) of
+ P when is_pid(P) ->
+ gen_server:call(net_kernel,Req,infinity);
+ _ -> ignored
+ end.
+
+%% This function is used to dynamically start the
+%% distribution.
+
+start(Args) ->
+ erl_distribution:start(Args).
+
+%% This is the main startup routine for net_kernel
+%% The defaults are longnames and a ticktime of 15 secs to the tcp_drv.
+
+start_link([Name]) ->
+ start_link([Name, longnames]);
+
+start_link([Name, LongOrShortNames]) ->
+ start_link([Name, LongOrShortNames, 15000]);
+
+start_link([Name, LongOrShortNames, Ticktime]) ->
+ case gen_server:start_link({local, net_kernel}, net_kernel,
+ {Name, LongOrShortNames, Ticktime}, []) of
+ {ok, Pid} ->
+ {ok, Pid};
+ {error, {already_started, Pid}} ->
+ {ok, Pid};
+ _Error ->
+ exit(nodistribution)
+ end.
+
+%% auth:get_cookie should only be able to return an atom
+%% tuple cookies are unknowns
+
+init({Name, LongOrShortNames, TickT}) ->
+ process_flag(trap_exit,true),
+ case init_node(Name, LongOrShortNames) of
+ {ok, Node, Listeners} ->
+ process_flag(priority, max),
+ Ticktime = to_integer(TickT),
+ Ticker = spawn_link(net_kernel, ticker, [self(), Ticktime]),
+ case auth:get_cookie(Node) of
+ Cookie when is_atom(Cookie) ->
+ {ok, #state{name = Name,
+ node = Node,
+ type = LongOrShortNames,
+ tick = #tick{ticker = Ticker, time = Ticktime},
+ connecttime = connecttime(),
+ connections =
+ ets:new(sys_dist,[named_table,
+ protected,
+ {keypos, 2}]),
+ listen = Listeners,
+ allowed = [],
+ verbose = 0
+ }};
+ _ELSE ->
+ {stop, {error,{bad_cookie, Node}}}
+ end;
+ Error ->
+ {stop, Error}
+ end.
+
+
+%% ------------------------------------------------------------
+%% handle_call.
+%% ------------------------------------------------------------
+
+%%
+%% Set up a connection to Node.
+%% The response is delayed until the connection is up and
+%% running.
+%%
+handle_call({connect, _, Node}, _From, State) when Node =:= node() ->
+ {reply, true, State};
+handle_call({connect, Type, Node}, From, State) ->
+ verbose({connect, Type, Node}, 1, State),
+ case ets:lookup(sys_dist, Node) of
+ [Conn] when Conn#connection.state =:= up ->
+ {reply, true, State};
+ [Conn] when Conn#connection.state =:= pending ->
+ Waiting = Conn#connection.waiting,
+ ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}),
+ {noreply, State};
+ [Conn] when Conn#connection.state =:= up_pending ->
+ Waiting = Conn#connection.waiting,
+ ets:insert(sys_dist, Conn#connection{waiting = [From|Waiting]}),
+ {noreply, State};
+ _ ->
+ case setup(Node,Type,From,State) of
+ {ok, SetupPid} ->
+ Owners = [{SetupPid, Node} | State#state.conn_owners],
+ {noreply,State#state{conn_owners=Owners}};
+ _ ->
+ ?connect_failure(Node, {setup_call, failed}),
+ {reply, false, State}
+ end
+ end;
+
+%%
+%% Close the connection to Node.
+%%
+handle_call({disconnect, Node}, _From, State) when Node =:= node() ->
+ {reply, false, State};
+handle_call({disconnect, Node}, _From, State) ->
+ verbose({disconnect, Node}, 1, State),
+ {Reply, State1} = do_disconnect(Node, State),
+ {reply, Reply, State1};
+
+%%
+%% The spawn/4 BIF ends up here.
+%%
+handle_call({spawn,M,F,A,Gleader},{From,Tag},State) when is_pid(From) ->
+ do_spawn([no_link,{From,Tag},M,F,A,Gleader],[],State);
+
+%%
+%% The spawn_link/4 BIF ends up here.
+%%
+handle_call({spawn_link,M,F,A,Gleader},{From,Tag},State) when is_pid(From) ->
+ do_spawn([link,{From,Tag},M,F,A,Gleader],[],State);
+
+%%
+%% The spawn_opt/5 BIF ends up here.
+%%
+handle_call({spawn_opt,M,F,A,O,L,Gleader},{From,Tag},State) when is_pid(From) ->
+ do_spawn([L,{From,Tag},M,F,A,Gleader],O,State);
+
+%%
+%% Only allow certain nodes.
+%%
+handle_call({allow, Nodes}, _From, State) ->
+ case all_atoms(Nodes) of
+ true ->
+ Allowed = State#state.allowed,
+ {reply,ok,State#state{allowed = Allowed ++ Nodes}};
+ false ->
+ {reply,error,State}
+ end;
+
+%%
+%% authentication, used by auth. Simply works as this:
+%% if the message comes through, the other node IS authorized.
+%%
+handle_call({is_auth, _Node}, _From, State) ->
+ {reply,yes,State};
+
+%%
+%% Not applicable any longer !?
+%%
+handle_call({apply,_Mod,_Fun,_Args}, {From,Tag}, State)
+ when is_pid(From), node(From) =:= node() ->
+ gen_server:reply({From,Tag}, not_implemented),
+% Port = State#state.port,
+% catch apply(Mod,Fun,[Port|Args]),
+ {noreply,State};
+
+handle_call(longnames, _From, State) ->
+ {reply, get(longnames), State};
+
+handle_call({update_publish_nodes, Ns}, _From, State) ->
+ {reply, ok, State#state{publish_on_nodes = Ns}};
+
+handle_call({publish_on_node, Node}, _From, State) ->
+ NewState = case State#state.publish_on_nodes of
+ undefined ->
+ State#state{publish_on_nodes =
+ global_group:publish_on_nodes()};
+ _ ->
+ State
+ end,
+ Publish = case NewState#state.publish_on_nodes of
+ all ->
+ true;
+ Nodes ->
+ lists:member(Node, Nodes)
+ end,
+ {reply, Publish, NewState};
+
+
+handle_call({verbose, Level}, _From, State) ->
+ {reply, State#state.verbose, State#state{verbose = Level}};
+
+%%
+%% Set new ticktime
+%%
+
+%% The tick field of the state contains either a #tick{} or a
+%% #tick_change{} record if the ticker process has been upgraded;
+%% otherwise, an integer or an atom.
+
+handle_call(ticktime, _, #state{tick = #tick{time = T}} = State) ->
+ {reply, T, State};
+handle_call(ticktime, _, #state{tick = #tick_change{time = T}} = State) ->
+ {reply, {ongoing_change_to, T}, State};
+
+handle_call({new_ticktime,T,_TP}, _, #state{tick = #tick{time = T}} = State) ->
+ ?tckr_dbg(no_tick_change),
+ {reply, unchanged, State};
+
+handle_call({new_ticktime,T,TP}, _, #state{tick = #tick{ticker = Tckr,
+ time = OT}} = State) ->
+ ?tckr_dbg(initiating_tick_change),
+ start_aux_ticker(T, OT, TP),
+ How = case T > OT of
+ true ->
+ ?tckr_dbg(longer_ticktime),
+ Tckr ! {new_ticktime,T},
+ longer;
+ false ->
+ ?tckr_dbg(shorter_ticktime),
+ shorter
+ end,
+ {reply, change_initiated, State#state{tick = #tick_change{ticker = Tckr,
+ time = T,
+ how = How}}};
+
+handle_call({new_ticktime,_,_},
+ _,
+ #state{tick = #tick_change{time = T}} = State) ->
+ {reply, {ongoing_change_to, T}, State}.
+
+%% ------------------------------------------------------------
+%% handle_cast.
+%% ------------------------------------------------------------
+
+handle_cast(_, State) ->
+ {noreply,State}.
+
+%% ------------------------------------------------------------
+%% code_change.
+%% ------------------------------------------------------------
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok,State}.
+
+%% ------------------------------------------------------------
+%% terminate.
+%% ------------------------------------------------------------
+
+terminate(no_network, State) ->
+ lists:foreach(
+ fun({Node, Type}) ->
+ case Type of
+ normal -> ?nodedown(Node, State);
+ _ -> ok
+ end
+ end, get_up_nodes() ++ [{node(), normal}]);
+terminate(_Reason, State) ->
+ lists:foreach(
+ fun(#listen {listen = Listen,module = Mod}) ->
+ Mod:close(Listen)
+ end, State#state.listen),
+ lists:foreach(
+ fun({Node, Type}) ->
+ case Type of
+ normal -> ?nodedown(Node, State);
+ _ -> ok
+ end
+ end, get_up_nodes() ++ [{node(), normal}]).
+
+
+%% ------------------------------------------------------------
+%% handle_info.
+%% ------------------------------------------------------------
+
+%%
+%% accept a new connection.
+%%
+handle_info({accept,AcceptPid,Socket,Family,Proto}, State) ->
+ MyNode = State#state.node,
+ case get_proto_mod(Family,Proto,State#state.listen) of
+ {ok, Mod} ->
+ Pid = Mod:accept_connection(AcceptPid,
+ Socket,
+ MyNode,
+ State#state.allowed,
+ State#state.connecttime),
+ AcceptPid ! {self(), controller, Pid},
+ {noreply,State};
+ _ ->
+ AcceptPid ! {self(), unsupported_protocol},
+ {noreply, State}
+ end;
+
+%%
+%% A node has successfully been connected.
+%%
+handle_info({SetupPid, {nodeup,Node,Address,Type,Immediate}},
+ State) ->
+ case {Immediate, ets:lookup(sys_dist, Node)} of
+ {true, [Conn]} when Conn#connection.state =:= pending,
+ Conn#connection.owner =:= SetupPid ->
+ ets:insert(sys_dist, Conn#connection{state = up,
+ address = Address,
+ waiting = [],
+ type = Type}),
+ SetupPid ! {self(), inserted},
+ reply_waiting(Node,Conn#connection.waiting, true),
+ {noreply, State};
+ _ ->
+ SetupPid ! {self(), bad_request},
+ {noreply, State}
+ end;
+
+%%
+%% Mark a node as pending (accept) if not busy.
+%%
+handle_info({AcceptPid, {accept_pending,MyNode,Node,Address,Type}}, State) ->
+ case ets:lookup(sys_dist, Node) of
+ [#connection{state=pending}=Conn] ->
+ if
+ MyNode > Node ->
+ AcceptPid ! {self(),{accept_pending,nok_pending}},
+ {noreply,State};
+ true ->
+ %%
+ %% A simultaneous connect has been detected and we want to
+ %% change pending process.
+ %%
+ OldOwner = Conn#connection.owner,
+ ?debug({net_kernel, remark, old, OldOwner, new, AcceptPid}),
+ exit(OldOwner, remarked),
+ receive
+ {'EXIT', OldOwner, _} ->
+ true
+ end,
+ Owners = lists:keyreplace(OldOwner,
+ 1,
+ State#state.conn_owners,
+ {AcceptPid, Node}),
+ ets:insert(sys_dist, Conn#connection{owner = AcceptPid}),
+ AcceptPid ! {self(),{accept_pending,ok_pending}},
+ State1 = State#state{conn_owners=Owners},
+ {noreply,State1}
+ end;
+ [#connection{state=up}=Conn] ->
+ AcceptPid ! {self(), {accept_pending, up_pending}},
+ ets:insert(sys_dist, Conn#connection { pending_owner = AcceptPid,
+ state = up_pending }),
+ Pend = [{AcceptPid, Node} | State#state.pend_owners ],
+ {noreply, State#state { pend_owners = Pend }};
+ [#connection{state=up_pending}] ->
+ AcceptPid ! {self(), {accept_pending, already_pending}},
+ {noreply, State};
+ _ ->
+ ets:insert(sys_dist, #connection{node = Node,
+ state = pending,
+ owner = AcceptPid,
+ address = Address,
+ type = Type}),
+ AcceptPid ! {self(),{accept_pending,ok}},
+ Owners = [{AcceptPid,Node} | State#state.conn_owners],
+ {noreply, State#state{conn_owners = Owners}}
+ end;
+
+handle_info({SetupPid, {is_pending, Node}}, State) ->
+ Reply = lists:member({SetupPid,Node},State#state.conn_owners),
+ SetupPid ! {self(), {is_pending, Reply}},
+ {noreply, State};
+
+
+%%
+%% Handle different types of process terminations.
+%%
+handle_info({'EXIT', From, Reason}, State) when is_pid(From) ->
+ verbose({'EXIT', From, Reason}, 1, State),
+ handle_exit(From, Reason, State);
+
+%%
+%% Handle badcookie and badname messages !
+%%
+handle_info({From,registered_send,To,Mess},State) ->
+ send(From,To,Mess),
+ {noreply,State};
+
+%% badcookies SHOULD not be sent
+%% (if someone does erlang:set_cookie(node(),foo) this may be)
+handle_info({From,badcookie,_To,_Mess}, State) ->
+ error_logger:error_msg("~n** Got OLD cookie from ~w~n",
+ [getnode(From)]),
+ {_Reply, State1} = do_disconnect(getnode(From), State),
+ {noreply,State1};
+
+%%
+%% Tick all connections.
+%%
+handle_info(tick, State) ->
+ ?tckr_dbg(tick),
+ lists:foreach(fun({Pid,_Node}) -> Pid ! {self(), tick} end,
+ State#state.conn_owners),
+ {noreply,State};
+
+handle_info(aux_tick, State) ->
+ ?tckr_dbg(aux_tick),
+ lists:foreach(fun({Pid,_Node}) -> Pid ! {self(), aux_tick} end,
+ State#state.conn_owners),
+ {noreply,State};
+
+handle_info(transition_period_end,
+ #state{tick = #tick_change{ticker = Tckr,
+ time = T,
+ how = How}} = State) ->
+ ?tckr_dbg(transition_period_ended),
+ case How of
+ shorter -> Tckr ! {new_ticktime, T};
+ _ -> done
+ end,
+ {noreply,State#state{tick = #tick{ticker = Tckr, time = T}}};
+
+handle_info(X, State) ->
+ error_msg("Net kernel got ~w~n",[X]),
+ {noreply,State}.
+
+%% -----------------------------------------------------------
+%% Handle exit signals.
+%% We have 6 types of processes to handle.
+%%
+%% 1. The Listen process.
+%% 2. The Accept process.
+%% 3. Connection owning processes.
+%% 4. The ticker process.
+%% (5. Garbage pid.)
+%%
+%% The process type function that handled the process throws
+%% the handle_info return value !
+%% -----------------------------------------------------------
+
+handle_exit(Pid, Reason, State) ->
+ catch do_handle_exit(Pid, Reason, State).
+
+do_handle_exit(Pid, Reason, State) ->
+ listen_exit(Pid, State),
+ accept_exit(Pid, State),
+ conn_own_exit(Pid, Reason, State),
+ pending_own_exit(Pid, State),
+ ticker_exit(Pid, State),
+ {noreply,State}.
+
+listen_exit(Pid, State) ->
+ case lists:keymember(Pid, ?LISTEN_ID, State#state.listen) of
+ true ->
+ error_msg("** Netkernel terminating ... **\n", []),
+ throw({stop,no_network,State});
+ false ->
+ false
+ end.
+
+accept_exit(Pid, State) ->
+ Listen = State#state.listen,
+ case lists:keysearch(Pid, ?ACCEPT_ID, Listen) of
+ {value, ListenR} ->
+ ListenS = ListenR#listen.listen,
+ Mod = ListenR#listen.module,
+ AcceptPid = Mod:accept(ListenS),
+ L = lists:keyreplace(Pid, ?ACCEPT_ID, Listen,
+ ListenR#listen{accept = AcceptPid}),
+ throw({noreply, State#state{listen = L}});
+ _ ->
+ false
+ end.
+
+conn_own_exit(Pid, Reason, State) ->
+ Owners = State#state.conn_owners,
+ case lists:keysearch(Pid, 1, Owners) of
+ {value, {Pid, Node}} ->
+ throw({noreply, nodedown(Pid, Node, Reason, State)});
+ _ ->
+ false
+ end.
+
+pending_own_exit(Pid, State) ->
+ Pend = State#state.pend_owners,
+ case lists:keysearch(Pid, 1, Pend) of
+ {value, {Pid, Node}} ->
+ NewPend = lists:keydelete(Pid, 1, Pend),
+ State1 = State#state { pend_owners = NewPend },
+ case get_conn(Node) of
+ {ok, Conn} when Conn#connection.state =:= up_pending ->
+ reply_waiting(Node,Conn#connection.waiting, true),
+ Conn1 = Conn#connection { state = up,
+ waiting = [],
+ pending_owner = undefined },
+ ets:insert(sys_dist, Conn1);
+ _ ->
+ ok
+ end,
+ throw({noreply, State1});
+ _ ->
+ false
+ end.
+
+ticker_exit(Pid, #state{tick = #tick{ticker = Pid, time = T} = Tck} = State) ->
+ Tckr = restart_ticker(T),
+ throw({noreply, State#state{tick = Tck#tick{ticker = Tckr}}});
+ticker_exit(Pid, #state{tick = #tick_change{ticker = Pid,
+ time = T} = TckCng} = State) ->
+ Tckr = restart_ticker(T),
+ throw({noreply, State#state{tick = TckCng#tick_change{ticker = Tckr}}});
+ticker_exit(_, _) ->
+ false.
+
+%% -----------------------------------------------------------
+%% A node has gone down !!
+%% nodedown(Owner, Node, Reason, State) -> State'
+%% -----------------------------------------------------------
+
+nodedown(Owner, Node, Reason, State) ->
+ case get_conn(Node) of
+ {ok, Conn} ->
+ nodedown(Conn, Owner, Node, Reason, Conn#connection.type, State);
+ _ ->
+ State
+ end.
+
+get_conn(Node) ->
+ case ets:lookup(sys_dist, Node) of
+ [Conn = #connection{}] -> {ok, Conn};
+ _ -> error
+ end.
+
+nodedown(Conn, Owner, Node, Reason, Type, OldState) ->
+ Owners = lists:keydelete(Owner, 1, OldState#state.conn_owners),
+ State = OldState#state{conn_owners = Owners},
+ case Conn#connection.state of
+ pending when Conn#connection.owner =:= Owner ->
+ pending_nodedown(Conn, Node, Type, State);
+ up when Conn#connection.owner =:= Owner ->
+ up_nodedown(Conn, Node, Reason, Type, State);
+ up_pending when Conn#connection.owner =:= Owner ->
+ up_pending_nodedown(Conn, Node, Reason, Type, State);
+ _ ->
+ OldState
+ end.
+
+pending_nodedown(Conn, Node, Type, State) ->
+ % Don't bar connections that have never been alive
+ %mark_sys_dist_nodedown(Node),
+ % - instead just delete the node:
+ ets:delete(sys_dist, Node),
+ reply_waiting(Node,Conn#connection.waiting, false),
+ case Type of
+ normal ->
+ ?nodedown(Node, State);
+ _ ->
+ ok
+ end,
+ State.
+
+up_pending_nodedown(Conn, Node, _Reason, _Type, State) ->
+ AcceptPid = Conn#connection.pending_owner,
+ Owners = State#state.conn_owners,
+ Pend = lists:keydelete(AcceptPid, 1, State#state.pend_owners),
+ Conn1 = Conn#connection { owner = AcceptPid,
+ pending_owner = undefined,
+ state = pending },
+ ets:insert(sys_dist, Conn1),
+ AcceptPid ! {self(), pending},
+ State#state{conn_owners = [{AcceptPid,Node}|Owners], pend_owners = Pend}.
+
+
+up_nodedown(_Conn, Node, _Reason, Type, State) ->
+ mark_sys_dist_nodedown(Node),
+ case Type of
+ normal -> ?nodedown(Node, State);
+ _ -> ok
+ end,
+ State.
+
+mark_sys_dist_nodedown(Node) ->
+ case application:get_env(kernel, dist_auto_connect) of
+ {ok, once} ->
+ ets:insert(sys_dist, #barred_connection{node = Node});
+ _ ->
+ ets:delete(sys_dist, Node)
+ end.
+
+%% -----------------------------------------------------------
+%% End handle_exit/2 !!
+%% -----------------------------------------------------------
+
+
+%% -----------------------------------------------------------
+%% monitor_nodes/[1,2] errors
+%% -----------------------------------------------------------
+
+check_opt(Opt, Opts) ->
+ check_opt(Opt, Opts, false, []).
+
+check_opt(_Opt, [], false, _OtherOpts) ->
+ false;
+check_opt(_Opt, [], {true, ORes}, OtherOpts) ->
+ {true, ORes, OtherOpts};
+check_opt(Opt, [Opt|RestOpts], false, OtherOpts) ->
+ check_opt(Opt, RestOpts, {true, Opt}, OtherOpts);
+check_opt(Opt, [Opt|RestOpts], {true, Opt} = ORes, OtherOpts) ->
+ check_opt(Opt, RestOpts, ORes, OtherOpts);
+check_opt({Opt, value}=TOpt,
+ [{Opt, _Val}=ORes|RestOpts],
+ false,
+ OtherOpts) ->
+ check_opt(TOpt, RestOpts, {true, ORes}, OtherOpts);
+check_opt({Opt, value}=TOpt,
+ [{Opt, _Val}=ORes|RestOpts],
+ {true, ORes}=TORes,
+ OtherOpts) ->
+ check_opt(TOpt, RestOpts, TORes, OtherOpts);
+check_opt({Opt, value},
+ [{Opt, _Val} = ORes1| _RestOpts],
+ {true, {Opt, _OtherVal} = ORes2},
+ _OtherOpts) ->
+ throw({error, {option_value_mismatch, [ORes1, ORes2]}});
+check_opt(Opt, [OtherOpt | RestOpts], TORes, OtherOpts) ->
+ check_opt(Opt, RestOpts, TORes, [OtherOpt | OtherOpts]).
+
+check_options(Opts) when is_list(Opts) ->
+ RestOpts1 = case check_opt({node_type, value}, Opts) of
+ {true, {node_type,Type}, RO1} when Type =:= visible;
+ Type =:= hidden;
+ Type =:= all ->
+ RO1;
+ {true, {node_type, _Type} = Opt, _RO1} ->
+ throw({error, {bad_option_value, Opt}});
+ false ->
+ Opts
+ end,
+ RestOpts2 = case check_opt(nodedown_reason, RestOpts1) of
+ {true, nodedown_reason, RO2} ->
+ RO2;
+ false ->
+ RestOpts1
+ end,
+ case RestOpts2 of
+ [] ->
+ %% This should never happen since we only call this function
+ %% when we know there is an error in the option list
+ {error, internal_error};
+ _ ->
+ {error, {unknown_options, RestOpts2}}
+ end;
+check_options(Opts) ->
+ {error, {options_not_a_list, Opts}}.
+
+mk_monitor_nodes_error(Flag, _Opts) when Flag =/= true, Flag =/= false ->
+ error;
+mk_monitor_nodes_error(_Flag, Opts) ->
+ case catch check_options(Opts) of
+ {error, _} = Error ->
+ Error;
+ UnexpectedError ->
+ {error, {internal_error, UnexpectedError}}
+ end.
+
+% -------------------------------------------------------------
+
+do_disconnect(Node, State) ->
+ case ets:lookup(sys_dist, Node) of
+ [Conn] when Conn#connection.state =:= up ->
+ disconnect_pid(Conn#connection.owner, State);
+ [Conn] when Conn#connection.state =:= up_pending ->
+ disconnect_pid(Conn#connection.owner, State);
+ _ ->
+ {false, State}
+ end.
+
+
+disconnect_pid(Pid, State) ->
+ exit(Pid, disconnect),
+ %% Sync wait for connection to die!!!
+ receive
+ {'EXIT',Pid,Reason} ->
+ {_,State1} = handle_exit(Pid, Reason, State),
+ {true, State1}
+ end.
+
+%%
+%%
+%%
+get_nodes(Which) ->
+ get_nodes(ets:first(sys_dist), Which).
+
+get_nodes('$end_of_table', _) ->
+ [];
+get_nodes(Key, Which) ->
+ case ets:lookup(sys_dist, Key) of
+ [Conn = #connection{state = up}] ->
+ [Conn#connection.node | get_nodes(ets:next(sys_dist, Key),
+ Which)];
+ [Conn = #connection{}] when Which =:= all ->
+ [Conn#connection.node | get_nodes(ets:next(sys_dist, Key),
+ Which)];
+ _ ->
+ get_nodes(ets:next(sys_dist, Key), Which)
+ end.
+
+%% Return a list of all nodes that are 'up'.
+get_up_nodes() ->
+ get_up_nodes(ets:first(sys_dist)).
+
+get_up_nodes('$end_of_table') -> [];
+get_up_nodes(Key) ->
+ case ets:lookup(sys_dist, Key) of
+ [#connection{state=up,node=Node,type=Type}] ->
+ [{Node,Type}|get_up_nodes(ets:next(sys_dist, Key))];
+ _ ->
+ get_up_nodes(ets:next(sys_dist, Key))
+ end.
+
+ticker(Kernel, Tick) when is_integer(Tick) ->
+ process_flag(priority, max),
+ ?tckr_dbg(ticker_started),
+ ticker_loop(Kernel, Tick).
+
+to_integer(T) when is_integer(T) -> T;
+to_integer(T) when is_atom(T) ->
+ list_to_integer(atom_to_list(T));
+to_integer(T) when is_list(T) ->
+ list_to_integer(T).
+
+ticker_loop(Kernel, Tick) ->
+ receive
+ {new_ticktime, NewTick} ->
+ ?tckr_dbg({ticker_changed_time, Tick, NewTick}),
+ ?MODULE:ticker_loop(Kernel, NewTick)
+ after Tick ->
+ Kernel ! tick,
+ ?MODULE:ticker_loop(Kernel, Tick)
+ end.
+
+start_aux_ticker(NewTick, OldTick, TransitionPeriod) ->
+ spawn_link(?MODULE, aux_ticker,
+ [self(), NewTick, OldTick, TransitionPeriod]).
+
+aux_ticker(NetKernel, NewTick, OldTick, TransitionPeriod) ->
+ process_flag(priority, max),
+ ?tckr_dbg(aux_ticker_started),
+ TickInterval = case NewTick > OldTick of
+ true -> OldTick;
+ false -> NewTick
+ end,
+ NoOfTicks = case TransitionPeriod > 0 of
+ true ->
+ %% 1 tick to start
+ %% + ticks to cover the transition period
+ 1 + (((TransitionPeriod - 1) div TickInterval) + 1);
+ false ->
+ 1
+ end,
+ aux_ticker1(NetKernel, TickInterval, NoOfTicks).
+
+aux_ticker1(NetKernel, _, 1) ->
+ NetKernel ! transition_period_end,
+ NetKernel ! aux_tick,
+ bye;
+aux_ticker1(NetKernel, TickInterval, NoOfTicks) ->
+ NetKernel ! aux_tick,
+ receive
+ after TickInterval ->
+ aux_ticker1(NetKernel, TickInterval, NoOfTicks-1)
+ end.
+
+send(_From,To,Mess) ->
+ case whereis(To) of
+ undefined ->
+ Mess;
+ P when is_pid(P) ->
+ P ! Mess
+ end.
+
+-ifdef(UNUSED).
+
+safesend(Name,Mess) when is_atom(Name) ->
+ case whereis(Name) of
+ undefined ->
+ Mess;
+ P when is_pid(P) ->
+ P ! Mess
+ end;
+safesend(Pid, Mess) -> Pid ! Mess.
+
+-endif.
+
+do_spawn(SpawnFuncArgs, SpawnOpts, State) ->
+ case catch spawn_opt(?MODULE, spawn_func, SpawnFuncArgs, SpawnOpts) of
+ {'EXIT', {Reason,_}} ->
+ {reply, {'EXIT', {Reason,[]}}, State};
+ {'EXIT', Reason} ->
+ {reply, {'EXIT', {Reason,[]}}, State};
+ _ ->
+ {noreply,State}
+ end.
+
+%% This code is really intricate. The link will go first and then comes
+%% the pid, This means that the client need not do a network link.
+%% If the link message would not arrive, the runtime system shall
+%% generate a nodedown message
+
+spawn_func(link,{From,Tag},M,F,A,Gleader) ->
+ link(From),
+ gen_server:reply({From,Tag},self()), %% ahhh
+ group_leader(Gleader,self()),
+ apply(M,F,A);
+spawn_func(_,{From,Tag},M,F,A,Gleader) ->
+ gen_server:reply({From,Tag},self()), %% ahhh
+ group_leader(Gleader,self()),
+ apply(M,F,A).
+
+%% -----------------------------------------------------------
+%% Set up connection to a new node.
+%% -----------------------------------------------------------
+
+setup(Node,Type,From,State) ->
+ Allowed = State#state.allowed,
+ case lists:member(Node, Allowed) of
+ false when Allowed =/= [] ->
+ error_msg("** Connection attempt with "
+ "disallowed node ~w ** ~n", [Node]),
+ {error, bad_node};
+ _ ->
+ case select_mod(Node, State#state.listen) of
+ {ok, L} ->
+ Mod = L#listen.module,
+ LAddr = L#listen.address,
+ MyNode = State#state.node,
+ Pid = Mod:setup(Node,
+ Type,
+ MyNode,
+ State#state.type,
+ State#state.connecttime),
+ Addr = LAddr#net_address {
+ address = undefined,
+ host = undefined },
+ ets:insert(sys_dist, #connection{node = Node,
+ state = pending,
+ owner = Pid,
+ waiting = [From],
+ address = Addr,
+ type = normal}),
+ {ok, Pid};
+ Error ->
+ Error
+ end
+ end.
+
+%%
+%% Find a module that is willing to handle connection setup to Node
+%%
+select_mod(Node, [L|Ls]) ->
+ Mod = L#listen.module,
+ case Mod:select(Node) of
+ true -> {ok, L};
+ false -> select_mod(Node, Ls)
+ end;
+select_mod(Node, []) ->
+ {error, {unsupported_address_type, Node}}.
+
+
+get_proto_mod(Family,Protocol,[L|Ls]) ->
+ A = L#listen.address,
+ if A#net_address.family =:= Family,
+ A#net_address.protocol =:= Protocol ->
+ {ok, L#listen.module};
+ true ->
+ get_proto_mod(Family,Protocol,Ls)
+ end;
+get_proto_mod(_Family, _Protocol, []) ->
+ error.
+
+%% -------- Initialisation functions ------------------------
+
+init_node(Name, LongOrShortNames) ->
+ {NameWithoutHost,_Host} = lists:splitwith(fun($@)->false;(_)->true end,
+ atom_to_list(Name)),
+ case create_name(Name, LongOrShortNames, 1) of
+ {ok,Node} ->
+ case start_protos(list_to_atom(NameWithoutHost),Node) of
+ {ok, Ls} ->
+ {ok, Node, Ls};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+%% Create the node name
+create_name(Name, LongOrShortNames, Try) ->
+ put(longnames, case LongOrShortNames of
+ shortnames -> false;
+ longnames -> true
+ end),
+ {Head,Host1} = create_hostpart(Name, LongOrShortNames),
+ case Host1 of
+ {ok,HostPart} ->
+ {ok,list_to_atom(Head ++ HostPart)};
+ {error,long} when Try =:= 1 ->
+ %% It could be we haven't read domain name from resolv file yet
+ inet_config:do_load_resolv(os:type(), longnames),
+ create_name(Name, LongOrShortNames, 0);
+ {error,Type} ->
+ error_logger:info_msg(
+ lists:concat(["Can\'t set ",
+ Type,
+ " node name!\n"
+ "Please check your configuration\n"])),
+ {error,badarg}
+ end.
+
+create_hostpart(Name, LongOrShortNames) ->
+ {Head,Host} = lists:splitwith(fun($@)->false;(_)->true end,
+ atom_to_list(Name)),
+ Host1 = case {Host,LongOrShortNames} of
+ {[$@,_|_],longnames} ->
+ {ok,Host};
+ {[$@,_|_],shortnames} ->
+ case lists:member($.,Host) of
+ true -> {error,short};
+ _ -> {ok,Host}
+ end;
+ {_,shortnames} ->
+ case inet_db:gethostname() of
+ H when is_list(H), length(H)>0 ->
+ {ok,"@" ++ H};
+ _ ->
+ {error,short}
+ end;
+ {_,longnames} ->
+ case {inet_db:gethostname(),inet_db:res_option(domain)} of
+ {H,D} when is_list(D), is_list(H),
+ length(D)> 0, length(H)>0 ->
+ {ok,"@" ++ H ++ "." ++ D};
+ _ ->
+ {error,long}
+ end
+ end,
+ {Head,Host1}.
+
+%%
+%%
+%%
+protocol_childspecs() ->
+ case init:get_argument(proto_dist) of
+ {ok, [Protos]} ->
+ protocol_childspecs(Protos);
+ _ ->
+ protocol_childspecs(["inet_tcp"])
+ end.
+
+protocol_childspecs([]) ->
+ [];
+protocol_childspecs([H|T]) ->
+ Mod = list_to_atom(H ++ "_dist"),
+ case (catch Mod:childspecs()) of
+ {ok, Childspecs} when is_list(Childspecs) ->
+ Childspecs ++ protocol_childspecs(T);
+ _ ->
+ protocol_childspecs(T)
+ end.
+
+
+%%
+%% epmd_module() -> module_name of erl_epmd or similar gen_server_module.
+%%
+
+epmd_module() ->
+ case init:get_argument(epmd_module) of
+ {ok,[[Module]]} ->
+ Module;
+ _ ->
+ erl_epmd
+ end.
+
+%%
+%% Start all protocols
+%%
+
+start_protos(Name,Node) ->
+ case init:get_argument(proto_dist) of
+ {ok, [Protos]} ->
+ start_protos(Name,Protos, Node);
+ _ ->
+ start_protos(Name,["inet_tcp"], Node)
+ end.
+
+start_protos(Name,Ps, Node) ->
+ case start_protos(Name, Ps, Node, []) of
+ [] -> {error, badarg};
+ Ls -> {ok, Ls}
+ end.
+
+start_protos(Name, [Proto | Ps], Node, Ls) ->
+ Mod = list_to_atom(Proto ++ "_dist"),
+ case catch Mod:listen(Name) of
+ {ok, {Socket, Address, Creation}} ->
+ case set_node(Node, Creation) of
+ ok ->
+ AcceptPid = Mod:accept(Socket),
+ auth:sync_cookie(),
+ L = #listen {
+ listen = Socket,
+ address = Address,
+ accept = AcceptPid,
+ module = Mod },
+ start_protos(Name,Ps, Node, [L|Ls]);
+ _ ->
+ Mod:close(Socket),
+ error_logger:info_msg("Invalid node name: ~p~n", [Node]),
+ start_protos(Name, Ps, Node, Ls)
+ end;
+ {'EXIT', {undef,_}} ->
+ error_logger:info_msg("Protocol: ~p: not supported~n", [Proto]),
+ start_protos(Name,Ps, Node, Ls);
+ {'EXIT', Reason} ->
+ error_logger:info_msg("Protocol: ~p: register error: ~p~n",
+ [Proto, Reason]),
+ start_protos(Name,Ps, Node, Ls);
+ {error, duplicate_name} ->
+ error_logger:info_msg("Protocol: ~p: the name " ++
+ atom_to_list(Node) ++
+ " seems to be in use by another Erlang node",
+ [Proto]),
+ start_protos(Name,Ps, Node, Ls);
+ {error, Reason} ->
+ error_logger:info_msg("Protocol: ~p: register/listen error: ~p~n",
+ [Proto, Reason]),
+ start_protos(Name,Ps, Node, Ls)
+ end;
+start_protos(_,[], _Node, Ls) ->
+ Ls.
+
+set_node(Node, Creation) when node() =:= nonode@nohost ->
+ case catch erlang:setnode(Node, Creation) of
+ true ->
+ ok;
+ {'EXIT',Reason} ->
+ {error,Reason}
+ end;
+set_node(Node, _Creation) when node() =:= Node ->
+ ok.
+
+connecttime() ->
+ case application:get_env(kernel, net_setuptime) of
+ {ok,Time} when is_number(Time), Time >= 120 ->
+ 120 * 1000;
+ {ok,Time} when is_number(Time), Time > 0 ->
+ round(Time * 1000);
+ _ ->
+ ?SETUPTIME
+ end.
+
+%% -------- End initialisation functions --------------------
+
+%% ------------------------------------------------------------
+%% Node information.
+%% ------------------------------------------------------------
+
+get_node_info(Node) ->
+ case ets:lookup(sys_dist, Node) of
+ [Conn = #connection{owner = Owner, state = State}] ->
+ case get_status(Owner, Node, State) of
+ {ok, In, Out} ->
+ {ok, [{owner, Owner},
+ {state, State},
+ {address, Conn#connection.address},
+ {type, Conn#connection.type},
+ {in, In},
+ {out, Out}]};
+ _ ->
+ {error, bad_node}
+ end;
+ _ ->
+ {error, bad_node}
+ end.
+
+%%
+%% We can't do monitor_node here incase the node is pending,
+%% the monitor_node/2 call hangs until the connection is ready.
+%% We will not ask about in/out information either for pending
+%% connections as this also would block this call awhile.
+%%
+get_status(Owner, Node, up) ->
+ monitor_node(Node, true),
+ Owner ! {self(), get_status},
+ receive
+ {Owner, get_status, Res} ->
+ monitor_node(Node, false),
+ Res;
+ {nodedown, Node} ->
+ error
+ end;
+get_status(_, _, _) ->
+ {ok, 0, 0}.
+
+get_node_info(Node, Key) ->
+ case get_node_info(Node) of
+ {ok, Info} ->
+ case lists:keysearch(Key, 1, Info) of
+ {value, {Key, Value}} -> {ok, Value};
+ _ -> {error, invalid_key}
+ end;
+ Error ->
+ Error
+ end.
+
+get_nodes_info() ->
+ get_nodes_info(get_nodes(all), []).
+
+get_nodes_info([Node|Nodes], InfoList) ->
+ case get_node_info(Node) of
+ {ok, Info} -> get_nodes_info(Nodes, [{Node, Info}|InfoList]);
+ _ -> get_nodes_info(Nodes, InfoList)
+ end;
+get_nodes_info([], InfoList) ->
+ {ok, InfoList}.
+
+%% ------------------------------------------------------------
+%% Misc. functions
+%% ------------------------------------------------------------
+
+reply_waiting(_Node, Waiting, Rep) ->
+ case Rep of
+ false ->
+ ?connect_failure(_Node, {setup_process, failure});
+ _ ->
+ ok
+ end,
+ reply_waiting1(lists:reverse(Waiting), Rep).
+
+reply_waiting1([From|W], Rep) ->
+ gen_server:reply(From, Rep),
+ reply_waiting1(W, Rep);
+reply_waiting1([], _) ->
+ ok.
+
+
+-ifdef(UNUSED).
+
+delete_all(From, [From |Tail]) -> delete_all(From, Tail);
+delete_all(From, [H|Tail]) -> [H|delete_all(From, Tail)];
+delete_all(_, []) -> [].
+
+-endif.
+
+all_atoms([]) -> true;
+all_atoms([N|Tail]) when is_atom(N) ->
+ all_atoms(Tail);
+all_atoms(_) -> false.
+
+%% It is assumed that only net_kernel uses restart_ticker()
+restart_ticker(Time) ->
+ ?tckr_dbg(restarting_ticker),
+ self() ! aux_tick,
+ spawn_link(?MODULE, ticker, [self(), Time]).
+
+%% ------------------------------------------------------------
+%% Print status information.
+%% ------------------------------------------------------------
+
+print_info() ->
+ nformat("Node", "State", "Type", "In", "Out", "Address"),
+ {ok, NodesInfo} = nodes_info(),
+ {In,Out} = lists:foldl(fun display_info/2, {0,0}, NodesInfo),
+ nformat("Total", "", "",
+ integer_to_list(In), integer_to_list(Out), "").
+
+display_info({Node, Info}, {I,O}) ->
+ State = atom_to_list(fetch(state, Info)),
+ In = fetch(in, Info),
+ Out = fetch(out, Info),
+ Type = atom_to_list(fetch(type, Info)),
+ Address = fmt_address(fetch(address, Info)),
+ nformat(atom_to_list(Node), State, Type,
+ integer_to_list(In), integer_to_list(Out), Address),
+ {I+In,O+Out}.
+
+fmt_address(undefined) ->
+ "-";
+fmt_address(A) ->
+ case A#net_address.family of
+ inet ->
+ case A#net_address.address of
+ {IP,Port} ->
+ inet_parse:ntoa(IP) ++ ":" ++ integer_to_list(Port);
+ _ -> "-"
+ end;
+ inet6 ->
+ case A#net_address.address of
+ {IP,Port} ->
+ inet_parse:ntoa(IP) ++ "/" ++ integer_to_list(Port);
+ _ -> "-"
+ end;
+ _ ->
+ lists:flatten(io_lib:format("~p", [A#net_address.address]))
+ end.
+
+
+fetch(Key, Info) ->
+ case lists:keysearch(Key, 1, Info) of
+ {value, {_, Val}} -> Val;
+ false -> 0
+ end.
+
+nformat(A1, A2, A3, A4, A5, A6) ->
+ io:format("~-20s ~-7s ~-6s ~8s ~8s ~s~n", [A1,A2,A3,A4,A5,A6]).
+
+print_info(Node) ->
+ case node_info(Node) of
+ {ok, Info} ->
+ State = fetch(state, Info),
+ In = fetch(in, Info),
+ Out = fetch(out, Info),
+ Type = fetch(type, Info),
+ Address = fmt_address(fetch(address, Info)),
+ io:format("Node = ~p~n"
+ "State = ~p~n"
+ "Type = ~p~n"
+ "In = ~p~n"
+ "Out = ~p~n"
+ "Address = ~s~n",
+ [Node, State, Type, In, Out, Address]);
+ Error ->
+ Error
+ end.
+
+verbose(Term, Level, #state{verbose = Verbose}) when Verbose >= Level ->
+ error_logger:info_report({net_kernel, Term});
+verbose(_, _, _) ->
+ ok.
+
+getnode(P) when is_pid(P) -> node(P);
+getnode(P) -> P.
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
new file mode 100644
index 0000000000..196e6cdeb2
--- /dev/null
+++ b/lib/kernel/src/os.erl
@@ -0,0 +1,291 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(os).
+
+%% Provides a common operating system interface.
+
+-export([type/0, version/0, cmd/1, find_executable/1, find_executable/2]).
+
+-include("file.hrl").
+
+-spec type() -> 'vxworks' | {'unix',atom()} | {'win32',atom()} | {'ose',atom()}.
+type() ->
+ case erlang:system_info(os_type) of
+ {vxworks, _} ->
+ vxworks;
+ Else -> Else
+ end.
+
+-spec version() -> string() | {non_neg_integer(),non_neg_integer(),non_neg_integer()}.
+version() ->
+ erlang:system_info(os_version).
+
+-spec find_executable(string()) -> string() | 'false'.
+find_executable(Name) ->
+ case os:getenv("PATH") of
+ false -> find_executable(Name, []);
+ Path -> find_executable(Name, Path)
+ end.
+
+-spec find_executable(string(), string()) -> string() | 'false'.
+find_executable(Name, Path) ->
+ Extensions = extensions(),
+ case filename:pathtype(Name) of
+ relative ->
+ find_executable1(Name, split_path(Path), Extensions);
+ _ ->
+ case verify_executable(Name, Extensions) of
+ {ok, Complete} ->
+ Complete;
+ error ->
+ false
+ end
+ end.
+
+find_executable1(Name, [Base|Rest], Extensions) ->
+ Complete0 = filename:join(Base, Name),
+ case verify_executable(Complete0, Extensions) of
+ {ok, Complete} ->
+ Complete;
+ error ->
+ find_executable1(Name, Rest, Extensions)
+ end;
+find_executable1(_Name, [], _Extensions) ->
+ false.
+
+verify_executable(Name0, [Ext|Rest]) ->
+ Name1 = Name0 ++ Ext,
+ case os:type() of
+ vxworks ->
+ %% We consider all existing VxWorks files to be executable
+ case file:read_file_info(Name1) of
+ {ok, _} ->
+ {ok, Name1};
+ _ ->
+ verify_executable(Name0, Rest)
+ end;
+ _ ->
+ case file:read_file_info(Name1) of
+ {ok, #file_info{mode=Mode}} when Mode band 8#111 =/= 0 ->
+ %% XXX This test for execution permission is not full-proof
+ %% on Unix, since we test if any execution bit is set.
+ {ok, Name1};
+ _ ->
+ verify_executable(Name0, Rest)
+ end
+ end;
+verify_executable(_, []) ->
+ error.
+
+split_path(Path) ->
+ case type() of
+ {win32, _} ->
+ {ok,Curr} = file:get_cwd(),
+ split_path(Path, $;, [], [Curr]);
+ _ ->
+ split_path(Path, $:, [], [])
+ end.
+
+split_path([Sep|Rest], Sep, Current, Path) ->
+ split_path(Rest, Sep, [], [reverse_element(Current)|Path]);
+split_path([C|Rest], Sep, Current, Path) ->
+ split_path(Rest, Sep, [C|Current], Path);
+split_path([], _, Current, Path) ->
+ lists:reverse(Path, [reverse_element(Current)]).
+
+reverse_element([]) -> ".";
+reverse_element([$"|T]) -> %"
+ case lists:reverse(T) of
+ [$"|List] -> List; %"
+ List -> List ++ [$"] %"
+ end;
+reverse_element(List) ->
+ lists:reverse(List).
+
+-spec extensions() -> [string()].
+extensions() ->
+ case type() of
+ {win32, _} -> [".exe",".com",".cmd",".bat"];
+ {unix, _} -> [""];
+ vxworks -> [""]
+ end.
+
+%% Executes the given command in the default shell for the operating system.
+-spec cmd(atom() | string() | [string()]) -> string().
+cmd(Cmd) ->
+ validate(Cmd),
+ case type() of
+ {unix, _} ->
+ unix_cmd(Cmd);
+ {win32, Wtype} ->
+ Command = case {os:getenv("COMSPEC"),Wtype} of
+ {false,windows} -> lists:concat(["command.com /c", Cmd]);
+ {false,_} -> lists:concat(["cmd /c", Cmd]);
+ {Cspec,_} -> lists:concat([Cspec," /c",Cmd])
+ end,
+ Port = open_port({spawn, Command}, [stream, in, eof, hide]),
+ get_data(Port, []);
+ %% VxWorks uses a 'sh -c hook' in 'vxcall.c' to run os:cmd.
+ vxworks ->
+ Command = lists:concat(["sh -c '", Cmd, "'"]),
+ Port = open_port({spawn, Command}, [stream, in, eof]),
+ get_data(Port, [])
+ end.
+
+unix_cmd(Cmd) ->
+ Tag = make_ref(),
+ {Pid,Mref} = erlang:spawn_monitor(
+ fun() ->
+ process_flag(trap_exit, true),
+ Port = start_port(),
+ erlang:port_command(Port, mk_cmd(Cmd)),
+ exit({Tag,unix_get_data(Port)})
+ end),
+ receive
+ {'DOWN',Mref,_,Pid,{Tag,Result}} ->
+ Result;
+ {'DOWN',Mref,_,Pid,Reason} ->
+ exit(Reason)
+ end.
+
+%% The -s flag implies that only the positional parameters are set,
+%% and the commands are read from standard input. We set the
+%% $1 parameter for easy identification of the resident shell.
+%%
+-define(SHELL, "/bin/sh -s unix:cmd 2>&1").
+
+%%
+%% Serializing open_port through a process to avoid smp lock contention
+%% when many concurrent os:cmd() want to do vfork (OTP-7890).
+%%
+-spec start_port() -> port().
+start_port() ->
+ {Ref,Client} = {make_ref(),self()},
+ try (os_cmd_port_creator ! {Ref,Client})
+ catch
+ error:_ -> spawn(fun() -> start_port_srv({Ref,Client}) end)
+ end,
+ receive
+ {Ref,Port} when is_port(Port) -> Port;
+ {Ref,Error} -> exit(Error)
+ end.
+
+start_port_srv(Request) ->
+ StayAlive = try register(os_cmd_port_creator, self())
+ catch
+ error:_ -> false
+ end,
+ start_port_srv_loop(Request, StayAlive).
+
+start_port_srv_loop({Ref,Client}, StayAlive) ->
+ Reply = try open_port({spawn, ?SHELL},[stream]) of
+ Port when is_port(Port) ->
+ port_connect(Port, Client),
+ unlink(Port),
+ Port
+ catch
+ error:Reason ->
+ {Reason,erlang:get_stacktrace()}
+ end,
+ Client ! {Ref,Reply},
+ case StayAlive of
+ true -> start_port_srv_loop(receive Msg -> Msg end, true);
+ false -> exiting
+ end.
+
+%%
+%% unix_get_data(Port) -> Result
+%%
+unix_get_data(Port) ->
+ unix_get_data(Port, []).
+
+unix_get_data(Port, Sofar) ->
+ receive
+ {Port,{data, Bytes}} ->
+ case eot(Bytes) of
+ {done, Last} ->
+ lists:flatten([Sofar|Last]);
+ more ->
+ unix_get_data(Port, [Sofar|Bytes])
+ end;
+ {'EXIT', Port, _} ->
+ lists:flatten(Sofar)
+ end.
+
+%%
+%% eot(String) -> more | {done, Result}
+%%
+eot(Bs) ->
+ eot(Bs, []).
+
+eot([4| _Bs], As) ->
+ {done, lists:reverse(As)};
+eot([B| Bs], As) ->
+ eot(Bs, [B| As]);
+eot([], _As) ->
+ more.
+
+%%
+%% mk_cmd(Cmd) -> {ok, ShellCommandString} | {error, ErrorString}
+%%
+%% We do not allow any input to Cmd (hence commands that want
+%% to read from standard input will return immediately).
+%% Standard error is redirected to standard output.
+%%
+%% We use ^D (= EOT = 4) to mark the end of the stream.
+%%
+mk_cmd(Cmd) when is_atom(Cmd) -> % backward comp.
+ mk_cmd(atom_to_list(Cmd));
+mk_cmd(Cmd) ->
+ %% We insert a new line after the command, in case the command
+ %% contains a comment character.
+ io_lib:format("(~s\n) </dev/null; echo \"\^D\"\n", [Cmd]).
+
+
+validate(Atom) when is_atom(Atom) ->
+ ok;
+validate(List) when is_list(List) ->
+ validate1(List).
+
+validate1([C|Rest]) when is_integer(C), 0 =< C, C < 256 ->
+ validate1(Rest);
+validate1([List|Rest]) when is_list(List) ->
+ validate1(List),
+ validate1(Rest);
+validate1([]) ->
+ ok.
+
+get_data(Port, Sofar) ->
+ receive
+ {Port, {data, Bytes}} ->
+ get_data(Port, [Sofar|Bytes]);
+ {Port, eof} ->
+ Port ! {self(), close},
+ receive
+ {Port, closed} ->
+ true
+ end,
+ receive
+ {'EXIT', Port, _} ->
+ ok
+ after 1 -> % force context switch
+ ok
+ end,
+ lists:flatten(Sofar)
+ end.
diff --git a/lib/kernel/src/packages.erl b/lib/kernel/src/packages.erl
new file mode 100644
index 0000000000..e0b1f36b85
--- /dev/null
+++ b/lib/kernel/src/packages.erl
@@ -0,0 +1,158 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(packages).
+
+-export([to_string/1, concat/1, concat/2, is_valid/1, is_segmented/1,
+ split/1, last/1, first/1, strip_last/1, find_modules/1,
+ find_modules/2]).
+
+%% A package name (or a package-qualified module name) may be an atom or
+%% a string (list of nonnegative integers) - not a deep list, and not a
+%% list containing atoms. A name may be empty, but may not contain two
+%% consecutive period (`.') characters or end with a period character.
+
+-type package_name() :: atom() | string().
+
+-spec to_string(package_name()) -> string().
+to_string(Name) when is_atom(Name) ->
+ atom_to_list(Name);
+to_string(Name) ->
+ Name.
+
+%% `concat' does not insert a leading period if the first segment is
+%% empty. However, the result may contain leading, consecutive or
+%% dangling period characters, if any of the segments after the first
+%% are empty. Use 'is_valid' to check the result if necessary.
+
+-spec concat(package_name(), package_name()) -> string().
+concat(A, B) ->
+ concat([A, B]).
+
+-spec concat([package_name()]) -> string().
+concat([H | T]) when is_atom(H) ->
+ concat([atom_to_list(H) | T]);
+concat(["" | T]) ->
+ concat_1(T);
+concat(L) ->
+ concat_1(L).
+
+concat_1([H | T]) when is_atom(H) ->
+ concat_1([atom_to_list(H) | T]);
+concat_1([H]) ->
+ H;
+concat_1([H | T]) ->
+ H ++ "." ++ concat_1(T);
+concat_1([]) ->
+ "";
+concat_1(Name) ->
+ erlang:error({badarg, Name}).
+
+-spec is_valid(package_name()) -> boolean().
+is_valid(Name) when is_atom(Name) ->
+ is_valid_1(atom_to_list(Name));
+is_valid([$. | _]) ->
+ false;
+is_valid(Name) ->
+ is_valid_1(Name).
+
+is_valid_1([$.]) -> false;
+is_valid_1([$., $. | _]) -> false;
+is_valid_1([H | T]) when is_integer(H), H >= 0 ->
+ is_valid_1(T);
+is_valid_1([]) -> true;
+is_valid_1(_) -> false.
+
+-spec split(package_name()) -> [string()].
+split(Name) when is_atom(Name) ->
+ split_1(atom_to_list(Name), []);
+split(Name) ->
+ split_1(Name, []).
+
+split_1([$. | T], Cs) ->
+ [lists:reverse(Cs) | split_1(T, [])];
+split_1([H | T], Cs) when is_integer(H), H >= 0 ->
+ split_1(T, [H | Cs]);
+split_1([], Cs) ->
+ [lists:reverse(Cs)];
+split_1(_, _) ->
+ erlang:error(badarg).
+
+%% This is equivalent to testing if `split(Name)' yields a list of
+%% length larger than one (i.e., if the name can be split into two or
+%% more segments), but is cheaper.
+
+-spec is_segmented(package_name()) -> boolean().
+is_segmented(Name) when is_atom(Name) ->
+ is_segmented_1(atom_to_list(Name));
+is_segmented(Name) ->
+ is_segmented_1(Name).
+
+is_segmented_1([$. | _]) -> true;
+is_segmented_1([H | T]) when is_integer(H), H >= 0 ->
+ is_segmented_1(T);
+is_segmented_1([]) -> false;
+is_segmented_1(_) ->
+ erlang:error(badarg).
+
+-spec last(package_name()) -> string().
+last(Name) ->
+ last_1(split(Name)).
+
+last_1([H]) -> H;
+last_1([_ | T]) -> last_1(T).
+
+-spec first(package_name()) -> [string()].
+first(Name) ->
+ first_1(split(Name)).
+
+first_1([H | T]) when T =/= [] -> [H | first_1(T)];
+first_1(_) -> [].
+
+-spec strip_last(package_name()) -> string().
+strip_last(Name) ->
+ concat(first(Name)).
+
+%% This finds all modules available for a given package, using the
+%% current code server search path. (There is no guarantee that the
+%% modules are loadable; only that the object files exist.)
+
+-spec find_modules(package_name()) -> [string()].
+find_modules(P) ->
+ find_modules(P, code:get_path()).
+
+-spec find_modules(package_name(), [string()]) -> [string()].
+find_modules(P, Paths) ->
+ P1 = filename:join(packages:split(P)),
+ find_modules(P1, Paths, code:objfile_extension(), sets:new()).
+
+find_modules(P, [Path | Paths], Ext, S0) ->
+ case file:list_dir(filename:join(Path, P)) of
+ {ok, Fs} ->
+ Fs1 = [F || F <- Fs, filename:extension(F) =:= Ext],
+ S1 = lists:foldl(fun (F, S) ->
+ F1 = filename:rootname(F, Ext),
+ sets:add_element(F1, S)
+ end,
+ S0, Fs1),
+ find_modules(P, Paths, Ext, S1);
+ _ ->
+ find_modules(P, Paths, Ext, S0)
+ end;
+find_modules(_P, [], _Ext, S) ->
+ sets:to_list(S).
diff --git a/lib/kernel/src/pg2.erl b/lib/kernel/src/pg2.erl
new file mode 100644
index 0000000000..fc9508a194
--- /dev/null
+++ b/lib/kernel/src/pg2.erl
@@ -0,0 +1,376 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(pg2).
+
+-export([create/1, delete/1, join/2, leave/2]).
+-export([get_members/1, get_local_members/1]).
+-export([get_closest_pid/1, which_groups/0]).
+-export([start/0,start_link/0,init/1,handle_call/3,handle_cast/2,handle_info/2,
+ terminate/2]).
+
+%%% As of R13B03 monitors are used instead of links.
+
+%%%
+%%% Exported functions
+%%%
+
+-spec start_link() -> {'ok', pid()} | {'error', term()}.
+
+start_link() ->
+ gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
+
+-spec start() -> {'ok', pid()} | {'error', term()}.
+
+start() ->
+ ensure_started().
+
+-spec create(term()) -> 'ok'.
+
+create(Name) ->
+ ensure_started(),
+ case ets:member(pg2_table, {group, Name}) of
+ false ->
+ global:trans({{?MODULE, Name}, self()},
+ fun() ->
+ gen_server:multi_call(?MODULE, {create, Name})
+ end),
+ ok;
+ true ->
+ ok
+ end.
+
+-type name() :: term().
+
+-spec delete(name()) -> 'ok'.
+
+delete(Name) ->
+ ensure_started(),
+ global:trans({{?MODULE, Name}, self()},
+ fun() ->
+ gen_server:multi_call(?MODULE, {delete, Name})
+ end),
+ ok.
+
+-spec join(name(), pid()) -> 'ok' | {'error', {'no_such_group', term()}}.
+
+join(Name, Pid) when is_pid(Pid) ->
+ ensure_started(),
+ case ets:member(pg2_table, {group, Name}) of
+ false ->
+ {error, {no_such_group, Name}};
+ true ->
+ global:trans({{?MODULE, Name}, self()},
+ fun() ->
+ gen_server:multi_call(?MODULE,
+ {join, Name, Pid})
+ end),
+ ok
+ end.
+
+-spec leave(name(), pid()) -> 'ok' | {'error', {'no_such_group', name()}}.
+
+leave(Name, Pid) when is_pid(Pid) ->
+ ensure_started(),
+ case ets:member(pg2_table, {group, Name}) of
+ false ->
+ {error, {no_such_group, Name}};
+ true ->
+ global:trans({{?MODULE, Name}, self()},
+ fun() ->
+ gen_server:multi_call(?MODULE,
+ {leave, Name, Pid})
+ end),
+ ok
+ end.
+
+-type get_members_ret() :: [pid()] | {'error', {'no_such_group', name()}}.
+
+-spec get_members(name()) -> get_members_ret().
+
+get_members(Name) ->
+ ensure_started(),
+ case ets:member(pg2_table, {group, Name}) of
+ true ->
+ group_members(Name);
+ false ->
+ {error, {no_such_group, Name}}
+ end.
+
+-spec get_local_members(name()) -> get_members_ret().
+
+get_local_members(Name) ->
+ ensure_started(),
+ case ets:member(pg2_table, {group, Name}) of
+ true ->
+ local_group_members(Name);
+ false ->
+ {error, {no_such_group, Name}}
+ end.
+
+-spec which_groups() -> [name()].
+
+which_groups() ->
+ ensure_started(),
+ all_groups().
+
+-type gcp_error_reason() :: {'no_process', term()} | {'no_such_group', term()}.
+
+-spec get_closest_pid(term()) -> pid() | {'error', gcp_error_reason()}.
+
+get_closest_pid(Name) ->
+ case get_local_members(Name) of
+ [Pid] ->
+ Pid;
+ [] ->
+ {_,_,X} = erlang:now(),
+ case get_members(Name) of
+ [] -> {error, {no_process, Name}};
+ Members ->
+ lists:nth((X rem length(Members))+1, Members)
+ end;
+ Members when is_list(Members) ->
+ {_,_,X} = erlang:now(),
+ lists:nth((X rem length(Members))+1, Members);
+ Else ->
+ Else
+ end.
+
+%%%
+%%% Callback functions from gen_server
+%%%
+
+-record(state, {}).
+
+-spec init([]) -> {'ok', #state{}}.
+
+init([]) ->
+ Ns = nodes(),
+ net_kernel:monitor_nodes(true),
+ lists:foreach(fun(N) ->
+ {?MODULE, N} ! {new_pg2, node()},
+ self() ! {nodeup, N}
+ end, Ns),
+ pg2_table = ets:new(pg2_table, [ordered_set, protected, named_table]),
+ {ok, #state{}}.
+
+-type call() :: {'create', name()}
+ | {'delete', name()}
+ | {'join', name(), pid()}
+ | {'leave', name(), pid()}.
+
+-spec handle_call(call(), _, #state{}) ->
+ {'reply', 'ok', #state{}}.
+
+handle_call({create, Name}, _From, S) ->
+ assure_group(Name),
+ {reply, ok, S};
+handle_call({join, Name, Pid}, _From, S) ->
+ ets:member(pg2_table, {group, Name}) andalso join_group(Name, Pid),
+ {reply, ok, S};
+handle_call({leave, Name, Pid}, _From, S) ->
+ ets:member(pg2_table, {group, Name}) andalso leave_group(Name, Pid),
+ {reply, ok, S};
+handle_call({delete, Name}, _From, S) ->
+ delete_group(Name),
+ {reply, ok, S};
+handle_call(Request, From, S) ->
+ error_logger:warning_msg("The pg2 server received an unexpected message:\n"
+ "handle_call(~p, ~p, _)\n",
+ [Request, From]),
+ {noreply, S}.
+
+-type all_members() :: [[name(),...]].
+-type cast() :: {'exchange', node(), all_members()}
+ | {'del_member', name(), pid()}.
+
+-spec handle_cast(cast(), #state{}) -> {'noreply', #state{}}.
+
+handle_cast({exchange, _Node, List}, S) ->
+ store(List),
+ {noreply, S};
+handle_cast(_, S) ->
+ %% Ignore {del_member, Name, Pid}.
+ {noreply, S}.
+
+-spec handle_info(tuple(), #state{}) -> {'noreply', #state{}}.
+
+handle_info({'DOWN', MonitorRef, process, _Pid, _Info}, S) ->
+ member_died(MonitorRef),
+ {noreply, S};
+handle_info({nodeup, Node}, S) ->
+ gen_server:cast({?MODULE, Node}, {exchange, node(), all_members()}),
+ {noreply, S};
+handle_info({new_pg2, Node}, S) ->
+ gen_server:cast({?MODULE, Node}, {exchange, node(), all_members()}),
+ {noreply, S};
+handle_info(_, S) ->
+ {noreply, S}.
+
+-spec terminate(term(), #state{}) -> 'ok'.
+
+terminate(_Reason, _S) ->
+ true = ets:delete(pg2_table),
+ ok.
+
+%%%
+%%% Local functions
+%%%
+
+%%% One ETS table, pg2_table, is used for bookkeeping. The type of the
+%%% table is ordered_set, and the fast matching of partially
+%%% instantiated keys is used extensively.
+%%%
+%%% {{group, Name}}
+%%% Process group Name.
+%%% {{ref, Pid}, RPid, MonitorRef, Counter}
+%%% {{ref, MonitorRef}, Pid}
+%%% Each process has one monitor. Sometimes a process is spawned to
+%%% monitor the pid (RPid). Counter is incremented when the Pid joins
+%%% some group.
+%%% {{member, Name, Pid}, GroupCounter}
+%%% {{local_member, Name, Pid}}
+%%% Pid is a member of group Name, GroupCounter is incremented when the
+%%% Pid joins the group Name.
+%%% {{pid, Pid, Name}}
+%%% Pid is a member of group Name.
+
+store(List) ->
+ _ = [assure_group(Name) andalso [join_group(Name, P) || P <- Members] ||
+ [Name, Members] <- List],
+ ok.
+
+assure_group(Name) ->
+ Key = {group, Name},
+ ets:member(pg2_table, Key) orelse true =:= ets:insert(pg2_table, {Key}).
+
+delete_group(Name) ->
+ _ = [leave_group(Name, Pid) || Pid <- group_members(Name)],
+ true = ets:delete(pg2_table, {group, Name}),
+ ok.
+
+member_died(Ref) ->
+ [{{ref, Ref}, Pid}] = ets:lookup(pg2_table, {ref, Ref}),
+ Names = member_groups(Pid),
+ _ = [leave_group(Name, P) ||
+ Name <- Names,
+ P <- member_in_group(Pid, Name)],
+ %% Kept for backward compatibility with links. Can be removed, eventually.
+ _ = [gen_server:abcast(nodes(), ?MODULE, {del_member, Name, Pid}) ||
+ Name <- Names],
+ ok.
+
+join_group(Name, Pid) ->
+ Ref_Pid = {ref, Pid},
+ try _ = ets:update_counter(pg2_table, Ref_Pid, {4, +1})
+ catch _:_ ->
+ {RPid, Ref} = do_monitor(Pid),
+ true = ets:insert(pg2_table, {Ref_Pid, RPid, Ref, 1}),
+ true = ets:insert(pg2_table, {{ref, Ref}, Pid})
+ end,
+ Member_Name_Pid = {member, Name, Pid},
+ try _ = ets:update_counter(pg2_table, Member_Name_Pid, {2, +1})
+ catch _:_ ->
+ true = ets:insert(pg2_table, {Member_Name_Pid, 1}),
+ _ = [ets:insert(pg2_table, {{local_member, Name, Pid}}) ||
+ node(Pid) =:= node()],
+ true = ets:insert(pg2_table, {{pid, Pid, Name}})
+ end.
+
+leave_group(Name, Pid) ->
+ Member_Name_Pid = {member, Name, Pid},
+ try ets:update_counter(pg2_table, Member_Name_Pid, {2, -1}) of
+ N ->
+ if
+ N =:= 0 ->
+ true = ets:delete(pg2_table, {pid, Pid, Name}),
+ _ = [ets:delete(pg2_table, {local_member, Name, Pid}) ||
+ node(Pid) =:= node()],
+ true = ets:delete(pg2_table, Member_Name_Pid);
+ true ->
+ ok
+ end,
+ Ref_Pid = {ref, Pid},
+ case ets:update_counter(pg2_table, Ref_Pid, {4, -1}) of
+ 0 ->
+ [{Ref_Pid,RPid,Ref,0}] = ets:lookup(pg2_table, Ref_Pid),
+ true = ets:delete(pg2_table, {ref, Ref}),
+ true = ets:delete(pg2_table, Ref_Pid),
+ true = erlang:demonitor(Ref, [flush]),
+ kill_monitor_proc(RPid, Pid);
+ _ ->
+ ok
+ end
+ catch _:_ ->
+ ok
+ end.
+
+all_members() ->
+ [[G, group_members(G)] || G <- all_groups()].
+
+group_members(Name) ->
+ [P ||
+ [P, N] <- ets:match(pg2_table, {{member, Name, '$1'},'$2'}),
+ _ <- lists:seq(1, N)].
+
+local_group_members(Name) ->
+ [P ||
+ [Pid] <- ets:match(pg2_table, {{local_member, Name, '$1'}}),
+ P <- member_in_group(Pid, Name)].
+
+member_in_group(Pid, Name) ->
+ [{{member, Name, Pid}, N}] = ets:lookup(pg2_table, {member, Name, Pid}),
+ lists:duplicate(N, Pid).
+
+member_groups(Pid) ->
+ [Name || [Name] <- ets:match(pg2_table, {{pid, Pid, '$1'}})].
+
+all_groups() ->
+ [N || [N] <- ets:match(pg2_table, {{group,'$1'}})].
+
+ensure_started() ->
+ case whereis(?MODULE) of
+ undefined ->
+ C = {pg2, {?MODULE, start_link, []}, permanent,
+ 1000, worker, [?MODULE]},
+ supervisor:start_child(kernel_safe_sup, C);
+ Pg2Pid ->
+ {ok, Pg2Pid}
+ end.
+
+
+kill_monitor_proc(RPid, Pid) ->
+ RPid =:= Pid orelse exit(RPid, kill).
+
+%% When/if erlang:monitor() returns before trying to connect to the
+%% other node this function can be removed.
+do_monitor(Pid) ->
+ case (node(Pid) =:= node()) orelse lists:member(node(Pid), nodes()) of
+ true ->
+ %% Assume the node is still up
+ {Pid, erlang:monitor(process, Pid)};
+ false ->
+ F = fun() ->
+ Ref = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', Ref, process, Pid, _Info} ->
+ exit(normal)
+ end
+ end,
+ erlang:spawn_monitor(F)
+ end.
diff --git a/lib/kernel/src/ram_file.erl b/lib/kernel/src/ram_file.erl
new file mode 100644
index 0000000000..d996650948
--- /dev/null
+++ b/lib/kernel/src/ram_file.erl
@@ -0,0 +1,492 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ram_file).
+
+%% Binary RAM file interface
+
+%% Generic file contents operations
+-export([open/2, close/1]).
+-export([write/2, read/2, copy/3,
+ pread/2, pread/3, pwrite/2, pwrite/3,
+ position/2, truncate/1, sync/1]).
+
+%% Specialized file operations
+-export([get_size/1, get_file/1, set_file/2, get_file_close/1]).
+-export([compress/1, uncompress/1, uuencode/1, uudecode/1]).
+
+-export([open_mode/1]). %% used by ftp-file
+
+-export([ipread_s32bu_p32bu/3]).
+
+
+
+%% Includes and defines
+
+-define(RAM_FILE_DRV, "ram_file_drv").
+-define(MAX_I32, (1 bsl 31)).
+-define(G_I32(X), is_integer(X), X >= -?MAX_I32, X < ?MAX_I32).
+
+-include("file.hrl").
+
+
+
+%% --------------------------------------------------------------------------
+%% These operation codes were once identical between efile_drv.c
+%% and ram_file_drv.c, but now these drivers are not depeding on each other.
+%% So, the codes could be changed to more logical values now, but why indeed?
+
+%% Defined "file" functions
+-define(RAM_FILE_OPEN, 1).
+-define(RAM_FILE_READ, 2).
+-define(RAM_FILE_LSEEK, 3).
+-define(RAM_FILE_WRITE, 4).
+-define(RAM_FILE_FSYNC, 9).
+-define(RAM_FILE_TRUNCATE, 14).
+-define(RAM_FILE_PREAD, 17).
+-define(RAM_FILE_PWRITE, 18).
+
+%% Other operations
+-define(RAM_FILE_GET, 30).
+-define(RAM_FILE_SET, 31).
+-define(RAM_FILE_GET_CLOSE, 32).
+-define(RAM_FILE_COMPRESS, 33).
+-define(RAM_FILE_UNCOMPRESS, 34).
+-define(RAM_FILE_UUENCODE, 35).
+-define(RAM_FILE_UUDECODE, 36).
+-define(RAM_FILE_SIZE, 37).
+
+%% Open modes for RAM_FILE_OPEN
+-define(RAM_FILE_MODE_READ, 1).
+-define(RAM_FILE_MODE_WRITE, 2).
+-define(RAM_FILE_MODE_READ_WRITE, 3).
+%% Use this mask to get just the mode bits to be passed to the driver.
+-define(RAM_FILE_MODE_MASK, 3).
+
+%% Seek modes for RAM_FILE_LSEEK
+-define(RAM_FILE_SEEK_SET, 0).
+-define(RAM_FILE_SEEK_CUR, 1).
+-define(RAM_FILE_SEEK_END, 2).
+
+%% Return codes
+-define(RAM_FILE_RESP_OK, 0).
+-define(RAM_FILE_RESP_ERROR, 1).
+-define(RAM_FILE_RESP_DATA, 2).
+-define(RAM_FILE_RESP_NUMBER, 3).
+-define(RAM_FILE_RESP_INFO, 4).
+
+%% --------------------------------------------------------------------------
+%% Generic file contents operations.
+%%
+%% Supposed to be called by applications through module file.
+
+open(Data, ModeList) when is_list(ModeList) ->
+ case open_mode(ModeList) of
+ {Mode,Opts} when is_integer(Mode) ->
+ case ll_open(Data, Mode, Opts) of
+ {ok,Port} ->
+ {ok,#file_descriptor{module=?MODULE, data=Port}};
+ Error ->
+ Error
+ end;
+ {error,_}=Error ->
+ Error
+ end;
+%% Old obsolete mode specification
+open(Data, Mode) ->
+ case mode_list(Mode) of
+ ModeList when is_list(ModeList) ->
+ open(Data, ModeList);
+ Error ->
+ Error
+ end.
+
+close(#file_descriptor{module = ?MODULE, data = Port}) ->
+ ll_close(Port).
+
+read(#file_descriptor{module = ?MODULE, data = Port}, Sz)
+ when is_integer(Sz), Sz >= 0 ->
+ if
+ ?G_I32(Sz) ->
+ Cmd = <<?RAM_FILE_READ:8,Sz:32>>,
+ case call_port(Port, Cmd) of
+ {ok, {0, _Data}} when Sz =/= 0 ->
+ eof;
+ {ok, {_Sz, Data}} ->
+ {ok, Data};
+ {error, enomem} ->
+ %% Garbage collecting here might help if
+ %% the current processes has some old binaries left.
+ erlang:garbage_collect(),
+ case call_port(Port, Cmd) of
+ {ok, {0, _Data}} when Sz =/= 0 ->
+ eof;
+ {ok, {_Sz, Data}} ->
+ {ok, Data};
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end;
+ true ->
+ {error, einval}
+ end.
+
+write(#file_descriptor{module = ?MODULE, data = Port}, Bytes) ->
+ case call_port(Port, [?RAM_FILE_WRITE | Bytes]) of
+ {ok, _Sz} ->
+ ok;
+ Error ->
+ Error
+ end.
+
+
+
+
+copy(#file_descriptor{module = ?MODULE} = Source,
+ #file_descriptor{module = ?MODULE} = Dest,
+ Length)
+ when is_integer(Length), Length >= 0;
+ is_atom(Length) ->
+ %% XXX Should be moved down to the driver for optimization.
+ file:copy_opened(Source, Dest, Length).
+
+
+sync(#file_descriptor{module = ?MODULE, data = Port}) ->
+ call_port(Port, <<?RAM_FILE_FSYNC>>).
+
+truncate(#file_descriptor{module = ?MODULE, data = Port}) ->
+ call_port(Port, <<?RAM_FILE_TRUNCATE>>).
+
+position(#file_descriptor{module = ?MODULE, data = Port}, Pos) ->
+ case lseek_position(Pos) of
+ {ok, Offs, Whence} when ?G_I32(Offs) ->
+ call_port(Port, <<?RAM_FILE_LSEEK:8,Offs:32,Whence:32>>);
+ {ok, _, _} ->
+ {error, einval};
+ Error ->
+ Error
+ end.
+
+
+
+pread(#file_descriptor{module = ?MODULE, data = Port}, L) when is_list(L) ->
+ pread_1(Port, L, []).
+
+pread_1(Port, [], Cs) ->
+ pread_2(Port, lists:reverse(Cs), []);
+pread_1(Port, [{At, Sz} | T], Cs)
+ when is_integer(At), is_integer(Sz), Sz >= 0 ->
+ if
+ ?G_I32(At), ?G_I32(Sz) ->
+ pread_1(Port, T, [{Sz,<<?RAM_FILE_PREAD:8,At:32,Sz:32>>}|Cs]);
+ true ->
+ {error, einval}
+ end;
+pread_1(_, _, _243) ->
+ {error, badarg}.
+
+pread_2(_Port, [], R) ->
+ {ok, lists:reverse(R)};
+pread_2(Port, [{Sz,Command}|Commands], R) ->
+ case call_port(Port, Command) of
+ {ok, {0,_Data}} when Sz =/= 0 ->
+ pread_2(Port, Commands, [eof | R]);
+ {ok, {_Sz,Data}} ->
+ pread_2(Port, Commands, [Data | R]);
+ Error ->
+ Error
+ end.
+
+pread(#file_descriptor{module = ?MODULE, data = Port}, At, Sz)
+ when is_integer(At), is_integer(Sz), Sz >= 0 ->
+ if
+ ?G_I32(At), ?G_I32(Sz) ->
+ case call_port(Port, <<?RAM_FILE_PREAD:8,At:32,Sz:32>>) of
+ {ok, {0,_Data}} when Sz =/= 0 ->
+ eof;
+ {ok, {_Sz,Data}} ->
+ {ok, Data};
+ Error ->
+ Error
+ end;
+ true ->
+ {error, einval}
+ end;
+pread(#file_descriptor{module = ?MODULE}, _, _) ->
+ {error, badarg}.
+
+
+
+pwrite(#file_descriptor{module = ?MODULE, data = Port}, L) when is_list(L) ->
+ pwrite_1(Port, L, 0, []).
+
+pwrite_1(Port, [], _, Cs) ->
+ pwrite_2(Port, lists:reverse(Cs), 0);
+pwrite_1(Port, [{At, Bytes} | T], R, Cs) when is_integer(At) ->
+ if
+ ?G_I32(At), is_binary(Bytes) ->
+ pwrite_1(Port, T, R+1,
+ [<<?RAM_FILE_PWRITE:8,At:32,Bytes/binary>> | Cs]);
+ ?G_I32(At) ->
+ try erlang:iolist_to_binary(Bytes) of
+ Bin ->
+ pwrite_1(Port, T, R+1,
+ [<<?RAM_FILE_PWRITE:8,At:32,Bin/binary>> | Cs])
+ catch
+ error:Reason ->
+ {error, Reason}
+ end;
+ true ->
+ {error, {R, einval}}
+ end;
+pwrite_1(_, _, _, _) ->
+ {error, badarg}.
+
+pwrite_2(_Port, [], _R) ->
+ ok;
+pwrite_2(Port, [Command|Commands], R) ->
+ case call_port(Port, Command) of
+ {ok, _Sz} ->
+ pwrite_2(Port, Commands, R+1);
+ {error, badarg} = Error ->
+ Error;
+ {error, Reason} ->
+ {error, {R, Reason}}
+ end.
+
+pwrite(#file_descriptor{module = ?MODULE, data = Port}, At, Bytes)
+ when is_integer(At) ->
+ if
+ ?G_I32(At) ->
+ case call_port(Port, [<<?RAM_FILE_PWRITE:8,At:32>>|Bytes]) of
+ {ok, _Sz} ->
+ ok;
+ Error ->
+ Error
+ end;
+ true ->
+ {error, einval}
+ end;
+pwrite(#file_descriptor{module = ?MODULE}, _, _) ->
+ {error, badarg}.
+
+
+ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE} = Handle, Pos, MaxSz) ->
+ file:ipread_s32bu_p32bu_int(Handle, Pos, MaxSz).
+
+
+
+%% --------------------------------------------------------------------------
+%% Specialized ram_file API for functions not in file, unique to ram_file.
+%%
+
+
+get_file(#file_descriptor{module = ?MODULE, data = Port}) ->
+ case call_port(Port, [?RAM_FILE_GET]) of
+ {ok, {_Sz, Data}} ->
+ {ok, Data};
+ Error ->
+ Error
+ end;
+get_file(#file_descriptor{}) ->
+ {error, enotsup}.
+
+set_file(#file_descriptor{module = ?MODULE, data = Port}, Data) ->
+ call_port(Port, [?RAM_FILE_SET | Data]);
+set_file(#file_descriptor{}, _) ->
+ {error, enotsup}.
+
+get_file_close(#file_descriptor{module = ?MODULE, data = Port}) ->
+ case call_port(Port, [?RAM_FILE_GET_CLOSE]) of
+ {ok, {_Sz, Data}} ->
+ {ok, Data};
+ Error ->
+ Error
+ end;
+get_file_close(#file_descriptor{}) ->
+ {error, enotsup}.
+
+get_size(#file_descriptor{module = ?MODULE, data = Port}) ->
+ call_port(Port, [?RAM_FILE_SIZE]);
+get_size(#file_descriptor{}) ->
+ {error, enotsup}.
+
+compress(#file_descriptor{module = ?MODULE, data = Port}) ->
+ call_port(Port, [?RAM_FILE_COMPRESS]);
+compress(#file_descriptor{}) ->
+ {error, enotsup}.
+
+uncompress(#file_descriptor{module = ?MODULE, data = Port}) ->
+ call_port(Port, [?RAM_FILE_UNCOMPRESS]);
+uncompress(#file_descriptor{}) ->
+ {error, enotsup}.
+
+
+uuencode(#file_descriptor{module = ?MODULE, data = Port}) ->
+ call_port(Port, [?RAM_FILE_UUENCODE]);
+uuencode(#file_descriptor{}) ->
+ {error, enotsup}.
+
+uudecode(#file_descriptor{module = ?MODULE, data = Port}) ->
+ call_port(Port, [?RAM_FILE_UUDECODE]);
+uudecode(#file_descriptor{}) ->
+ {error, enotsup}.
+
+
+
+%%%-----------------------------------------------------------------
+%%% Functions to communicate with the driver
+
+ll_open(Data, Mode, Opts) ->
+ try erlang:open_port({spawn, ?RAM_FILE_DRV}, Opts) of
+ Port ->
+ case call_port(Port, [<<?RAM_FILE_OPEN:8,Mode:32>>|Data]) of
+ {error, _} = Error ->
+ ll_close(Port),
+ Error;
+ {ok, _} ->
+ {ok, Port}
+ end
+ catch
+ error:Reason ->
+ {error, Reason}
+ end.
+
+call_port(Port, Command) when is_port(Port), is_binary(Command) ->
+ try erlang:port_command(Port, Command) of
+ true ->
+ get_response(Port)
+ catch
+ error:badarg ->
+ {error, einval}; % Since Command is valid, Port must be dead
+ error:Reason ->
+ {error, Reason}
+ end;
+call_port(Port, Command) ->
+ try erlang:iolist_to_binary(Command) of
+ Bin ->
+ call_port(Port, Bin)
+ catch
+ error:Reason ->
+ {error, Reason}
+ end.
+
+get_response(Port) ->
+ receive
+ {Port, {data, [Response|Rest]}} ->
+ translate_response(Response, Rest);
+ {'EXIT', Port, _Reason} ->
+ {error, port_died}
+ end.
+
+ll_close(Port) ->
+ try erlang:port_close(Port) catch error:_ -> ok end,
+ receive %% In case the caller is the owner and traps exits
+ {'EXIT', Port, _} ->
+ ok
+ after 0 ->
+ ok
+ end.
+
+%%%-----------------------------------------------------------------
+%%% Utility functions.
+
+mode_list(read) ->
+ [read];
+mode_list(write) ->
+ [write];
+mode_list(read_write) ->
+ [read, write];
+mode_list({binary, Mode}) when is_atom(Mode) ->
+ [binary | mode_list(Mode)];
+mode_list({character, Mode}) when is_atom(Mode) ->
+ mode_list(Mode);
+mode_list(_) ->
+ {error, badarg}.
+
+
+
+%% Converts a list of mode atoms into an mode word for the driver.
+%% Returns {Mode, Opts} wher Opts is a list of options for
+%% erlang:open_port/2, or {error, einval} upon failure.
+
+open_mode(List) when is_list(List) ->
+ case open_mode(List, {0, []}) of
+ {Mode, Opts} when Mode band
+ (?RAM_FILE_MODE_READ bor ?RAM_FILE_MODE_WRITE)
+ =:= 0 ->
+ {Mode bor ?RAM_FILE_MODE_READ, Opts};
+ Other ->
+ Other
+ end.
+
+open_mode([ram|Rest], {Mode, Opts}) ->
+ open_mode(Rest, {Mode, Opts});
+open_mode([read|Rest], {Mode, Opts}) ->
+ open_mode(Rest, {Mode bor ?RAM_FILE_MODE_READ, Opts});
+open_mode([write|Rest], {Mode, Opts}) ->
+ open_mode(Rest, {Mode bor ?RAM_FILE_MODE_WRITE, Opts});
+open_mode([binary|Rest], {Mode, Opts}) ->
+ open_mode(Rest, {Mode, [binary | Opts]});
+open_mode([], {Mode, Opts}) ->
+ {Mode, Opts};
+open_mode(_, _) ->
+ {error, badarg}.
+
+
+
+%% Converts a position tuple {bof, X} | {cur, X} | {eof, X} into
+%% {ok, Offset, OriginCode} for the driver.
+%% Returns {error, einval} upon failure.
+
+lseek_position(Pos) when is_integer(Pos) ->
+ lseek_position({bof, Pos});
+lseek_position(bof) ->
+ lseek_position({bof, 0});
+lseek_position(cur) ->
+ lseek_position({cur, 0});
+lseek_position(eof) ->
+ lseek_position({eof, 0});
+lseek_position({bof, Offset}) when is_integer(Offset) ->
+ {ok, Offset, ?RAM_FILE_SEEK_SET};
+lseek_position({cur, Offset}) when is_integer(Offset) ->
+ {ok, Offset, ?RAM_FILE_SEEK_CUR};
+lseek_position({eof, Offset}) when is_integer(Offset) ->
+ {ok, Offset, ?RAM_FILE_SEEK_END};
+lseek_position(_) ->
+ {error, badarg}.
+
+
+
+translate_response(?RAM_FILE_RESP_OK, []) ->
+ ok;
+translate_response(?RAM_FILE_RESP_OK, Data) ->
+ {ok, Data};
+translate_response(?RAM_FILE_RESP_ERROR, List) when is_list(List) ->
+ {error, list_to_atom(List)};
+translate_response(?RAM_FILE_RESP_NUMBER, [X1, X2, X3, X4]) ->
+ {ok, i32(X1, X2, X3, X4)};
+translate_response(?RAM_FILE_RESP_DATA, [X1, X2, X3, X4|Data]) ->
+ {ok, {i32(X1, X2, X3, X4), Data}};
+translate_response(X, Data) ->
+ {error, {bad_response_from_port, X, Data}}.
+
+i32(X1,X2,X3,X4) ->
+ (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.
diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl
new file mode 100644
index 0000000000..d69f2a12ad
--- /dev/null
+++ b/lib/kernel/src/rpc.erl
@@ -0,0 +1,609 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(rpc).
+
+%% General rpc, broadcast,multicall, promise and parallel evaluator
+%% facility
+
+%% This code used to reside in net.erl, but has now been moved to
+%% a searate module.
+
+-define(NAME, rex).
+
+-behaviour(gen_server).
+
+-export([start/0, start_link/0, stop/0,
+ call/4, call/5,
+ block_call/4, block_call/5,
+ server_call/4,
+ cast/4,
+ abcast/2,
+ abcast/3,
+ sbcast/2,
+ sbcast/3,
+ eval_everywhere/3,
+ eval_everywhere/4,
+ multi_server_call/2,
+ multi_server_call/3,
+ multicall/3,
+ multicall/4,
+ multicall/5,
+ async_call/4,
+ yield/1,
+ nb_yield/2,
+ nb_yield/1,
+ parallel_eval/1,
+ pmap/3, pinfo/1, pinfo/2]).
+
+%% Deprecated calls.
+-deprecated([{safe_multi_server_call,2},{safe_multi_server_call,3}]).
+-export([safe_multi_server_call/2,safe_multi_server_call/3]).
+
+%% gen_server exports
+-export([init/1,handle_call/3,handle_cast/2,handle_info/2,
+ terminate/2, code_change/3]).
+
+%% Internals
+-export([proxy_user_flush/0]).
+
+%%------------------------------------------------------------------------
+
+%% Remote execution and broadcasting facility
+
+start() ->
+ gen_server:start({local,?NAME},?MODULE,[],[]).
+
+start_link() ->
+ gen_server:start_link({local,?NAME},?MODULE,[],[]).
+
+stop() ->
+ stop(?NAME).
+
+stop(Rpc) ->
+ gen_server:call(Rpc, stop, infinity).
+
+-spec init([]) -> {'ok', gb_tree()}.
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok, gb_trees:empty()}.
+
+handle_call({call, Mod, Fun, Args, Gleader}, To, S) ->
+ handle_call_call(Mod, Fun, Args, Gleader, To, S);
+handle_call({block_call, Mod, Fun, Args, Gleader}, _To, S) ->
+ MyGL = group_leader(),
+ set_group_leader(Gleader),
+ Reply =
+ case catch apply(Mod,Fun,Args) of
+ {'EXIT', _} = Exit ->
+ {badrpc, Exit};
+ Other ->
+ Other
+ end,
+ group_leader(MyGL, self()), % restore
+ {reply, Reply, S};
+handle_call(stop, _To, S) ->
+ {stop, normal, stopped, S};
+handle_call(_, _To, S) ->
+ {noreply, S}. % Ignore !
+
+
+handle_cast({cast, Mod, Fun, Args, Gleader}, S) ->
+ spawn(
+ fun() ->
+ set_group_leader(Gleader),
+ apply(Mod, Fun, Args)
+ end),
+ {noreply, S};
+handle_cast(_, S) ->
+ {noreply, S}. % Ignore !
+
+
+handle_info({'DOWN', _, process, Caller, Reason}, S) ->
+ case gb_trees:lookup(Caller, S) of
+ {value, To} ->
+ receive
+ {Caller, {reply, Reply}} ->
+ gen_server:reply(To, Reply)
+ after 0 ->
+ gen_server:reply(To, {badrpc, {'EXIT', Reason}})
+ end,
+ {noreply, gb_trees:delete(Caller, S)};
+ none ->
+ {noreply, S}
+ end;
+handle_info({Caller, {reply, Reply}}, S) ->
+ case gb_trees:lookup(Caller, S) of
+ {value, To} ->
+ receive
+ {'DOWN', _, process, Caller, _} ->
+ gen_server:reply(To, Reply),
+ {noreply, gb_trees:delete(Caller, S)}
+ end;
+ none ->
+ {noreply, S}
+ end;
+handle_info({From, {sbcast, Name, Msg}}, S) ->
+ case catch Name ! Msg of %% use catch to get the printout
+ {'EXIT', _} ->
+ From ! {?NAME, node(), {nonexisting_name, Name}};
+ _ ->
+ From ! {?NAME, node(), node()}
+ end,
+ {noreply,S};
+handle_info({From, {send, Name, Msg}}, S) ->
+ case catch Name ! {From, Msg} of %% use catch to get the printout
+ {'EXIT', _} ->
+ From ! {?NAME, node(), {nonexisting_name, Name}};
+ _ ->
+ ok %% It's up to Name to respond !!!!!
+ end,
+ {noreply,S};
+handle_info({From, {call,Mod,Fun,Args,Gleader}}, S) ->
+ %% Special for hidden C node's, uugh ...
+ handle_call_call(Mod, Fun, Args, Gleader, {From,?NAME}, S);
+handle_info(_, S) ->
+ {noreply,S}.
+
+terminate(_, _S) ->
+ ok.
+
+code_change(_, S, _) ->
+ {ok, S}.
+
+%%
+%% Auxiliary function to avoid a false dialyzer warning -- do not inline
+%%
+handle_call_call(Mod, Fun, Args, Gleader, To, S) ->
+ RpcServer = self(),
+ %% Spawn not to block the rpc server.
+ {Caller,_} =
+ erlang:spawn_monitor(
+ fun () ->
+ set_group_leader(Gleader),
+ Reply =
+ %% in case some sucker rex'es
+ %% something that throws
+ case catch apply(Mod, Fun, Args) of
+ {'EXIT', _} = Exit ->
+ {badrpc, Exit};
+ Result ->
+ Result
+ end,
+ RpcServer ! {self(), {reply, Reply}}
+ end),
+ {noreply, gb_trees:insert(Caller, To, S)}.
+
+
+%% RPC aid functions ....
+
+set_group_leader(Gleader) when is_pid(Gleader) ->
+ group_leader(Gleader, self());
+set_group_leader(user) ->
+ %% For example, hidden C nodes doesn't want any I/O.
+ Gleader = case whereis(user) of
+ Pid when is_pid(Pid) -> Pid;
+ undefined -> proxy_user()
+ end,
+ group_leader(Gleader, self()).
+
+
+%% The 'rex_proxy_user' process serve as group leader for early rpc's that
+%% may do IO before the real group leader 'user' has been started (OTP-7903).
+proxy_user() ->
+ case whereis(rex_proxy_user) of
+ Pid when is_pid(Pid) -> Pid;
+ undefined ->
+ Pid = spawn(fun()-> proxy_user_loop() end),
+ try register(rex_proxy_user,Pid) of
+ true -> Pid
+ catch error:_ -> % spawn race, kill and try again
+ exit(Pid,kill),
+ proxy_user()
+ end
+ end.
+
+proxy_user_loop() ->
+ %% Wait for the real 'user' to start
+ timer:sleep(200),
+ case whereis(user) of
+ Pid when is_pid(Pid) -> proxy_user_flush();
+ undefined -> proxy_user_loop()
+ end.
+
+proxy_user_flush() ->
+ %% Forward all received messages to 'user'
+ receive Msg ->
+ user ! Msg
+ after 10*1000 ->
+ %% Hibernate but live for ever, as it's not easy to know
+ %% when no more messages will arrive.
+ erlang:hibernate(?MODULE, proxy_user_flush, [])
+ end,
+ proxy_user_flush().
+
+
+%% THE rpc client interface
+
+-spec call(node(), atom(), atom(), [term()]) -> term().
+
+call(N,M,F,A) when node() =:= N -> %% Optimize local call
+ local_call(M, F, A);
+call(N,M,F,A) ->
+ do_call(N, {call,M,F,A,group_leader()}, infinity).
+
+-spec call(node(), atom(), atom(), [term()], timeout()) -> term().
+
+call(N,M,F,A,_Timeout) when node() =:= N -> %% Optimize local call
+ local_call(M,F,A);
+call(N,M,F,A,infinity) ->
+ do_call(N, {call,M,F,A,group_leader()}, infinity);
+call(N,M,F,A,Timeout) when is_integer(Timeout), Timeout >= 0 ->
+ do_call(N, {call,M,F,A,group_leader()}, Timeout).
+
+-spec block_call(node(), atom(), atom(), [term()]) -> term().
+
+block_call(N,M,F,A) when node() =:= N -> %% Optimize local call
+ local_call(M,F,A);
+block_call(N,M,F,A) ->
+ do_call(N, {block_call,M,F,A,group_leader()}, infinity).
+
+-spec block_call(node(), atom(), atom(), [term()], timeout()) -> term().
+
+block_call(N,M,F,A,_Timeout) when node() =:= N -> %% Optimize local call
+ local_call(M, F, A);
+block_call(N,M,F,A,infinity) ->
+ do_call(N, {block_call,M,F,A,group_leader()}, infinity);
+block_call(N,M,F,A,Timeout) when is_integer(Timeout), Timeout >= 0 ->
+ do_call(N, {block_call,M,F,A,group_leader()}, Timeout).
+
+local_call(M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
+ case catch apply(M, F, A) of
+ {'EXIT',_}=V -> {badrpc, V};
+ Other -> Other
+ end.
+
+do_call(Node, Request, infinity) ->
+ rpc_check(catch gen_server:call({?NAME,Node}, Request, infinity));
+do_call(Node, Request, Timeout) ->
+ Tag = make_ref(),
+ {Receiver,Mref} =
+ erlang:spawn_monitor(
+ fun() ->
+ %% Middleman process. Should be unsensitive to regular
+ %% exit signals.
+ process_flag(trap_exit, true),
+ Result = gen_server:call({?NAME,Node}, Request, Timeout),
+ exit({self(),Tag,Result})
+ end),
+ receive
+ {'DOWN',Mref,_,_,{Receiver,Tag,Result}} ->
+ rpc_check(Result);
+ {'DOWN',Mref,_,_,Reason} ->
+ %% The middleman code failed. Or someone did
+ %% exit(_, kill) on the middleman process => Reason==killed
+ rpc_check_t({'EXIT',Reason})
+ end.
+
+rpc_check_t({'EXIT', {timeout,_}}) -> {badrpc, timeout};
+rpc_check_t(X) -> rpc_check(X).
+
+rpc_check({'EXIT', {{nodedown,_},_}}) -> {badrpc, nodedown};
+rpc_check({'EXIT', X}) -> exit(X);
+rpc_check(X) -> X.
+
+
+%% This is a real handy function to be used when interacting with
+%% a server called Name at node Node, It is assumed that the server
+%% Receives messages on the form {From, Request} and replies on the
+%% form From ! {ReplyWrapper, Node, Reply}.
+%% This function makes such a server call and ensures that that
+%% The entire call is packed into an atomic transaction which
+%% either succeeds or fails, i.e. never hangs (unless the server itself hangs).
+
+-spec server_call(node(), atom(), term(), term()) -> term() | {'error', 'nodedown'}.
+
+server_call(Node, Name, ReplyWrapper, Msg)
+ when is_atom(Node), is_atom(Name) ->
+ if node() =:= nonode@nohost, Node =/= nonode@nohost ->
+ {error, nodedown};
+ true ->
+ Ref = erlang:monitor(process, {Name, Node}),
+ {Name, Node} ! {self(), Msg},
+ receive
+ {'DOWN', Ref, _, _, _} ->
+ {error, nodedown};
+ {ReplyWrapper, Node, Reply} ->
+ erlang:demonitor(Ref),
+ receive
+ {'DOWN', Ref, _, _, _} ->
+ Reply
+ after 0 ->
+ Reply
+ end
+ end
+ end.
+
+-spec cast(node(), atom(), atom(), [term()]) -> 'true'.
+
+cast(Node, Mod, Fun, Args) when Node =:= node() ->
+ catch spawn(Mod, Fun, Args),
+ true;
+cast(Node, Mod, Fun, Args) ->
+ gen_server:cast({?NAME,Node}, {cast,Mod,Fun,Args,group_leader()}),
+ true.
+
+
+%% Asynchronous broadcast, returns nothing, it's just send'n prey
+-spec abcast(atom(), term()) -> 'abcast'.
+
+abcast(Name, Mess) ->
+ abcast([node() | nodes()], Name, Mess).
+
+-spec abcast([node()], atom(), term()) -> 'abcast'.
+
+abcast([Node|Tail], Name, Mess) ->
+ Dest = {Name,Node},
+ case catch erlang:send(Dest, Mess, [noconnect]) of
+ noconnect -> spawn(erlang, send, [Dest,Mess]);
+ _ -> ok
+ end,
+ abcast(Tail, Name, Mess);
+abcast([], _,_) -> abcast.
+
+
+%% Syncronous broadcast, returns a list of the nodes which had Name
+%% as a registered server. Returns {Goodnodes, Badnodes}.
+%% Syncronous in the sense that we know that all servers have received the
+%% message when we return from the call, we can't know that they have
+%% processed the message though.
+
+-spec sbcast(atom(), term()) -> {[node()], [node()]}.
+
+sbcast(Name, Mess) ->
+ sbcast([node() | nodes()], Name, Mess).
+
+-spec sbcast([node()], atom(), term()) -> {[node()], [node()]}.
+
+sbcast(Nodes, Name, Mess) ->
+ Monitors = send_nodes(Nodes, ?NAME, {sbcast, Name, Mess}, []),
+ rec_nodes(?NAME, Monitors).
+
+-spec eval_everywhere(atom(), atom(), [term()]) -> 'abcast'.
+
+eval_everywhere(Mod, Fun, Args) ->
+ eval_everywhere([node() | nodes()] , Mod, Fun, Args).
+
+-spec eval_everywhere([node()], atom(), atom(), [term()]) -> 'abcast'.
+
+eval_everywhere(Nodes, Mod, Fun, Args) ->
+ gen_server:abcast(Nodes, ?NAME, {cast,Mod,Fun,Args,group_leader()}).
+
+
+send_nodes([Node|Tail], Name, Msg, Monitors) when is_atom(Node) ->
+ Monitor = start_monitor(Node, Name),
+ %% Handle non-existing names in rec_nodes.
+ catch {Name, Node} ! {self(), Msg},
+ send_nodes(Tail, Name, Msg, [Monitor | Monitors]);
+send_nodes([_Node|Tail], Name, Msg, Monitors) ->
+ %% Skip non-atom _Node
+ send_nodes(Tail, Name, Msg, Monitors);
+send_nodes([], _Name, _Req, Monitors) ->
+ Monitors.
+
+%% Starts a monitor, either the new way, or the old.
+%% Assumes that the arguments are atoms.
+start_monitor(Node, Name) ->
+ if node() =:= nonode@nohost, Node =/= nonode@nohost ->
+ Ref = make_ref(),
+ self() ! {'DOWN', Ref, process, {Name, Node}, noconnection},
+ {Node, Ref};
+ true ->
+ {Node,erlang:monitor(process, {Name, Node})}
+ end.
+
+%% Cancels a monitor started with Ref=erlang:monitor(_, _),
+%% i.e return value {Node, Ref} from start_monitor/2 above.
+unmonitor(Ref) when is_reference(Ref) ->
+ erlang:demonitor(Ref),
+ receive
+ {'DOWN', Ref, _, _, _} ->
+ true
+ after 0 ->
+ true
+ end.
+
+
+%% Call apply(M,F,A) on all nodes in parallel
+-spec multicall(atom(), atom(), [term()]) -> {[_], [node()]}.
+
+multicall(M, F, A) ->
+ multicall(M, F, A, infinity).
+
+-spec multicall([node()], atom(), atom(), [term()]) -> {[_], [node()]}
+ ; (atom(), atom(), [term()], timeout()) -> {[_], [node()]}.
+
+multicall(Nodes, M, F, A) when is_list(Nodes) ->
+ multicall(Nodes, M, F, A, infinity);
+multicall(M, F, A, Timeout) ->
+ multicall([node() | nodes()], M, F, A, Timeout).
+
+-spec multicall([node()], atom(), atom(), [term()], timeout()) -> {[_], [node()]}.
+
+multicall(Nodes, M, F, A, infinity)
+ when is_list(Nodes), is_atom(M), is_atom(F), is_list(A) ->
+ do_multicall(Nodes, M, F, A, infinity);
+multicall(Nodes, M, F, A, Timeout)
+ when is_list(Nodes), is_atom(M), is_atom(F), is_list(A), is_integer(Timeout),
+ Timeout >= 0 ->
+ do_multicall(Nodes, M, F, A, Timeout).
+
+do_multicall(Nodes, M, F, A, Timeout) ->
+ {Rep,Bad} = gen_server:multi_call(Nodes, ?NAME,
+ {call, M,F,A, group_leader()},
+ Timeout),
+ {lists:map(fun({_,R}) -> R end, Rep), Bad}.
+
+
+%% Send Msg to Name on all nodes, and collect the answers.
+%% Return {Replies, Badnodes} where Badnodes is a list of the nodes
+%% that failed during the timespan of the call.
+%% This function assumes that if we send a request to a server
+%% called Name, the server will reply with a reply
+%% on the form {Name, Node, Reply}, otherwise this function will
+%% hang forever.
+%% It also assumes that the server receives messages on the form
+%% {From, Msg} and then replies as From ! {Name, node(), Reply}.
+%%
+%% There is no apparent order among the replies.
+
+-spec multi_server_call(atom(), term()) -> {[_], [node()]}.
+
+multi_server_call(Name, Msg) ->
+ multi_server_call([node() | nodes()], Name, Msg).
+
+-spec multi_server_call([node()], atom(), term()) -> {[_], [node()]}.
+
+multi_server_call(Nodes, Name, Msg)
+ when is_list(Nodes), is_atom(Name) ->
+ Monitors = send_nodes(Nodes, Name, Msg, []),
+ rec_nodes(Name, Monitors).
+
+%% Deprecated functions. Were only needed when communicating with R6 nodes.
+
+safe_multi_server_call(Name, Msg) ->
+ multi_server_call(Name, Msg).
+
+safe_multi_server_call(Nodes, Name, Msg) ->
+ multi_server_call(Nodes, Name, Msg).
+
+
+rec_nodes(Name, Nodes) ->
+ rec_nodes(Name, Nodes, [], []).
+
+rec_nodes(_Name, [], Badnodes, Replies) ->
+ {Replies, Badnodes};
+rec_nodes(Name, [{N,R} | Tail], Badnodes, Replies) ->
+ receive
+ {'DOWN', R, _, _, _} ->
+ rec_nodes(Name, Tail, [N|Badnodes], Replies);
+ {?NAME, N, {nonexisting_name, _}} ->
+ %% used by sbcast()
+ unmonitor(R),
+ rec_nodes(Name, Tail, [N|Badnodes], Replies);
+ {Name, N, Reply} -> %% Name is bound !!!
+ unmonitor(R),
+ rec_nodes(Name, Tail, Badnodes, [Reply|Replies])
+ end.
+
+%% Now for an asynchronous rpc.
+%% An asyncronous version of rpc that is faster for series of
+%% rpc's towards the same node. I.e. it returns immediately and
+%% it returns a Key that can be used in a subsequent yield(Key).
+
+-spec async_call(node(), atom(), atom(), [term()]) -> pid().
+
+async_call(Node, Mod, Fun, Args) ->
+ ReplyTo = self(),
+ spawn(
+ fun() ->
+ R = call(Node, Mod, Fun, Args), %% proper rpc
+ ReplyTo ! {self(), {promise_reply, R}} %% self() is key
+ end).
+
+-spec yield(pid()) -> term().
+
+yield(Key) when is_pid(Key) ->
+ {value,R} = do_yield(Key, infinity),
+ R.
+
+-spec nb_yield(pid(), timeout()) -> {'value', _} | 'timeout'.
+
+nb_yield(Key, infinity=Inf) when is_pid(Key) ->
+ do_yield(Key, Inf);
+nb_yield(Key, Timeout) when is_pid(Key), is_integer(Timeout), Timeout >= 0 ->
+ do_yield(Key, Timeout).
+
+-spec nb_yield(pid()) -> {'value', _} | 'timeout'.
+
+nb_yield(Key) when is_pid(Key) ->
+ do_yield(Key, 0).
+
+-spec do_yield(pid(), timeout()) -> {'value', _} | 'timeout'.
+
+do_yield(Key, Timeout) ->
+ receive
+ {Key,{promise_reply,R}} ->
+ {value,R}
+ after Timeout ->
+ timeout
+ end.
+
+
+%% A parallel network evaluator
+%% ArgL === [{M,F,Args},........]
+%% Returns a lists of the evaluations in the same order as
+%% given to ArgL
+-spec parallel_eval([{atom(), atom(), [_]}]) -> [_].
+
+parallel_eval(ArgL) ->
+ Nodes = [node() | nodes()],
+ Keys = map_nodes(ArgL,Nodes,Nodes),
+ [yield(K) || K <- Keys].
+
+map_nodes([],_,_) -> [];
+map_nodes(ArgL,[],Original) ->
+ map_nodes(ArgL,Original,Original);
+map_nodes([{M,F,A}|Tail],[Node|MoreNodes], Original) ->
+ [?MODULE:async_call(Node,M,F,A) |
+ map_nodes(Tail,MoreNodes,Original)].
+
+%% Parallel version of lists:map/3 with exactly the same
+%% arguments and return value as lists:map/3,
+%% except that it calls exit/1 if a network error occurs.
+-spec pmap({atom(),atom()}, [term()], [term()]) -> [term()].
+
+pmap({M,F}, As, List) ->
+ check(parallel_eval(build_args(M,F,As, List, [])), []).
+
+%% By using an accumulator twice we get the whole thing right
+build_args(M,F, As, [Arg|Tail], Acc) ->
+ build_args(M,F, As, Tail, [{M,F,[Arg|As]}|Acc]);
+build_args(M,F, _, [], Acc) when is_atom(M), is_atom(F) -> Acc.
+
+%% If one single call fails, we fail the whole computation
+check([{badrpc, _}|_], _) -> exit(badrpc);
+check([X|T], Ack) -> check(T, [X|Ack]);
+check([], Ack) -> Ack.
+
+
+%% location transparent version of process_info
+-spec pinfo(pid()) -> [{atom(), _}] | 'undefined'.
+
+pinfo(Pid) when node(Pid) =:= node() ->
+ process_info(Pid);
+pinfo(Pid) ->
+ call(node(Pid), erlang, process_info, [Pid]).
+
+-spec pinfo(pid(), Item) -> {Item, _} | 'undefined' | []
+ when is_subtype(Item, atom()).
+
+pinfo(Pid, Item) when node(Pid) =:= node() ->
+ process_info(Pid, Item);
+pinfo(Pid, Item) ->
+ block_call(node(Pid), erlang, process_info, [Pid, Item]).
diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl
new file mode 100644
index 0000000000..78c3040f21
--- /dev/null
+++ b/lib/kernel/src/seq_trace.erl
@@ -0,0 +1,126 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(seq_trace).
+
+-define(SEQ_TRACE_SEND, 1). %(1 << 0)
+-define(SEQ_TRACE_RECEIVE, 2). %(1 << 1)
+-define(SEQ_TRACE_PRINT, 4). %(1 << 2)
+-define(SEQ_TRACE_TIMESTAMP, 8). %(1 << 3)
+
+-export([set_token/1,
+ set_token/2,
+ get_token/0,
+ get_token/1,
+ print/1,
+ print/2,
+ reset_trace/0,
+ set_system_tracer/1,
+ get_system_tracer/0]).
+
+%%---------------------------------------------------------------------------
+
+-type flag() :: 'send' | 'receive' | 'print' | 'timestamp'.
+-type component() :: 'label' | 'serial' | flag().
+-type value() :: non_neg_integer()
+ | {non_neg_integer(), non_neg_integer()}
+ | boolean().
+-type token_pair() :: {component(), value()}.
+
+%%---------------------------------------------------------------------------
+
+-type token() :: [] | {integer(), boolean(), _, _, _}.
+-spec set_token(token()) -> token() | 'ok'.
+
+set_token([]) ->
+ erlang:seq_trace(sequential_trace_token,[]);
+set_token({Flags,Label,Serial,_From,Lastcnt}) ->
+ F = decode_flags(Flags),
+ set_token2([{label,Label},{serial,{Lastcnt, Serial}} | F]).
+
+%% We limit the label type to always be a small integer because erl_interface
+%% expects that, the BIF can however "unofficially" handle atoms as well, and
+%% atoms can be used if only Erlang nodes are involved
+
+-spec set_token(component(), value()) -> token_pair().
+
+set_token(Type, Val) ->
+ erlang:seq_trace(Type, Val).
+
+-spec get_token() -> term().
+
+get_token() ->
+ element(2,process_info(self(),sequential_trace_token)).
+
+-spec get_token(component()) -> token_pair().
+
+get_token(Type) ->
+ erlang:seq_trace_info(Type).
+
+-spec print(term()) -> 'ok'.
+
+print(Term) ->
+ erlang:seq_trace_print(Term),
+ ok.
+
+-spec print(integer(), term()) -> 'ok'.
+
+print(Label, Term) when is_atom(Label) ->
+ erlang:error(badarg, [Label, Term]);
+print(Label, Term) ->
+ erlang:seq_trace_print(Label, Term),
+ ok.
+
+-spec reset_trace() -> 'true'.
+
+reset_trace() ->
+ erlang:system_flag(1, 0).
+
+%% reset_trace(Pid) -> % this might be a useful function too
+
+-type tracer() :: pid() | port() | 'false'.
+
+-spec set_system_tracer(tracer()) -> tracer().
+
+set_system_tracer(Pid) ->
+ erlang:system_flag(sequential_tracer, Pid).
+
+-spec get_system_tracer() -> tracer().
+
+get_system_tracer() ->
+ element(2, erlang:system_info(sequential_tracer)).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% internal help functions
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+set_token2([{Type,Val}|T]) ->
+ erlang:seq_trace(Type, Val),
+ set_token2(T);
+set_token2([]) ->
+ ok.
+
+decode_flags(Flags) ->
+ Print = (Flags band ?SEQ_TRACE_PRINT) > 0,
+ Send = (Flags band ?SEQ_TRACE_SEND) > 0,
+ Rec = (Flags band ?SEQ_TRACE_RECEIVE) > 0,
+ Ts = (Flags band ?SEQ_TRACE_TIMESTAMP) > 0,
+ [{print,Print},{send,Send},{'receive',Rec},{timestamp,Ts}].
diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl
new file mode 100644
index 0000000000..73901d9896
--- /dev/null
+++ b/lib/kernel/src/standard_error.erl
@@ -0,0 +1,253 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(standard_error).
+-behaviour(supervisor_bridge).
+
+%% Basic standard i/o server for user interface port.
+-export([start_link/0, init/1, terminate/2]).
+
+-define(NAME, standard_error).
+-define(PROCNAME_SUP, standard_error_sup).
+%% Internal exports
+-export([server/1, server/2]).
+
+%% Defines for control ops
+-define(CTRL_OP_GET_WINSIZE,100).
+
+%%
+%% The basic server and start-up.
+%%
+start_link() ->
+ supervisor_bridge:start_link({local, ?PROCNAME_SUP}, ?MODULE, []).
+
+terminate(_Reason,Pid) ->
+ (catch exit(Pid,kill)),
+ ok.
+
+init([]) ->
+ case (catch start_port([out,binary])) of
+ Pid when is_pid(Pid) ->
+ {ok,Pid,Pid};
+ _ ->
+ {error,no_stderror}
+ end.
+
+
+start_port(PortSettings) ->
+ Id = spawn(?MODULE,server,[{fd,2,2},PortSettings]),
+ register(?NAME,Id),
+ Id.
+
+
+server(Pid) when is_pid(Pid) ->
+ process_flag(trap_exit, true),
+ link(Pid),
+ run(Pid).
+
+server(PortName,PortSettings) ->
+ process_flag(trap_exit, true),
+ Port = open_port(PortName,PortSettings),
+ run(Port).
+
+run(P) ->
+ put(unicode,false),
+ server_loop(P).
+
+server_loop(Port) ->
+ receive
+ {io_request,From,ReplyAs,Request} when is_pid(From) ->
+ do_io_request(Request, From, ReplyAs, Port),
+ server_loop(Port);
+ {'EXIT',Port,badsig} -> % Ignore badsig errors
+ server_loop(Port);
+ {'EXIT',Port,What} -> % Port has exited
+ exit(What);
+ _Other -> % Ignore other messages
+ server_loop(Port)
+ end.
+
+
+get_fd_geometry(Port) ->
+ case (catch port_control(Port,?CTRL_OP_GET_WINSIZE,[])) of
+ List when is_list(List), length(List) =:= 8 ->
+ <<W:32/native,H:32/native>> = list_to_binary(List),
+ {W,H};
+ _ ->
+ error
+ end.
+
+
+%% NewSaveBuffer = io_request(Request, FromPid, ReplyAs, Port, SaveBuffer)
+
+do_io_request(Req, From, ReplyAs, Port) ->
+ {_Status,Reply} = io_request(Req, Port),
+ io_reply(From, ReplyAs, Reply).
+
+%% New in R13B
+% Wide characters (Unicode)
+io_request({put_chars,Encoding,Chars}, Port) -> % Binary new in R9C
+ put_chars(wrap_characters_to_binary(Chars,Encoding,
+ case get(unicode) of
+ true -> unicode;
+ _ -> latin1
+ end), Port);
+io_request({put_chars,Encoding,Mod,Func,Args}, Port) ->
+ Result = case catch apply(Mod,Func,Args) of
+ Data when is_list(Data); is_binary(Data) ->
+ wrap_characters_to_binary(Data,Encoding,
+ case get(unicode) of
+ true -> unicode;
+ _ -> latin1
+ end);
+ Undef ->
+ Undef
+ end,
+ put_chars(Result, Port);
+%% BC if called from pre-R13 node
+io_request({put_chars,Chars}, Port) ->
+ io_request({put_chars,latin1,Chars}, Port);
+io_request({put_chars,Mod,Func,Args}, Port) ->
+ io_request({put_chars,latin1,Mod,Func,Args}, Port);
+%% New in R12
+io_request({get_geometry,columns},Port) ->
+ case get_fd_geometry(Port) of
+ {W,_H} ->
+ {ok,W};
+ _ ->
+ {error,{error,enotsup}}
+ end;
+io_request({get_geometry,rows},Port) ->
+ case get_fd_geometry(Port) of
+ {_W,H} ->
+ {ok,H};
+ _ ->
+ {error,{error,enotsup}}
+ end;
+io_request({getopts,[]}, Port) ->
+ getopts(Port);
+io_request({setopts,Opts}, Port) when is_list(Opts) ->
+ setopts(Opts, Port);
+io_request({requests,Reqs}, Port) ->
+ io_requests(Reqs, {ok,ok}, Port);
+io_request(R, _Port) -> %Unknown request
+ {error,{error,{request,R}}}. %Ignore but give error (?)
+
+%% Status = io_requests(RequestList, PrevStat, Port)
+%% Process a list of output requests as long as the previous status is 'ok'.
+
+io_requests([R|Rs], {ok,_Res}, Port) ->
+ io_requests(Rs, io_request(R, Port), Port);
+io_requests([_|_], Error, _) ->
+ Error;
+io_requests([], Stat, _) ->
+ Stat.
+
+%% put_port(DeepList, Port)
+%% Take a deep list of characters, flatten and output them to the
+%% port.
+
+put_port(List, Port) ->
+ send_port(Port, {command, List}).
+
+%% send_port(Port, Command)
+
+send_port(Port, Command) ->
+ Port ! {self(),Command}.
+
+
+%% io_reply(From, ReplyAs, Reply)
+%% The function for sending i/o command acknowledgement.
+%% The ACK contains the return value.
+
+io_reply(From, ReplyAs, Reply) ->
+ From ! {io_reply,ReplyAs,Reply}.
+
+%% put_chars
+put_chars(Chars, Port) when is_binary(Chars) ->
+ put_port(Chars, Port),
+ {ok,ok};
+put_chars(Chars, Port) ->
+ case catch list_to_binary(Chars) of
+ Binary when is_binary(Binary) ->
+ put_chars(Binary, Port);
+ _ ->
+ {error,{error,put_chars}}
+ end.
+
+%% setopts
+setopts(Opts0,Port) ->
+ Opts = proplists:unfold(
+ proplists:substitute_negations(
+ [{latin1,unicode}],
+ Opts0)),
+ case check_valid_opts(Opts) of
+ true ->
+ do_setopts(Opts,Port);
+ false ->
+ {error,{error,enotsup}}
+ end.
+check_valid_opts([]) ->
+ true;
+check_valid_opts([{unicode,Valid}|T]) when Valid =:= true; Valid =:= utf8; Valid =:= false ->
+ check_valid_opts(T);
+check_valid_opts(_) ->
+ false.
+
+do_setopts(Opts, _Port) ->
+ case proplists:get_value(unicode,Opts) of
+ Valid when Valid =:= true; Valid =:= utf8 ->
+ put(unicode,true);
+ false ->
+ put(unicode,false);
+ undefined ->
+ ok
+ end,
+ {ok,ok}.
+
+getopts(_Port) ->
+ Uni = {unicode, case get(unicode) of
+ true ->
+ true;
+ _ ->
+ false
+ end},
+ {ok,[Uni]}.
+
+wrap_characters_to_binary(Chars,From,To) ->
+ TrNl = (whereis(user_drv) =/= undefined),
+ Limit = case To of
+ latin1 ->
+ 255;
+ _Else ->
+ 16#10ffff
+ end,
+ unicode:characters_to_binary(
+ [ case X of
+ $\n ->
+ if
+ TrNl ->
+ "\r\n";
+ true ->
+ $\n
+ end;
+ High when High > Limit ->
+ ["\\x{",erlang:integer_to_list(X, 16),$}];
+ Ordinary ->
+ Ordinary
+ end || X <- unicode:characters_to_list(Chars,From) ],unicode,To).
diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl
new file mode 100644
index 0000000000..edf650ec59
--- /dev/null
+++ b/lib/kernel/src/user.erl
@@ -0,0 +1,786 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(user).
+-compile( [ inline, { inline_size, 100 } ] ).
+
+%% Basic standard i/o server for user interface port.
+
+-export([start/0, start/1, start_out/0]).
+-export([interfaces/1]).
+
+-define(NAME, user).
+
+%% Internal exports
+-export([server/1, server/2]).
+
+%% Defines for control ops
+-define(CTRL_OP_GET_WINSIZE,100).
+
+%%
+%% The basic server and start-up.
+%%
+
+start() ->
+ start_port([eof,binary]).
+
+start([Mod,Fun|Args]) ->
+ %% Mod,Fun,Args should return a pid. That process is supposed to act
+ %% as the io port.
+ Pid = apply(Mod, Fun, Args), % This better work!
+ Id = spawn(?MODULE, server, [Pid]),
+ register(?NAME, Id),
+ Id.
+
+start_out() ->
+ %% Output-only version of start/0
+ start_port([out,binary]).
+
+start_port(PortSettings) ->
+ Id = spawn(?MODULE,server,[{fd,0,1},PortSettings]),
+ register(?NAME,Id),
+ Id.
+
+%% Return the pid of the shell process.
+%% Note: We can't ask the user process for this info since it
+%% may be busy waiting for data from the port.
+interfaces(User) ->
+ case process_info(User, dictionary) of
+ {dictionary,Dict} ->
+ case lists:keysearch(shell, 1, Dict) of
+ {value,Sh={shell,Shell}} when is_pid(Shell) ->
+ [Sh];
+ _ ->
+ []
+ end;
+ _ ->
+ []
+ end.
+
+
+server(Pid) when is_pid(Pid) ->
+ process_flag(trap_exit, true),
+ link(Pid),
+ run(Pid).
+
+server(PortName,PortSettings) ->
+ process_flag(trap_exit, true),
+ Port = open_port(PortName,PortSettings),
+ run(Port).
+
+run(P) ->
+ put(read_mode,list),
+ put(unicode,false),
+ case init:get_argument(noshell) of
+ %% non-empty list -> noshell
+ {ok, [_|_]} ->
+ put(shell, noshell),
+ server_loop(P, queue:new());
+ _ ->
+ group_leader(self(), self()),
+ catch_loop(P, start_init_shell())
+ end.
+
+catch_loop(Port, Shell) ->
+ catch_loop(Port, Shell, queue:new()).
+
+catch_loop(Port, Shell, Q) ->
+ case catch server_loop(Port, Q) of
+ new_shell ->
+ exit(Shell, kill),
+ catch_loop(Port, start_new_shell());
+ {unknown_exit,{Shell,Reason},_} -> % shell has exited
+ case Reason of
+ normal ->
+ put_chars("*** ", Port, []);
+ _ ->
+ put_chars("*** ERROR: ", Port, [])
+ end,
+ put_chars("Shell process terminated! ***\n", Port, []),
+ catch_loop(Port, start_new_shell());
+ {unknown_exit,_,Q1} ->
+ catch_loop(Port, Shell, Q1);
+ {'EXIT',R} ->
+ exit(R)
+ end.
+
+link_and_save_shell(Shell) ->
+ link(Shell),
+ put(shell, Shell),
+ Shell.
+
+start_init_shell() ->
+ link_and_save_shell(shell:start(init)).
+
+start_new_shell() ->
+ link_and_save_shell(shell:start()).
+
+server_loop(Port, Q) ->
+ receive
+ {io_request,From,ReplyAs,Request} when is_pid(From) ->
+ server_loop(Port, do_io_request(Request, From, ReplyAs, Port, Q));
+ {Port,{data,Bytes}} ->
+ case get(shell) of
+ noshell ->
+ server_loop(Port, queue:snoc(Q, Bytes));
+ _ ->
+ case contains_ctrl_g_or_ctrl_c(Bytes) of
+ false ->
+ server_loop(Port, queue:snoc(Q, Bytes));
+ _ ->
+ throw(new_shell)
+ end
+ end;
+ {Port, eof} ->
+ put(eof, true),
+ server_loop(Port, Q);
+
+ %% Ignore messages from port here.
+ {'EXIT',Port,badsig} -> % Ignore badsig errors
+ server_loop(Port, Q);
+ {'EXIT',Port,What} -> % Port has exited
+ exit(What);
+
+ %% Check if shell has exited
+ {'EXIT',SomePid,What} ->
+ case get(shell) of
+ noshell ->
+ server_loop(Port, Q); % Ignore
+ _ ->
+ throw({unknown_exit,{SomePid,What},Q})
+ end;
+
+ _Other -> % Ignore other messages
+ server_loop(Port, Q)
+ end.
+
+
+get_fd_geometry(Port) ->
+ case (catch port_control(Port,?CTRL_OP_GET_WINSIZE,[])) of
+ List when is_list(List), length(List) =:= 8 ->
+ <<W:32/native,H:32/native>> = list_to_binary(List),
+ {W,H};
+ _ ->
+ error
+ end.
+
+
+%% NewSaveBuffer = io_request(Request, FromPid, ReplyAs, Port, SaveBuffer)
+
+do_io_request(Req, From, ReplyAs, Port, Q0) ->
+ case io_request(Req, Port, Q0) of
+ {_Status,Reply,Q1} ->
+ io_reply(From, ReplyAs, Reply),
+ Q1;
+ {exit,What} ->
+ send_port(Port, close),
+ exit(What)
+ end.
+
+%% New in R13B
+%% Encoding option (unicode/latin1)
+io_request({put_chars,unicode,Chars}, Port, Q) -> % Binary new in R9C
+ put_chars(wrap_characters_to_binary(Chars,unicode,
+ case get(unicode) of
+ true -> unicode;
+ _ -> latin1
+ end), Port, Q);
+io_request({put_chars,unicode,Mod,Func,Args}, Port, Q) ->
+ Result = case catch apply(Mod,Func,Args) of
+ Data when is_list(Data); is_binary(Data) ->
+ wrap_characters_to_binary(Data,unicode,
+ case get(unicode) of
+ true -> unicode;
+ _ -> latin1
+ end);
+ Undef ->
+ Undef
+ end,
+ put_chars(Result, Port, Q);
+io_request({put_chars,latin1,Chars}, Port, Q) -> % Binary new in R9C
+ Data = case get(unicode) of
+ true ->
+ unicode:characters_to_binary(Chars,latin1,unicode);
+ false ->
+ erlang:iolist_to_binary(Chars)
+ end,
+ put_chars(Data, Port, Q);
+io_request({put_chars,latin1,Mod,Func,Args}, Port, Q) ->
+ Result = case catch apply(Mod,Func,Args) of
+ Data when is_list(Data); is_binary(Data) ->
+ unicode:characters_to_binary(Data,latin1,
+ case get(unicode) of
+ true -> unicode;
+ _ -> latin1
+ end);
+ Undef ->
+ Undef
+ end,
+ put_chars(Result, Port, Q);
+io_request({get_chars,Enc,Prompt,N}, Port, Q) -> % New in R9C
+ get_chars(Prompt, io_lib, collect_chars, N, Port, Q, Enc);
+io_request({get_line,Enc,Prompt}, Port, Q) ->
+ case get(read_mode) of
+ binary ->
+ get_line_bin(Prompt,Port,Q,Enc);
+ _ ->
+ get_chars(Prompt, io_lib, collect_line, [], Port, Q, Enc)
+ end;
+io_request({get_until,Enc,Prompt,M,F,As}, Port, Q) ->
+ get_chars(Prompt, io_lib, get_until, {M,F,As}, Port, Q, Enc);
+%% End New in R13B
+io_request(getopts, Port, Q) ->
+ getopts(Port, Q);
+io_request({setopts,Opts}, Port, Q) when is_list(Opts) ->
+ setopts(Opts, Port, Q);
+io_request({requests,Reqs}, Port, Q) ->
+ io_requests(Reqs, {ok,ok,Q}, Port);
+
+%% New in R12
+io_request({get_geometry,columns},Port,Q) ->
+ case get_fd_geometry(Port) of
+ {W,_H} ->
+ {ok,W,Q};
+ _ ->
+ {error,{error,enotsup},Q}
+ end;
+io_request({get_geometry,rows},Port,Q) ->
+ case get_fd_geometry(Port) of
+ {_W,H} ->
+ {ok,H,Q};
+ _ ->
+ {error,{error,enotsup},Q}
+ end;
+%% BC with pre-R13 nodes
+io_request({put_chars,Chars}, Port, Q) ->
+ io_request({put_chars,latin1,Chars}, Port, Q);
+io_request({put_chars,Mod,Func,Args}, Port, Q) ->
+ io_request({put_chars,latin1,Mod,Func,Args}, Port, Q);
+io_request({get_chars,Prompt,N}, Port, Q) ->
+ io_request({get_chars,latin1,Prompt,N}, Port, Q);
+io_request({get_line,Prompt}, Port, Q) ->
+ io_request({get_line,latin1,Prompt}, Port, Q);
+io_request({get_until,Prompt,M,F,As}, Port, Q) ->
+ io_request({get_until,latin1,Prompt,M,F,As}, Port, Q);
+
+io_request(R, _Port, Q) -> %Unknown request
+ {error,{error,{request,R}},Q}. %Ignore but give error (?)
+
+%% Status = io_requests(RequestList, PrevStat, Port)
+%% Process a list of output requests as long as the previous status is 'ok'.
+
+io_requests([R|Rs], {ok,_Res,Q}, Port) ->
+ io_requests(Rs, io_request(R, Port, Q), Port);
+io_requests([_|_], Error, _) ->
+ Error;
+io_requests([], Stat, _) ->
+ Stat.
+
+%% put_port(DeepList, Port)
+%% Take a deep list of characters, flatten and output them to the
+%% port.
+
+put_port(List, Port) ->
+ send_port(Port, {command, List}).
+
+%% send_port(Port, Command)
+
+send_port(Port, Command) ->
+ Port ! {self(),Command}.
+
+%% io_reply(From, ReplyAs, Reply)
+%% The function for sending i/o command acknowledgement.
+%% The ACK contains the return value.
+
+io_reply(From, ReplyAs, Reply) ->
+ From ! {io_reply,ReplyAs,Reply}.
+
+%% put_chars
+put_chars(Chars, Port, Q) when is_binary(Chars) ->
+ put_port(Chars, Port),
+ {ok,ok,Q};
+put_chars(Chars, Port, Q) ->
+ case catch list_to_binary(Chars) of
+ Binary when is_binary(Binary) ->
+ put_chars(Binary, Port, Q);
+ _ ->
+ {error,{error,put_chars},Q}
+ end.
+
+expand_encoding([]) ->
+ [];
+expand_encoding([latin1 | T]) ->
+ [{encoding,latin1} | expand_encoding(T)];
+expand_encoding([unicode | T]) ->
+ [{encoding,unicode} | expand_encoding(T)];
+expand_encoding([H|T]) ->
+ [H|expand_encoding(T)].
+
+%% setopts
+setopts(Opts0,Port,Q) ->
+ Opts = proplists:unfold(
+ proplists:substitute_negations(
+ [{list,binary}],
+ expand_encoding(Opts0))),
+ case check_valid_opts(Opts) of
+ true ->
+ do_setopts(Opts,Port,Q);
+ false ->
+ {error,{error,enotsup},Q}
+ end.
+check_valid_opts([]) ->
+ true;
+check_valid_opts([{binary,_}|T]) ->
+ check_valid_opts(T);
+check_valid_opts([{encoding,Valid}|T]) when Valid =:= latin1; Valid =:= utf8; Valid =:= unicode ->
+ check_valid_opts(T);
+check_valid_opts(_) ->
+ false.
+
+do_setopts(Opts, _Port, Q) ->
+ case proplists:get_value(encoding,Opts) of
+ Valid when Valid =:= unicode; Valid =:= utf8 ->
+ put(unicode,true);
+ latin1 ->
+ put(unicode,false);
+ undefined ->
+ ok
+ end,
+ case proplists:get_value(binary, Opts) of
+ true ->
+ put(read_mode,binary),
+ {ok,ok,Q};
+ false ->
+ put(read_mode,list),
+ {ok,ok,Q};
+ _ ->
+ {ok,ok,Q}
+ end.
+
+getopts(_Port,Q) ->
+ Bin = {binary, case get(read_mode) of
+ binary ->
+ true;
+ _ ->
+ false
+ end},
+ Uni = {encoding, case get(unicode) of
+ true ->
+ unicode;
+ _ ->
+ latin1
+ end},
+ {ok,[Bin,Uni],Q}.
+
+
+get_line_bin(Prompt,Port,Q, Enc) ->
+ prompt(Port, Prompt),
+ case {get(eof),queue:is_empty(Q)} of
+ {true,true} ->
+ {ok,eof,Q};
+ _ ->
+ get_line(Prompt,Port, Q, [], Enc)
+ end.
+get_line(Prompt, Port, Q, Acc, Enc) ->
+ case queue:is_empty(Q) of
+ true ->
+ receive
+ {Port,{data,Bytes}} ->
+ get_line_bytes(Prompt, Port, Q, Acc, Bytes, Enc);
+ {Port, eof} ->
+ put(eof, true),
+ {ok, eof, []};
+ {io_request,From,ReplyAs,{get_geometry,_}=Req} when is_pid(From) ->
+ do_io_request(Req, From, ReplyAs, Port,
+ queue:new()),
+ %% No prompt.
+ get_line(Prompt, Port, Q, Acc, Enc);
+ {io_request,From,ReplyAs,Request} when is_pid(From) ->
+ do_io_request(Request, From, ReplyAs, Port, queue:new()),
+ prompt(Port, Prompt),
+ get_line(Prompt, Port, Q, Acc, Enc);
+ {'EXIT',From,What} when node(From) =:= node() ->
+ {exit,What}
+ end;
+ false ->
+ get_line_doit(Prompt, Port, Q, Acc, Enc)
+ end.
+
+get_line_bytes(Prompt, Port, Q, Acc, Bytes, Enc) ->
+ case get(shell) of
+ noshell ->
+ get_line_doit(Prompt, Port, queue:snoc(Q, Bytes),Acc,Enc);
+ _ ->
+ case contains_ctrl_g_or_ctrl_c(Bytes) of
+ false ->
+ get_line_doit(Prompt, Port, queue:snoc(Q, Bytes), Acc, Enc);
+ _ ->
+ throw(new_shell)
+ end
+ end.
+is_cr_at(Pos,Bin) ->
+ case Bin of
+ <<_:Pos/binary,$\r,_/binary>> ->
+ true;
+ _ ->
+ false
+ end.
+srch(<<>>,_,_) ->
+ nomatch;
+srch(<<X:8,_/binary>>,X,N) ->
+ {match,[{N,1}]};
+srch(<<_:8,T/binary>>,X,N) ->
+ srch(T,X,N+1).
+get_line_doit(Prompt, Port, Q, Accu, Enc) ->
+ case queue:is_empty(Q) of
+ true ->
+ case get(eof) of
+ true ->
+ case Accu of
+ [] ->
+ {ok,eof,Q};
+ _ ->
+ {ok,binrev(Accu,[]),Q}
+ end;
+ _ ->
+ get_line(Prompt, Port, Q, Accu, Enc)
+ end;
+ false ->
+ Bin = queue:head(Q),
+ case srch(Bin,$\n,0) of
+ nomatch ->
+ X = byte_size(Bin)-1,
+ case is_cr_at(X,Bin) of
+ true ->
+ <<D:X/binary,_/binary>> = Bin,
+ get_line_doit(Prompt, Port, queue:tail(Q),
+ [<<$\r>>,D|Accu], Enc);
+ false ->
+ get_line_doit(Prompt, Port, queue:tail(Q),
+ [Bin|Accu], Enc)
+ end;
+ {match,[{Pos,1}]} ->
+ %% We are done
+ PosPlus = Pos + 1,
+ case Accu of
+ [] ->
+ {Head,Tail} =
+ case is_cr_at(Pos - 1,Bin) of
+ false ->
+ <<H:PosPlus/binary,
+ T/binary>> = Bin,
+ {H,T};
+ true ->
+ PosMinus = Pos - 1,
+ <<H:PosMinus/binary,
+ _,_,T/binary>> = Bin,
+ {binrev([],[H,$\n]),T}
+ end,
+ case Tail of
+ <<>> ->
+ {ok, cast(Head,Enc), queue:tail(Q)};
+ _ ->
+ {ok, cast(Head,Enc),
+ queue:cons(Tail, queue:tail(Q))}
+ end;
+ [<<$\r>>|Stack1] when Pos =:= 0 ->
+ <<_:PosPlus/binary,Tail/binary>> = Bin,
+ case Tail of
+ <<>> ->
+ {ok, cast(binrev(Stack1, [$\n]),Enc),
+ queue:tail(Q)};
+ _ ->
+ {ok, cast(binrev(Stack1, [$\n]),Enc),
+ queue:cons(Tail, queue:tail(Q))}
+ end;
+ _ ->
+ {Head,Tail} =
+ case is_cr_at(Pos - 1,Bin) of
+ false ->
+ <<H:PosPlus/binary,
+ T/binary>> = Bin,
+ {H,T};
+ true ->
+ PosMinus = Pos - 1,
+ <<H:PosMinus/binary,
+ _,_,T/binary>> = Bin,
+ {[H,$\n],T}
+ end,
+ case Tail of
+ <<>> ->
+ {ok, cast(binrev(Accu,[Head]),Enc),
+ queue:tail(Q)};
+ _ ->
+ {ok, cast(binrev(Accu,[Head]),Enc),
+ queue:cons(Tail, queue:tail(Q))}
+ end
+ end
+ end
+ end.
+
+binrev(L, T) ->
+ list_to_binary(lists:reverse(L, T)).
+
+%% is_cr_at(Pos,Bin) ->
+%% case Bin of
+%% <<_:Pos/binary,$\r,_/binary>> ->
+%% true;
+%% _ ->
+%% false
+%% end.
+
+%% collect_line_bin_re(Bin,_Data,Stack,_) ->
+%% case re:run(Bin,<<"\n">>) of
+%% nomatch ->
+%% X = byte_size(Bin)-1,
+%% case is_cr_at(X,Bin) of
+%% true ->
+%% <<D:X/binary,_/binary>> = Bin,
+%% [<<$\r>>,D|Stack];
+%% false ->
+%% [Bin|Stack]
+%% end;
+%% {match,[{Pos,1}]} ->
+%% PosPlus = Pos + 1,
+%% case Stack of
+%% [] ->
+%% case is_cr_at(Pos - 1,Bin) of
+%% false ->
+%% <<Head:PosPlus/binary,Tail/binary>> = Bin,
+%% {stop, Head, Tail};
+%% true ->
+%% PosMinus = Pos - 1,
+%% <<Head:PosMinus/binary,_,_,Tail/binary>> = Bin,
+%% {stop, binrev([],[Head,$\n]),Tail}
+%% end;
+%% [<<$\r>>|Stack1] when Pos =:= 0 ->
+
+%% <<_:PosPlus/binary,Tail/binary>> = Bin,
+%% {stop,binrev(Stack1, [$\n]),Tail};
+%% _ ->
+%% case is_cr_at(Pos - 1,Bin) of
+%% false ->
+%% <<Head:PosPlus/binary,Tail/binary>> = Bin,
+%% {stop,binrev(Stack, [Head]),Tail};
+%% true ->
+%% PosMinus = Pos - 1,
+%% <<Head:PosMinus/binary,_,_,Tail/binary>> = Bin,
+%% {stop, binrev(Stack,[Head,$\n]),Tail}
+%% end
+%% end
+%% end.
+%% get_chars(Prompt, Module, Function, XtraArg, Port, Queue)
+%% Gets characters from the input port until the applied function
+%% returns {stop,Result,RestBuf}. Does not block output until input
+%% has been received.
+%% Returns:
+%% {Status,Result,NewQueue}
+%% {exit,Reason}
+
+%% Entry function.
+get_chars(Prompt, M, F, Xa, Port, Q, Fmt) ->
+ prompt(Port, Prompt),
+ case {get(eof),queue:is_empty(Q)} of
+ {true,true} ->
+ {ok,eof,Q};
+ _ ->
+ get_chars(Prompt, M, F, Xa, Port, Q, start, Fmt)
+ end.
+
+%% First loop. Wait for port data. Respond to output requests.
+get_chars(Prompt, M, F, Xa, Port, Q, State, Fmt) ->
+ case queue:is_empty(Q) of
+ true ->
+ receive
+ {Port,{data,Bytes}} ->
+ get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Fmt);
+ {Port, eof} ->
+ put(eof, true),
+ {ok, eof, []};
+ %%{io_request,From,ReplyAs,Request} when is_pid(From) ->
+ %% get_chars_req(Prompt, M, F, Xa, Port, queue:new(), State,
+ %% Request, From, ReplyAs);
+ {io_request,From,ReplyAs,{get_geometry,_}=Req} when is_pid(From) ->
+ do_io_request(Req, From, ReplyAs, Port,
+ queue:new()), %Keep Q over this call
+ %% No prompt.
+ get_chars(Prompt, M, F, Xa, Port, Q, State, Fmt);
+ {io_request,From,ReplyAs,Request} when is_pid(From) ->
+ get_chars_req(Prompt, M, F, Xa, Port, Q, State,
+ Request, From, ReplyAs, Fmt);
+ {'EXIT',From,What} when node(From) =:= node() ->
+ {exit,What}
+ end;
+ false ->
+ get_chars_apply(State, M, F, Xa, Port, Q, Fmt)
+ end.
+
+get_chars_req(Prompt, M, F, XtraArg, Port, Q, State,
+ Req, From, ReplyAs, Fmt) ->
+ do_io_request(Req, From, ReplyAs, Port, queue:new()), %Keep Q over this call
+ prompt(Port, Prompt),
+ get_chars(Prompt, M, F, XtraArg, Port, Q, State, Fmt).
+
+%% Second loop. Pass data to client as long as it wants more.
+%% A ^G in data interrupts loop if 'noshell' is not undefined.
+get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Fmt) ->
+ case get(shell) of
+ noshell ->
+ get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, Bytes),Fmt);
+ _ ->
+ case contains_ctrl_g_or_ctrl_c(Bytes) of
+ false ->
+ get_chars_apply(State, M, F, Xa, Port,
+ queue:snoc(Q, Bytes),Fmt);
+ _ ->
+ throw(new_shell)
+ end
+ end.
+
+get_chars_apply(State0, M, F, Xa, Port, Q, Fmt) ->
+ case catch M:F(State0, cast(queue:head(Q),Fmt), Fmt, Xa) of
+ {stop,Result,<<>>} ->
+ {ok,Result,queue:tail(Q)};
+ {stop,Result,[]} ->
+ {ok,Result,queue:tail(Q)};
+ {stop,Result,eof} ->
+ {ok,Result,queue:tail(Q)};
+ {stop,Result,Buf} ->
+ {ok,Result,queue:cons(Buf, queue:tail(Q))};
+ {'EXIT',_} ->
+ {error,{error,err_func(M, F, Xa)},queue:new()};
+ State1 ->
+ get_chars_more(State1, M, F, Xa, Port, queue:tail(Q), Fmt)
+ end.
+
+get_chars_more(State, M, F, Xa, Port, Q, Fmt) ->
+ case queue:is_empty(Q) of
+ true ->
+ case get(eof) of
+ undefined ->
+ receive
+ {Port,{data,Bytes}} ->
+ get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Fmt);
+ {Port,eof} ->
+ put(eof, true),
+ get_chars_apply(State, M, F, Xa, Port,
+ queue:snoc(Q, eof), Fmt);
+ {'EXIT',From,What} when node(From) =:= node() ->
+ {exit,What}
+ end;
+ _ ->
+ get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, eof), Fmt)
+ end;
+ false ->
+ get_chars_apply(State, M, F, Xa, Port, Q, Fmt)
+ end.
+
+
+%% prompt(Port, Prompt)
+%% Print Prompt onto Port
+
+%% common case, reduces execution time by 20%
+prompt(_Port, '') -> ok;
+
+prompt(Port, Prompt) ->
+ put_port(io_lib:format_prompt(Prompt), Port).
+
+%% Convert error code to make it look as before
+err_func(io_lib, get_until, {_,F,_}) ->
+ F;
+err_func(_, F, _) ->
+ F.
+
+%% using regexp reduces execution time by >50% compared to old code
+%% running two regexps in sequence is much faster than \\x03|\\x07
+contains_ctrl_g_or_ctrl_c(BinOrList)->
+ case {re:run(BinOrList, <<3>>),re:run(BinOrList, <<7>>)} of
+ {nomatch, nomatch} -> false;
+ _ -> true
+ end.
+
+%% Convert a buffer between list and binary
+cast(Data, _Format) when is_atom(Data) ->
+ Data;
+cast(Data, Format) ->
+ cast(Data, get(read_mode), Format, get(unicode)).
+
+cast(B, binary, latin1, false) when is_binary(B) ->
+ B;
+cast(B, binary, latin1, true) when is_binary(B) ->
+ unicode:characters_to_binary(B, unicode, latin1);
+cast(L, binary, latin1, false) ->
+ erlang:iolist_to_binary(L);
+cast(L, binary, latin1, true) ->
+ case unicode:characters_to_binary(
+ erlang:iolist_to_binary(L),unicode,latin1) of % may fail
+ {error,_,_} -> exit({no_translation, unicode, latin1});
+ Else -> Else
+ end;
+cast(B, binary, unicode, true) when is_binary(B) ->
+ B;
+cast(B, binary, unicode, false) when is_binary(B) ->
+ unicode:characters_to_binary(B,latin1,unicode);
+cast(L, binary, unicode, true) ->
+ % possibly a list containing UTF-8 encoded characters
+ unicode:characters_to_binary(erlang:iolist_to_binary(L));
+cast(L, binary, unicode, false) ->
+ unicode:characters_to_binary(L, latin1, unicode);
+cast(L, list, latin1, UniTerm) ->
+ case UniTerm of
+ true -> % Convert input characters to protocol format (i.e latin1)
+ case unicode:characters_to_list(
+ erlang:iolist_to_binary(L),unicode) of % may fail
+ {error,_,_} -> exit({no_translation, unicode, latin1});
+ Else -> [ case X of
+ High when High > 255 ->
+ exit({no_translation, unicode, latin1});
+ Low ->
+ Low
+ end || X <- Else ]
+ end;
+ _ ->
+ binary_to_list(erlang:iolist_to_binary(L))
+ end;
+cast(L, list, unicode, UniTerm) ->
+ unicode:characters_to_list(erlang:iolist_to_binary(L),
+ case UniTerm of
+ true -> unicode;
+ _ -> latin1
+ end);
+cast(Other, _, _,_) ->
+ Other.
+
+wrap_characters_to_binary(Chars,unicode,latin1) ->
+ case unicode:characters_to_binary(Chars,unicode,latin1) of
+ {error,_,_} ->
+ list_to_binary(
+ [ case X of
+ High when High > 255 ->
+ ["\\x{",erlang:integer_to_list(X, 16),$}];
+ Low ->
+ Low
+ end || X <- unicode:characters_to_list(Chars,unicode) ]);
+ Bin ->
+ Bin
+ end;
+
+wrap_characters_to_binary(Bin,From,From) when is_binary(Bin) ->
+ Bin;
+wrap_characters_to_binary(Chars,From,To) ->
+ unicode:characters_to_binary(Chars,From,To).
diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl
new file mode 100644
index 0000000000..c34f2ddeb0
--- /dev/null
+++ b/lib/kernel/src/user_drv.erl
@@ -0,0 +1,614 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(user_drv).
+
+%% Basic interface to a port.
+
+-export([start/0,start/1,start/2,start/3,server/2,server/3]).
+
+-export([interfaces/1]).
+
+-define(OP_PUTC,0).
+-define(OP_MOVE,1).
+-define(OP_INSC,2).
+-define(OP_DELC,3).
+-define(OP_BEEP,4).
+% Control op
+-define(CTRL_OP_GET_WINSIZE,100).
+-define(CTRL_OP_GET_UNICODE_STATE,101).
+-define(CTRL_OP_SET_UNICODE_STATE,102).
+
+%% start()
+%% start(ArgumentList)
+%% start(PortName, Shell)
+%% start(InPortName, OutPortName, Shell)
+%% Start the user driver server. The arguments to start/1 are slightly
+%% strange as this may be called both at start up from the command line
+%% and explicitly from other code.
+
+-spec start() -> pid().
+
+start() -> %Default line editing shell
+ spawn(user_drv, server, ['tty_sl -c -e',{shell,start,[init]}]).
+
+start([Pname]) ->
+ spawn(user_drv, server, [Pname,{shell,start,[init]}]);
+start([Pname|Args]) ->
+ spawn(user_drv, server, [Pname|Args]);
+start(Pname) ->
+ spawn(user_drv, server, [Pname,{shell,start,[init]}]).
+
+start(Pname, Shell) ->
+ spawn(user_drv, server, [Pname,Shell]).
+
+start(Iname, Oname, Shell) ->
+ spawn(user_drv, server, [Iname,Oname,Shell]).
+
+
+%% Return the pid of the active group process.
+%% Note: We can't ask the user_drv process for this info since it
+%% may be busy waiting for data from the port.
+
+-spec interfaces(pid()) -> [{'current_group', pid()}].
+
+interfaces(UserDrv) ->
+ case process_info(UserDrv, dictionary) of
+ {dictionary,Dict} ->
+ case lists:keysearch(current_group, 1, Dict) of
+ {value,Gr={_,Group}} when is_pid(Group) ->
+ [Gr];
+ _ ->
+ []
+ end;
+ _ ->
+ []
+ end.
+
+%% server(Pid, Shell)
+%% server(Pname, Shell)
+%% server(Iname, Oname, Shell)
+%% The initial calls to run the user driver. These start the port(s)
+%% then call server1/3 to set everything else up.
+
+server(Pid, Shell) when is_pid(Pid) ->
+ server1(Pid, Pid, Shell);
+server(Pname, Shell) ->
+ process_flag(trap_exit, true),
+ case catch open_port({spawn,Pname}, [eof]) of
+ {'EXIT', _} ->
+ %% Let's try a dumb user instead
+ user:start();
+ Port ->
+ server1(Port, Port, Shell)
+ end.
+
+server(Iname, Oname, Shell) ->
+ process_flag(trap_exit, true),
+ case catch open_port({spawn,Iname}, [eof]) of
+ {'EXIT', _} -> %% It might be a dumb terminal lets start dumb user
+ user:start();
+ Iport ->
+ Oport = open_port({spawn,Oname}, [eof]),
+ server1(Iport, Oport, Shell)
+ end.
+
+server1(Iport, Oport, Shell) ->
+ put(eof, false),
+ %% Start user and initial shell.
+ User = start_user(),
+ Gr1 = gr_add_cur(gr_new(), User, {}),
+
+ {Curr,Shell1} =
+ case init:get_argument(remsh) of
+ {ok,[[Node]]} ->
+ RShell = {list_to_atom(Node),shell,start,[]},
+ RGr = group:start(self(), RShell),
+ {RGr,RShell};
+ E when E =:= error ; E =:= {ok,[[]]} ->
+ {group:start(self(), Shell),Shell}
+ end,
+
+ put(current_group, Curr),
+ Gr = gr_add_cur(Gr1, Curr, Shell1),
+ %% Print some information.
+ io_request({put_chars, unicode,
+ flatten(io_lib:format("~s\n",
+ [erlang:system_info(system_version)]))},
+ Iport, Oport),
+ %% Enter the server loop.
+ server_loop(Iport, Oport, Curr, User, Gr).
+
+%% start_user()
+%% Start a group leader process and register it as 'user', unless,
+%% of course, a 'user' already exists.
+
+start_user() ->
+ case whereis(user_drv) of
+ undefined ->
+ register(user_drv, self());
+ _ ->
+ ok
+ end,
+ case whereis(user) of
+ undefined ->
+ User = group:start(self(), {}),
+ register(user, User),
+ User;
+ User ->
+ User
+ end.
+
+server_loop(Iport, Oport, User, Gr) ->
+ Curr = gr_cur_pid(Gr),
+ put(current_group, Curr),
+ server_loop(Iport, Oport, Curr, User, Gr).
+
+server_loop(Iport, Oport, Curr, User, Gr) ->
+ receive
+ {Iport,{data,Bs}} ->
+ BsBin = list_to_binary(Bs),
+ Unicode = unicode:characters_to_list(BsBin,utf8),
+ port_bytes(Unicode, Iport, Oport, Curr, User, Gr);
+ {Iport,eof} ->
+ Curr ! {self(),eof},
+ server_loop(Iport, Oport, Curr, User, Gr);
+ {User,Req} -> % never block from user!
+ io_request(Req, Iport, Oport),
+ server_loop(Iport, Oport, Curr, User, Gr);
+ {Curr,tty_geometry} ->
+ Curr ! {self(),tty_geometry,get_tty_geometry(Iport)},
+ server_loop(Iport, Oport, Curr, User, Gr);
+ {Curr,get_unicode_state} ->
+ Curr ! {self(),get_unicode_state,get_unicode_state(Iport)},
+ server_loop(Iport, Oport, Curr, User, Gr);
+ {Curr,set_unicode_state, Bool} ->
+ Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)},
+ server_loop(Iport, Oport, Curr, User, Gr);
+ {Curr,Req} ->
+ io_request(Req, Iport, Oport),
+ server_loop(Iport, Oport, Curr, User, Gr);
+ {'EXIT',Iport,_R} ->
+ server_loop(Iport, Oport, Curr, User, Gr);
+ {'EXIT',Oport,_R} ->
+ server_loop(Iport, Oport, Curr, User, Gr);
+ {'EXIT',User,_R} -> % keep 'user' alive
+ NewU = start_user(),
+ server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {}));
+ {'EXIT',Pid,R} -> % shell and group leader exit
+ case gr_cur_pid(Gr) of
+ Pid when R =/= die ,
+ R =/= terminated -> % current shell exited
+ if R =/= normal ->
+ io_requests([{put_chars,unicode,"*** ERROR: "}], Iport, Oport);
+ true -> % exit not caused by error
+ io_requests([{put_chars,unicode,"*** "}], Iport, Oport)
+ end,
+ io_requests([{put_chars,unicode,"Shell process terminated! "}], Iport, Oport),
+ Gr1 = gr_del_pid(Gr, Pid),
+ case gr_get_info(Gr, Pid) of
+ {Ix,{shell,start,Params}} -> % 3-tuple == local shell
+ io_requests([{put_chars,unicode,"***\n"}], Iport, Oport),
+ %% restart group leader and shell, same index
+ Pid1 = group:start(self(), {shell,start,Params}),
+ {ok,Gr2} = gr_set_cur(gr_set_num(Gr1, Ix, Pid1,
+ {shell,start,Params}), Ix),
+ put(current_group, Pid1),
+ server_loop(Iport, Oport, Pid1, User, Gr2);
+ _ -> % remote shell
+ io_requests([{put_chars,unicode,"(^G to start new job) ***\n"}],
+ Iport, Oport),
+ server_loop(Iport, Oport, Curr, User, Gr1)
+ end;
+ _ -> % not current, just remove it
+ server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid))
+ end;
+ _X ->
+ %% Ignore unknown messages.
+ server_loop(Iport, Oport, Curr, User, Gr)
+ end.
+
+%% port_bytes(Bytes, InPort, OutPort, CurrentProcess, UserProcess, Group)
+%% Check the Bytes from the port to see if it contains a ^G. If so,
+%% either escape to switch_loop or restart the shell. Otherwise send
+%% the bytes to Curr.
+
+port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr) ->
+ handle_escape(Iport, Oport, User, Gr);
+
+port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr) ->
+ interrupt_shell(Iport, Oport, Curr, User, Gr);
+
+port_bytes([B], Iport, Oport, Curr, User, Gr) ->
+ Curr ! {self(),{data,[B]}},
+ server_loop(Iport, Oport, Curr, User, Gr);
+port_bytes(Bs, Iport, Oport, Curr, User, Gr) ->
+ case member($\^G, Bs) of
+ true ->
+ handle_escape(Iport, Oport, User, Gr);
+ false ->
+ Curr ! {self(),{data,Bs}},
+ server_loop(Iport, Oport, Curr, User, Gr)
+ end.
+
+interrupt_shell(Iport, Oport, Curr, User, Gr) ->
+ case gr_get_info(Gr, Curr) of
+ undefined ->
+ ok; % unknown
+ _ ->
+ exit(Curr, interrupt)
+ end,
+ server_loop(Iport, Oport, Curr, User, Gr).
+
+handle_escape(Iport, Oport, User, Gr) ->
+ case application:get_env(stdlib, shell_esc) of
+ {ok,abort} ->
+ Pid = gr_cur_pid(Gr),
+ exit(Pid, die),
+ Gr1 =
+ case gr_get_info(Gr, Pid) of
+ {_Ix,{}} -> % no shell
+ Gr;
+ _ ->
+ receive {'EXIT',Pid,_} ->
+ gr_del_pid(Gr, Pid)
+ after 1000 ->
+ Gr
+ end
+ end,
+ Pid1 = group:start(self(), {shell,start,[]}),
+ io_request({put_chars,unicode,"\n"}, Iport, Oport),
+ server_loop(Iport, Oport, User,
+ gr_add_cur(Gr1, Pid1, {shell,start,[]}));
+
+ _ -> % {ok,jcl} | undefined
+ io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport),
+ server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr))
+ end.
+
+switch_loop(Iport, Oport, Gr) ->
+ Line = get_line(edlin:start(" --> "), Iport, Oport),
+ switch_cmd(erl_scan:string(Line), Iport, Oport, Gr).
+
+switch_cmd({ok,[{atom,_,c},{integer,_,I}],_}, Iport, Oport, Gr0) ->
+ case gr_set_cur(Gr0, I) of
+ {ok,Gr} -> Gr;
+ undefined -> unknown_group(Iport, Oport, Gr0)
+ end;
+switch_cmd({ok,[{atom,_,c}],_}, Iport, Oport, Gr) ->
+ case gr_get_info(Gr, gr_cur_pid(Gr)) of
+ undefined ->
+ unknown_group(Iport, Oport, Gr);
+ _ ->
+ Gr
+ end;
+switch_cmd({ok,[{atom,_,i},{integer,_,I}],_}, Iport, Oport, Gr) ->
+ case gr_get_num(Gr, I) of
+ {pid,Pid} ->
+ exit(Pid, interrupt),
+ switch_loop(Iport, Oport, Gr);
+ undefined ->
+ unknown_group(Iport, Oport, Gr)
+ end;
+switch_cmd({ok,[{atom,_,i}],_}, Iport, Oport, Gr) ->
+ Pid = gr_cur_pid(Gr),
+ case gr_get_info(Gr, Pid) of
+ undefined ->
+ unknown_group(Iport, Oport, Gr);
+ _ ->
+ exit(Pid, interrupt),
+ switch_loop(Iport, Oport, Gr)
+ end;
+switch_cmd({ok,[{atom,_,k},{integer,_,I}],_}, Iport, Oport, Gr) ->
+ case gr_get_num(Gr, I) of
+ {pid,Pid} ->
+ exit(Pid, die),
+ case gr_get_info(Gr, Pid) of
+ {_Ix,{}} -> % no shell
+ switch_loop(Iport, Oport, Gr);
+ _ ->
+ Gr1 =
+ receive {'EXIT',Pid,_} ->
+ gr_del_pid(Gr, Pid)
+ after 1000 ->
+ Gr
+ end,
+ switch_loop(Iport, Oport, Gr1)
+ end;
+ undefined ->
+ unknown_group(Iport, Oport, Gr)
+ end;
+switch_cmd({ok,[{atom,_,k}],_}, Iport, Oport, Gr) ->
+ Pid = gr_cur_pid(Gr),
+ Info = gr_get_info(Gr, Pid),
+ case Info of
+ undefined ->
+ unknown_group(Iport, Oport, Gr);
+ {_Ix,{}} -> % no shell
+ switch_loop(Iport, Oport, Gr);
+ _ ->
+ exit(Pid, die),
+ Gr1 =
+ receive {'EXIT',Pid,_} ->
+ gr_del_pid(Gr, Pid)
+ after 1000 ->
+ Gr
+ end,
+ switch_loop(Iport, Oport, Gr1)
+ end;
+switch_cmd({ok,[{atom,_,j}],_}, Iport, Oport, Gr) ->
+ io_requests(gr_list(Gr), Iport, Oport),
+ switch_loop(Iport, Oport, Gr);
+switch_cmd({ok,[{atom,_,s},{atom,_,Shell}],_}, Iport, Oport, Gr0) ->
+ Pid = group:start(self(), {Shell,start,[]}),
+ Gr = gr_add_cur(Gr0, Pid, {Shell,start,[]}),
+ switch_loop(Iport, Oport, Gr);
+switch_cmd({ok,[{atom,_,s}],_}, Iport, Oport, Gr0) ->
+ Pid = group:start(self(), {shell,start,[]}),
+ Gr = gr_add_cur(Gr0, Pid, {shell,start,[]}),
+ switch_loop(Iport, Oport, Gr);
+switch_cmd({ok,[{atom,_,r}],_}, Iport, Oport, Gr0) ->
+ case is_alive() of
+ true ->
+ Node = pool:get_node(),
+ Pid = group:start(self(), {Node,shell,start,[]}),
+ Gr = gr_add_cur(Gr0, Pid, {Node,shell,start,[]}),
+ switch_loop(Iport, Oport, Gr);
+ false ->
+ io_request({put_chars,unicode,"Not alive\n"}, Iport, Oport),
+ switch_loop(Iport, Oport, Gr0)
+ end;
+switch_cmd({ok,[{atom,_,r},{atom,_,Node}],_}, Iport, Oport, Gr0) ->
+ Pid = group:start(self(), {Node,shell,start,[]}),
+ Gr = gr_add_cur(Gr0, Pid, {Node,shell,start,[]}),
+ switch_loop(Iport, Oport, Gr);
+switch_cmd({ok,[{atom,_,r},{atom,_,Node},{atom,_,Shell}],_},
+ Iport, Oport, Gr0) ->
+ Pid = group:start(self(), {Node,Shell,start,[]}),
+ Gr = gr_add_cur(Gr0, Pid, {Node,Shell,start,[]}),
+ switch_loop(Iport, Oport, Gr);
+switch_cmd({ok,[{atom,_,q}],_}, Iport, Oport, Gr) ->
+ case erlang:system_info(break_ignored) of
+ true -> % noop
+ io_request({put_chars,unicode,"Unknown command\n"}, Iport, Oport),
+ switch_loop(Iport, Oport, Gr);
+ false ->
+ halt()
+ end;
+switch_cmd({ok,[{atom,_,h}],_}, Iport, Oport, Gr) ->
+ list_commands(Iport, Oport),
+ switch_loop(Iport, Oport, Gr);
+switch_cmd({ok,[{'?',_}],_}, Iport, Oport, Gr) ->
+ list_commands(Iport, Oport),
+ switch_loop(Iport, Oport, Gr);
+switch_cmd({ok,[],_}, Iport, Oport, Gr) ->
+ switch_loop(Iport, Oport, Gr);
+switch_cmd({ok,_Ts,_}, Iport, Oport, Gr) ->
+ io_request({put_chars,unicode,"Unknown command\n"}, Iport, Oport),
+ switch_loop(Iport, Oport, Gr);
+switch_cmd(_Ts, Iport, Oport, Gr) ->
+ io_request({put_chars,unicode,"Illegal input\n"}, Iport, Oport),
+ switch_loop(Iport, Oport, Gr).
+
+unknown_group(Iport, Oport, Gr) ->
+ io_request({put_chars,unicode,"Unknown job\n"}, Iport, Oport),
+ switch_loop(Iport, Oport, Gr).
+
+list_commands(Iport, Oport) ->
+ QuitReq = case erlang:system_info(break_ignored) of
+ true ->
+ [];
+ false ->
+ [{put_chars,unicode," q - quit erlang\n"}]
+ end,
+ io_requests([{put_chars, unicode," c [nn] - connect to job\n"},
+ {put_chars, unicode," i [nn] - interrupt job\n"},
+ {put_chars, unicode," k [nn] - kill job\n"},
+ {put_chars, unicode," j - list all jobs\n"},
+ {put_chars, unicode," s [shell] - start local shell\n"},
+ {put_chars, unicode," r [node [shell]] - start remote shell\n"}] ++
+ QuitReq ++
+ [{put_chars, unicode," ? | h - this message\n"}],
+ Iport, Oport).
+
+get_line({done,Line,_Rest,Rs}, Iport, Oport) ->
+ io_requests(Rs, Iport, Oport),
+ Line;
+get_line({undefined,_Char,Cs,Cont,Rs}, Iport, Oport) ->
+ io_requests(Rs, Iport, Oport),
+ io_request(beep, Iport, Oport),
+ get_line(edlin:edit_line(Cs, Cont), Iport, Oport);
+get_line({What,Cont0,Rs}, Iport, Oport) ->
+ io_requests(Rs, Iport, Oport),
+ receive
+ {Iport,{data,Cs}} ->
+ get_line(edlin:edit_line(Cs, Cont0), Iport, Oport);
+ {Iport,eof} ->
+ get_line(edlin:edit_line(eof, Cont0), Iport, Oport)
+ after
+ get_line_timeout(What) ->
+ get_line(edlin:edit_line([], Cont0), Iport, Oport)
+ end.
+
+get_line_timeout(blink) -> 1000;
+get_line_timeout(more_chars) -> infinity.
+
+% Let driver report window geometry,
+% definitely outside of the common interface
+get_tty_geometry(Iport) ->
+ case (catch port_control(Iport,?CTRL_OP_GET_WINSIZE,[])) of
+ List when length(List) =:= 8 ->
+ <<W:32/native,H:32/native>> = list_to_binary(List),
+ {W,H};
+ _ ->
+ error
+ end.
+get_unicode_state(Iport) ->
+ case (catch port_control(Iport,?CTRL_OP_GET_UNICODE_STATE,[])) of
+ [Int] when Int > 0 ->
+ true;
+ [Int] when Int =:= 0 ->
+ false;
+ _ ->
+ error
+ end.
+
+set_unicode_state(Iport, Bool) ->
+ Data = case Bool of
+ true -> [1];
+ false -> [0]
+ end,
+ case (catch port_control(Iport,?CTRL_OP_SET_UNICODE_STATE,Data)) of
+ [Int] when Int > 0 ->
+ {unicode, utf8};
+ [Int] when Int =:= 0 ->
+ {unicode, false};
+ _ ->
+ error
+ end.
+
+%% io_request(Request, InPort, OutPort)
+%% io_requests(Requests, InPort, OutPort)
+
+io_request({put_chars, unicode,Cs}, _Iport, Oport) ->
+ Oport ! {self(),{command,[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)]}};
+io_request({move_rel,N}, _Iport, Oport) ->
+ Oport ! {self(),{command,[?OP_MOVE|put_int16(N, [])]}};
+io_request({insert_chars,unicode,Cs}, _Iport, Oport) ->
+ Oport ! {self(),{command,[?OP_INSC|unicode:characters_to_binary(Cs,utf8)]}};
+io_request({delete_chars,N}, _Iport, Oport) ->
+ Oport ! {self(),{command,[?OP_DELC|put_int16(N, [])]}};
+io_request(beep, _Iport, Oport) ->
+ Oport ! {self(),{command,[?OP_BEEP]}};
+io_request({requests,Rs}, Iport, Oport) ->
+ io_requests(Rs, Iport, Oport);
+io_request(_R, _Iport, _Oport) ->
+ ok.
+
+io_requests([R|Rs], Iport, Oport) ->
+ io_request(R, Iport, Oport),
+ io_requests(Rs, Iport, Oport);
+io_requests([], _Iport, _Oport) ->
+ ok.
+
+put_int16(N, Tail) ->
+ [(N bsr 8)band 255,N band 255|Tail].
+
+%% gr_new()
+%% gr_get_num(Group, Index)
+%% gr_get_info(Group, Pid)
+%% gr_add_cur(Group, Pid, Shell)
+%% gr_set_cur(Group, Index)
+%% gr_cur_pid(Group)
+%% gr_del_pid(Group, Pid)
+%% Manage the group list. The group structure has the form:
+%% {NextIndex,CurrIndex,CurrPid,GroupList}
+%%
+%% where each element in the group list is:
+%% {Index,GroupPid,Shell}
+
+gr_new() ->
+ {0,0,none,[]}.
+
+gr_get_num({_Next,_CurI,_CurP,Gs}, I) ->
+ gr_get_num1(Gs, I).
+
+gr_get_num1([{I,_Pid,{}}|_Gs], I) ->
+ undefined;
+gr_get_num1([{I,Pid,_S}|_Gs], I) ->
+ {pid,Pid};
+gr_get_num1([_G|Gs], I) ->
+ gr_get_num1(Gs, I);
+gr_get_num1([], _I) ->
+ undefined.
+
+gr_get_info({_Next,_CurI,_CurP,Gs}, Pid) ->
+ gr_get_info1(Gs, Pid).
+
+gr_get_info1([{I,Pid,S}|_Gs], Pid) ->
+ {I,S};
+gr_get_info1([_G|Gs], I) ->
+ gr_get_info1(Gs, I);
+gr_get_info1([], _I) ->
+ undefined.
+
+gr_add_cur({Next,_CurI,_CurP,Gs}, Pid, Shell) ->
+ {Next+1,Next,Pid,append(Gs, [{Next,Pid,Shell}])}.
+
+gr_set_cur({Next,_CurI,_CurP,Gs}, I) ->
+ case gr_get_num1(Gs, I) of
+ {pid,Pid} -> {ok,{Next,I,Pid,Gs}};
+ undefined -> undefined
+ end.
+
+gr_set_num({Next,CurI,CurP,Gs}, I, Pid, Shell) ->
+ {Next,CurI,CurP,gr_set_num1(Gs, I, Pid, Shell)}.
+
+gr_set_num1([{I,_Pid,_Shell}|Gs], I, NewPid, NewShell) ->
+ [{I,NewPid,NewShell}|Gs];
+gr_set_num1([{I,Pid,Shell}|Gs], NewI, NewPid, NewShell) when NewI > I ->
+ [{I,Pid,Shell}|gr_set_num1(Gs, NewI, NewPid, NewShell)];
+gr_set_num1(Gs, NewI, NewPid, NewShell) ->
+ [{NewI,NewPid,NewShell}|Gs].
+
+gr_del_pid({Next,CurI,CurP,Gs}, Pid) ->
+ {Next,CurI,CurP,gr_del_pid1(Gs, Pid)}.
+
+gr_del_pid1([{_I,Pid,_S}|Gs], Pid) ->
+ Gs;
+gr_del_pid1([G|Gs], Pid) ->
+ [G|gr_del_pid1(Gs, Pid)];
+gr_del_pid1([], _Pid) ->
+ [].
+
+gr_cur_pid({_Next,_CurI,CurP,_Gs}) ->
+ CurP.
+
+gr_list({_Next,CurI,_CurP,Gs}) ->
+ gr_list(Gs, CurI, []).
+
+gr_list([{_I,_Pid,{}}|Gs], Cur, Jobs) ->
+ gr_list(Gs, Cur, Jobs);
+gr_list([{Cur,_Pid,Shell}|Gs], Cur, Jobs) ->
+ gr_list(Gs, Cur, [{put_chars, unicode,flatten(io_lib:format("~4w* ~w\n", [Cur,Shell]))}|Jobs]);
+gr_list([{I,_Pid,Shell}|Gs], Cur, Jobs) ->
+ gr_list(Gs, Cur, [{put_chars, unicode,flatten(io_lib:format("~4w ~w\n", [I,Shell]))}|Jobs]);
+gr_list([], _Cur, Jobs) ->
+ lists:reverse(Jobs).
+
+append([H|T], X) ->
+ [H|append(T, X)];
+append([], X) ->
+ X.
+
+member(X, [X|_Rest]) -> true;
+member(X, [_H|Rest]) ->
+ member(X, Rest);
+member(_X, []) -> false.
+
+flatten(List) ->
+ flatten(List, [], []).
+
+flatten([H|T], Cont, Tail) when is_list(H) ->
+ flatten(H, [T|Cont], Tail);
+flatten([H|T], Cont, Tail) ->
+ [H|flatten(T, Cont, Tail)];
+flatten([], [H|Cont], Tail) ->
+ flatten(H, Cont, Tail);
+flatten([], [], Tail) ->
+ Tail.
diff --git a/lib/kernel/src/user_sup.erl b/lib/kernel/src/user_sup.erl
new file mode 100644
index 0000000000..35b7ff0cfe
--- /dev/null
+++ b/lib/kernel/src/user_sup.erl
@@ -0,0 +1,129 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(user_sup).
+
+%% ---------------------------------------------
+%% This is a supervisor bridge hiding the process
+%% details of the user/group implementation.
+%% ---------------------------------------------
+
+-behaviour(supervisor_bridge).
+
+-export([start/0]).
+
+%% Internal exports.
+-export([init/1, terminate/2, relay/1]).
+
+-spec start() -> {'error', {'already_started', pid()}} | {'ok', pid()}.
+
+start() ->
+ supervisor_bridge:start_link(user_sup, []).
+
+-spec init([]) -> 'ignore' | {'error', 'nouser'} | {'ok', pid(), pid()}.
+
+init([]) ->
+ case get_user() of
+ nouser ->
+ ignore;
+ {master, Master} ->
+ Pid = start_slave(Master),
+ {ok, Pid, Pid};
+ {M, F, A} ->
+ case start_user({M, F}, A) of
+ {ok, Pid} ->
+ {ok, Pid, Pid};
+ Error ->
+ Error
+ end
+ end.
+
+start_slave(Master) ->
+ case rpc:call(Master, erlang, whereis, [user]) of
+ User when is_pid(User) ->
+ spawn(?MODULE, relay, [User]);
+ _ ->
+ error_logger:error_msg("Cannot get remote user", []),
+ receive after 1000 -> true end,
+ halt()
+ end.
+
+-spec relay(pid()) -> no_return().
+
+relay(Pid) ->
+ register(user, self()),
+ relay1(Pid).
+
+relay1(Pid) ->
+ receive
+ X ->
+ Pid ! X,
+ relay1(Pid)
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Sleep a while in order to let user write all (some) buffered
+%% information before termination.
+%%-----------------------------------------------------------------
+
+-spec terminate(term(), pid()) -> 'ok'.
+
+terminate(_Reason, UserPid) ->
+ receive after 1000 -> ok end,
+ exit(UserPid, kill),
+ ok.
+
+%%-----------------------------------------------------------------
+%% If there is a user, wait for it to register itself. (But wait
+%% no more than 10 seconds). This is so the application_controller
+%% is guaranteed that the user is started.
+%%-----------------------------------------------------------------
+
+start_user(Func,A) ->
+ apply(Func, A),
+ wait_for_user_p(100).
+
+wait_for_user_p(0) ->
+ {error, nouser};
+wait_for_user_p(N) ->
+ case whereis(user) of
+ Pid when is_pid(Pid) ->
+ link(Pid),
+ {ok, Pid};
+ _ ->
+ receive after 100 -> ok end,
+ wait_for_user_p(N-1)
+ end.
+
+get_user() ->
+ Flags = init:get_arguments(),
+ check_flags(Flags, {user_drv, start, []}).
+
+%% These flags depend upon what arguments the erl script passes on
+%% to erl91.
+check_flags([{nouser, []} |T], _) -> check_flags(T, nouser);
+check_flags([{user, [User]} | T], _) ->
+ check_flags(T, {list_to_atom(User), start, []});
+check_flags([{noshell, []} | T], _) -> check_flags(T, {user, start, []});
+check_flags([{oldshell, []} | T], _) -> check_flags(T, {user, start, []});
+check_flags([{noinput, []} | T], _) -> check_flags(T, {user, start_out, []});
+check_flags([{master, [Node]} | T], _) ->
+ check_flags(T, {master, list_to_atom(Node)});
+check_flags([_H | T], User) -> check_flags(T, User);
+check_flags([], User) -> User.
diff --git a/lib/kernel/src/wrap_log_reader.erl b/lib/kernel/src/wrap_log_reader.erl
new file mode 100644
index 0000000000..5030d3aed5
--- /dev/null
+++ b/lib/kernel/src/wrap_log_reader.erl
@@ -0,0 +1,288 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% Read wrap files with internal format
+
+-module(wrap_log_reader).
+
+%%-define(debug, true).
+-ifdef(debug).
+-define(FORMAT(P, A), io:format(P, A)).
+-else.
+-define(FORMAT(P, A), ok).
+-endif.
+
+-export([open/1, open/2, chunk/1, chunk/2, close/1]).
+
+-include("disk_log.hrl").
+
+-record(wrap_reader,
+ {fd :: file:fd(),
+ cont :: dlog_cont(), % disk_log's continuation record
+ file :: file:filename(), % file name without extension
+ file_no :: non_neg_integer(), % current file number
+ mod_time :: date_time(), % modification time of current file
+ first_no :: non_neg_integer() | 'one' % first read file number
+ }).
+
+%%
+%% Exported functions
+%%
+
+%% A special case to be handled when appropriate: if current file
+%% number is one greater than number of files then the max file number
+%% is not yet reached, we are on the first 'round' of filling the wrap
+%% files.
+
+-type open_ret() :: {'ok', #wrap_reader{}} | {'error', tuple()}.
+
+-spec open(atom() | string()) -> open_ret().
+
+open(File) when is_atom(File) ->
+ open(atom_to_list(File));
+open(File) when is_list(File) ->
+ case read_index_file(File) of
+ %% The special case described above.
+ {ok, {CurFileNo, _CurFileSz, _TotSz, NoOfFiles}}
+ when CurFileNo =:= NoOfFiles + 1 ->
+ FileNo = 1,
+ ?FORMAT("open from ~p Cur = ~p, Sz = ~p, Tot = ~p, NoFiles = ~p~n",
+ [FileNo, CurFileNo, _CurFileSz, _TotSz, NoOfFiles]),
+ open_int(File, FileNo, FileNo);
+ {ok, {CurFileNo, _CurFileSz, _TotSz, NoOfFiles}} ->
+ FileNo = case (CurFileNo + 1) rem NoOfFiles of
+ 0 -> NoOfFiles;
+ No -> No
+ end,
+ ?FORMAT("open from ~p Cur = ~p, Sz = ~p, Tot = ~p, NoFiles = ~p~n",
+ [FileNo, CurFileNo, _CurFileSz, _TotSz, NoOfFiles]),
+ open_int(File, FileNo, FileNo);
+ Error ->
+ Error
+ end.
+
+-spec open(atom() | string(), integer()) -> open_ret().
+
+open(File, FileNo) when is_atom(File), is_integer(FileNo) ->
+ open(atom_to_list(File), FileNo);
+open(File, FileNo) when is_list(File), is_integer(FileNo) ->
+ case read_index_file(File) of
+ {ok, {_CurFileNo, _CurFileSz, _TotSz, NoOfFiles}}
+ when NoOfFiles >= FileNo ->
+ ?FORMAT("open file ~p Cur = ~p, Sz = ~p, Tot = ~p, NoFiles = ~p~n",
+ [FileNo, _CurFileNo, _CurFileSz, _TotSz, NoOfFiles]),
+ open_int(File, FileNo, one);
+ %% The special case described above.
+ {ok, {CurFileNo, _CurFileSz, _TotSz, NoOfFiles}}
+ when CurFileNo =:= FileNo, CurFileNo =:= NoOfFiles +1 ->
+ ?FORMAT("open file ~p Cur = ~p, Sz = ~p, Tot = ~p, NoFiles = ~p~n",
+ [FileNo, CurFileNo, _CurFileSz, _TotSz, NoOfFiles]),
+ open_int(File, FileNo, one);
+ {ok, {_CurFileNo, _CurFileSz, _TotSz, _NoOfFiles}} ->
+ {error, {file_not_found, add_ext(File, FileNo)}};
+ Error ->
+ Error
+ end.
+
+-spec close(#wrap_reader{}) -> 'ok' | {'error', atom()}.
+
+close(#wrap_reader{fd = FD}) ->
+ file:close(FD).
+
+-type chunk_ret() :: {#wrap_reader{}, [term()]}
+ | {#wrap_reader{}, [term()], non_neg_integer()}
+ | {#wrap_reader{}, 'eof'}
+ | {'error', term()}.
+
+-spec chunk(#wrap_reader{}) -> chunk_ret().
+
+chunk(WR = #wrap_reader{}) ->
+ chunk(WR, ?MAX_CHUNK_SIZE, 0).
+
+-spec chunk(#wrap_reader{}, 'infinity' | pos_integer()) -> chunk_ret().
+
+chunk(WR = #wrap_reader{}, infinity) ->
+ chunk(WR, ?MAX_CHUNK_SIZE, 0);
+chunk(WR = #wrap_reader{}, N) when is_integer(N), N > 0 ->
+ chunk(WR, N, 0).
+
+%%
+%% Local functions
+%%
+
+open_int(File, FileNo, FirstFileNo) ->
+ FName = add_ext(File, FileNo),
+ case file:open(FName, [raw, binary, read]) of
+ {ok, Fd} -> %% File exists
+ case file:read(Fd, ?HEADSZ) of
+ {ok, Head} ->
+ case disk_log_1:is_head(Head) of
+ no ->
+ file:close(Fd),
+ {error, {not_a_log_file, FName}};
+ _ -> % yes or yes_not_closed
+ case last_mod_time(FName) of
+ {ok, ModTime} ->
+ WR = #wrap_reader{fd = Fd, cont = start,
+ file = File,
+ file_no = FileNo,
+ mod_time = ModTime,
+ first_no = FirstFileNo},
+ {ok, WR};
+ {error, E} ->
+ file:close(Fd),
+ {error, {file_error, FName, E}}
+ end
+ end;
+ _Other ->
+ file:close(Fd),
+ {error, {not_a_log_file, FName}}
+ end;
+ _Other ->
+ {error, {not_a_log_file, FName}}
+ end.
+
+chunk(WR, N, Bad) ->
+ #wrap_reader{fd = Fd, cont = Continue, file = File, file_no = CurFileNo,
+ first_no = FirstFileNo} = WR,
+ case read_a_chunk(Fd, N, Continue, add_ext(File, CurFileNo)) of
+ eof ->
+ case FirstFileNo of
+ one ->
+ {WR, eof};
+ _Else ->
+ chunk_at_eof(WR, N, Bad)
+ end;
+ {ContOut, [], BadBytes} ->
+ ?FORMAT("chunk: empty chunk read, ~p bad bytes~n", [BadBytes]),
+ chunk(WR#wrap_reader{cont = ContOut}, N, Bad + BadBytes);
+ {ContOut, Chunk, BadBytes} when Bad + BadBytes =:= 0 ->
+ {WR#wrap_reader{cont = ContOut}, Chunk};
+ {ContOut, Chunk, BadBytes} ->
+ ?FORMAT("chunk: total of ~p bad bytes~n", [BadBytes]),
+ {WR#wrap_reader{cont = ContOut}, Chunk, Bad + BadBytes};
+ Error ->
+ Error
+ end.
+
+read_a_chunk(Fd, N, start, FileName) ->
+ read_a_chunk(Fd, FileName, 0, [], N);
+read_a_chunk(Fd, N, More, FileName) ->
+ Pos = More#continuation.pos,
+ B = More#continuation.b,
+ read_a_chunk(Fd, FileName, Pos, B, N).
+
+read_a_chunk(Fd, FileName, Pos, B, N) ->
+ R = disk_log_1:chunk_read_only(Fd, FileName, Pos, B, N),
+ %% Create terms from the binaries returned from chunk_read_only/5.
+ %% 'foo' will do here since Log is not used in read-only mode.
+ Log = foo,
+ case disk_log:ichunk_end(R, Log) of
+ {C = #continuation{}, S} ->
+ {C, S, 0};
+ Else ->
+ Else
+ end.
+
+chunk_at_eof(WR, N, Bad) ->
+ #wrap_reader{file = File, file_no = CurFileNo,
+ first_no = FirstFileNo} = WR,
+ case read_index_file(File) of
+ {ok, IndexFile} ->
+ {_, _, _, NoOfFiles} = IndexFile,
+ NewFileNo = case (CurFileNo + 1) rem NoOfFiles of
+ %% The special case described above.
+ _ when CurFileNo > NoOfFiles -> 1;
+ 0 when NoOfFiles > 1 -> NoOfFiles;
+ No when CurFileNo =:= NoOfFiles ->
+ FileName = add_ext(File, CurFileNo+1),
+ case file:read_file_info(FileName) of
+ {ok, _} -> CurFileNo + 1;
+ _ -> No
+ end;
+ No -> No
+ end,
+ ?FORMAT("chunk: at eof, index file: ~p, FirstFileNo: ~p, "
+ "CurFileNo: ~p, NoOfFiles: ~p, NewFileNo: ~p~n",
+ [IndexFile, FirstFileNo, CurFileNo,
+ NoOfFiles, NewFileNo]),
+ case {FirstFileNo, NewFileNo} of
+ {_, 0} -> {WR, eof};
+ {_, FirstFileNo} -> {WR, eof};
+ _ -> read_next_file(WR, N, NewFileNo, Bad)
+ end;
+ Error ->
+ Error
+ end.
+
+%% Read the index file for the File
+%% -> {ok, {CurFileNo, CurFileSz, TotSz, NoOfFiles}} | {error, Reason}
+read_index_file(File) ->
+ case catch disk_log_1:read_index_file(File) of
+ {1, 0, 0, 0} ->
+ {error, {index_file_not_found, File}};
+ {error, _Reason} ->
+ {error, {index_file_not_found, File}};
+ FileData ->
+ {ok, FileData}
+ end.
+
+%% When reading all the index files, this function closes the previous
+%% index file and opens the next one.
+read_next_file(WR, N, NewFileNo, Bad) ->
+ #wrap_reader{file = File, file_no = CurFileNo,
+ mod_time = ModTime, first_no = FirstFileNo} = WR,
+ %% If current file were closed here, then WR would be in a strange
+ %% state should an error occur below.
+ case last_mod_time(add_ext(File, NewFileNo)) of
+ {ok, NewModTime} ->
+ OldMT = calendar:datetime_to_gregorian_seconds(ModTime),
+ NewMT = calendar:datetime_to_gregorian_seconds(NewModTime),
+ Diff = NewMT - OldMT,
+ ?FORMAT("next: now = ~p~n last mtime = ~p~n"
+ " mtime = ~p~n diff = ~p~n",
+ [calendar:local_time(), ModTime, NewModTime, Diff]),
+ if
+ Diff < 0 ->
+ %% The file to be read is older than the one just finished.
+ {error, {is_wrapped, add_ext(File, CurFileNo)}};
+ true ->
+ case open_int(File, NewFileNo, FirstFileNo) of
+ {ok, NWR} ->
+ close(WR), %% Now we can safely close the old file.
+ chunk(NWR, N, Bad);
+ Error ->
+ Error
+ end
+ end;
+ {error, EN} ->
+ {error, {file_error, add_ext(File, NewFileNo), EN}}
+ end.
+
+%% Get the last modification time of a file
+last_mod_time(File) ->
+ case file:read_file_info(File) of
+ {ok, FileInfo} ->
+ {ok, FileInfo#file_info.mtime};
+ E ->
+ {error, E}
+ end.
+
+add_ext(File, Ext) ->
+ lists:concat([File, ".", Ext]).
diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile
new file mode 100644
index 0000000000..ffad998d96
--- /dev/null
+++ b/lib/kernel/test/Makefile
@@ -0,0 +1,149 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 1997-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+# ----------------------------------------------------
+# Target Specs
+# ----------------------------------------------------
+
+MODULES= \
+ rpc_SUITE \
+ pdict_SUITE \
+ bif_SUITE \
+ kernel_SUITE \
+ application_SUITE \
+ myApp \
+ topApp \
+ topApp2 \
+ topApp3 \
+ ch \
+ ch_sup \
+ appinc1 \
+ appinc1x \
+ appinc2 \
+ appinc2top \
+ appinc2A \
+ appinc2B \
+ code_SUITE \
+ code_b_test \
+ disk_log_SUITE \
+ erl_boot_server_SUITE \
+ erl_distribution_SUITE \
+ erl_distribution_wb_SUITE \
+ erl_prim_loader_SUITE \
+ error_logger_SUITE \
+ error_logger_warn_SUITE \
+ file_SUITE \
+ prim_file_SUITE \
+ ram_file_SUITE \
+ gen_tcp_api_SUITE \
+ gen_tcp_echo_SUITE \
+ gen_tcp_misc_SUITE \
+ gen_udp_SUITE \
+ gen_sctp_SUITE \
+ global_SUITE \
+ global_group_SUITE \
+ heart_SUITE \
+ inet_SUITE \
+ inet_sockopt_SUITE \
+ inet_res_SUITE \
+ interactive_shell_SUITE \
+ init_SUITE \
+ kernel_config_SUITE \
+ os_SUITE \
+ pg2_SUITE \
+ seq_trace_SUITE \
+ wrap_log_reader_SUITE \
+ cleanup \
+ zlib_SUITE \
+ loose_node
+
+APP_FILES = \
+ appinc.app \
+ appinc1.app \
+ appinc1x.app \
+ appinc2.app \
+ appinc2top.app \
+ appinc2A.app \
+ appinc2B.app \
+ myApp.app \
+ topApp.app \
+ topApp2.app \
+ topApp3.app
+
+ERL_FILES= $(MODULES:%=%.erl) code_a_test.erl
+
+TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
+INSTALL_PROGS= $(TARGET_FILES)
+
+EMAKEFILE=Emakefile
+COVERFILE=kernel.cover
+
+# ----------------------------------------------------
+# Release directory specification
+# ----------------------------------------------------
+RELSYSDIR = $(RELEASE_PATH)/kernel_test
+
+# ----------------------------------------------------
+# FLAGS
+# ----------------------------------------------------
+
+ERL_MAKE_FLAGS +=
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+
+EBIN = .
+
+# ----------------------------------------------------
+# Targets
+# ----------------------------------------------------
+
+make_emakefile:
+ $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \
+ >> $(EMAKEFILE)
+ $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \
+ >> $(EMAKEFILE)
+
+tests debug opt: make_emakefile
+ erl $(ERL_MAKE_FLAGS) -make
+
+clean:
+ rm -f $(EMAKEFILE)
+ rm -f $(TARGET_FILES) $(GEN_FILES)
+ rm -f core
+
+docs:
+
+# ----------------------------------------------------
+# Release Target
+# ----------------------------------------------------
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec: opt
+
+release_tests_spec: make_emakefile
+ $(INSTALL_DIR) $(RELSYSDIR)
+ $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)
+ $(INSTALL_DATA) $(APP_FILES) $(RELSYSDIR)
+ $(INSTALL_DATA) kernel.dynspec $(EMAKEFILE)\
+ $(COVERFILE) $(RELSYSDIR)
+ chmod -f -R u+w $(RELSYSDIR)
+ @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -)
+
+release_docs_spec:
diff --git a/lib/kernel/test/appinc.app b/lib/kernel/test/appinc.app
new file mode 100644
index 0000000000..43c475530f
--- /dev/null
+++ b/lib/kernel/test/appinc.app
@@ -0,0 +1,10 @@
+{application, appinc,
+ [{description, "Test of new app file, including appnew"},
+ {id, "CXC 138 ai"},
+ {vsn, "2.0"},
+ {applications, [kernel]},
+ {modules, []},
+ {registered, []},
+ {included_applications, [appinc1, appinc2]},
+ {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]},
+ {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }}]}.
diff --git a/lib/kernel/test/appinc1.app b/lib/kernel/test/appinc1.app
new file mode 100644
index 0000000000..8ff8c7fd89
--- /dev/null
+++ b/lib/kernel/test/appinc1.app
@@ -0,0 +1,9 @@
+{application, appinc1,
+ [{description, "Test of new start, no inc file"},
+ {id, "CXC 138 xx1"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {start_phases, [{go, [goArgs1]}]},
+ {mod, {appinc1, [ch_sup, start, {app1, 55, 57}] }}]}.
diff --git a/lib/kernel/test/appinc1.erl b/lib/kernel/test/appinc1.erl
new file mode 100644
index 0000000000..8456b0eac2
--- /dev/null
+++ b/lib/kernel/test/appinc1.erl
@@ -0,0 +1,49 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(appinc1).
+
+%% External exports
+-export([start/2, stop/1]).
+-export([start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, [_M,_F,{_AppN, Low, High}]) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, appinc1,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) ->
+ ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/appinc1x.app b/lib/kernel/test/appinc1x.app
new file mode 100644
index 0000000000..5b374c7735
--- /dev/null
+++ b/lib/kernel/test/appinc1x.app
@@ -0,0 +1,9 @@
+{application, appinc1x,
+ [{description, "Test of new start"},
+ {id, "CXC 138 xx1"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {start_phases, [{spec, [specArgs1]}, {go, [goArgs1]}]},
+ {mod, {appinc1x, [arg1, arg2, arg3] }}]}.
diff --git a/lib/kernel/test/appinc1x.erl b/lib/kernel/test/appinc1x.erl
new file mode 100644
index 0000000000..2e177727f2
--- /dev/null
+++ b/lib/kernel/test/appinc1x.erl
@@ -0,0 +1,49 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(appinc1x).
+
+%% External exports
+-export([start/2, stop/1]).
+-export([start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, [_M,_F,{_AppN, Low, High}]) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, appinc1x,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) ->
+ ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/appinc2.app b/lib/kernel/test/appinc2.app
new file mode 100644
index 0000000000..9dd2dc6d05
--- /dev/null
+++ b/lib/kernel/test/appinc2.app
@@ -0,0 +1,9 @@
+{application, appinc2,
+ [{description, "Test of new start, no inc file"},
+ {id, "CXC 138 xx2"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {start_phases, [{init, [initArgs2]}, {go, [goArgs2]}]},
+ {mod, {appinc2, [ch_sup, start, {app1, 55, 57}] }}]}.
diff --git a/lib/kernel/test/appinc2.erl b/lib/kernel/test/appinc2.erl
new file mode 100644
index 0000000000..e41d58bb71
--- /dev/null
+++ b/lib/kernel/test/appinc2.erl
@@ -0,0 +1,49 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(appinc2).
+
+%% External exports
+-export([start/2, stop/1]).
+-export([start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, [_M,_F,{_AppN, Low, High}]) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, appinc2,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) ->
+ ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/appinc2A.app b/lib/kernel/test/appinc2A.app
new file mode 100644
index 0000000000..2b04ae2190
--- /dev/null
+++ b/lib/kernel/test/appinc2A.app
@@ -0,0 +1,9 @@
+{application, appinc2A,
+ [{description, "Test of new start"},
+ {id, "CXC 138 xx2"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {start_phases, [{some, [someArgs2A]}, {go, [goArgs2A]}]},
+ {mod, {appinc2A, [arg1, arg2] }}]}.
diff --git a/lib/kernel/test/appinc2A.erl b/lib/kernel/test/appinc2A.erl
new file mode 100644
index 0000000000..b51a1f5035
--- /dev/null
+++ b/lib/kernel/test/appinc2A.erl
@@ -0,0 +1,49 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(appinc2A).
+
+%% External exports
+-export([start/2, stop/1]).
+-export([start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, [_M,_F,{_AppN, Low, High}]) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, appinc2A,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) ->
+ ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/appinc2B.app b/lib/kernel/test/appinc2B.app
new file mode 100644
index 0000000000..a1d7e3529d
--- /dev/null
+++ b/lib/kernel/test/appinc2B.app
@@ -0,0 +1,9 @@
+{application, appinc2B,
+ [{description, "Test of new start"},
+ {id, "CXC 138 xx2"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {start_phases, [{init, [initArgs2B]}]},
+ {mod, {appinc2B, [arg1, arg2] }}]}.
diff --git a/lib/kernel/test/appinc2B.erl b/lib/kernel/test/appinc2B.erl
new file mode 100644
index 0000000000..cafb061ae3
--- /dev/null
+++ b/lib/kernel/test/appinc2B.erl
@@ -0,0 +1,49 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(appinc2B).
+
+%% External exports
+-export([start/2, stop/1]).
+-export([start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, [_M,_F,{_AppN, Low, High}]) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, appinc2B,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) ->
+ ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/appinc2top.app b/lib/kernel/test/appinc2top.app
new file mode 100644
index 0000000000..b7758a33cf
--- /dev/null
+++ b/lib/kernel/test/appinc2top.app
@@ -0,0 +1,10 @@
+{application, appinc2top,
+ [{description, "Test of new start"},
+ {id, "CXC 138 xx2"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {included_applications, [appinc2A, appinc2B]},
+ {applications, [kernel]},
+ {start_phases, [{init, []}, {some, []}, {go, []}]},
+ {mod, {application_starter, [appinc2top, {app1, 107, 109}] }}]}.
diff --git a/lib/kernel/test/appinc2top.erl b/lib/kernel/test/appinc2top.erl
new file mode 100644
index 0000000000..5bd19a59e7
--- /dev/null
+++ b/lib/kernel/test/appinc2top.erl
@@ -0,0 +1,49 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(appinc2top).
+
+%% External exports
+-export([start/2, stop/1]).
+-export([start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, [_M,_F,{_AppN, Low, High}]) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, appinc2top,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) ->
+ ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl
new file mode 100644
index 0000000000..313b50f976
--- /dev/null
+++ b/lib/kernel/test/application_SUITE.erl
@@ -0,0 +1,2734 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(application_SUITE).
+
+-include("test_server.hrl").
+
+-export([all/1, failover/1, failover_comp/1, permissions/1, load/1, reported_bugs/1,
+ load_use_cache/1,
+ otp_1586/1, otp_2078/1, otp_2012/1, otp_2718/1, otp_2973/1,
+ otp_3002/1, otp_3184/1, otp_4066/1, otp_4227/1, otp_5363/1,
+ otp_5606/1,
+ start_phases/1, get_key/1,
+ permit_false_start_local/1, permit_false_start_dist/1, script_start/1,
+ nodedown_start/1, init2973/0, loop2973/0, loop5606/1]).
+
+-export([config_change/1,
+ distr_changed/1, distr_changed_tc1/1, distr_changed_tc2/1,
+ shutdown_func/1, do_shutdown/1]).
+
+-define(TESTCASE, testcase_name).
+-define(testcase, ?config(?TESTCASE, Config)).
+
+-export([init_per_testcase/2, fin_per_testcase/2, start_type/0,
+ start_phase/0, conf_change/0]).
+% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(2)).
+
+all(suite) ->
+ [failover, failover_comp, permissions, load,
+ load_use_cache, reported_bugs,
+ start_phases, script_start, nodedown_start,
+ permit_false_start_local, permit_false_start_dist,
+ get_key, distr_changed, config_change, shutdown_func].
+
+
+init_per_testcase(otp_2973=Case, Config) ->
+ code:add_path(?config(data_dir,Config)),
+ ?line Dog = test_server:timetrap(?default_timeout),
+ [{?TESTCASE, Case}, {watchdog, Dog}|Config];
+init_per_testcase(Case, Config) ->
+ ?line Dog = test_server:timetrap(?default_timeout),
+ [{?TESTCASE, Case}, {watchdog, Dog}|Config].
+
+fin_per_testcase(otp_2973, Config) ->
+ code:del_path(?config(data_dir,Config)),
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok;
+fin_per_testcase(_Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+-define(UNTIL(Seq), loop_until_true(fun() -> Seq end)).
+
+-record(st, {
+ normal = 0,
+ local = 0,
+ takeover = 0,
+ failover = 0
+ }).
+
+loop_until_true(Fun) ->
+ case Fun() of
+ true ->
+ ok;
+ _ ->
+ timer:sleep(100),
+ loop_until_true(Fun)
+ end.
+
+%%-----------------------------------------------------------------
+%% Should be started in a CC view with:
+%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3]
+%%-----------------------------------------------------------------
+failover(suite) -> [];
+failover(doc) ->
+ ["Tests failover and takeover for distributed applications. Tests",
+ "start, load etc implicitly."];
+failover(Conf) when is_list(Conf) ->
+ %% start a help process to check the start type
+ StPid = spawn_link(?MODULE, start_type, []),
+ ?line yes = global:register_name(st_type, StPid),
+
+ NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ NoSyncTime = config_fun_fast(config_fo(NodeNames)),
+ WithSyncTime = config_fun(config_fo(NodeNames)),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf),
+ ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf),
+ Cps = [Cp1, Cp2, Cp3],
+ ?line wait_for_ready_net(),
+
+ % Start app1 and make sure cp1 starts it
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app1()]),
+ ?line ?UNTIL(is_loaded(app1, Cps)),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+ ?line ok = get_start_type(#st{normal = 3}),
+
+ % Stop cp1 and make sure cp2 starts app1
+ stop_node_nice(Cp1),
+ ?line ?UNTIL(is_started(app1, Cp2)),
+ ?line ok = get_start_type(#st{normal = 3}),
+
+ % Restart cp1 and make sure it restarts app1
+ ?line {ok, Cp1_2} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line global:sync(),
+ ?line ok = rpc:call(Cp1_2, application, load, [app1()]),
+ ?line ok = rpc:call(Cp1_2, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line ?UNTIL(not is_started(app1, Cp2)),
+ ?line ok = get_start_type(#st{takeover = 3}),
+
+ % Test [{cp1, cp2}, cp3]
+ % Start app_sp and make sure cp2 starts it (cp1 has more apps started)
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1_2, Cp2, Cp3], application, load, [app_sp()]),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1_2, Cp2, Cp3], application, start,[app_sp,permanent]),
+ ?line ?UNTIL(is_started(app_sp, Cp2)),
+ ?line false = is_started(app_sp, Cp1),
+ ?line false = is_started(app_sp, Cp3),
+ ?line ok = get_start_type(#st{normal = 3}),
+
+ % Stop cp2 and make sure cp1 starts app_sp
+ stop_node_nice(Cp2),
+ ?line ?UNTIL(is_started(app_sp, Cp1_2)),
+ ?line ok = get_start_type(#st{failover = 3}),
+
+ % Stop cp1 and make sure cp3 starts app_sp
+ stop_node_nice(Cp1_2),
+ ?line ?UNTIL(is_started(app_sp, Cp3)),
+ ?line ok = get_start_type(#st{normal = 3, failover = 3}),
+
+ % Restart cp2 and make sure it restarts app_sp
+ ?line {ok, Cp2_2} = start_node_config(Ncp2, NoSyncTime, Conf),
+ ?line global:sync(),
+ ?line ok = rpc:call(Cp2_2, application, load, [app_sp()]),
+ ?line ok = rpc:call(Cp2_2, application, start, [app_sp, permanent]),
+ ?line ?UNTIL(is_started(app_sp, Cp2_2)),
+ ?line ?UNTIL(not is_started(app_sp, Cp3)),
+ ?line ok = get_start_type(#st{takeover = 3}),
+
+ % Restart cp1 and make sure it doesn't restart app_sp
+ ?line {ok, Cp1_3} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line global:sync(),
+ ?line ok = rpc:call(Cp1_3, application, load, [app_sp()]),
+ ?line ok = rpc:call(Cp1_3, application, start, [app_sp, permanent]),
+ test_server:sleep(500),
+ ?line false = is_started(app_sp, Cp1_3),
+ ?line true = is_started(app_sp, Cp2_2),
+
+ % Force takeover to cp1
+ ?line ok = rpc:call(Cp1_3, application, takeover, [app_sp, permanent]),
+ ?line ?UNTIL(is_started(app_sp, Cp1_3)),
+ ?line ?UNTIL(not is_started(app_sp, Cp2_2)),
+ ?line ok = get_start_type(#st{takeover = 3}),
+
+ %% Kill one child process and see that it is started with type local
+ PP = global:whereis_name({ch,3}),
+ exit(PP, kill),
+ ?line ok = get_start_type(#st{local = 1}),
+
+ global:send(st_type, kill),
+
+ stop_node_nice(Cp1_3),
+ stop_node_nice(Cp2_2),
+ stop_node_nice(Cp3),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Should be started in a CC view with:
+%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3]
+%%-----------------------------------------------------------------
+failover_comp(suite) -> [];
+failover_comp(doc) ->
+ ["Tests failover and takeover for distributed applications. Tests",
+ "start, load etc implicitly. The applications do not use start_phases,"
+ "i.e the failover should be trasfered to normal start type."];
+failover_comp(Conf) when is_list(Conf) ->
+ %% start a help process to check the start type
+ StPid = spawn_link(?MODULE, start_type, []),
+ ?line yes = global:register_name(st_type, StPid),
+
+ NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ NoSyncTime = config_fun_fast(config(NodeNames)),
+ WithSyncTime = config_fun(config(NodeNames)),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf),
+ ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf),
+ Cps = [Cp1, Cp2, Cp3],
+ ?line wait_for_ready_net(),
+
+ % Start app1 and make sure cp1 starts it
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app1()]),
+ ?line ?UNTIL(is_loaded(app1, Cps)),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+ ?line ok = get_start_type(#st{normal = 3}),
+
+ % Stop cp1 and make sure cp2 starts app1
+ stop_node_nice(Cp1),
+ ?line ?UNTIL(is_started(app1, Cp2)),
+ ?line ok = get_start_type(#st{normal = 3}),
+
+ % Restart cp1 and make sure it restarts app1
+ ?line {ok, Cp1_2} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line global:sync(),
+ ?line ok = rpc:call(Cp1_2, application, load, [app1()]),
+ ?line ?UNTIL(is_loaded(app1, Cp1_2)),
+ ?line ok = rpc:call(Cp1_2, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1_2)),
+ ?line ?UNTIL(not is_started(app1, Cp2)),
+ ?line ok = get_start_type(#st{takeover = 3}),
+
+ % Test [{cp1, cp2}, cp3]
+ % Start app3 and make sure cp2 starts it (cp1 has more apps started)
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1_2, Cp2, Cp3], application, load, [app3()]),
+ ?line ?UNTIL(is_loaded(app3, [Cp1_2, Cp2, Cp3])),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1_2, Cp2, Cp3], application, start,[app3,permanent]),
+ ?line ?UNTIL(is_started(app3, Cp2)),
+ ?line false = is_started(app3, Cp1),
+ ?line false = is_started(app3, Cp3),
+ ?line ok = get_start_type(#st{normal = 3}),
+
+ % Stop cp2 and make sure cp1 starts app3
+ stop_node_nice(Cp2),
+ ?line ?UNTIL(is_started(app3, Cp1_2)),
+ ?line ok = get_start_type(#st{normal = 3}),
+
+ % Stop cp1 and make sure cp3 starts app3
+ stop_node_nice(Cp1_2),
+ ?line ?UNTIL(is_started(app3, Cp3)),
+ ?line ok = get_start_type(#st{normal = 6}),
+
+ % Restart cp2 and make sure it restarts app3
+ ?line {ok, Cp2_2} = start_node_config(Ncp2, NoSyncTime, Conf),
+ ?line global:sync(),
+ ?line ok = rpc:call(Cp2_2, application, load, [app3()]),
+ ?line ?UNTIL(is_loaded(app3, Cp2_2)),
+ ?line ok = rpc:call(Cp2_2, application, start, [app3, permanent]),
+ ?line ?UNTIL(is_started(app3, Cp2_2)),
+ ?line ?UNTIL(not is_started(app3, Cp3)),
+ ?line ok = get_start_type(#st{takeover = 3}),
+
+ % Restart cp1 and make sure it doesn't restart app3
+ ?line {ok, Cp1_3} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line global:sync(),
+ ?line ok = rpc:call(Cp1_3, application, load, [app3()]),
+ ?line true = is_loaded(app3, Cp1_3),
+ ?line ok = rpc:call(Cp1_3, application, start, [app3, permanent]),
+ test_server:sleep(5000),
+ ?line false = is_started(app3, Cp1_3),
+ ?line true = is_started(app3, Cp2_2),
+
+ % Force takeover to cp1
+ ?line ok = rpc:call(Cp1_3, application, takeover, [app3, permanent]),
+ ?line ?UNTIL(is_started(app3, Cp1_3)),
+ ?line ?UNTIL(not is_started(app3, Cp2_2)),
+ ?line ok = get_start_type(#st{takeover = 3}),
+
+ %% Kill one child process and see that it is started with type local
+ PP = global:whereis_name({ch,3}),
+ exit(PP, kill),
+ ?line ok = get_start_type(#st{local = 1}),
+
+ global:send(st_type, kill),
+
+ stop_node_nice(Cp1_3),
+ stop_node_nice(Cp2_2),
+ stop_node_nice(Cp3),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Should be started in a CC view with:
+%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3]
+%%-----------------------------------------------------------------
+permissions(suite) -> [];
+permissions(doc) ->
+ ["Tests permissions for distributed applications."];
+permissions(Conf) when is_list(Conf) ->
+
+ NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ NoSyncTime = config_fun_fast(config2(NodeNames)),
+ WithSyncTime = config_fun(config2(NodeNames)),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf),
+ ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf),
+ Cps = [Cp1, Cp2, Cp3],
+ ?line wait_for_ready_net(),
+
+ % Start app1 and make sure cp1 starts it
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app1()]),
+ ?line ?UNTIL(is_loaded(app1, Cps)),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+
+ % Unpermit app1 on cp1, make sure cp2 starts it
+ ?line ok = rpc:call(Cp1, application, permit, [app1, false]),
+ ?line false = is_started(app1, Cp1),
+ ?line true = is_started(app1, Cp2),
+
+ % Unpermit app1 on cp2, make sure cp3 starts it
+ ?line ok = rpc:call(Cp2, application, permit, [app1, false]),
+ ?line false = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp2),
+ ?line true = is_started(app1, Cp3),
+
+ % Permit cp2 again
+ ?line ok = rpc:call(Cp2, application, permit, [app1, true]),
+ ?line false = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp3),
+ ?line true = is_started(app1, Cp2),
+
+ % Start app3, make sure noone starts it
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app3()]),
+ ?line ?UNTIL(is_loaded(app3, Cps)),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, start, [app3, permanent]),
+ test_server:sleep(1000),
+ ?line false = is_started(app3, Cp1),
+ ?line false = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ % Permit app3 on Cp3
+ ?line ok = rpc:call(Cp3, application, permit, [app3, true]),
+ ?line true = is_started(app3, Cp3),
+
+ % Permit app3 on Cp2, make sure it starts it
+ ?line ok = rpc:call(Cp2, application, permit, [app3, true]),
+ ?line true = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ % Permit app3 on Cp1, make sure it doesn't start it
+ ?line ok = rpc:call(Cp1, application, permit, [app3, true]),
+ ?line false = is_started(app3, Cp1),
+ ?line true = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ % Stop Cp2, make sure Cp1 starts app3
+ stop_node_nice(Cp2),
+ ?line ?UNTIL(is_started(app3, Cp1)),
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp3),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Should be started in a CC view with:
+%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3]
+%%-----------------------------------------------------------------
+load(suite) -> [];
+load(doc) ->
+ ["Tests loading of distributed applications."];
+load(Conf) when is_list(Conf) ->
+ NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ NoSyncTime = config_fun_fast(config3(NodeNames)),
+ WithSyncTime = config_fun(config3(NodeNames)),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf),
+ ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf),
+ Cps = [Cp1, Cp2, Cp3],
+ ?line wait_for_ready_net(),
+
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app1(), d1(NodeNames)]),
+ ?line ?UNTIL(is_loaded(app1, Cps)),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Load app1 with different specs and make sure we get an error
+ ?line {[{error,_},{error,_}],[]} =
+ rpc:multicall([Cp1, Cp2], application, load, [app1(), d1(NodeNames)]),
+ ?line {error, _} = rpc:call(Cp3, application, load, [app1(), d2(NodeNames)]),
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp2),
+ stop_node_nice(Cp3),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Same test as load/1, only with code path cache enabled.
+%%-----------------------------------------------------------------
+load_use_cache(suite) -> [];
+load_use_cache(doc) ->
+ ["Tests loading of distributed applications. Code path cache enabled."];
+load_use_cache(Conf) when is_list(Conf) ->
+ NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ NoSyncTime = config_fun_fast(config3(NodeNames)),
+ WithSyncTime = config_fun(config3(NodeNames)),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_with_cache(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_with_cache(Ncp2, NoSyncTime, Conf),
+ ?line {ok, Cp3} = start_node_with_cache(Ncp3, WithSyncTime, Conf),
+ Cps = [Cp1, Cp2, Cp3],
+ ?line wait_for_ready_net(),
+
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app1(), d1(NodeNames)]),
+ ?line ?UNTIL(is_loaded(app1, Cps)),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+
+ % Load app1 with different specs and make sure we get an error
+ ?line {[{error,_},{error,_}],[]} =
+ rpc:multicall([Cp1, Cp2], application, load, [app1(), d1(NodeNames)]),
+ ?line {error, _} = rpc:call(Cp3, application, load, [app1(), d2(NodeNames)]),
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp2),
+ stop_node_nice(Cp3),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Should be started in a CC view with:
+%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3]
+%%-----------------------------------------------------------------
+start_phases(suite) -> [];
+start_phases(doc) ->
+ ["Tests new start phases and failover."];
+start_phases(Conf) when is_list(Conf) ->
+ %% start a help process to check the start type
+ SpPid = spawn_link(?MODULE, start_phase, []),
+ ?line yes = global:register_name(start_phase, SpPid),
+
+ NodeNames = [Ncp1, _Ncp2, _Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ WithSyncTime = config_fun(config_sf(NodeNames)),
+
+ ?line {ok, Cp1} = start_node_config_sf(Ncp1, WithSyncTime, Conf),
+ ?line wait_for_ready_net(),
+
+ %%=============================
+ %%Example 1 in the user's guide
+ %%=============================
+ ?line ok = rpc:call(Cp1, application, load, [myApp,
+ d_any3(myApp, NodeNames)]),
+ ?line ?UNTIL(is_loaded(myApp, Cp1)),
+ ?line ok = rpc:call(Cp1, application, start, [myApp, permanent]),
+ ?line ?UNTIL(is_started(myApp, Cp1)),
+ ?line ok = get_start_phase({sp, 0, 1, 0, 0, 1}),
+ ?line ok = rpc:call(Cp1, application, stop, [myApp]),
+
+ %%=============================
+ %%Example 2 in the user's guide
+ %%=============================
+ ?line ok = rpc:call(Cp1, application, load, [topApp,
+ d_any3(topApp, NodeNames)]),
+ ?line ?UNTIL(is_loaded(topApp, Cp1)),
+ ?line ok = rpc:call(Cp1, application, start, [topApp, permanent]),
+ ?line ?UNTIL(is_started(topApp, Cp1)),
+ ?line ok = get_start_phase({sp, 0, 1, 0, 0, 1}),
+ ?line ok = rpc:call(Cp1, application, stop, [topApp]),
+
+ %%=============================
+ %%Example 3 in the user's guide
+ %%=============================
+ ?line ok = rpc:call(Cp1, application, load, [topApp2,
+ d_any3(topApp2, NodeNames)]),
+ ?line ?UNTIL(is_loaded(topApp2, Cp1)),
+ ?line ok = rpc:call(Cp1, application, start, [topApp2, permanent]),
+ ?line ?UNTIL(is_started(topApp2, Cp1)),
+ ?line ok = get_start_phase({sp, 0, 2, 0, 0, 3}),
+ ?line ok = rpc:call(Cp1, application, stop, [topApp2]),
+
+ %%=============================
+ %%Example 4 in the user's guide
+ %%=============================
+ ?line ok = rpc:call(Cp1, application, load, [topApp3,
+ d_any3(topApp3, NodeNames)]),
+ ?line ?UNTIL(is_loaded(topApp3, Cp1)),
+ ?line ok = rpc:call(Cp1, application, start, [topApp3, permanent]),
+ ?line ?UNTIL(is_started(topApp3, Cp1)),
+ ?line ok = get_start_phase({sp, 1, 3, 3, 2, 4}),
+ ?line ok = rpc:call(Cp1, application, stop, [topApp3]),
+
+ global:send(start_phase, kill),
+
+ stop_node_nice(Cp1),
+ ok.
+
+
+script_start(doc) ->
+ ["Start distributed applications from within a boot script. Test ",
+ "same as failover."];
+script_start(suite) -> [];
+script_start(Conf) when is_list(Conf) ->
+ %% start a help process to check the start type
+ StPid = spawn_link(?MODULE, start_type, []),
+ ?line yes = global:register_name(st_type, StPid),
+
+
+ % Create the .app files and the boot script
+ ?line ok = create_app(),
+ ?line {{KernelVer,StdlibVer}, _} = create_script("latest"),
+ ?line case is_real_system(KernelVer, StdlibVer) of
+ true ->
+ Options = [];
+ false ->
+ Options = [local]
+ end,
+ ?line ok = systools:make_script("latest", Options),
+
+ NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ NoSyncTime = config_fun_fast(config_fo(NodeNames)),
+ WithSyncTime = config_fun(config_fo(NodeNames)),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_boot_config(Ncp1, NoSyncTime, Conf, latest),
+ ?line {ok, Cp2} = start_node_boot_config(Ncp2, NoSyncTime, Conf, latest),
+ ?line {ok, Cp3} = start_node_boot_config(Ncp3, WithSyncTime, Conf, latest),
+ ?line wait_for_ready_net(),
+
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line ?UNTIL(is_started(app2, Cp1)),
+ ?line ?UNTIL(is_started(app_sp, Cp1)),
+ ?line false = is_started(app1, Cp2),
+ ?line ok = get_start_type(#st{normal = 9}),
+
+ % Stop cp1 and make sure cp2 starts app1, app2 normally (no
+ % start_phases defined) and app_sp as failover (start_phases
+ % defined)
+ stop_node_nice(Cp1),
+ ?line ?UNTIL(is_started(app1, Cp2)),
+ ?line ?UNTIL(is_started(app2, Cp2)),
+ ?line ?UNTIL(is_started(app_sp, Cp2)),
+ ?line ok = get_start_type(#st{normal = 6, failover = 3}),
+
+ % Restart cp1, Cp1 takesover app1 and app2
+ ?line {ok, Cp1_2} = start_node_boot_config(Ncp1, NoSyncTime, Conf, latest),
+ ?line global:sync(),
+ ?line ?UNTIL(is_started(app1, Cp1_2)),
+ ?line false = is_started(app1, Cp2),
+ ?line ?UNTIL(is_started(app2, Cp1_2)),
+ ?line true = is_started(app_sp, Cp2),
+ ?line ?UNTIL(not is_started(app1, Cp2)),
+ ?line ?UNTIL(not is_started(app2, Cp2)),
+ ?line ok = get_start_type(#st{takeover = 6}),
+
+ % Stop cp2 and make sure cp1 starts app_sp.
+ ?line false = is_started(app_sp, Cp1_2),
+ stop_node_nice(Cp2),
+ ?line ?UNTIL(is_started(app_sp, Cp1_2)),
+ ?line ok = get_start_type(#st{failover = 3}),
+
+ % Stop cp1 and make sure cp3 starts app1, app2 and app_sp
+ stop_node_nice(Cp1_2),
+ ?line ?UNTIL(is_started(app_sp, Cp3)),
+ ?line ?UNTIL(is_started(app1, Cp3)),
+ ?line ?UNTIL(is_started(app2, Cp3)),
+ ?line ok = get_start_type(#st{normal = 6, failover = 3}),
+
+ % Restart cp2 and make sure it takesover app1, app2 and app_sp
+ ?line {ok, Cp2_2} = start_node_boot_config(Ncp2, NoSyncTime, Conf, latest),
+ ?line global:sync(),
+ ?line ?UNTIL(is_started(app_sp, Cp2_2)),
+ ?line ?UNTIL(is_started(app1, Cp2_2)),
+ ?line ?UNTIL(is_started(app2, Cp2_2)),
+ ?line ?UNTIL(not is_started(app_sp, Cp3)),
+ ?line ?UNTIL(not is_started(app1, Cp3)),
+ ?line ?UNTIL(not is_started(app2, Cp3)),
+ ?line ok = get_start_type(#st{takeover = 9}),
+
+ % Restart cp1 and make sure it takesover app1, app2
+ ?line {ok, Cp1_3} = start_node_boot_config(Ncp1, NoSyncTime, Conf, latest),
+ ?line global:sync(),
+ ?line ?UNTIL(is_started(app1, Cp1_3)),
+ ?line ?UNTIL(is_started(app2, Cp1_3)),
+ ?line false = is_started(app_sp, Cp1_3),
+ ?line true = is_started(app_sp, Cp2_2),
+ ?line ?UNTIL(not is_started(app1, Cp2_2)),
+ ?line ?UNTIL(not is_started(app2, Cp2_2)),
+ ?line ok = get_start_type(#st{takeover = 6}),
+
+ % Force takeover to cp1
+ ?line ok = rpc:call(Cp1_3, application, takeover, [app_sp, permanent]),
+ ?line ?UNTIL(is_started(app_sp, Cp1_3)),
+ ?line ?UNTIL(not is_started(app_sp, Cp2_2)),
+ ?line ok = get_start_type(#st{takeover = 3}),
+
+ %% Kill one child process and see that it is started with type local
+ PP = global:whereis_name({ch,3}),
+ exit(PP, kill),
+ ?line ok = get_start_type(#st{local = 1}),
+
+ global:send(st_type, kill),
+
+ stop_node_nice(Cp1_3),
+ stop_node_nice(Cp2_2),
+ stop_node_nice(Cp3),
+
+ ?line ok = file:delete("latest.boot"),
+ ?line ok = file:delete("latest.rel"),
+ ?line ok = file:delete("latest.script"),
+
+ ok.
+
+permit_false_start_local(doc) ->
+ ["Start local applications with permission false. Set",
+ "permit true on different nodes."];
+permit_false_start_local(suite) -> [];
+permit_false_start_local(Conf) when is_list(Conf) ->
+ %% This configuration does not start dist_ac.
+ Config = write_config_file(fun config_perm/1, Conf),
+
+ % Test [cp1, cp2, cp3]
+ [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ ?line {ok, Cp1} = start_node(Ncp1, Config),
+ ?line {ok, Cp2} = start_node(Ncp2, Config),
+ ?line {ok, Cp3} = start_node(Ncp3, Config),
+ ?line wait_for_ready_net(),
+
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2, Cp3], application, load, [app1()]),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2, Cp3], application, start, [app1, permanent]),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2, Cp3], application, load, [app2()]),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2, Cp3], application, start, [app2, permanent]),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2, Cp3], application, load, [app3()]),
+
+ test_server:sleep(1000),
+ ?line false = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ %Permit a not started application
+ ?line ok = rpc:call(Cp1, application, permit, [app3, true]),
+ test_server:sleep(1000),
+ ?line false = is_started(app3, Cp1),
+ ?line false = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ %Permit a not loaded application
+ ?line {error,{not_loaded,app_notloaded}} =
+ rpc:call(Cp1, application, permit, [app_notloaded, true]),
+ test_server:sleep(1000),
+ ?line false = is_started(app_notloaded, Cp1),
+ ?line false = is_started(app_notloaded, Cp2),
+ ?line false = is_started(app_notloaded, Cp3),
+
+ %Unpermit a not started application
+ ?line ok = rpc:call(Cp1, application, permit, [app3, false]),
+ test_server:sleep(1000),
+ ?line false = is_started(app3, Cp1),
+ ?line false = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ %Unpermit a not loaded application
+ ?line {error,{not_loaded,app_notloaded}} =
+ rpc:call(Cp1, application, permit, [app_notloaded, false]),
+ test_server:sleep(1000),
+ ?line false = is_started(app_notloaded, Cp1),
+ ?line false = is_started(app_notloaded, Cp2),
+ ?line false = is_started(app_notloaded, Cp3),
+
+ % Permit app1 on CP1 and make sure it is started
+ ?line ok = rpc:call(Cp1, application, permit, [app1, true]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Permit it again
+ ?line ok = rpc:call(Cp1, application, permit, [app1, true]),
+ test_server:sleep(1000),
+ ?line true = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Permit app2 on CP1 and make sure it is started
+ ?line ok = rpc:call(Cp1, application, permit, [app2, true]),
+ ?line ?UNTIL(is_started(app2, Cp1)),
+ ?line false = is_started(app2, Cp2),
+ ?line false = is_started(app2, Cp3),
+
+ % Permit app1 on CP2 and make sure it is started
+ ?line ok = rpc:call(Cp2, application, permit, [app1, true]),
+ ?line ?UNTIL(is_started(app1, Cp2)),
+ ?line true = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp3),
+
+ % Unpermit app1 on CP1 and make sure it is stopped
+ ?line ok = rpc:call(Cp1, application, permit, [app1, false]),
+ ?line ?UNTIL(false =:= is_started(app1, Cp1)),
+ ?line true = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Unpermit it agin
+ ?line ok = rpc:call(Cp1, application, permit, [app1, false]),
+ test_server:sleep(1000),
+ ?line false = is_started(app1, Cp1),
+ ?line true = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Permit app1 on CP1 and make sure it is started
+ ?line ok = rpc:call(Cp1, application, permit, [app1, true]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line true = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Unpermit app1 on CP1 and make sure it is stopped
+ ?line ok = rpc:call(Cp1, application, permit, [app1, false]),
+ ?line ?UNTIL(false =:= is_started(app1, Cp1)),
+ ?line true = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Unpermit app1 on CP2 and make sure it is stopped
+ ?line ok = rpc:call(Cp2, application, permit, [app1, false]),
+ test_server:sleep(1000),
+ ?line ?UNTIL(false =:= is_started(app1, Cp2)),
+ ?line false = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp3),
+
+ % Unpermit app2 on CP1 and make sure it is stopped
+ ?line ok = rpc:call(Cp1, application, permit, [app2, false]),
+ ?line ?UNTIL(false =:= is_started(app2, Cp2)),
+ ?line false = is_started(app2, Cp1),
+ ?line false = is_started(app2, Cp3),
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp2),
+ stop_node_nice(Cp3),
+ ok.
+
+
+permit_false_start_dist(doc) ->
+ ["Start distributed applications with permission false. Set",
+ "permit true on different nodes."];
+permit_false_start_dist(suite) -> [];
+permit_false_start_dist(Conf) when is_list(Conf) ->
+ NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ NoSyncTime = config_fun_fast(config_perm2(NodeNames)),
+ WithSyncTime = config_fun(config_perm2(NodeNames)),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf),
+ ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf),
+ Cps = [Cp1, Cp2, Cp3],
+ ?line wait_for_ready_net(),
+
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app1()]),
+ ?line ?UNTIL(is_loaded(app1, Cps)),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, start, [app1, permanent]),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app2()]),
+
+ test_server:sleep(1000),
+ ?line false = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ %Permit a not started application
+ ?line ok = rpc:call(Cp1, application, permit, [app2, true]),
+ test_server:sleep(1000),
+ ?line false = is_started(app2, Cp1),
+ ?line false = is_started(app2, Cp2),
+ ?line false = is_started(app2, Cp3),
+
+ %Permit a not loaded application
+ ?line {error,{not_loaded,app3}} =
+ rpc:call(Cp1, application, permit, [app3, true]),
+ test_server:sleep(1000),
+ ?line false = is_started(app3, Cp1),
+ ?line false = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ %Unpermit a not started application
+ ?line ok = rpc:call(Cp1, application, permit, [app2, false]),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2, Cp3], application, start, [app2, permanent]),
+ test_server:sleep(1000),
+ ?line false = is_started(app2, Cp1),
+ ?line false = is_started(app2, Cp2),
+ ?line false = is_started(app2, Cp3),
+
+ %Unpermit a not loaded application
+ ?line {error,{not_loaded,app3}} =
+ rpc:call(Cp1, application, permit, [app3, false]),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app3()]),
+ ?line ?UNTIL(is_loaded(app3, Cps)),
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall(Cps, application, start, [app3, permanent]),
+ test_server:sleep(1000),
+ ?line false = is_started(app3, Cp1),
+ ?line false = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ % Permit app1 on CP1 and make sure it is started
+ ?line ok = rpc:call(Cp1, application, permit, [app1, true]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Permit it again
+ ?line ok = rpc:call(Cp1, application, permit, [app1, true]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Permit app2 on CP1 and make sure it is started
+ ?line ok = rpc:call(Cp1, application, permit, [app2, true]),
+ ?line ?UNTIL(is_started(app2, Cp1)),
+ ?line false = is_started(app2, Cp2),
+ ?line false = is_started(app2, Cp3),
+
+ % Permit app1 on CP2 and make sure it is not started
+ ?line ok = rpc:call(Cp2, application, permit, [app1, true]),
+ test_server:sleep(1000),
+ ?line true = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp2),
+ ?line false = is_started(app1, Cp3),
+
+ % Crash CP1 and make sure app1, but not app2, is started on CP2
+ stop_node_nice(Cp1),
+ ?line ?UNTIL(is_started(app1, Cp2)),
+ ?line false = is_started(app2, Cp2),
+
+ % Restart CP1 again, check nothing is running on it
+ ?line {ok, Cp1_2} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line global:sync(),
+ ?line ok = rpc:call(Cp1_2, application, load, [app1()]),
+ ?line ?UNTIL(is_loaded(app1, Cp1_2)),
+ ?line ok = rpc:call(Cp1_2, application, start, [app1, permanent]),
+ ?line ok = rpc:call(Cp1_2, application, load, [app2()]),
+ ?line ?UNTIL(is_loaded(app2, Cp1_2)),
+ ?line ok = rpc:call(Cp1_2, application, start, [app2, permanent]),
+ ?line ok = rpc:call(Cp1_2, application, load, [app3()]),
+ ?line ?UNTIL(is_loaded(app3, Cp1_2)),
+ ?line ok = rpc:call(Cp1_2, application, start, [app3, permanent]),
+ ?line false = is_started(app1, Cp1_2),
+ ?line false = is_started(app2, Cp1_2),
+
+ % Permit app3 on CP3 and make sure it is started
+ ?line ok = rpc:call(Cp3, application, permit, [app3, true]),
+ ?line ?UNTIL(is_started(app3, Cp3)),
+ ?line false = is_started(app3, Cp1_2),
+ ?line false = is_started(app3, Cp2),
+
+ % Permit app3 on CP1 and make sure it is moved there from CP3
+ ?line ok = rpc:call(Cp1_2, application, permit, [app3, true]),
+ ?line ?UNTIL(is_started(app3, Cp1_2)),
+ ?line false = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ % Unpermit app3 on CP3 and CP1 and make sure it is stopped
+ ?line ok = rpc:call(Cp3, application, permit, [app3, false]),
+ ?line ok = rpc:call(Cp1_2, application, permit, [app3, false]),
+ ?line ?UNTIL(false =:= is_started(app3, Cp1_2)),
+ ?line false = is_started(app3, Cp2),
+ ?line false = is_started(app3, Cp3),
+
+ stop_node_nice(Cp1_2),
+ stop_node_nice(Cp2),
+ stop_node_nice(Cp3),
+ ok.
+
+nodedown_start(doc) ->
+ ["app1 distributed as [cp1, cp2]. Call application:start(app1) on",
+ "cp2, but not on cp1. Kill cp1. Make sure app1 is started on cp2."];
+nodedown_start(suite) -> [];
+nodedown_start(Conf) when is_list(Conf) ->
+ NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf),
+ NoSyncTime = config_fun_fast(config4(NodeNames)),
+ WithSyncTime = config_fun(config4(NodeNames)),
+
+ % Test [cp1, cp2]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, WithSyncTime, Conf),
+ ?line wait_for_ready_net(),
+
+ % Start app1 and make sure cp1 starts it
+ ?line {[ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2], application, load, [app1()]),
+ ?line _ = rpc:cast(Cp2, application, start, [app1, permanent]),
+ test_server:sleep(1000),
+
+ % Crash CP1 and make sure app1 is started on CP2
+ stop_node_nice(Cp1),
+ ?line ?UNTIL(is_started(app1, Cp2)),
+
+ stop_node_nice(Cp2),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Testing of reported bugs and other tickets.
+%%%-----------------------------------------------------------------
+reported_bugs(suite) -> [otp_1586, otp_2078, otp_2012, otp_2718,
+ otp_2973, otp_3002, otp_3184, otp_4066,
+ otp_4227, otp_5363, otp_5606].
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-1586
+%% Slogan: recursive load of applications fails
+%%-----------------------------------------------------------------
+otp_1586(suite) -> [];
+otp_1586(doc) ->
+ ["Test recursive load of applications."];
+otp_1586(Conf) when is_list(Conf) ->
+ Dir = ?config(priv_dir,Conf),
+ {ok, Fd} = file:open(filename:join(Dir, "app5.app"), write),
+ w_app5(Fd),
+ file:close(Fd),
+ ?line code:add_patha(Dir),
+ ?line ok = application:load(app4()),
+ ?line ok = application:unload(app4),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-2078
+%% Slogan: start of distrib apps fails when the nodes start
+%% simultaneously
+%%-----------------------------------------------------------------
+otp_2078(suite) -> [];
+otp_2078(doc) ->
+ ["Test start of distrib apps fails when the nodes start simultaneously."];
+otp_2078(Conf) when is_list(Conf) ->
+ NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf),
+ NoSyncTime = config_fun_fast(config4(NodeNames)),
+ WithSyncTime = config_fun(config4(NodeNames)),
+
+ % Test [cp1, cp2]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, WithSyncTime, Conf),
+ Cps = [Cp1, Cp2],
+ ?line wait_for_ready_net(),
+
+ % Start app1 and make sure cp1 starts it
+ ?line {[ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app1()]),
+ ?line ?UNTIL(is_loaded(app1, Cps)),
+ ?line ok = rpc:call(Cp1, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+
+ % Start app1 on cp2; make sure it works (the bug was that this start
+ % returned error)
+ ?line ok = rpc:call(Cp2, application, start, [app1, permanent]),
+ ?line true = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp2),
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp2),
+ ok.
+
+otp_2012(suite) -> [];
+otp_2012(doc) ->
+ ["Test change of configuration parameters without changing code."];
+otp_2012(Conf) when is_list(Conf) ->
+ %% start a help process to check the config change
+ CcPid = spawn_link(?MODULE, conf_change, []),
+ ?line yes = global:register_name(conf_change, CcPid),
+
+ % Write a .app file
+ {ok, Fd} = file:open("app1.app", write),
+ w_app1(Fd),
+ file:close(Fd),
+ {ok, Fd2} = file:open("app2.app", write),
+ w_app1(Fd2),
+ file:close(Fd2),
+
+ % Start app1
+ ?line ok = application:load(app1()),
+ ?line ok = application:start(app1, permanent),
+
+ %% Read the current configuration parameters, and change them
+ EnvBefore = application_controller:prep_config_change(),
+ application_controller:test_change_apps([app1],[[{app1,[{new1, hi},
+ {new2, moi}]}]]),
+ ?line ok = application_controller:config_change(EnvBefore),
+ ?line ok = get_conf_change([{[], [{new1, hi}, {new2, moi}], []}]),
+
+ % Start app2
+ ?line ok = application:load(app2()),
+ ?line ok = application:start(app2, permanent),
+
+ %% Read the current configuration parameters, and change them again
+ EnvBefore2 = application_controller:prep_config_change(),
+ application_controller:test_change_apps([app1],[[{app1,[{new1, hello},
+ {new3, mors}]}]]),
+ application_controller:test_change_apps([app2],[[{app2,[{new1, si},
+ {new2, no}]}]]),
+ _EnvBefore22 = application_controller:prep_config_change(),
+ ?line ok = application_controller:config_change(EnvBefore2),
+
+ ?line ok = get_conf_change([{[],[{new1,si},{new2,no}],[]},
+ {[{new1,hello}],[{new3,mors}],[new2]}]),
+
+ ?line ok = application:stop(app1),
+ ?line ok = application:stop(app2),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-2718
+%% Slogan: transient app which fails during start is ignored
+%%-----------------------------------------------------------------
+otp_2718(suite) -> [];
+otp_2718(doc) ->
+ ["Test fail of transient app at start."];
+otp_2718(Conf) when is_list(Conf) ->
+ ?line {ok, Cp1} = start_node_args(cp1, "-pa " ++ ?config(data_dir,Conf)),
+ ?line wait_for_ready_net(),
+
+ %% normal exit from the application
+ ?line ok = rpc:call(Cp1, application, load, [app_trans_normal()]),
+ ?line ?UNTIL(is_loaded(trans_normal, Cp1)),
+ ?line {error, {{'EXIT',normal},_}} =
+ rpc:call(Cp1, application, start, [trans_normal, transient]),
+ test_server:sleep(2000),
+ ?line false = is_started(trans_normal, Cp1),
+
+ %% abnormal exit from the application
+ ?line ok = rpc:call(Cp1, application, load, [app_trans_abnormal()]),
+ ?line {error, {bad_return,{{trans_abnormal_sup,start,[normal,[]]},
+ {'EXIT',abnormal}}}} =
+ rpc:call(Cp1, application, start, [trans_abnormal, transient]),
+ test_server:sleep(3000),
+ ?line {badrpc,nodedown} = which_applications(Cp1),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-2973
+%% Slogan: application:start does not test if an appl is already starting...
+%%-----------------------------------------------------------------
+otp_2973(suite) -> [];
+otp_2973(doc) ->
+ ["Test of two processes simultanously starting the same application."];
+otp_2973(Conf) when is_list(Conf) ->
+ % Write a .app file
+ {ok, Fd} = file:open("app0.app", write),
+ w_app(Fd, app0()),
+ file:close(Fd),
+
+ ?line Pid1 = spawn_link(?MODULE, init2973, []),
+ ?line Pid2 = spawn_link(?MODULE, init2973, []),
+
+ ?line Pid1 ! {start, self(), app0},
+ ?line Pid2 ! {start, self(), app0},
+
+ ?line {Res1, Res2} = receive
+ {Pid1, res, Res1x} ->
+ receive
+ {Pid2, res, Res2x} ->
+ {Res1x, Res2x}
+ after 2000 ->
+ ?line test_server:fail(timeout_pid2)
+ end;
+ {Pid2, res, Res2x} ->
+ receive
+ {Pid1, res, Res1x} ->
+ {Res1x, Res2x}
+ after 2000 ->
+ ?line test_server:fail(timeout_pid1)
+ end
+ end,
+
+ %% Stop it. Inteferes with other global.
+ ?line ok = application:stop(app0),
+
+ %% Test result.
+ case {Res1, Res2} of
+ {ok, ok} ->
+ ok;
+ _ ->
+ ?line Txt = io_lib:format("Illegal results from start: ~p ~p ",
+ [Res1, Res2]),
+ ?line test_server:fail(lists:flatten(Txt))
+ end,
+
+
+ % Write a .app file
+ ?line {ok, Fda} = file:open("app_start_error.app", write),
+ ?line w_app_start_error(Fda),
+ ?line file:close(Fda),
+
+ ?line Pid1 ! {start, self(), app_start_error},
+ ?line Pid2 ! {start, self(), app_start_error},
+
+ ?line {Res1a, Res2a} = receive
+ {Pid1, res, Res1y} ->
+ receive
+ {Pid2, res, Res2y} ->
+ {Res1y, Res2y}
+ after 2000 ->
+ ?line test_server:fail(timeout_pid2)
+ end;
+ {Pid2, res, Res2y} ->
+ receive
+ {Pid1, res, Res1y} ->
+ {Res1y, Res2y}
+ after 2000 ->
+ ?line test_server:fail(timeout_pid1)
+ end
+ end,
+
+ case {Res1a, Res2a} of
+ {{error,{'start error',{app_start_error,start,[normal,[]]}}},
+ {error,{'start error',{app_start_error,start,[normal,[]]}}}} ->
+ ok;
+ _ ->
+ ?line Txta = io_lib:format("Illegal results from start ~p ~p ",[Res1a, Res2a]),
+ ?line test_server:fail(lists:flatten(Txta))
+ end,
+
+ ok.
+
+
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-3184
+%% Slogan: crash the node if permanent appl has illegal env parameter values
+%%-----------------------------------------------------------------
+otp_3184(suite) -> [];
+otp_3184(doc) ->
+ ["When a distributed application is started the permit flag is checked "
+ "that the permit flag is not changed during the start. "
+ "Te check must only be made if the application is started on the own node"];
+otp_3184(Conf) when is_list(Conf) ->
+ NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf),
+ NoSyncTime = config_fun_fast(config3184(NodeNames)),
+ WithSyncTime = config_fun(config3184(NodeNames)),
+
+ % Test [cp1, cp2]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, WithSyncTime, Conf),
+ ?line wait_for_ready_net(),
+
+ % Start app1 and make sure it is not started
+ ?line {[ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2], application, load, [app1()]),
+ test_server:sleep(3000),
+ ?line false = is_started(app1, Cp1),
+ ?line false = is_started(app1, Cp2),
+
+ % Start app1 on cp1
+ ?line ok = rpc:call(Cp1, application, permit, [app1, true]),
+ ?line ok = rpc:call(Cp1, application, start, [app1, permanent]),
+ ?line ok = rpc:call(Cp2, application, start, [app1, permanent]),
+ ?line ?UNTIL(is_started(app1, Cp1)),
+ ?line false = is_started(app1, Cp2),
+
+ % Check that the application is marked as running in application_controller
+ ?line X = rpc:call(Cp1, application_controller, info, []),
+ ?line {value, {running, Xrunning}} = lists:keysearch(running, 1, X),
+ ?line {value, Xapp1} = lists:keysearch(app1, 1, Xrunning),
+ ?line {app1, _Xpid} = Xapp1,
+
+ ?line Y = rpc:call(Cp2, application_controller, info, []),
+ ?line {value, {running, Yrunning}} = lists:keysearch(running, 1, Y),
+ ?line {value, Yapp1} = lists:keysearch(app1, 1, Yrunning),
+ ?line {app1, {distributed, Cp1}} = Yapp1,
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp2),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-3002
+%% Slogan: crash the node if permanent appl has illegal env parameter values
+%%-----------------------------------------------------------------
+otp_3002(suite) -> [];
+otp_3002(doc) ->
+ ["crash the node if permanent appl has illegal env parameter values."];
+otp_3002(Conf) when is_list(Conf) ->
+ % Create the boot script
+ ?line {{KernelVer,StdlibVer}, {LatestDir, LatestName}} =
+ create_script_3002("script_3002"),
+ ?t:format(0, "LatestDir = ~p~n", [LatestDir]),
+ ?t:format(0, "LatestName = ~p~n", [LatestName]),
+
+ ?line case is_real_system(KernelVer, StdlibVer) of
+ true ->
+ Options = [];
+ false ->
+ Options = [local]
+ end,
+
+ ?line ok = systools:make_script("script_3002", Options),
+ ?line ok = systools:script2boot("script_3002"),
+
+ ?line {error, timeout} = start_node_boot_3002(cp1, "script_3002"),
+
+ ?line ok = file:delete("script_3002.boot"),
+ ?line ok = file:delete("script_3002.rel"),
+ ?line ok = file:delete("script_3002.script"),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-4066
+%% Slogan: dist_ac crashed if a distributed application that it
+%% didn't know of was stopped by another dist_ac (bad_match
+%% when it received dist_ac_app_stopped).
+%%-----------------------------------------------------------------
+
+otp_4066(suite) -> [];
+otp_4066(doc) -> ["Check that application stop don't cause dist_ac crash"];
+otp_4066(Conf) when is_list(Conf) ->
+ % Write config files
+ [Ncp1, Ncp2] = node_names([cp1, cp2], Conf),
+ Host = from($@, atom_to_list(node())),
+ Cp1 = list_to_atom(Ncp1 ++ "@" ++ Host),
+ Cp2 = list_to_atom(Ncp2 ++ "@" ++ Host),
+ AllNodes = [Cp1, Cp2],
+ App1Nodes = {app1, AllNodes},
+
+ Dir = ?config(priv_dir,Conf),
+ ?line {ok, FdC} = file:open(filename:join(Dir, "otp_4066.config"), write),
+ ?line write_config(FdC, config_4066(AllNodes, 5000, [App1Nodes])),
+ ?line file:close(FdC),
+
+ % Write the app1.app file
+ ?line {ok, FdA12} = file:open(filename:join(Dir, "app1.app"), write),
+ ?line w_app1(FdA12),
+ ?line file:close(FdA12),
+
+ Args1 = "-pa " ++ Dir ++ " -config " ++ filename:join(Dir, "otp_4066"),
+ Args2 = "-pa " ++ Dir ++ " -kernel start_dist_ac true",
+
+ ?line {ok, Cp2} = start_node_args(Ncp2, Args2),
+ %% Cp1 syncs with cp2 (which is known to be up).
+ ?line {ok, Cp1} = start_node_args(Ncp1, Args1),
+ ?line wait_for_ready_net(),
+
+ ?line ok = rpc:call(Cp1, application, start, [app1]),
+ ?line wait_until_started(app1, [Cp1]),
+ ?line test_server:format("--- App1 started at Cp1 ---~n", []),
+ ?line print_dac_state(AllNodes),
+
+ % Cp2 previously crashed on this stop
+ ?line ok = rpc:call(Cp1, application, stop, [app1]),
+ ?line wait_until_stopped(app1, [Cp1]),
+ ?line test_server:format("--- App1 stopped at Cp1 ---~n", []),
+ ?line print_dac_state(AllNodes),
+
+ ?line ok = rpc:call(Cp1, application, start, [app1]),
+ ?line wait_until_started(app1, [Cp1]),
+ ?line test_server:format("--- App1 started at Cp1 ---~n", []),
+ ?line print_dac_state(AllNodes),
+
+ ?line ok = rpc:call(Cp2, application, load, [app1, App1Nodes]),
+ ?line ok = rpc:call(Cp2, application, start, [app1]),
+ ?line test_server:format("--- App1 started at Cp2 ---~n", []),
+ ?line print_dac_state(AllNodes),
+
+
+ ?line stop_node_nice(Cp1),
+ ?line wait_until_started(app1, [Cp2]),
+ ?line test_server:format("--- Cp1 crashed; failover to Cp2 ---~n", []),
+ ?line print_dac_state(Cp2),
+
+ ?line stop_node_nice(Cp2),
+ ok.
+
+config_4066(SyncNodesOptional, SyncNodesTimeout, Distributed) ->
+ [{kernel, [{sync_nodes_optional,SyncNodesOptional},
+ {sync_nodes_timeout, SyncNodesTimeout},
+ {distributed, Distributed}]}].
+
+write_config(Fd, Config) ->
+ io:format(Fd, "~p.~n", [Config]).
+
+print_dac_state(Node) when is_atom(Node) ->
+ State = gen_server:call({dist_ac, Node}, info),
+ test_server:format(" * dist_ac state on node ~p:~n ~p~n",
+ [Node, State]);
+print_dac_state(Nodes) when is_list(Nodes) ->
+ lists:foreach(fun (N) -> print_dac_state(N) end, Nodes).
+
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-4227
+%% Slogan: Bad return value from application.
+%%-----------------------------------------------------------------
+otp_4227(suite) -> [];
+otp_4227(doc) ->
+ ["Test start of depending app when required app crashed."];
+otp_4227(Conf) when is_list(Conf) ->
+ NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf),
+ NoSyncTime = config_fun_fast(config_4227(NodeNames)),
+ WithSyncTime = config_fun(config_4227(NodeNames)),
+
+ %% Test [cp1, cp2]
+ ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf),
+ ?line {ok, Cp2} = start_node_config(Ncp2, WithSyncTime, Conf),
+ Cps = [Cp1, Cp2],
+ ?line wait_for_ready_net(),
+
+ %% Try to start app10 which should fail since app9 is not started
+ ?line {[ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app9()]),
+ ?line ?UNTIL(is_loaded(app9, Cps)),
+ ?line {[ok,ok],[]} =
+ rpc:multicall(Cps, application, load, [app10_dep9()]),
+ ?line {error, {not_started, app9}} =
+ rpc:call(Cp1, application, start, [app10]),
+
+ %% Start app9 and brutally kill it, then try to start app10
+ ?line ok = rpc:call(Cp1, application, start, [app9]),
+ ?line test_server:sleep(1000),
+ ?line Pid9 = rpc:call(Cp1, erlang, whereis, [ch_sup19]),
+ ?line true = erlang:is_pid(Pid9),
+ ?line true = erlang:exit(Pid9, kill),
+ ?line test_server:sleep(1000),
+
+ %% This gave {error, no_report} before the patch
+ ?line {error, {not_running, app9}} =
+ rpc:call(Cp1, application, start, [app10]),
+
+ ?line stop_node_nice(Cp1),
+ ?line stop_node_nice(Cp2),
+ ok.
+
+config_4227([Ncp1, Ncp2]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd,
+ "[{kernel, "
+ " [{sync_nodes_optional, ['~s@~s','~s@~s']},"
+ " {sync_nodes_timeout, ~w},"
+ " {start_dist_ac, true},"
+ " {distributed, "
+ " [{app9, ['~s@~s','~s@~s']}, "
+ " {app10, ['~s@~s','~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M,
+ SyncNodesTimeout,
+ Ncp1, M, Ncp2, M,
+ Ncp1, M, Ncp2, M])
+ end.
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-5363
+%% Slogan: Slow termination in application_master
+%%-----------------------------------------------------------------
+otp_5363(Conf) when is_list(Conf) ->
+ %% When stopping an application, all processes having the
+ %% application master as group leader should get killed.
+ %% The killing was done in an inefficient way.
+ %% In this test case, we will not test the efficiency of
+ %% the code, but only that the correct processes ARE killed.
+
+ OldPath = code:get_path(),
+ code:add_patha(?config(data_dir,Conf)),
+ try
+ ?line ok = application:load(app_group_leader()),
+ ?line ok = application:start(group_leader),
+ ?line case whereis(nisse) of
+ Pid when is_pid(Pid) ->
+ ?line Mref = erlang:monitor(process, Pid),
+ ?line ok = application:stop(group_leader),
+ receive
+ {'DOWN',Mref,_,_,_} -> ok
+ end,
+ ?line undefined = whereis(nisse);
+ Bad ->
+ ?line io:format("~p\n", [Bad]),
+ ?t:fail()
+ end
+ after
+ code:set_path(OldPath)
+ end,
+ ok.
+
+%%-----------------------------------------------------------------
+%% Ticket: OTP-5606
+%% Slogan: Problems with starting a distributed application
+%%-----------------------------------------------------------------
+otp_5606(suite) -> [];
+otp_5606(doc) ->
+ ["Test of several processes simultanously starting the same "
+ "distributed application."];
+otp_5606(Conf) when is_list(Conf) ->
+
+ %% Write a config file
+ Dir = ?config(priv_dir, Conf),
+ {ok, Fd} = file:open(filename:join(Dir, "sys.config"), write),
+ NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf),
+ (config4(NodeNames))(Fd, 10000),
+ file:close(Fd),
+ Config = filename:join(Dir, "sys"),
+
+ %% Test [cp1, cp2]
+ ?line {ok, Cp1} = start_node(Ncp1, Config),
+ ?line {ok, Cp2} = start_node(Ncp2, Config),
+ Cps = [Cp1, Cp2],
+ ?line wait_for_ready_net(),
+
+ %% Load app1 on both nodes
+ ?line {[ok, ok], []} =
+ rpc:multicall(Cps, application, load, [app1()]),
+
+ %% Attempt to start app1 from different processes simultaneously
+ ?line Pid11 = spawn_link(Cp1, ?MODULE, loop5606, [self()]),
+ ?line Pid12 = spawn_link(Cp1, ?MODULE, loop5606, [self()]),
+ ?line Pid13 = spawn_link(Cp1, ?MODULE, loop5606, [self()]),
+ ?line Pid2 = spawn_link(Cp2, ?MODULE, loop5606, [self()]),
+
+ ?line Pid2 ! start,
+ ?line Pid11 ! start,
+ ?line Pid12 ! start,
+ ?line Pid13 ! start,
+
+ ResL = otp_5606_loop([]),
+
+ case ResL of
+ [ok, ok, ok, ok] ->
+ ok;
+ [Res1, Res2, Res3, Res4] ->
+ Txt = io_lib:format("Illegal results from start ~p ~p ~p ~p",
+ [Res1, Res2, Res3, Res4]),
+ ?line test_server:fail(lists:flatten(Txt))
+ end,
+
+ ?line {error, {already_started, app1}} =
+ rpc:call(Cp1, application, start, [app1]),
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp2),
+ ok.
+
+otp_5606_loop(ResL) when length(ResL)<4 ->
+ receive
+ {_Pid, Res} ->
+ otp_5606_loop([Res|ResL])
+ after 5000 ->
+ ?line test_server:fail(timeout_waiting_for_res)
+ end;
+otp_5606_loop(ResL) ->
+ ResL.
+
+loop5606(Pid) ->
+ receive
+ start ->
+ Res = application:start(app1),
+ Pid ! {self(), Res}
+ end.
+
+
+%%-----------------------------------------------------------------
+%% Should be started in a CC view with:
+%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3]
+%%-----------------------------------------------------------------
+get_key(suite) -> [];
+get_key(doc) ->
+ ["Tests read the .app keys."];
+get_key(Conf) when is_list(Conf) ->
+ NodeNames = [Ncp1, _Ncp2, _Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ WithSyncTime = config_fun(config_inc(NodeNames)),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_config(Ncp1, WithSyncTime, Conf),
+
+ ?line ok = rpc:call(Cp1, application, load, [appinc(), d3(NodeNames)]),
+ ?line ?UNTIL(is_loaded(appinc, Cp1)),
+ ?line ok = rpc:call(Cp1, application, start, [appinc, permanent]),
+ ?line ?UNTIL(is_started(appinc, Cp1)),
+
+ ?line {ok, "Test of new app file, including appnew"} =
+ rpc:call(Cp1, application, get_key, [appinc, description]),
+ ?line {ok, "CXC 138 ai"} = rpc:call(Cp1, application, get_key, [appinc ,id]),
+ ?line {ok, "2.0"} = rpc:call(Cp1, application, get_key, [appinc, vsn]),
+ ?line {ok, [kernel]} = rpc:call(Cp1, application, get_key, [appinc, applications]),
+ ?line {ok, [appinc1, appinc2]} =
+ rpc:call(Cp1, application, get_key, [appinc, included_applications]),
+ ?line {ok, []} = rpc:call(Cp1, application, get_key, [appinc, registered]),
+ ?line {ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} =
+ rpc:call(Cp1, application, get_key, [appinc, start_phases]),
+ ?line {ok, Env} = rpc:call(Cp1, application, get_key, [appinc ,env]),
+ ?line [{included_applications,[appinc1,appinc2]},
+ {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ ?line {ok, []} = rpc:call(Cp1, application, get_key, [appinc, modules]),
+ ?line {ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} =
+ rpc:call(Cp1, application, get_key, [appinc, mod]),
+ ?line {ok, infinity} = rpc:call(Cp1, application, get_key, [appinc, maxP]),
+ ?line {ok, infinity} = rpc:call(Cp1, application, get_key, [appinc, maxT]),
+ ?line undefined = rpc:call(Cp1, application, get_key, [appinc, very_unknown]),
+
+ ?line {ok, [{description, "Test of new app file, including appnew"},
+ {id, "CXC 138 ai"},
+ {vsn, "2.0"},
+ {modules, []},
+ {maxP, infinity},
+ {maxT, infinity},
+ {registered, []},
+ {included_applications, [appinc1, appinc2]},
+ {applications, [kernel]},
+ {env, Env},
+ {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }},
+ {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} =
+ rpc:call(Cp1, application, get_all_key, [appinc]),
+ ?line [{included_applications,[appinc1,appinc2]},
+ {own2,val2},{own_env1,value1}] = lists:sort(Env),
+
+ ?line {ok, "Test of new app file, including appnew"} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, description}),
+ ?line {ok, "CXC 138 ai"} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, id}),
+ ?line {ok, "2.0"} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, vsn}),
+ ?line {ok, [kernel]} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, applications}),
+ ?line {ok, [appinc1, appinc2]} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, included_applications}),
+ ?line {ok, []} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, registered}),
+ ?line {ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, start_phases}),
+ ?line {ok, Env} = gen_server:call({global, {ch,41}}, {get_pid_key, env}),
+ ?line [{included_applications,[appinc1,appinc2]},
+ {own2,val2},{own_env1,value1}] = lists:sort(Env),
+ ?line {ok, []} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, modules}),
+ ?line {ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, mod}),
+ ?line {ok, infinity} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, maxP}),
+ ?line {ok, infinity} =
+ gen_server:call({global, {ch,41}}, {get_pid_key, maxT}),
+ ?line undefined =
+ gen_server:call({global, {ch,41}}, {get_pid_key, very_unknown}),
+
+
+
+ ?line {ok, [{description, "Test of new app file, including appnew"},
+ {id, "CXC 138 ai"},
+ {vsn, "2.0"},
+ {modules, []},
+ {maxP, infinity},
+ {maxT, infinity},
+ {registered, []},
+ {included_applications, [appinc1, appinc2]},
+ {applications, [kernel]},
+ {env, Env},
+ {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }},
+ {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} =
+ gen_server:call({global, {ch,41}}, get_pid_all_key),
+ ?line [{included_applications,[appinc1,appinc2]},
+ {own2,val2},{own_env1,value1}] = lists:sort(Env),
+
+ stop_node_nice(Cp1),
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Testing of change of distributed parameter.
+%%%-----------------------------------------------------------------
+distr_changed(suite) -> [distr_changed_tc1, distr_changed_tc2].
+
+distr_changed_tc1(suite) -> [];
+distr_changed_tc1(doc) -> ["Test change of distributed parameter."];
+distr_changed_tc1(Conf) when is_list(Conf) ->
+
+ {OldKernel, OldEnv, {Cp1, Cp2, Cp3}, {_Ncp1, _Ncp2, _Ncp3}, _Config2} =
+ distr_changed_prep(Conf),
+
+ ?line NewDist = {distributed, [{app1, [Cp3]},
+ {app2, 5000, [Cp2]},
+ {app3, [Cp3, {Cp1, Cp2}]},
+ {app6, [Cp1, {Cp3, Cp2}]},
+ {app7, 1000, [Cp3]},
+ {app8, [Cp1, {Cp2, Cp3}]}]},
+
+ ?line NewKernel = [{kernel, lists:keyreplace(distributed, 1, OldKernel, NewDist)}],
+ ?line ok = rpc:call(Cp1, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(Cp2, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(Cp3, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2, Cp3],
+ application_controller, config_change, [OldEnv]),
+
+ ?line test_server:sleep(7000),
+
+ ?line DcInfo1 = rpc:call(Cp1, dist_ac, info, []),
+ ?line DcInfo2 = rpc:call(Cp2, dist_ac, info, []),
+ ?line DcInfo3 = rpc:call(Cp3, dist_ac, info, []),
+
+ ?line DcWa1 = which_applications(Cp1),
+ ?line DcWa2 = which_applications(Cp2),
+ ?line DcWa3 = which_applications(Cp3),
+
+ ?line Wa1 = lists:foldl(fun({A1, _N1, _V1}, AccIn) -> [A1 | AccIn] end,
+ [], DcWa1),
+ ?line Wa2 = lists:foldl(fun({A2, _N2, _V2}, AccIn) -> [A2 | AccIn] end,
+ [], DcWa2),
+ ?line Wa3 = lists:foldl(fun({A3, _N3, _V3}, AccIn) -> [A3 | AccIn] end,
+ [], DcWa3),
+ ?line case lists:sort(Wa1) of
+ [app1, app2, app3, kernel, stdlib] ->
+ ok;
+ EWa1 ->
+ X1 = io_lib:format("distribution error: Cp1 ~p ",[EWa1]),
+ ?line test_server:fail(lists:flatten(X1))
+ end,
+
+ ?line case lists:sort(Wa2) of
+ [app6, app8, kernel, stdlib] ->
+ ok;
+ EWa2 ->
+ X2 = io_lib:format("distribution error: Cp2 ~p ",[EWa2]),
+ ?line test_server:fail(lists:flatten(X2))
+ end,
+
+ ?line case lists:sort(Wa3) of
+ [app7, kernel, stdlib] ->
+ ok;
+ EWa3 ->
+ X3 = io_lib:format("distribution error: Cp3 ~p ",[EWa3]),
+ ?line test_server:fail(lists:flatten(X3))
+ end,
+
+ ?line DcInfo1n = rpc:call(Cp1, dist_ac, info, []),
+ ?line DcInfo2n = rpc:call(Cp2, dist_ac, info, []),
+ ?line DcInfo3n = rpc:call(Cp3, dist_ac, info, []),
+
+ %% Added afterwards. Got rid of some warnings for unused variables.
+ ?line true = DcInfo1 =:= DcInfo1n,
+ ?line true = DcInfo2 =:= DcInfo2n,
+ ?line true = DcInfo3 =:= DcInfo3n,
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp2),
+ stop_node_nice(Cp3),
+
+ ?line ok = file:delete("dc.boot"),
+ ?line ok = file:delete("dc.rel"),
+ ?line ok = file:delete("dc.script"),
+
+ ok.
+
+distr_changed_tc2(suite) -> [];
+distr_changed_tc2(doc) -> ["Test change of distributed parameter, "
+ "move appls by crashing a node."];
+distr_changed_tc2(Conf) when is_list(Conf) ->
+
+ {OldKernel, OldEnv, {Cp1, Cp2, Cp3}, {Ncp1, _Ncp2, _Ncp3}, Config2} =
+ distr_changed_prep(Conf),
+
+ ?line NewDist = {distributed, [{app1, [Cp3]},
+ {app2, 5000, [Cp2]},
+ {app3, [Cp3, {Cp1, Cp2}]},
+ {app6, [Cp1, {Cp3, Cp2}]},
+ {app7, 1000, [Cp3]},
+ {app8, [Cp1, {Cp2, Cp3}]}]},
+
+ ?line NewKernel = [{kernel, lists:keyreplace(distributed, 1, OldKernel, NewDist)}],
+ ?line ok = rpc:call(Cp1, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(Cp2, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(Cp3, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+
+ ?line {[ok,ok,ok],[]} =
+ rpc:multicall([Cp1, Cp2, Cp3],
+ application_controller, config_change, [OldEnv]),
+
+ ?line test_server:sleep(4000),
+ ?line stop_node_nice(Cp1),
+ ?line test_server:sleep(10000),
+
+% ?line _DcInfo1 = rpc:call(Cp1, dist_ac, info, []),
+ ?line _DcInfo2 = rpc:call(Cp2, dist_ac, info, []),
+ ?line _DcInfo3 = rpc:call(Cp3, dist_ac, info, []),
+% ?t:format(0,"#### DcInfo1 ~n~p~n",[_DcInfo1]),
+
+% ?line DcWa1 = which_applications(Cp1),
+ ?line DcWa2 = which_applications(Cp2),
+ ?line DcWa3 = which_applications(Cp3),
+
+% ?line Wa1 = lists:foldl(fun({A1, _N1, _V1}, AccIn) -> [A1 | AccIn] end,
+% [], DcWa1),
+ ?line Wa2 = lists:foldl(fun({A2, _N2, _V2}, AccIn) -> [A2 | AccIn] end,
+ [], DcWa2),
+ ?line Wa3 = lists:foldl(fun({A3, _N3, _V3}, AccIn) -> [A3 | AccIn] end,
+ [], DcWa3),
+
+
+ ?line case lists:sort(Wa2) of
+ [app2, app6, app8, kernel, stdlib] ->
+ ok;
+ EWa2 ->
+ X2 = io_lib:format("distribution error: Cp2 ~p ",[EWa2]),
+ ?line test_server:fail(lists:flatten(X2))
+ end,
+
+ ?line case lists:sort(Wa3) of
+ [app1, app3, app7, kernel, stdlib] ->
+ ok;
+ EWa3 ->
+ X3 = io_lib:format("distribution error: Cp3 ~p ",[EWa3]),
+ ?line test_server:fail(lists:flatten(X3))
+ end,
+
+
+ ?line {ok, Cp1} = start_node_boot(Ncp1, Config2, dc),
+ ?line test_server:sleep(10000),
+
+ ?line _DcInfo1rs = rpc:call(Cp1, dist_ac, info, []),
+ ?line _DcInfo2rs = rpc:call(Cp2, dist_ac, info, []),
+ ?line _DcInfo3rs = rpc:call(Cp3, dist_ac, info, []),
+
+ ?line DcWa1rs = which_applications(Cp1),
+ ?line DcWa2rs = which_applications(Cp2),
+ ?line DcWa3rs = which_applications(Cp3),
+
+ ?line Wa1rs = lists:foldl(fun({A1, _N1, _V1}, AccIn) -> [A1 | AccIn] end,
+ [], DcWa1rs),
+ ?line Wa2rs = lists:foldl(fun({A2, _N2, _V2}, AccIn) -> [A2 | AccIn] end,
+ [], DcWa2rs),
+ ?line Wa3rs = lists:foldl(fun({A3, _N3, _V3}, AccIn) -> [A3 | AccIn] end,
+ [], DcWa3rs),
+
+ ?line case lists:sort(Wa1rs) of
+ [app6, app8, kernel, stdlib] ->
+ ok;
+ EWa1rs ->
+ X1rs = io_lib:format("distribution error: Cp1 ~p ",[EWa1rs]),
+ ?line test_server:fail(lists:flatten(X1rs))
+ end,
+
+ ?line case lists:sort(Wa2rs) of
+ [app2, kernel, stdlib] ->
+ ok;
+ EWa2rs ->
+ X2rs = io_lib:format("distribution error: Cp2 ~p ",[EWa2rs]),
+ ?line test_server:fail(lists:flatten(X2rs))
+ end,
+
+ ?line case lists:sort(Wa3rs) of
+ [app1, app3, app7, kernel, stdlib] ->
+ ok;
+ EWa3rs ->
+ X3rs = io_lib:format("distribution error: Cp3 ~p ",[EWa3rs]),
+ ?line test_server:fail(lists:flatten(X3rs))
+ end,
+
+
+ stop_node_nice(Cp1),
+ stop_node_nice(Cp2),
+ stop_node_nice(Cp3),
+
+ ?line ok = file:delete("dc.boot"),
+ ?line ok = file:delete("dc.rel"),
+ ?line ok = file:delete("dc.script"),
+
+ ok.
+
+
+
+%%%-----------------------------------------------------------------
+%%% Testing of application configuration change
+%%%-----------------------------------------------------------------
+config_change(suite) ->
+ [];
+config_change(doc) ->
+ ["Test change of application configuration"];
+config_change(Conf) when is_list(Conf) ->
+
+ %% Change to data_dir
+ ?line {ok, CWD} = file:get_cwd(),
+ ?line DataDir = ?config(data_dir, Conf),
+ ?line ok = file:set_cwd(DataDir),
+
+ %% Find out application data from boot script
+ ?line Boot = filename:join([code:root_dir(), "bin", "start.boot"]),
+ ?line {ok, Bin} = file:read_file(Boot),
+ ?line Appls = get_appls(binary_to_term(Bin)),
+
+ %% Simulate contents of "sys.config"
+ ?line Config = [{stdlib, [{par1,sys},{par2,sys}]},
+ "t1",
+ "t2.config",
+ filename:join([DataDir, "subdir", "t3"]),
+ {stdlib, [{par6,sys}]}],
+
+ %% Order application_controller to update configuration
+ ?line ok = application_controller:change_application_data(Appls,
+ Config),
+
+ %% Check that stdlib parameters are correctly set
+ ?line Env = application:get_all_env(stdlib),
+ ?line {value, {par1,sys}} = lists:keysearch(par1, 1, Env),
+ ?line {value, {par2,t1}} = lists:keysearch(par2, 1, Env),
+ ?line {value, {par3,t1}} = lists:keysearch(par3, 1, Env),
+ ?line {value, {par4,t2}} = lists:keysearch(par4, 1, Env),
+ ?line {value, {par5,t3}} = lists:keysearch(par5, 1, Env),
+ ?line {value, {par6,sys}} = lists:keysearch(par6, 1, Env),
+
+ ?line ok = file:set_cwd(CWD).
+
+%% This function is stolen from SASL module release_handler, OTP R10B
+get_appls({script, _, Script}) ->
+ get_appls(Script, []).
+
+%% kernel is taken care of separately
+get_appls([{kernelProcess, application_controller,
+ {application_controller, start, [App]}} | T], Res) ->
+ get_appls(T, [App | Res]);
+%% other applications but kernel
+get_appls([{apply, {application, load, [App]}} | T], Res) ->
+ get_appls(T, [App | Res]);
+get_appls([_ | T], Res) ->
+ get_appls(T, Res);
+get_appls([], Res) ->
+ Res.
+
+%%%-----------------------------------------------------------------
+%%% Tests the 'shutdown_func' kernel config parameter
+%%%-----------------------------------------------------------------
+shutdown_func(suite) ->
+ [];
+shutdown_func(doc) ->
+ ["Tests the 'shutdown_func' kernel config parameter"];
+shutdown_func(Config) when is_list(Config) ->
+ ?line {ok,Cp1} = start_node(?MODULE_STRING++"_shutdown_func"),
+ ?line wait_for_ready_net(),
+ ?line Tag = make_ref(),
+ ?line ok = rpc:call(Cp1, application, set_env,
+ [kernel, shutdown_func, {?MODULE, do_shutdown}]),
+ ?line ok = rpc:call(Cp1, application, set_env,
+ [kernel, shutdown_func_test, {self(), Tag}]),
+ ?line _ = rpc:call(Cp1, init, stop, []),
+ ?line receive
+ {Pid, Tag, shutting_down, shutdown} ->
+ ?line Mref = erlang:monitor(process, Pid),
+ ?line Pid ! {self(), Tag, ok},
+ receive
+ {'DOWN', Mref, _, Pid, noconnection} ->
+ ok
+ after 10000 ->
+ test_server:fail(timeout)
+ end
+ after 10000 ->
+ test_server:fail(timeout)
+ end.
+
+
+
+do_shutdown(Reason) ->
+ {ok, {Pid, Tag}} = application:get_env(kernel, shutdown_func_test),
+ Pid ! {self(), Tag, shutting_down, Reason},
+ receive
+ {Pid, Tag, ok} -> ok
+ end.
+
+
+
+%%-----------------------------------------------------------------
+%% Utility functions
+%%-----------------------------------------------------------------
+app0() ->
+ {application, app0,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app0, 77, 80}}}]}.
+
+app1() ->
+ {application, app1,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app1, 1, 3}}}]}.
+
+app2() ->
+ {application, app2,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app2, 4, 6}}}]}.
+
+app3() ->
+ {application, app3,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app3, 7, 9}}}]}.
+
+app4() ->
+ {application, app4,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {applications, [kernel]},
+ {included_applications, [app5]},
+ {mod, {ch_sup, {app3, 7, 9}}}]}.
+
+app5() ->
+ {application, app5,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app3, 7, 9}}}]}.
+
+app6() ->
+ {application, app6,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app6, 10, 12}}}]}.
+
+app7() ->
+ {application, app7,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app7, 13, 15}}}]}.
+
+app8() ->
+ {application, app8,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app7, 16, 18}}}]}.
+
+app9() ->
+ {application, app9,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {ch_sup, {app9, 19, 19}}}]}.
+
+app10_dep9() ->
+ {application, app10,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel, app9]},
+ {mod, {ch_sup, {app10, 20, 20}}}]}.
+
+appinc() ->
+ {application, appinc,
+ [{description, "Test of new app file, including appnew"},
+ {id, "CXC 138 ai"},
+ {vsn, "2.0"},
+ {applications, [kernel]},
+ {modules, []},
+ {registered, []},
+ {env, [{own_env1, value1}, {own2, val2}]},
+ {included_applications, [appinc1, appinc2]},
+ {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]},
+ {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }}]}.
+
+
+app_sp() ->
+ {application, app_sp,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {start_phases, [{init, [kurt]}, {go, [sune]}]},
+ {applications, [kernel]},
+ {modules, []},
+ {registered, []},
+ {mod, {application_starter, [ch_sup, {app_sp, 31, 33}] }}]}.
+
+app_trans_normal() ->
+ {application, trans_normal,
+ [{description, "A CXC 138 11"},
+ {vsn, "1.0"},
+ {modules, [{transient, 1}, {trans_normal_sup,1}]},
+ {registered, [trans_normal_sup]},
+ {applications, [kernel, stdlib]},
+ {mod, {trans_normal_sup, []}}]}.
+
+app_trans_abnormal() ->
+ {application, trans_abnormal,
+ [{description, "A CXC 138 11"},
+ {vsn, "1.0"},
+ {modules, [{transient, 1}, {trans_abnormal_sup,1}]},
+ {registered, [trans_abnormal_sup]},
+ {applications, [kernel, stdlib]},
+ {mod, {trans_abnormal_sup, []}}]}.
+
+app_start_error() ->
+ {application, app_start_error,
+ [{description, "ERTS CXC 138 10"},
+ {vsn, "2.0"},
+ {modules, []},
+ {registered, []},
+ {applications, [kernel]},
+ {mod, {app_start_error, []}}]}.
+
+app_group_leader() ->
+ {application, group_leader,
+ [{description, "GROUP_LEADER CXC 138 11"},
+ {vsn, "1.0"},
+ {modules, [group_leader,group_leader_sup]},
+ {registered, [group_leader_sup]},
+ {applications, [kernel,stdlib]},
+ {mod, {group_leader_sup, []}}]}.
+
+
+d1([Ncp1, Ncp2, Ncp3]) ->
+ M = from($@, atom_to_list(node())),
+ {app1, [list_to_atom(Ncp1 ++ "@" ++ M),
+ list_to_atom(Ncp2 ++ "@" ++ M),
+ list_to_atom(Ncp3 ++ "@" ++ M)]}.
+
+d2([Ncp1, _Ncp2, Ncp3]) ->
+ M = from($@, atom_to_list(node())),
+ {app1, [list_to_atom(Ncp1 ++ "@" ++ M),
+ list_to_atom(Ncp3 ++ "@" ++ M)]}.
+
+d3([Ncp1, Ncp2, Ncp3]) ->
+ M = from($@, atom_to_list(node())),
+ {appinc, [list_to_atom(Ncp1 ++ "@" ++ M),
+ list_to_atom(Ncp2 ++ "@" ++ M),
+ list_to_atom(Ncp3 ++ "@" ++ M)]}.
+
+d_any3(Any, [Ncp1, Ncp2, Ncp3]) ->
+ M = from($@, atom_to_list(node())),
+ {Any, [list_to_atom(Ncp1 ++ "@" ++ M),
+ list_to_atom(Ncp2 ++ "@" ++ M),
+ list_to_atom(Ncp3 ++ "@" ++ M)]}.
+
+
+config([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{distributed, [{app1, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app2, 1000, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app3, 1000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ SyncNodesTimeout, Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M])
+ end.
+
+config2([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{permissions, [{app3, false}]},"
+ "{distributed, [{app1, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app2, 10000, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app3, 5000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ SyncNodesTimeout,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M])
+ end.
+
+config3([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{start_dist_ac, true},"
+ "{permissions, [{app3, false}]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ SyncNodesTimeout])
+ end.
+
+config4([Ncp1, Ncp2]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{start_dist_ac, true},"
+ "{distributed, [{app1, ['~s@~s', '~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, SyncNodesTimeout,
+ Ncp1, M, Ncp2, M])
+ end.
+
+config3184([Ncp1, Ncp2]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{permissions, [{app1, false}]},"
+ "{distributed, [{app1, ['~s@~s', '~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, SyncNodesTimeout,
+ Ncp1, M, Ncp2, M])
+ end.
+
+config_perm(Fd) ->
+ io:format(Fd, "[{kernel, [{permissions, "
+ "[{app1, false}, {app2, false}, {app3, false}]} ]}].~n",[]).
+
+config_perm2([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{permissions, [{app1, false}, {app2, false}, {app3, false}]},"
+ "{distributed, [{app1, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app2, 10000, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app3, 5000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ SyncNodesTimeout,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M])
+ end.
+
+config_inc([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{distributed, [{appinc, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app2, 10000, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app3, 5000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ SyncNodesTimeout,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M])
+ end.
+
+config_sf([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{distributed, [{myApp, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{topApp, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{inclOne, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{inclTwo, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{inclTwoTop, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{incl2A, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{incl2B, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{with, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{wrapper, ['~s@~s', '~s@~s', '~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ SyncNodesTimeout,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M])
+ end.
+
+config_fo([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{distributed, [{app1, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app2, 2000, ['~s@~s', '~s@~s', '~s@~s']},"
+ "{app_sp, 1000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ SyncNodesTimeout,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M])
+ end.
+
+config_dc([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd, SyncNodesTimeout) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, ~w},"
+ "{distributed, [{app1, ['~s@~s', '~s@~s']},"
+ " {app2, 10000, ['~s@~s']},"
+ " {app3, [{'~s@~s', '~s@~s'}]}, "
+ " {app6, [{'~s@~s', '~s@~s'}]}, "
+ " {app7, ['~s@~s']}, "
+ " {app8, ['~s@~s', {'~s@~s', '~s@~s'}]}"
+ " ]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ SyncNodesTimeout,
+ Ncp1, M, Ncp2, M,
+ Ncp1, M,
+ Ncp1, M, Ncp2, M,
+ Ncp3, M, Ncp2, M,
+ Ncp3, M,
+ Ncp2, M, Ncp1, M, Ncp3, M])
+ end.
+
+config_dc2([Ncp1, Ncp2, Ncp3]) ->
+ fun(Fd) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, "
+ "['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, 10000},"
+ "{distributed, [{app1, ['~s@~s']},"
+ " {app2, 5000, ['~s@~s']},"
+ " {app3, ['~s@~s', {'~s@~s', '~s@~s'}]}, "
+ " {app6, ['~s@~s', {'~s@~s', '~s@~s'}]}, "
+ " {app7, 1000, ['~s@~s']}, "
+ " {app8, ['~s@~s', {'~s@~s', '~s@~s'}]}"
+ " ]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncp3, M,
+ Ncp2, M,
+ Ncp3, M, Ncp1, M, Ncp2, M,
+ Ncp1, M, Ncp3, M, Ncp2, M,
+ Ncp3, M,
+ Ncp1, M, Ncp2, M, Ncp3, M])
+ end.
+
+w_app1(Fd) ->
+ io:format(Fd, "~p.\n", [app1()]).
+
+w_app2(Fd) ->
+ io:format(Fd, "~p.\n", [app2()]).
+
+w_app3(Fd) ->
+ io:format(Fd, "~p.\n", [app3()]).
+
+w_app5(Fd) ->
+ io:format(Fd, "~p.\n", [app5()]).
+
+w_app6(Fd) ->
+ io:format(Fd, "~p.\n", [app6()]).
+
+w_app7(Fd) ->
+ io:format(Fd, "~p.\n", [app7()]).
+
+w_app8(Fd) ->
+ io:format(Fd, "~p.\n", [app8()]).
+
+w_app_start_error(Fd) ->
+ io:format(Fd, "~p.\n", [app_start_error()]).
+
+w_app(Fd, AppData) ->
+ io:format(Fd, "~p.\n", [AppData]).
+
+from(H, [H | T]) -> T;
+from(H, [_ | T]) -> from(H, T);
+from(_H, []) -> [].
+
+is_loaded(Name, [Node | Nodes]) ->
+ Apps = rpc:call(Node, application, loaded_applications, []),
+ case lists:keysearch(Name, 1, Apps) of
+ {value, _} -> is_loaded(Name, Nodes);
+ false -> false
+ end;
+is_loaded(_Name, []) ->
+ true;
+is_loaded(Name, Node) ->
+ is_loaded(Name, [Node]).
+
+is_started(Name, Node) ->
+ Apps = which_applications(Node),
+ case lists:keysearch(Name, 1, Apps) of
+ {value, _} -> true;
+ false -> false
+ end.
+
+% Waits until application Name is started on at least one node.
+wait_until_started(Name, Nodes) ->
+ case lists:member(true,
+ lists:map(fun (N) ->
+ is_started(Name, N)
+ end,
+ Nodes)) of
+ true ->
+ true;
+ false ->
+ test_server:sleep(500),
+ wait_until_started(Name, Nodes)
+ end.
+
+% Waits until application Name is stopped on all nodes.
+wait_until_stopped(Name, Nodes) ->
+ case lists:member(true,
+ lists:map(fun (N) ->
+ is_started(Name, N)
+ end,
+ Nodes)) of
+ false ->
+ true;
+ true ->
+ test_server:sleep(500),
+ wait_until_stopped(Name, Nodes)
+ end.
+
+%% The test server has no support for starting nodes in parallel. To
+%% avoid long delays a small sync_nodes_timeout is used. Use this
+%% function when starting all nodes but the last one, and when
+%% restarting nodes (then use global:sync() to synchronize).
+config_fun_fast(SysConfigFun) ->
+ fun(Fd) -> SysConfigFun(Fd, 1) end.
+
+config_fun(SysConfigFun) ->
+ fun(Fd) -> SysConfigFun(Fd, 10000) end.
+
+start_node_config(Name, SysConfigFun, Conf) ->
+ ConfigFile = write_config_file(SysConfigFun, Conf),
+ start_node(Name, ConfigFile, "").
+
+start_node(Name) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ test_server:start_node(Name, slave, [{args, " -pa " ++ Pa}]).
+
+start_node(Name, ConfigFile) ->
+ start_node(Name, ConfigFile, "").
+
+start_node(Name, ConfigFile, ExtraArgs) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ test_server:start_node(Name, slave, [{args,
+ " -pa " ++ Pa ++
+ " -config " ++ ConfigFile ++
+ ExtraArgs}]).
+
+start_node_with_cache(Name, SysConfigFun, Conf) ->
+ ConfigFile = write_config_file(SysConfigFun, Conf),
+ start_node(Name, ConfigFile, " -code_path_cache").
+
+start_node_args(Name, Args) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ test_server:start_node(Name, slave, [{args, " -pa " ++ Pa ++ " " ++ Args}]).
+
+start_node_boot_3002(Name, Boot) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ ?t:format(0, "start_node_boot ~p~n",
+ [" -pa " ++ Pa ++ " -env ERL_CRASH_DUMP erl_crash_dump." ++
+ atom_to_list(Name) ++ " -boot " ++ Boot ++
+ " -sasl dummy \"missing "]),
+ test_server:start_node(Name, slave,
+ [{args, " -pa " ++ Pa ++
+ " -env ERL_CRASH_DUMP erl_crash_dump." ++
+ atom_to_list(Name) ++ " -boot " ++ Boot ++
+ " -sasl dummy \"missing "}]).
+
+start_node_boot_config(Name, SysConfigFun, Conf, Boot) ->
+ ConfigFile = write_config_file(SysConfigFun, Conf),
+ start_node(Name, ConfigFile, " -boot " ++ atom_to_list(Boot)).
+
+start_node_boot(Name, Config, Boot) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ ?t:format(0, "start_node_boot ~p~n",[" -pa " ++ Pa ++ " -config " ++ Config ++
+ " -boot " ++ atom_to_list(Boot)]),
+ test_server:start_node(Name, slave, [{args, " -pa " ++ Pa ++ " -config " ++ Config ++
+ " -boot " ++ atom_to_list(Boot)}]).
+
+start_node_config_sf(Name, SysConfigFun, Conf) ->
+ ConfigFile = write_config_file(SysConfigFun, Conf),
+ DataDir = ?config(data_dir, Conf), % is it used?
+ start_node(Name, ConfigFile, " -pa " ++ DataDir).
+
+write_config_file(SysConfigFun, Conf) ->
+ Dir = ?config(priv_dir, Conf),
+ {ok, Fd} = file:open(filename:join(Dir, "sys.config"), write),
+ SysConfigFun(Fd),
+ file:close(Fd),
+ filename:join(Dir,"sys").
+
+node_names(Names, Config) ->
+ [node_name(Name, Config) || Name <- Names].
+
+node_name(Name, Config) ->
+ U = "_",
+ {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()),
+ Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w",
+ [Y,M,D, H,Min,S]),
+ L = lists:flatten(Date),
+ lists:concat([Name,U,?testcase,U,U,L]).
+
+stop_node_nice(Node) when is_atom(Node) ->
+ ?line test_server:stop_node(Node);
+stop_node_nice(Nodes) when is_list(Nodes) ->
+ ?line lists:foreach(fun (N) -> stop_node_nice(N) end, Nodes).
+
+
+get_start_type(Expected) ->
+ get_start_type(Expected, 30*5, #st{}).
+
+get_start_type(_Expected, 0, Ack) ->
+ test_server:format("====== ~p ======~n", [Ack]),
+ test_server:fail(not_valid_start_type);
+get_start_type(Expected, Times, Ack0) ->
+ #st{normal = N0, local = L0, takeover = T0, failover = F0} = Ack0,
+ global:send(st_type, {st, read, self()}),
+ receive
+ {st, N, L, T, F} ->
+ Ack = #st{normal = N0 + N, local = L0 + L,
+ takeover = T0 + T, failover = F0 + F},
+ if
+ Ack =:= Expected ->
+ ok;
+ true ->
+ timer:sleep(200),
+ get_start_type(Expected, Times-1, Ack)
+ end
+ after 30*1000 ->
+ get_start_type(Expected, 0, Ack0)
+ end.
+
+start_type() ->
+ st(0, 0, 0, 0).
+
+st(Normal, Local, Takeover, Failover) ->
+ receive
+ {st, normal} ->
+ st(Normal+1, Local, Takeover, Failover);
+ {st, local} ->
+ st(Normal, Local+1, Takeover, Failover);
+ {st, takeover} ->
+ st(Normal, Local, Takeover+1, Failover);
+ {st, failover} ->
+ st(Normal, Local, Takeover, Failover+1);
+ {st, read, From} ->
+ From ! {st, Normal, Local, Takeover, Failover},
+ st(0, 0, 0, 0);
+ kill ->
+ exit(normal)
+ end.
+
+
+get_start_phase(Expected) ->
+ global:send(start_phase, {sp, read, self()}),
+ receive
+ Expected ->
+ ok;
+ {sp, T1, I1, So1, Sp1, G1} ->
+ test_server:format("=============== {sp,T,I,So,Sp,G} ~p ~n",[" "]),
+ test_server:format("=========== got ~p ~n",
+ [{sp, T1, I1, So1, Sp1, G1}]),
+ test_server:format("====== expected ~p ~n", [Expected]),
+ test_server:fail(not_valid_start_phase)
+ after 5000 ->
+ test_server:fail(not_valid_start_phase)
+ end.
+
+start_phase() ->
+ sp(0, 0, 0, 0, 0).
+
+sp(Top, Init, Some, Spec, Go) ->
+ receive
+ {sp, top} ->
+ sp(Top+1, Init, Some, Spec, Go);
+ {sp, init} ->
+ sp(Top, Init+1, Some, Spec, Go);
+ {sp, some} ->
+ sp(Top, Init, Some+1, Spec, Go);
+ {sp, spec} ->
+ sp(Top, Init, Some, Spec+1, Go);
+ {sp, go} ->
+ sp(Top, Init, Some, Spec, Go+1);
+ {sp, read, From} ->
+ From ! {sp, Top, Init, Some, Spec, Go},
+ sp(0, 0, 0, 0, 0);
+ kill ->
+ exit(normal)
+ end.
+
+get_conf_change(Expected) ->
+ global:send(conf_change, {cc, read, self()}),
+ receive
+ {cc, Expected} ->
+ ok;
+ {cc, List} ->
+ ?line test_server:format("====== ~p ======~n",[{cc, List}]),
+ ?line test_server:fail(not_valid_conf_change)
+ after 5000 ->
+ ?line test_server:fail(not_valid_conf_change_to)
+ end.
+
+conf_change() ->
+ cc([]).
+
+cc(List) ->
+ receive
+ {cc, New} ->
+ cc(List ++ New);
+ {cc, read, From} ->
+ From ! {cc, List},
+ cc([]);
+ kill ->
+ exit(normal)
+ end.
+
+
+
+create_app() ->
+ ?line Dir = "./",
+ ?line App1 = Dir ++ "app1",
+ ?line {ok, Fd1} = file:open(App1++".app",write),
+ ?line io:format(Fd1, "~p. \n", [app1()]),
+ ?line file:close(Fd1),
+ ?line App2 = Dir ++ "app2",
+ ?line {ok, Fd2} = file:open(App2++".app",write),
+ ?line io:format(Fd2, "~p. \n", [app2()]),
+ ?line file:close(Fd2),
+ ?line App3 = Dir ++ "app_sp",
+ ?line {ok, Fd3} = file:open(App3++".app",write),
+ ?line io:format(Fd3, "~p. \n", [app_sp()]),
+ ?line file:close(Fd3),
+ ok.
+
+
+create_script(ScriptName) ->
+ ?line Dir = "./",
+ ?line Name = Dir ++ ScriptName,
+ ?line Apps = which_applications(),
+ ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps),
+ ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps),
+ ?line {ok,Fd} = file:open(Name++".rel",write),
+ ?line io:format(Fd,
+ "{release, {\"Test release 3\", \"LATEST\"}, \n"
+ " {erts, \"4.4\"}, \n"
+ " [{kernel, \"~s\"}, {stdlib, \"~s\"}, \n"
+ " {app1, \"2.0\"}, {app2, \"2.0\"}, {app_sp, \"2.0\"}]}.\n",
+ [KernelVer,StdlibVer]),
+ ?line file:close(Fd),
+ {{KernelVer,StdlibVer},
+ {filename:dirname(Name), filename:basename(Name)}}.
+
+
+
+create_script_dc(ScriptName) ->
+ ?line Dir = "./",
+ ?line Name = Dir ++ ScriptName,
+ ?line Apps = which_applications(),
+ ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps),
+ ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps),
+ ?line {ok,Fd} = file:open(Name++".rel",write),
+ ?line io:format(Fd,
+ "{release, {\"Test release 3\", \"LATEST\"}, \n"
+ " {erts, \"4.4\"}, \n"
+ " [{kernel, \"~s\"}, {stdlib, \"~s\"}, \n"
+ " {app1, \"2.0\"}, {app2, \"2.0\"}, {app3, \"2.0\"}, \n"
+ " {app6, \"2.0\"}, {app7, \"2.0\"}, {app8, \"2.0\"}]}.\n",
+ [KernelVer,StdlibVer]),
+ ?line file:close(Fd),
+ {{KernelVer,StdlibVer},
+ {filename:dirname(Name), filename:basename(Name)}}.
+
+
+create_script_3002(ScriptName) ->
+ ?line Dir = "./",
+ ?line Name = Dir ++ ScriptName,
+ ?line Apps = which_applications(),
+ ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps),
+ ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps),
+ ?line {value,{_,_,SaslVer}} = lists:keysearch(sasl,1,Apps),
+ ?line {ok,Fd} = file:open(Name++".rel",write),
+ ?line io:format(Fd,
+ "{release, {\"Test release 3\", \"LATEST\"}, \n"
+ " {erts, \"4.4\"}, \n"
+ " [{kernel, \"~s\"}, {stdlib, \"~s\"}, \n"
+ " {sasl, \"~s\"}]}.\n",
+ [KernelVer, StdlibVer, SaslVer]),
+ ?line file:close(Fd),
+ {{KernelVer,StdlibVer},
+ {filename:dirname(Name), filename:basename(Name)}}.
+
+
+
+distr_changed_prep(Conf) when is_list(Conf) ->
+
+ % Write .app files
+ ?line {ok, Fd1} = file:open("app1.app", write),
+ ?line w_app1(Fd1),
+ ?line file:close(Fd1),
+ ?line {ok, Fd2} = file:open("app2.app", write),
+ ?line w_app2(Fd2),
+ ?line file:close(Fd2),
+ ?line {ok, Fd3} = file:open("app3.app", write),
+ ?line w_app3(Fd3),
+ ?line file:close(Fd3),
+ ?line {ok, Fd4} = file:open("app6.app", write),
+ ?line w_app6(Fd4),
+ ?line file:close(Fd4),
+ ?line {ok, Fd5} = file:open("app7.app", write),
+ ?line w_app7(Fd5),
+ ?line file:close(Fd5),
+ ?line {ok, Fd6} = file:open("app8.app", write),
+ ?line w_app8(Fd6),
+ ?line file:close(Fd6),
+
+
+ % Create the .app files and the boot script
+ ?line {{KernelVer,StdlibVer}, _} = create_script_dc("dc"),
+
+ ?line case is_real_system(KernelVer, StdlibVer) of
+ true ->
+ Options = [];
+ false ->
+ Options = [local]
+ end,
+
+ ?line ok = systools:make_script("dc", Options),
+
+ NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf),
+ NoSyncTime = config_fun_fast(config_dc(NodeNames)),
+ WithSyncTime = config_fun(config_dc(NodeNames)),
+
+ ?line Dir = ?config(priv_dir,Conf),
+ ?line {ok, Fd_dc2} = file:open(filename:join(Dir, "sys2.config"), write),
+ ?line (config_dc2(NodeNames))(Fd_dc2),
+ ?line file:close(Fd_dc2),
+ ?line Config2 = filename:join(Dir, "sys2"),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_boot_config(Ncp1, NoSyncTime, Conf, dc),
+ ?line {ok, Cp2} = start_node_boot_config(Ncp2, NoSyncTime, Conf, dc),
+ ?line {ok, Cp3} = start_node_boot_config(Ncp3, WithSyncTime, Conf, dc),
+ ?line global:sync(),
+
+ %% Read the current configuration parameters, and change them
+ ?line OldEnv = rpc:call(Cp1, application_controller, prep_config_change, []),
+ ?line {value, {kernel, OldKernel}} = lists:keysearch(kernel, 1, OldEnv),
+ {OldKernel, OldEnv, {Cp1, Cp2, Cp3}, {Ncp1, Ncp2, Ncp3}, Config2}.
+
+
+%%% Copied from init_SUITE.erl.
+is_real_system(KernelVsn, StdlibVsn) ->
+ LibDir = code:lib_dir(),
+ case file:read_file_info(LibDir ++ "/kernel-" ++ KernelVsn) of
+ {ok, _} ->
+ case file:read_file_info(LibDir ++ "/stdlib-" ++ StdlibVsn) of
+ {ok, _} ->
+ true;
+ _ ->
+ false
+ end;
+ _ ->
+ false
+ end.
+
+init2973() ->
+ loop2973().
+
+
+loop2973() ->
+ receive
+ {start, From, App} ->
+ Res = application:start(App),
+ From ! {self(), res, Res},
+ loop2973();
+
+ kill ->
+ exit(normal)
+ end.
+
+wait_for_ready_net() ->
+ Nodes = lists:sort([node() | nodes()]),
+ ?UNTIL(begin
+ lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and
+ lists:all(fun(N) ->
+ LNs = rpc:call(N, erlang, nodes, []),
+ Nodes =:= lists:sort([N | LNs])
+ end, Nodes)
+ end).
+
+get_known(Node) ->
+ case catch gen_server:call({global_name_server,Node}, get_known) of
+ {'EXIT', _} ->
+ [list, without, nodenames];
+ Known ->
+ lists:sort([Node | Known])
+ end.
+
+which_applications() ->
+ application_controller:which_applications(infinity).
+
+which_applications(Node) ->
+ rpc:call(Node, application, which_applications, [infinity]).
diff --git a/lib/kernel/test/application_SUITE_data/Makefile.src b/lib/kernel/test/application_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..a237f6badb
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/Makefile.src
@@ -0,0 +1,24 @@
+EFLAGS=+debug_info
+
+all: app_start_error.@EMULATOR@ trans_abnormal_sup.@EMULATOR@ \
+ trans_normal_sup.@EMULATOR@ transient.@EMULATOR@ \
+ group_leader_sup.@EMULATOR@ group_leader.@EMULATOR@
+
+app_start_error.@EMULATOR@: app_start_error.erl
+ erlc $(EFLAGS) app_start_error.erl
+
+trans_abnormal_sup.@EMULATOR@: trans_abnormal_sup.erl
+ erlc $(EFLAGS) trans_abnormal_sup.erl
+
+trans_normal_sup.@EMULATOR@: trans_normal_sup.erl
+ erlc $(EFLAGS) trans_normal_sup.erl
+
+transient.@EMULATOR@: transient.erl
+ erlc $(EFLAGS) transient.erl
+
+group_leader.@EMULATOR@: group_leader.erl
+ erlc $(EFLAGS) group_leader.erl
+
+group_leader_sup.@EMULATOR@: group_leader_sup.erl
+ erlc $(EFLAGS) group_leader_sup.erl
+
diff --git a/lib/kernel/test/application_SUITE_data/app_start_error.erl b/lib/kernel/test/application_SUITE_data/app_start_error.erl
new file mode 100644
index 0000000000..cfe3508eb3
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/app_start_error.erl
@@ -0,0 +1,35 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(app_start_error).
+
+%%-compile(export_all).
+%%-export([Function/Arity, ...]).
+
+
+-export([start/2,
+ init/0]).
+
+start(_,_) ->
+ Pid = spawn_link(m, foo, []),
+ {error, 'start error'}.
+
+init() ->
+ exit(normal).
+
diff --git a/lib/kernel/test/application_SUITE_data/group_leader.erl b/lib/kernel/test/application_SUITE_data/group_leader.erl
new file mode 100644
index 0000000000..08c5b43808
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/group_leader.erl
@@ -0,0 +1,61 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(group_leader).
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/0, code_change/3]).
+
+%% Internal exports
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]).
+
+start_link() -> gen_server:start_link({local,aa}, ?MODULE, [], []).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+init([]) ->
+ Self = self(),
+ Pid = spawn(fun() -> stupid_child(Self) end) ,
+ receive {Pid, registration_done} -> ok end,
+ process_flag(trap_exit, true),
+ {ok,state}.
+
+handle_call(transient, _From, State) ->
+ X = application:get_all_env(transient),
+ {reply,X,State}.
+
+handle_cast(transient, State) ->
+ {noreply, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+stupid_child(Parent) ->
+ register(nisse, self()),
+ Parent ! {self(), registration_done},
+ receive
+ _Msg -> ok
+ end.
diff --git a/lib/kernel/test/application_SUITE_data/group_leader_sup.erl b/lib/kernel/test/application_SUITE_data/group_leader_sup.erl
new file mode 100644
index 0000000000..04bb0538fe
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/group_leader_sup.erl
@@ -0,0 +1,37 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(group_leader_sup).
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_, _) ->
+ supervisor:start_link(group_leader_sup, []).
+
+init([]) ->
+ SupFlags = {one_for_one,4,3600},
+ Config = {group_leader,
+ {group_leader,start_link,[]},
+ temporary,4000,worker,[group_leader]},
+ {ok,{SupFlags,[Config]}}.
diff --git a/lib/kernel/test/application_SUITE_data/subdir/t3.config b/lib/kernel/test/application_SUITE_data/subdir/t3.config
new file mode 100644
index 0000000000..b7445eacfe
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/subdir/t3.config
@@ -0,0 +1 @@
+[{stdlib, [{par5,t3},{par6,t3}]}].
diff --git a/lib/kernel/test/application_SUITE_data/t1.config b/lib/kernel/test/application_SUITE_data/t1.config
new file mode 100644
index 0000000000..32838ee6a7
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/t1.config
@@ -0,0 +1,2 @@
+[{stdlib, [{par2,t1},{par3,t1}]},
+ {kernel, [{kpar1,kval1}]}].
diff --git a/lib/kernel/test/application_SUITE_data/t2.config b/lib/kernel/test/application_SUITE_data/t2.config
new file mode 100644
index 0000000000..953bb6477b
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/t2.config
@@ -0,0 +1,2 @@
+%% Intentionally no NL after the line following to make sure it works (OTP-5543).
+[{stdlib, [{par4,t2}]}]. \ No newline at end of file
diff --git a/lib/kernel/test/application_SUITE_data/trans_abnormal_sup.erl b/lib/kernel/test/application_SUITE_data/trans_abnormal_sup.erl
new file mode 100644
index 0000000000..d060347aff
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/trans_abnormal_sup.erl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(trans_abnormal_sup).
+
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_, _) ->
+ supervisor:start_link({local, trans_abnormal_sup}, trans_abnormal_sup, []),
+ exit(abnormal).
+
+init([]) ->
+ SupFlags = {one_for_one, 4, 3600},
+ Config = {transient,
+ {transient, start_link, []},
+ transient, 2000, worker, [transient]},
+ {ok, {SupFlags, [Config]}}.
diff --git a/lib/kernel/test/application_SUITE_data/trans_normal_sup.erl b/lib/kernel/test/application_SUITE_data/trans_normal_sup.erl
new file mode 100644
index 0000000000..48eb52ddcf
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/trans_normal_sup.erl
@@ -0,0 +1,38 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(trans_normal_sup).
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_, _) ->
+ supervisor:start_link({local, trans_normal_sup}, trans_normal_sup, []),
+ exit(normal).
+
+init([]) ->
+ SupFlags = {one_for_one, 4, 3600},
+ Config = {transient,
+ {transient, start_link, []},
+ transient, 2000, worker, [transient]},
+ {ok, {SupFlags, [Config]}}.
diff --git a/lib/kernel/test/application_SUITE_data/transient.erl b/lib/kernel/test/application_SUITE_data/transient.erl
new file mode 100644
index 0000000000..1f38b4803a
--- /dev/null
+++ b/lib/kernel/test/application_SUITE_data/transient.erl
@@ -0,0 +1,52 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(transient).
+
+
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/0, transient/0]).
+%% Internal exports
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]).
+
+start_link() -> gen_server:start_link({local, aa}, transient, [], []).
+
+transient() -> gen_server:call(aa, transient).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+init([]) ->
+ process_flag(trap_exit, true),
+ {ok, state}.
+
+handle_call(transient, _From, State) ->
+ X = application:get_all_env(transient),
+ {reply, X, State}.
+
+handle_cast(transient, State) ->
+ {noreply, State}.
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
diff --git a/lib/kernel/test/bif_SUITE.erl b/lib/kernel/test/bif_SUITE.erl
new file mode 100644
index 0000000000..c78d82659f
--- /dev/null
+++ b/lib/kernel/test/bif_SUITE.erl
@@ -0,0 +1,649 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(bif_SUITE).
+-export([all/1]).
+
+-export([spawn_tests/1,
+ spawn1/1, spawn2/1, spawn3/1, spawn4/1,
+
+ spawn_link_tests/1,
+ spawn_link1/1, spawn_link2/1, spawn_link3/1, spawn_link4/1,
+
+ spawn_opt_tests/1,
+ spawn_opt2/1, spawn_opt3/1, spawn_opt4/1, spawn_opt5/1,
+
+ spawn_failures/1,
+
+ run_fun/1,
+ wilderness/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+-include("test_server.hrl").
+
+% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog = ?t:timetrap(?default_timeout),
+ [{watchdog, Dog} | Config].
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+all(suite) ->
+ [spawn_tests, spawn_link_tests, spawn_opt_tests, spawn_failures, wilderness].
+
+spawn_tests(doc) -> ["Test spawn"];
+spawn_tests(suite) ->
+ [spawn1, spawn2, spawn3, spawn4].
+
+spawn_link_tests(doc) -> ["Test spawn_link"];
+spawn_link_tests(suite) ->
+ [spawn_link1, spawn_link2, spawn_link3, spawn_link4].
+
+spawn_opt_tests(doc) -> ["Test spawn_opt"];
+spawn_opt_tests(suite) ->
+ [spawn_opt2, spawn_opt3, spawn_opt4, spawn_opt5].
+
+spawn1(doc) -> ["Test spawn/1"];
+spawn1(suite) ->
+ [];
+spawn1(Config) when list(Config) ->
+ ?line Node = node(),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn
+ ?line P = spawn(fun() -> Parent ! {self(), fetch_proc_vals(self())} end),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(false, normal, FA, 0, PV)
+ end,
+ ok.
+
+spawn2(doc) -> ["Test spawn/2"];
+spawn2(suite) ->
+ [];
+spawn2(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn2),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn(Node,
+ fun() -> Parent ! {self(), fetch_proc_vals(self())} end),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(false, normal, FA, 0, PV)
+ end,
+
+ ?line true = stop_node(Node),
+ ok.
+
+
+spawn3(doc) -> ["Test spawn/3"];
+spawn3(suite) ->
+ [];
+spawn3(Config) when list(Config) ->
+ ?line Node = node(),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn(?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end]),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(false, normal, FA, 0, PV)
+ end,
+ ok.
+
+spawn4(doc) -> ["Test spawn/4"];
+spawn4(suite) ->
+ [];
+spawn4(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn4),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn(Node,
+ ?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end]),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(false, normal, FA, 0, PV)
+ end,
+
+ ?line true = stop_node(Node),
+ ok.
+
+
+
+spawn_link1(doc) -> ["Test spawn_link/1"];
+spawn_link1(suite) ->
+ [];
+spawn_link1(Config) when list(Config) ->
+ ?line Node = node(),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn_link(fun() -> Parent ! {self(), fetch_proc_vals(self())} end),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(true, normal, FA, 0, PV)
+ end,
+ ok.
+
+spawn_link2(doc) -> ["Test spawn_link/2"];
+spawn_link2(suite) ->
+ [];
+spawn_link2(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn_link2),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn_link(Node,
+ fun() -> Parent ! {self(), fetch_proc_vals(self())} end),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(true, normal, FA, 0, PV)
+ end,
+
+ ?line true = stop_node(Node),
+ ok.
+
+spawn_link3(doc) -> ["Test spawn_link/3"];
+spawn_link3(suite) ->
+ [];
+spawn_link3(Config) when list(Config) ->
+ ?line Node = node(),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn_link(?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end]),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(true, normal, FA, 0, PV)
+ end,
+ ok.
+
+spawn_link4(doc) -> ["Test spawn_link/4"];
+spawn_link4(suite) ->
+ [];
+spawn_link4(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn_link4),
+
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ % spawn_link
+ ?line P = spawn_link(Node,
+ ?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end]),
+ ?line receive
+ {P, PV} ->
+ ?line Node = node(P),
+ ?line check_proc_vals(true, normal, FA, 0, PV)
+ end,
+
+ ?line true = stop_node(Node),
+ ok.
+
+
+spawn_opt2(doc) -> ["Test spawn_opt/2"];
+spawn_opt2(suite) ->
+ [];
+spawn_opt2(Config) when list(Config) ->
+ ?line Node = node(),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+
+ ?line P1 = spawn_opt(fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end,
+ case heap_type() of
+ separate ->
+ [{fullsweep_after, 0},{min_heap_size, 1000}];
+ shared ->
+ []
+ end
+ ++ [link, {priority, max}]),
+ ?line receive
+ {P1, PV1} ->
+ ?line Node = node(P1),
+ ?line check_proc_vals(true, max, 0, 1000, PV1)
+ end,
+ ?line P2 = spawn_opt(fun() -> Parent ! {self(), fetch_proc_vals(self())} end,
+ case heap_type() of
+ separate -> [{min_heap_size, 10}];
+ shared -> []
+ end),
+ ?line receive
+ {P2, PV2} ->
+ ?line Node = node(P2),
+ ?line check_proc_vals(false, normal, FA, 10, PV2)
+ end,
+ ok.
+
+spawn_opt3(doc) -> ["Test spawn_opt/3"];
+spawn_opt3(suite) ->
+ [];
+spawn_opt3(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn_opt3),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+ ?line P1 = spawn_opt(Node,
+ fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end,
+ case heap_type() of
+ separate ->
+ [{fullsweep_after,0}, {min_heap_size,1000}];
+ shared ->
+ []
+ end
+ ++ [link, {priority, max}]),
+ ?line receive
+ {P1, PV1} ->
+ ?line Node = node(P1),
+ ?line check_proc_vals(true, max, 0, 1000, PV1)
+ end,
+ ?line P2 = spawn_opt(Node,
+ fun() -> Parent ! {self(), fetch_proc_vals(self())} end,
+ case heap_type() of
+ separate -> [{min_heap_size, 10}];
+ shared -> []
+ end),
+ ?line receive
+ {P2, PV2} ->
+ ?line Node = node(P2),
+ ?line check_proc_vals(false, normal, FA, 10, PV2)
+ end,
+ ?line true = stop_node(Node),
+ ok.
+
+spawn_opt4(doc) -> ["Test spawn_opt/4"];
+spawn_opt4(suite) ->
+ [];
+spawn_opt4(Config) when list(Config) ->
+ ?line Node = node(),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+ ?line P1 = spawn_opt(?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end],
+ case heap_type() of
+ separate ->
+ [{fullsweep_after,0}, {min_heap_size,1000}];
+ shared ->
+ []
+ end
+ ++ [link, {priority, max}]),
+ ?line receive
+ {P1, PV1} ->
+ ?line Node = node(P1),
+ ?line check_proc_vals(true, max, 0, 1000, PV1)
+ end,
+ ?line P2 = spawn_opt(?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end],
+ case heap_type() of
+ separate -> [{min_heap_size, 10}];
+ shared -> []
+ end),
+ ?line receive
+ {P2, PV2} ->
+ ?line Node = node(P2),
+ ?line check_proc_vals(false, normal, FA, 10, PV2)
+ end,
+ ok.
+
+spawn_opt5(doc) -> ["Test spawn_opt/5"];
+spawn_opt5(suite) ->
+ [];
+spawn_opt5(Config) when list(Config) ->
+ ?line {ok, Node} = start_node(spawn_opt5),
+ ?line Parent = self(),
+ ?line {_, _, FA, _} = fetch_proc_vals(self()),
+ ?line P1 = spawn_opt(Node,
+ ?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end],
+ case heap_type() of
+ separate ->
+ [{fullsweep_after,0}, {min_heap_size,1000}];
+ shared ->
+ []
+ end
+ ++ [link, {priority, max}]),
+ ?line receive
+ {P1, PV1} ->
+ ?line Node = node(P1),
+ ?line check_proc_vals(true, max, 0, 1000, PV1)
+ end,
+ ?line P2 = spawn_opt(Node,
+ ?MODULE,
+ run_fun,
+ [fun() ->
+ Parent ! {self(), fetch_proc_vals(self())}
+ end],
+ case heap_type() of
+ separate -> [{min_heap_size, 10}];
+ shared -> []
+ end),
+ ?line receive
+ {P2, PV2} ->
+ ?line Node = node(P2),
+ ?line check_proc_vals(false, normal, FA, 10, PV2)
+ end,
+ ?line true = stop_node(Node),
+ ok.
+
+spawn_failures(doc) ->
+ ["Test failure behavior of spawn bifs"];
+spawn_failures(suite) ->
+ [];
+spawn_failures(Config) when list(Config) ->
+ ?line ThisNode = node(),
+ ?line {ok, Node} = start_node(spawn_remote_failure),
+
+ % unknown nodes
+ test_server:format("Testing unknown nodes~n", []),
+ ?line CrashPid1 = (catch spawn_opt('unknown@node',
+ erlang,
+ nodes,
+ [],
+ [])),
+ ?line true = is_pid(CrashPid1),
+ ?line ThisNode = node(CrashPid1),
+ ?line CrashPid2 = (catch spawn_opt('unknown@node',
+ fun () -> erlang:nodes() end,
+ [])),
+ ?line true = is_pid(CrashPid2),
+ ?line ThisNode = node(CrashPid2),
+
+ ?line CrashPid3 = (catch spawn('unknown@node',
+ erlang,
+ nodes,
+ [])),
+ ?line true = is_pid(CrashPid3),
+ ?line ThisNode = node(CrashPid3),
+ ?line CrashPid4 = (catch spawn('unknown@node',
+ fun () -> erlang:nodes() end)),
+ ?line true = is_pid(CrashPid4),
+ ?line ThisNode = node(CrashPid4),
+
+ ?line OTE = process_flag(trap_exit,true),
+ ?line CrashPid5 = (catch spawn_link('unknown@node',
+ erlang,
+ nodes,
+ [])),
+ receive
+ {'EXIT', CrashPid5, noconnection} ->
+ ?line true = is_pid(CrashPid5),
+ ?line ThisNode = node(CrashPid5)
+ end,
+ ?line CrashPid6 = (catch spawn_link('unknown@node',
+ fun () -> erlang:nodes() end)),
+ receive
+ {'EXIT', CrashPid6, noconnection} ->
+ ?line true = is_pid(CrashPid6),
+ ?line ThisNode = node(CrashPid6)
+ end,
+ process_flag(trap_exit,OTE),
+ case OTE of
+ false ->
+ receive
+ {'EXIT', P, R} ->
+ ?line test_server:fail({'EXIT', P, R})
+ after 0 ->
+ ok
+ end;
+ _ ->
+ ok
+ end,
+
+ % bad node
+ test_server:format("Testing bad nodes~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt("Node",erlang,nodes,[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt("Node",
+ fun () ->
+ erlang:nodes()
+ end,
+ [])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link("Node",
+ fun () ->
+ erlang:nodes()
+ end)),
+ ?line {'EXIT', {badarg, _}} = (catch spawn("Node",erlang,nodes,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn("Node",
+ fun () ->
+ erlang:nodes()
+ end)),
+
+ % bad module
+ test_server:format("Testing bad modules~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,"erlang",nodes,[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt("erlang",nodes,[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,"erlang",nodes,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link("erlang",nodes,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(Node,"erlang",nodes,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn("erlang",nodes,[])),
+
+ % bad function
+ test_server:format("Testing bad functions~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,"nodes",[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,not_a_fun,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,"nodes",[],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(not_a_fun,[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,erlang,"nodes",[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,not_a_fun)),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(erlang,"nodes",[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(not_a_fun)),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(Node,erlang,"nodes",[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(Node,not_a_fun)),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(erlang,"nodes",[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(not_a_fun)),
+
+
+ % bad argument
+ test_server:format("Testing bad arguments~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,nodes,[a|b],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,nodes,[a|b],[])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,erlang,nodes,[a|b])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_link(erlang,nodes,[a|b])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(Node,erlang,nodes,[a|b])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn(erlang,nodes,[a|b])),
+
+ % bad option
+ test_server:format("Testing bad options~n", []),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,nodes,[],[a|b])),
+ ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,nodes,[],[a|b])),
+
+
+ ?line true = stop_node(Node),
+ ok.
+
+check_proc_vals(Link, Priority, FullsweepAfter, MinHeapSize, {Ls, P, FA, HS}) ->
+ ?line Link = lists:member(self(), Ls),
+ ?line Priority = P,
+ ?line case heap_type() of
+ separate ->
+ ?line FullsweepAfter = FA,
+ ?line true = (HS >= MinHeapSize);
+ shared ->
+ ?line ok
+ end,
+ ?line ok.
+
+fetch_proc_vals(Pid) ->
+ ?line PI = process_info(Pid),
+ ?line {value,{links, Ls}} = lists:keysearch(links, 1, PI),
+ ?line {value,{priority,P}} = lists:keysearch(priority, 1, PI),
+ ?line {FA, HS}
+ = case heap_type() of
+ separate ->
+ ?line {value,
+ {garbage_collection,
+ Gs}} = lists:keysearch(garbage_collection, 1, PI),
+ ?line {value,
+ {fullsweep_after,
+ Fa}} = lists:keysearch(fullsweep_after, 1, Gs),
+ ?line {value,
+ {heap_size,Hs}} = lists:keysearch(heap_size, 1, PI),
+ ?line {Fa, Hs};
+ shared ->
+ {undefined, undefined}
+ end,
+ ?line {Ls, P, FA, HS}.
+
+% This testcase should probably be moved somewhere else
+wilderness(doc) ->
+ ["Test that memory allocation command line options affecting the"
+ "wilderness of the heap are interpreted correct by the emulator "];
+wilderness(suite) ->
+ [];
+wilderness(Config) when list(Config) ->
+ ?line Dog = ?t:timetrap(?default_timeout),
+ ?line OKParams = {512, 8},
+ ?line Alloc = erlang:system_info(allocator),
+ ?line test_server:format("Test server allocator info:~n~p", [Alloc]),
+ Result = case Alloc of
+ {Allocator, _, _, _} when Allocator == glibc;
+ Allocator == dlmalloc ->
+ ?line run_wilderness_test(OKParams, OKParams),
+ ?line {comment,
+ "Allocator used: " ++ atom_to_list(Allocator)};
+ {OtherAllocator, _, _, _} ->
+ ?line {skipped,
+ "Only run when glibc is used. "
+ "Allocator used: "
+ ++ atom_to_list(OtherAllocator)}
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ Result.
+
+run_wilderness_test({Set_tt, Set_tp}, {Exp_tt, Exp_tp}) ->
+ Self = self(),
+ Ref = make_ref(),
+ SuiteDir = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = test_server:start_node(allocator_test,
+ slave,
+ [{args,
+ " -pa "
+ ++ SuiteDir
+ ++" +MYtt "++to_string(Set_tt)
+ ++" +MYtp "++to_string(Set_tp)},
+ {linked, false}]),
+ spawn(Node, fun () ->
+ Self ! {Ref, erlang:system_info(allocator)}
+ end),
+ receive
+ {Ref, {A, V, F, S}} ->
+ Ett = Exp_tt*1024,
+ Etp = Exp_tp*1024,
+ ?line test_server:format("Test allocator info:~n~p",
+ [{A, V, F, S}]),
+ ?line {value, {sys_alloc, SA_Opts}}
+ = lists:keysearch(sys_alloc, 1, S),
+ ?line {value, {tt, Ett}} = lists:keysearch(tt, 1, SA_Opts),
+ ?line {value, {tp, Etp}} = lists:keysearch(tp, 1, SA_Opts)
+ end,
+ stop_node(Node).
+
+to_string(X) when integer(X) ->
+ integer_to_list(X);
+to_string(X) when atom(X) ->
+ atom_to_list(X);
+to_string(X) when list(X) ->
+ X.
+
+get_nodenames(N, T) ->
+ get_nodenames(N, T, []).
+
+get_nodenames(0, _, Acc) ->
+ Acc;
+get_nodenames(N, T, Acc) ->
+ {A, B, C} = now(),
+ get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(T)
+ ++ "-"
+ ++ integer_to_list(A)
+ ++ "-"
+ ++ integer_to_list(B)
+ ++ "-"
+ ++ integer_to_list(C)) | Acc]).
+
+start_node(TestCase) ->
+ ?line [Name] = get_nodenames(1, TestCase),
+ ?line Pa = filename:dirname(code:which(?MODULE)),
+ ?line test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]).
+
+stop_node(Node) ->
+ ?line true = test_server:stop_node(Node).
+
+run_fun(Fun) ->
+ Fun().
+
+heap_type() ->
+ case catch erlang:system_info(heap_type) of
+ shared -> shared;
+ unified -> shared;
+ _ -> separate
+ end.
+
+
diff --git a/lib/kernel/test/ch.erl b/lib/kernel/test/ch.erl
new file mode 100644
index 0000000000..25d1b4354c
--- /dev/null
+++ b/lib/kernel/test/ch.erl
@@ -0,0 +1,84 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ch).
+-behaviour(gen_server).
+
+%% External exports
+-export([start_link/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_info/2, terminate/2,
+ handle_cast/2, code_change/3]).
+
+start_link(Name) -> gen_server:start_link(ch, Name, []).
+
+%%-----------------------------------------------------------------
+%% Callback functions from gen_server
+%%-----------------------------------------------------------------
+init(Name) ->
+ process_flag(trap_exit, true),
+ global:re_register_name(Name, self()),
+ St = application:start_type(),
+ St1 = case St of
+ normal ->
+ normal;
+ local ->
+ local;
+ {takeover, _N} ->
+ takeover;
+ {failover, _N} ->
+ failover;
+ Else ->
+ Else
+ end,
+
+ %% Slow start to make sure that applications are started
+ %% "at the same time". (otp_2973)
+ case Name of
+ {ch,77} -> timer:sleep(100);
+ _ -> ok
+ end,
+
+ (catch global:send(Name, {st_type,{st, St1}})),
+ {ok, []}.
+
+handle_call({get_pid_key, Key}, _, State) ->
+ Res = application:get_key(Key),
+ {reply, Res, State};
+
+handle_call(get_pid_all_key, _, State) ->
+ Res = application:get_all_key(),
+ {reply, Res, State}.
+
+handle_info({st_type, Msg}, State) ->
+ timer:sleep(1000),
+ (catch global:send(st_type, Msg)),
+ {noreply, State};
+
+handle_info(_, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+handle_cast(_, State) ->
+ {noreply, State}.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
diff --git a/lib/kernel/test/ch_sup.erl b/lib/kernel/test/ch_sup.erl
new file mode 100644
index 0000000000..9d03628839
--- /dev/null
+++ b/lib/kernel/test/ch_sup.erl
@@ -0,0 +1,51 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ch_sup).
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2, start_phase/3, stop/1, config_change/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, {_AppN, Low, High}) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, ch_sup,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) -> ok.
+
+start_phase(_Phase, _Type, _Args) ->
+ ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+config_change(Changed, New, Removed) ->
+ (catch global:send(conf_change,{cc, [{Changed, New, Removed}]})),
+ ok.
diff --git a/lib/kernel/test/cleanup.erl b/lib/kernel/test/cleanup.erl
new file mode 100644
index 0000000000..6e1a1edeac
--- /dev/null
+++ b/lib/kernel/test/cleanup.erl
@@ -0,0 +1,38 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(cleanup).
+
+-export([all/1, cleanup/1]).
+
+-include("test_server.hrl").
+
+all(suite) -> {req, [kernel], [cleanup]}.
+
+cleanup(suite) -> [];
+cleanup(_) ->
+ ?line Localhost = list_to_atom(net_adm:localhost()),
+ ?line net_adm:world_list([Localhost]),
+ ?line case nodes() of
+ [] ->
+ ok;
+ Nodes when list(Nodes) ->
+ Kill = fun(Node) -> spawn(Node, erlang, halt, []) end,
+ ?line lists:foreach(Kill, Nodes),
+ ?line test_server:fail({nodes_left, Nodes})
+ end.
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
new file mode 100644
index 0000000000..9fda66711d
--- /dev/null
+++ b/lib/kernel/test/code_SUITE.erl
@@ -0,0 +1,1236 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code_SUITE).
+
+-include("test_server.hrl").
+
+-export([all/1]).
+-export([set_path/1, get_path/1, add_path/1, add_paths/1, del_path/1,
+ replace_path/1, load_file/1, load_abs/1, ensure_loaded/1,
+ delete/1, purge/1, soft_purge/1, is_loaded/1, all_loaded/1,
+ load_binary/1, dir_req/1, object_code/1, set_path_file/1,
+ sticky_dir/1, pa_pz_option/1, add_del_path/1,
+ dir_disappeared/1, ext_mod_dep/1,
+ load_cached/1, start_node_with_cache/1, add_and_rehash/1,
+ where_is_file_cached/1, where_is_file_no_cache/1,
+ purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1,
+ code_archive/1, code_archive2/1, on_load/1,
+ on_load_embedded/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2,
+ init_per_suite/1, end_per_suite/1,
+ sticky_compiler/1]).
+
+all(suite) ->
+ [set_path, get_path, add_path, add_paths, del_path,
+ replace_path, load_file, load_abs, ensure_loaded,
+ delete, purge, soft_purge, is_loaded, all_loaded,
+ load_binary, dir_req, object_code, set_path_file,
+ pa_pz_option, add_del_path,
+ dir_disappeared, ext_mod_dep,
+ load_cached, start_node_with_cache, add_and_rehash,
+ where_is_file_no_cache, where_is_file_cached,
+ purge_stacktrace, mult_lib_roots, bad_erl_libs,
+ code_archive, code_archive2, on_load, on_load_embedded].
+
+init_per_suite(Config) ->
+ %% The compiler will no longer create a Beam file if
+ %% the module name does not match the filename, so
+ %% we must compile to a binary and write the Beam file
+ %% ourselves.
+ ?line Dir = filename:dirname(code:which(?MODULE)),
+ ?line File = filename:join(Dir, "code_a_test"),
+ ?line {ok,code_b_test,Code} = compile:file(File, [binary]),
+ ?line ok = file:write_file(File++".beam", Code),
+ Config.
+
+end_per_suite(Config) ->
+ Config.
+
+init_per_testcase(_Func, Config) ->
+ Dog=?t:timetrap(?t:minutes(5)),
+ P=code:get_path(),
+ P=code:get_path(),
+ [{watchdog, Dog}, {code_path, P}|Config].
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog),
+ P=?config(code_path, Config),
+ true=code:set_path(P),
+ P=code:get_path(),
+ ok.
+
+set_path(suite) -> [];
+set_path(doc) -> [];
+set_path(Config) when is_list(Config) ->
+ P = code:get_path(),
+ NonExDir = filename:join(?config(priv_dir, Config), ?t:temp_name("hej")),
+ ?line {'EXIT',_} = (catch code:set_path({a})),
+ ?line {error, bad_directory} = (catch code:set_path([{a}])),
+ ?line {error, bad_directory} = code:set_path(NonExDir),
+ ?line P = code:get_path(), % still the same path.
+ ?line true = code:set_path(P), % set the same path again.
+ ?line P = code:get_path(), % still the same path.
+ LibDir = code:lib_dir(),
+ ?line true = code:set_path([LibDir | P]),
+ ?line [LibDir | P] = code:get_path(),
+ ?line true = code:set_path([LibDir]),
+ ?line [LibDir] = code:get_path(),
+ ok.
+
+get_path(suite) -> [];
+get_path(doc) -> [];
+get_path(Config) when is_list(Config) ->
+ ?line P = code:get_path(),
+ % test that all directories are strings (lists).
+ ?line [] = lists:filter(fun(Dir) when is_list(Dir) ->
+ false;
+ (_) ->
+ true
+ end,
+ P),
+ ok.
+
+add_path(suite) -> [];
+add_path(doc) -> [];
+add_path(Config) when is_list(Config) ->
+ P = code:get_path(),
+ ?line {'EXIT',_} = (catch code:add_path({})),
+ ?line {'EXIT',_} = (catch code:add_patha({})),
+ ?line {'EXIT',_} = (catch code:add_pathz({})),
+ ?line {error, bad_directory} = code:add_path("xyz"),
+ ?line {error, bad_directory} = code:add_patha("xyz"),
+ ?line {error, bad_directory} = code:add_pathz("xyz"),
+ LibDir = code:lib_dir(),
+ ?line true = code:add_path(LibDir),
+ ?line LibDir = lists:last(code:get_path()),
+ code:set_path(P),
+ ?line true = code:add_pathz(LibDir),
+ ?line LibDir = lists:last(code:get_path()),
+ code:set_path(P),
+ ?line true = code:add_patha(LibDir),
+ ?line [LibDir|_] = code:get_path(),
+ code:set_path(P),
+ ok.
+
+add_paths(suite) -> [];
+add_paths(doc) -> [];
+add_paths(Config) when is_list(Config) ->
+ P = code:get_path(),
+ ?line ok = code:add_paths([{}]),
+ ?line ok = code:add_pathsa([{}]),
+ ?line ok = code:add_pathsz([{}]),
+ ?line ok = code:add_paths(["xyz"]),
+ ?line ok = code:add_pathsa(["xyz"]),
+ ?line ok = code:add_pathsz(["xyz"]),
+ P = code:get_path(), % check that no directory is added.
+
+ LibDir = code:lib_dir(),
+ ?line ok = code:add_paths([LibDir]),
+ ?line LibDir = lists:last(code:get_path()),
+ code:set_path(P),
+ ?line ok = code:add_pathsz([LibDir]),
+ ?line LibDir = lists:last(code:get_path()),
+ code:set_path(P),
+ ?line ok = code:add_pathsa([LibDir]),
+ ?line [LibDir|P] = code:get_path(),
+ code:set_path(P),
+
+ RootDir = code:root_dir(),
+ Res = P ++ [LibDir, RootDir],
+ ?line ok = code:add_paths([LibDir, RootDir]),
+ ?line Res = code:get_path(),
+ code:set_path(P),
+ ?line ok = code:add_pathsz([LibDir, RootDir]),
+ ?line Res = code:get_path(),
+ code:set_path(P),
+ ?line ok = code:add_pathsa([LibDir, RootDir]),
+ ?line [RootDir, LibDir|P] = code:get_path(),
+ code:set_path(P),
+
+ ?line ok = code:add_paths([LibDir, "xyz"]),
+ Res1 = P ++ [LibDir],
+ ?line Res1 = code:get_path(),
+ code:set_path(P),
+ ?line ok = code:add_pathsz([LibDir, "xyz"]),
+ ?line Res1 = code:get_path(),
+ code:set_path(P),
+ ?line ok = code:add_pathsa([LibDir, "xyz"]),
+ ?line [LibDir|P] = code:get_path(),
+ code:set_path(P),
+ ok.
+
+del_path(suite) -> [];
+del_path(doc) -> [];
+del_path(Config) when is_list(Config) ->
+ ?line P = code:get_path(),
+ test_server:format("Initial code:get_path()=~p~n",[P]),
+ ?line {'EXIT',_} = (catch code:del_path(3)),
+ ?line false = code:del_path(my_dummy_name),
+ ?line false = code:del_path("/kdlk/my_dummy_dir"),
+ Dir = filename:join([code:lib_dir(kernel),"ebin"]),
+ test_server:format("kernel dir: ~p~n",[Dir]),
+
+
+ ?line true = code:del_path(kernel),
+ NewP = code:get_path(),
+ test_server:format("Path after removing 'kernel':~p~n",[NewP]),
+ ReferenceP = lists:delete(Dir,P),
+ test_server:format("Reference path:~p~n",[ReferenceP]),
+ ?line NewP = ReferenceP, % check that dir is deleted
+
+ code:set_path(P),
+ ?line true = code:del_path(Dir),
+ NewP1 = code:get_path(),
+ ?line NewP1 = lists:delete(Dir,P), % check that dir is deleted
+ code:set_path(P),
+ ok.
+
+replace_path(suite) -> [];
+replace_path(doc) -> [];
+replace_path(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line P = code:get_path(),
+ ?line {'EXIT',_} = (catch code:replace_path(3,"")),
+ ?line {error, bad_name} = code:replace_path(dummy_name,""),
+ ?line {error, bad_name} = code:replace_path(kernel,
+ "/kdlk/my_dummy_dir"),
+ ?line {error, bad_directory} = code:replace_path(kernel,
+ "/kdlk/kernel-1.2"),
+ ?line P = code:get_path(), % Check that path is not changed.
+
+ ?line ok = file:set_cwd(PrivDir),
+
+ %% Replace an existing application.
+
+ file:make_dir("./kernel-2.11"),
+ {ok, Cwd} = file:get_cwd(),
+ NewDir = Cwd ++ "/kernel-2.11",
+ ?line true = code:replace_path(kernel, NewDir),
+ ?line NewDir = code:lib_dir(kernel),
+ ?line true = code:set_path(P), %Reset path
+ ?line ok = file:del_dir("./kernel-2.11"),
+
+ %% Add a completly new application.
+
+ NewAppName = "blurf_blarfer",
+ ?line NewAppDir = filename:join(Cwd, NewAppName ++ "-6.33.1"),
+ ?line ok = file:make_dir(NewAppDir),
+ ?line true = code:replace_path(NewAppName, NewAppDir),
+ ?line NewAppDir = code:lib_dir(NewAppName),
+ ?line NewAppDir = lists:last(code:get_path()),
+ ?line true = code:set_path(P), %Reset path
+ ?line ok = file:del_dir(NewAppDir),
+
+ ok.
+
+dir_disappeared(suite) -> [];
+dir_disappeared(doc) -> ["OTP-3977"];
+dir_disappeared(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Dir = filename:join(PrivDir, "temp"),
+ ?line ok = file:make_dir(Dir),
+ ?line true = code:add_path(Dir),
+ ?line ok = file:del_dir(Dir),
+ ?line non_existing = code:which(bubbelskrammel),
+ ok.
+
+load_file(suite) -> [];
+load_file(doc) -> [];
+load_file(Config) when is_list(Config) ->
+ ?line {error, nofile} = code:load_file(duuuumy_mod),
+ ?line {error, badfile} = code:load_file(code_a_test),
+ ?line {'EXIT', _} = (catch code:load_file(123)),
+ ?line {module, code_b_test} = code:load_file(code_b_test),
+ TestDir = test_dir(),
+ code:stick_dir(TestDir),
+ ?line {error, sticky_directory} = code:load_file(code_b_test),
+ code:unstick_dir(TestDir),
+ ok.
+
+test_dir() ->
+ filename:dirname(code:which(?MODULE)).
+
+load_abs(suite) -> [];
+load_abs(doc) -> [];
+load_abs(Config) when is_list(Config) ->
+ TestDir = test_dir(),
+ ?line {error, nofile} = code:load_abs(TestDir ++ "/duuuumy_mod"),
+ ?line {error, badfile} = code:load_abs(TestDir ++ "/code_a_test"),
+ ?line {'EXIT', _} = (catch code:load_abs({})),
+ ?line {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"),
+ code:stick_dir(TestDir),
+ ?line {error, sticky_directory} = code:load_abs(TestDir ++ "/code_b_test"),
+ code:unstick_dir(TestDir),
+ ok.
+
+ensure_loaded(suite) -> [];
+ensure_loaded(doc) -> [];
+ensure_loaded(Config) when is_list(Config) ->
+ ?line {module, lists} = code:ensure_loaded(lists),
+ case init:get_argument(mode) of
+ {ok, [["embedded"]]} ->
+ ?line {error, embedded} = code:ensure_loaded(code_b_test),
+ ?line {error, badarg} = code:ensure_loaded(34),
+ ok;
+ _ ->
+ ?line {error, nofile} = code:ensure_loaded(duuuumy_mod),
+ ?line {error, badfile} = code:ensure_loaded(code_a_test),
+ ?line {'EXIT', _} = (catch code:ensure_loaded(34)),
+ ?line {module, code_b_test} = code:ensure_loaded(code_b_test),
+ ?line {module, code_b_test} = code:ensure_loaded(code_b_test),
+ ok
+ end.
+
+delete(suite) -> [];
+delete(doc) -> [];
+delete(Config) when is_list(Config) ->
+ OldFlag = process_flag(trap_exit, true),
+ code:purge(code_b_test),
+ ?line Pid = code_b_test:do_spawn(),
+ ?line true = code:delete(code_b_test),
+ ?line {'EXIT',_} = (catch code:delete(122)),
+ ?line false = code_b_test:check_exit(Pid),
+ ?line false = code:delete(code_b_test),
+ ?line false = code_b_test:check_exit(Pid),
+ exit(Pid,kill),
+ ?line true = code_b_test:check_exit(Pid),
+ ?line false = code:delete(code_b_test),
+ code:purge(code_b_test),
+ process_flag(trap_exit, OldFlag),
+ ok.
+
+purge(suite) -> [];
+purge(doc) -> [];
+purge(Config) when is_list(Config) ->
+ OldFlag = process_flag(trap_exit, true),
+ code:purge(code_b_test),
+ ?line {'EXIT',_} = (catch code:purge({})),
+ ?line false = code:purge(code_b_test),
+ ?line Pid = code_b_test:do_spawn(),
+ ?line true = code:delete(code_b_test),
+ ?line false = code_b_test:check_exit(Pid),
+ ?line true = code:purge(code_b_test),
+ ?line true = code_b_test:check_exit(Pid),
+ process_flag(trap_exit, OldFlag),
+ ok.
+
+soft_purge(suite) -> [];
+soft_purge(doc) -> [];
+soft_purge(Config) when is_list(Config) ->
+ OldFlag = process_flag(trap_exit, true),
+ code:purge(code_b_test),
+ ?line {'EXIT',_} = (catch code:soft_purge(23)),
+ ?line true = code:soft_purge(code_b_test),
+ ?line Pid = code_b_test:do_spawn(),
+ ?line true = code:delete(code_b_test),
+ ?line false = code_b_test:check_exit(Pid),
+ ?line false = code:soft_purge(code_b_test),
+ ?line false = code_b_test:check_exit(Pid),
+ exit(Pid,kill),
+ ?line true = code_b_test:check_exit(Pid),
+ ?line true = code:soft_purge(code_b_test),
+ process_flag(trap_exit, OldFlag),
+ ok.
+
+is_loaded(suite) -> [];
+is_loaded(doc) -> [];
+is_loaded(Config) when is_list(Config) ->
+ code:purge(code_b_test),
+ code:delete(code_b_test),
+ ?line false = code:is_loaded(duuuuuumy_mod),
+ ?line {'EXIT',_} = (catch code:is_loaded(23)),
+ ?line {file, preloaded} = code:is_loaded(init),
+ TestDir = test_dir(),
+ ?line {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"),
+ ?line {file, _Loaded} = code:is_loaded(code_b_test),
+ code:purge(code_b_test),
+ code:delete(code_b_test),
+ ok.
+
+all_loaded(suite) -> [];
+all_loaded(doc) -> [];
+all_loaded(Config) when is_list(Config) ->
+ case ?t:is_cover() of
+ true -> {skip,"Cover is running"};
+ false -> all_loaded_1()
+ end.
+
+all_loaded_1() ->
+ ?line Preloaded = [{M,preloaded} || M <- lists:sort(erlang:pre_loaded())],
+
+ ?line Loaded0 = lists:sort(code:all_loaded()),
+ ?line all_unique(Loaded0),
+ ?line Loaded1 = lists:keysort(2, Loaded0),
+ ?line Loaded2 = match_and_remove(Preloaded, Loaded1),
+
+ ObjExt = code:objfile_extension(),
+ ?line [] = lists:filter(fun({Mod,AbsName}) when is_atom(Mod), is_list(AbsName) ->
+ Mod =:= filename:basename(AbsName, ObjExt);
+ (_) -> true
+ end,
+ Loaded2),
+ ok.
+
+match_and_remove([], List) -> List;
+match_and_remove([X|T1], [X|T2]) -> match_and_remove(T1, T2).
+
+all_unique([]) -> ok;
+all_unique([_]) -> ok;
+all_unique([{X,_}|[{Y,_}|_]=T]) when X < Y -> all_unique(T).
+
+load_binary(suite) -> [];
+load_binary(doc) -> [];
+load_binary(Config) when is_list(Config) ->
+ TestDir = test_dir(),
+ File = TestDir ++ "/code_b_test" ++ code:objfile_extension(),
+ ?line {ok,Bin} = file:read_file(File),
+ ?line {'EXIT',_} = (catch code:load_binary(12, File, Bin)),
+ ?line {'EXIT',_} = (catch code:load_binary(code_b_test, 12, Bin)),
+ ?line {'EXIT',_} = (catch code:load_binary(code_b_test, File, 12)),
+ ?line {module, code_b_test} = code:load_binary(code_b_test, File, Bin),
+ code:stick_dir(TestDir),
+ ?line {error, sticky_directory} = code:load_binary(code_b_test, File, Bin),
+ code:unstick_dir(TestDir),
+ code:purge(code_b_test),
+ code:delete(code_b_test),
+ ok.
+
+dir_req(suite) -> [];
+dir_req(doc) -> [];
+dir_req(Config) when is_list(Config) ->
+ ?line {ok,[[Root0]]} = init:get_argument(root),
+ ?line Root = filename:join([Root0]), % Normalised form.
+ ?line Root = code:root_dir(),
+ LibDir = Root ++ "/lib",
+ ?line LibDir = code:lib_dir(),
+ ?line code:compiler_dir(),
+ ?line {error, bad_name} = code:lib_dir(duuumy),
+ ?line KernLib = code:lib_dir(kernel),
+ ?line Priv = KernLib ++ "/priv",
+ ?line Priv = code:priv_dir(kernel),
+ ?line {error, bad_name} = code:priv_dir(duuumy),
+ ok.
+
+object_code(suite) -> [];
+object_code(doc) -> [];
+object_code(Config) when is_list(Config) ->
+ TestDir = test_dir(),
+ P = code:get_path(),
+ P = code:get_path(),
+ code:add_path(TestDir),
+ ?line {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"),
+ LoadedFile = filename:absname(TestDir ++ "/code_b_test" ++
+ code:objfile_extension()),
+ ?line case code:get_object_code(code_b_test) of
+ {code_b_test,Bin,LoadedFile} when is_binary(Bin) ->
+ ok
+ end,
+ code:purge(code_b_test),
+ code:delete(code_b_test),
+ ?line error = code:get_object_code(dddddddduuuuuuumy),
+ ?line {'EXIT',_} = (catch code:get_object_code(23)),
+ ?line code:set_path(P),
+ ?line P=code:get_path(),
+ ok.
+
+set_path_file(suite) -> [];
+set_path_file(doc) -> ["Test that set_path does not accept ",
+ "files as pathnames (known previous bug)"];
+set_path_file(Config) when is_list(Config) ->
+ File=filename:join(?config(priv_dir, Config), "testfil"),
+ ?line ok=file:write_file(File, list_to_binary("lite data")),
+ ?line {error, bad_directory}=code:set_path([File]).
+
+sticky_dir(suite) -> [];
+sticky_dir(doc) -> ["Test that a module with the same name as a module in ",
+ "a sticky directory cannot be loaded."];
+sticky_dir(Config) when is_list(Config) ->
+ MyDir=filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node}=?t:start_node(sticky_dir, slave,[{args, "-pa "++MyDir}]),
+ File=filename:join([?config(data_dir, Config), "calendar"]),
+ ?line Ret=rpc:call(Node, ?MODULE, sticky_compiler, [File]),
+ case Ret of
+ fail ->
+ ?t:fail("c:c allowed a sticky module to be compiled and loaded.");
+ ok ->
+ ok;
+ Other ->
+ test_server:format("Other: ~p",[Other])
+ end,
+ ?t:stop_node(Node).
+
+sticky_compiler(File) ->
+ Compiled=File++code:objfile_extension(),
+ Dir=filename:dirname(File),
+ code:add_patha(Dir),
+ file:delete(Compiled),
+ case c:c(File, [{outdir, Dir}]) of
+ {ok, Module} ->
+ case catch Module:test(apa) of
+ {error, _} ->
+ fail;
+ {'EXIT', _} ->
+ ok
+ end;
+ Other ->
+ test_server:format("c:c(~p) returned: ~p",[File, Other]),
+ ok
+ end.
+
+pa_pz_option(suite) -> [];
+pa_pz_option(doc) -> ["Test that the -pa and -pz options work as expected"];
+pa_pz_option(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "Slave nodes not supported on VxWorks"};
+ _ ->
+ DDir = ?config(data_dir,Config),
+ PaDir = filename:join(DDir,"pa"),
+ PzDir = filename:join(DDir,"pz"),
+ ?line {ok, Node}=?t:start_node(pa_pz1, slave,
+ [{args,
+ "-pa " ++ PaDir
+ ++ " -pz " ++ PzDir}]),
+ ?line Ret=rpc:call(Node, code, get_path, []),
+ ?line [PaDir|Paths] = Ret,
+ ?line [PzDir|_] = lists:reverse(Paths),
+ ?t:stop_node(Node),
+ ?line {ok, Node2}=?t:start_node(pa_pz2, slave,
+ [{args,
+ "-mode embedded " ++ "-pa "
+ ++ PaDir ++ " -pz " ++ PzDir}]),
+ ?line Ret2=rpc:call(Node2, code, get_path, []),
+ ?line [PaDir|Paths2] = Ret2,
+ ?line [PzDir|_] = lists:reverse(Paths2),
+ ?t:stop_node(Node2)
+ end.
+
+add_del_path(suite) ->
+ [];
+add_del_path(doc) -> ["add_path, del_path should not cause priv_dir(App) to fail"];
+add_del_path(Config) ->
+ DDir = ?config(data_dir,Config),
+ Dir1 = filename:join(DDir,"dummy_app-1.0/ebin"),
+ Dir2 = filename:join(DDir,"dummy_app-2.0/ebin"),
+ code:add_patha(Dir1),
+ ?line PrivDir1 = filename:join(DDir,"dummy_app-1.0/priv"),
+ ?line PrivDir1 = code:priv_dir(dummy_app),
+ ?line code:add_path(Dir2), % put last in path
+ ?line PrivDir1 = code:priv_dir(dummy_app),
+ ?line code:del_path(Dir2),
+ ?line PrivDir1 = code:priv_dir(dummy_app),
+ ok.
+
+
+ext_mod_dep(suite) ->
+ [];
+ext_mod_dep(doce) ->
+ ["Every module that the code_server uses should be preloaded, "
+ "this test case verifies that"];
+ext_mod_dep(Config) when is_list(Config) ->
+ xref:start(s),
+ xref:set_default(s, [{verbose,false},{warnings,false},
+ {builtins,true},{recurse,true}]),
+ xref:set_library_path(s, code:get_path()),
+ xref:add_directory(s, filename:dirname(code:which(kernel))),
+ xref:add_directory(s, filename:dirname(code:which(lists))),
+ case catch ext_mod_dep2() of
+ {'EXIT', Reason} ->
+ xref:stop(s),
+ exit(Reason);
+ Else ->
+ xref:stop(s),
+ case Else of
+ ok -> ok;
+ _ -> test_server:fail(Else)
+ end
+ end.
+
+ext_mod_dep2() ->
+ Exports0 = code_server:module_info(exports) --
+ [{module_info,0},{module_info,1}],
+ Exports = [{code_server,M,A} || {M,A} <- Exports0],
+ case analyse(Exports, [], [], 0) of
+ {_Visited,0} ->
+ ok;
+ {_Visited,ErrCnt} ->
+ {not_verified,ErrCnt}
+ end.
+
+analyse([], [], Visited, ErrCnt) ->
+ {Visited,ErrCnt};
+analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) ->
+ %% The code_server has been granted to use the following modules,
+ %% These modules should be loaded by code.erl before
+ %% the code_server is started.
+ OK = [erlang, os, prim_file, erl_prim_loader, init, ets,
+ code_server, lists, lists_sort, filename, packages,
+ gb_sets, gb_trees, hipe_unified_loader, hipe_bifs,
+ prim_zip, zlib],
+ ErrCnt1 =
+ case lists:member(M, OK) or erlang:is_builtin(M,F,A) of
+ true ->
+ 0;
+ false ->
+ check_funs(This, Path)
+ end,
+ {Visited, ErrCnt1+ErrCnt0};
+analyse([MFA|R], Path, Visited0, ErrCnt0) ->
+ case lists:member(MFA,Visited0) of
+ false ->
+ {Visited,ErrCnt1} = analyse2(MFA, Path, Visited0),
+ analyse(R, Path, Visited, ErrCnt1+ErrCnt0);
+ true ->
+ analyse(R, Path, Visited0, ErrCnt0)
+ end.
+
+analyse2(MFA = {'$M_EXPR',_, _}, Path, Visited0) ->
+ analyse([], [MFA|Path], Visited0, 0);
+analyse2(MFA={_,_,_}, Path, Visited0) ->
+ {ok, FL} = xref:analyze(s,{call,MFA}),
+ analyse(FL, [MFA|Path], my_usort([MFA|Visited0]), 0).
+
+%%%% We need to check these manually...
+% fun's are ok as long as they are defined locally.
+check_funs({'$M_EXPR','$F_EXPR',_},
+ [{code_server,load_native_code,4},
+ {code_server,load_native_code_1,2},
+ {code_server,load_native_code,2},
+ {code_server,try_load_module,4},
+ {code_server,do_load_binary,4},
+ {code_server,handle_call,3},
+ {code_server,loop,1}|_]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',_},
+ [{code_server,do_mod_call,4},
+ {code_server,handle_call,3}|_]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',_},
+ [{lists,flatmap,2},
+ {lists,concat,1},
+ {code_server,load_abs,4},
+ {code_server,handle_call,3},
+ {code_server,loop,1}|_]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',_},
+ [{lists,foreach,2},
+ {code_server,stick_dir,3},
+ {code_server,handle_call,3},
+ {code_server,loop,1}|_]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',1},
+ [{lists,all,2},
+ {code_server,is_numstr,1},
+ {code_server,is_vsn,1},
+ {code_server,vsn_to_num,1},
+ {code_server,create_bundle,2},
+ {code_server,choose_bundles,1},
+ {code_server,make_path,2},
+ {code_server,get_user_lib_dirs_1,1},
+ {code_server,get_user_lib_dirs,0},
+ {code_server,init,3},
+ {code_server,start_link,1}]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',1},
+ [{lists,filter,2},
+ {code_server,try_archive_subdirs,3},
+ {code_server,all_archive_subdirs,1},
+ {code_server,archive_subdirs,1},
+ {code_server,insert_name,3},
+ {code_server,replace_name,2},
+ {code_server,update,2},
+ {code_server,maybe_update,2},
+ {code_server,do_add,4},
+ {code_server,add_path,4},
+ {code_server,handle_call,3},
+ {code_server,loop,1},
+ {code_server,system_continue,3}]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',_},
+ [{erlang,apply,2},
+ {erlang,spawn_link,1},
+ {code_server,start_link,1}]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',_},
+ [{erlang,spawn_link,1},{code_server,start_link,1}]) -> 0;
+check_funs({'$M_EXPR',module_info,1},
+ [{hipe_unified_loader,patch_to_emu_step1,1} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',2},
+ [{lists,foldl,3},
+ {hipe_unified_loader,sort_and_write,4} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',1},
+ [{lists,foreach,2},
+ {hipe_unified_loader,patch_consts,3} | _]) -> 0;
+%% This is cheating! /raimo
+%%
+%% check_funs(This = {M,_,_}, Path) ->
+%% case catch atom_to_list(M) of
+%% [$h,$i,$p,$e | _] ->
+%% test_server:format("hipe_module_ignored(~p, ~p)~n", [This, Path]),
+%% 0;
+%% _ ->
+%% test_server:format("not_verified(~p, ~p)~n", [This, Path]),
+%% 1
+%% end;
+check_funs(This, Path) ->
+ test_server:format("not_verified(~p, ~p)~n", [This, Path]),
+ 1.
+
+my_usort(List) ->
+ lists:reverse(uniq(lists:sort(List),[])).
+
+uniq([],A) ->
+ A;
+uniq([H|T],[]) ->
+ uniq(T,[H]);
+uniq([H|T],[H|_]=A) ->
+ uniq(T,A);
+uniq([H|T],A) ->
+ uniq(T,[H|A]).
+
+
+load_cached(suite) ->
+ [];
+load_cached(doc) ->
+ [];
+load_cached(Config) when is_list(Config) ->
+ ?line Priv = ?config(priv_dir, Config),
+ ?line WD = filename:dirname(code:which(?MODULE)),
+ ?line {ok,Node} =
+ ?t:start_node(code_cache_node, peer, [{args,
+ "-pa " ++ WD},
+ {erl, [this]}]),
+ CCTabCreated = fun(Tab) ->
+ case ets:info(Tab, name) of
+ code_cache -> true;
+ _ -> false
+ end
+ end,
+ ?line Tabs = rpc:call(Node, ets, all, []),
+ case rpc:call(Node, lists, any, [CCTabCreated,Tabs]) of
+ true ->
+ ?t:stop_node(Node),
+ ?t:fail("Code cache should not be active!");
+ false ->
+ ok
+ end,
+ ?line rpc:call(Node, code, del_path, [Priv]),
+ ?line rpc:call(Node, code, add_pathz, [Priv]),
+
+ FullModName = Priv ++ "/code_cache_test",
+ ?line {ok,Dev} = file:open(FullModName ++ ".erl", [write]),
+ ?line io:format(Dev, "-module(code_cache_test). -export([a/0]). a() -> ok.~n", []),
+ ?line ok = file:close(Dev),
+ ?line {ok,code_cache_test} = compile:file(FullModName, [{outdir,Priv}]),
+
+ F = fun load_loop/2,
+ N = 1000,
+ ?line {T0,T1} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]),
+ TNoCache = now_diff(T1, T0),
+ ?line rpc:call(Node, code, rehash, []),
+ ?line {T2,T3} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]),
+ ?line TCache = now_diff(T3, T2),
+ AvgNoCache = TNoCache/N,
+ AvgCache = TCache/N,
+ ?line io:format("Avg. load time (no_cache/cache): ~w/~w~n", [AvgNoCache,AvgCache]),
+ ?t:stop_node(Node),
+ if AvgNoCache =< AvgCache ->
+ ?t:fail("Cache not working properly.");
+ true ->
+ ok
+ end.
+
+load_loop(N, M) ->
+ load_loop(N, M, now()).
+load_loop(0, _M, T0) ->
+ {T0,now()};
+load_loop(N, M, T0) ->
+ code:load_file(M),
+ code:delete(M),
+ code:purge(M),
+ load_loop(N-1, M, T0).
+
+now_diff({A2, B2, C2}, {A1, B1, C1}) ->
+ ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1.
+
+start_node_with_cache(suite) ->
+ [];
+start_node_with_cache(doc) ->
+ [];
+start_node_with_cache(Config) when is_list(Config) ->
+ ?line {ok,Node} =
+ ?t:start_node(code_cache_node, peer, [{args,
+ "-code_path_cache"},
+ {erl, [this]}]),
+ ?line Tabs = rpc:call(Node, ets, all, []),
+ io:format("Tabs: ~w~n", [Tabs]),
+ CCTabCreated = fun(Tab) ->
+ case rpc:call(Node, ets, info, [Tab,name]) of
+ code_cache -> true;
+ _ -> false
+ end
+ end,
+ ?line true = lists:any(CCTabCreated, Tabs),
+ ?t:stop_node(Node),
+ ok.
+
+add_and_rehash(suite) ->
+ [];
+add_and_rehash(doc) ->
+ [];
+add_and_rehash(Config) when is_list(Config) ->
+ ?line Priv = ?config(priv_dir, Config),
+ ?line WD = filename:dirname(code:which(?MODULE)),
+ ?line {ok,Node} =
+ ?t:start_node(code_cache_node, peer, [{args,
+ "-pa " ++ WD},
+ {erl, [this]}]),
+ CCTabCreated = fun(Tab) ->
+ case ets:info(Tab, name) of
+ code_cache -> true;
+ _ -> false
+ end
+ end,
+ ?line Tabs0 = rpc:call(Node, ets, all, []),
+ case rpc:call(Node, lists, any, [CCTabCreated,Tabs0]) of
+ true ->
+ ?t:stop_node(Node),
+ ?t:fail("Code cache should not be active!");
+ false ->
+ ok
+ end,
+ ?line ok = rpc:call(Node, code, rehash, []), % create cache
+ ?line Tabs1 = rpc:call(Node, ets, all, []),
+ ?line true = rpc:call(Node, lists, any, [CCTabCreated,Tabs1]), % cache table created
+ ?line ok = rpc:call(Node, code, rehash, []),
+ OkDir = filename:join(Priv, ""),
+ BadDir = filename:join(Priv, "guggemuffsussiputt"),
+ ?line CP = [OkDir | rpc:call(Node, code, get_path, [])],
+ ?line true = rpc:call(Node, code, set_path, [CP]),
+ CP1 = [BadDir | CP],
+ ?line {error,_} = rpc:call(Node, code, set_path, [CP1]),
+ ?line true = rpc:call(Node, code, del_path, [OkDir]),
+ ?line true = rpc:call(Node, code, add_path, [OkDir]),
+ ?line true = rpc:call(Node, code, add_path, [OkDir]),
+ ?line {error,_} = rpc:call(Node, code, add_path, [BadDir]),
+ ?line ok = rpc:call(Node, code, rehash, []),
+ ok.
+
+where_is_file_no_cache(suite) ->
+ [];
+where_is_file_no_cache(doc) ->
+ [];
+where_is_file_no_cache(Config) when is_list(Config) ->
+ ?line {T,KernelBeamFile} = timer:tc(code, where_is_file, ["kernel.beam"]),
+ io:format("Load time: ~w ms~n", [T]),
+ ?line KernelEbinDir = filename:dirname(KernelBeamFile),
+ ?line AppFile = filename:join(KernelEbinDir, "kernel.app"),
+ ?line AppFile = code:where_is_file("kernel.app"),
+ ?line non_existing = code:where_is_file("kernel"), % no such file
+ ok.
+
+where_is_file_cached(suite) ->
+ [];
+where_is_file_cached(doc) ->
+ [];
+where_is_file_cached(Config) when is_list(Config) ->
+ ?line {ok,Node} =
+ ?t:start_node(code_cache_node, peer, [{args,
+ "-code_path_cache"},
+ {erl, [this]}]),
+ ?line Tabs = rpc:call(Node, ets, all, []),
+ io:format("Tabs: ~w~n", [Tabs]),
+ CCTabCreated = fun(Tab) ->
+ case rpc:call(Node, ets, info, [Tab,name]) of
+ code_cache -> true;
+ _ -> false
+ end
+ end,
+ ?line true = lists:any(CCTabCreated, Tabs),
+ ?line KernelBeamFile = rpc:call(Node, code, where_is_file, ["kernel.beam"]),
+ ?line {T,KernelBeamFile} = rpc:call(Node, timer, tc, [code,where_is_file,["kernel.beam"]]),
+ io:format("Load time: ~w ms~n", [T]),
+ ?line KernelEbinDir = rpc:call(Node, filename, dirname, [KernelBeamFile]),
+ ?line AppFile = rpc:call(Node, filename, join, [KernelEbinDir,"kernel.app"]),
+ ?line AppFile = rpc:call(Node, code, where_is_file, ["kernel.app"]),
+ ?line non_existing = rpc:call(Node, code, where_is_file, ["kernel"]), % no such file
+ ?t:stop_node(Node),
+ ok.
+
+
+purge_stacktrace(suite) ->
+ [];
+purge_stacktrace(doc) ->
+ ["Test that stacktrace is deleted when purging a referred module"];
+purge_stacktrace(Config) when is_list(Config) ->
+ ?line code:purge(code_b_test),
+ try code_b_test:call(fun(b) -> ok end, a)
+ catch
+ error:function_clause ->
+ ?line code:load_file(code_b_test),
+ ?line case erlang:get_stacktrace() of
+ [{?MODULE,_,[a]},
+ {code_b_test,call,2},
+ {?MODULE,purge_stacktrace,1}|_] ->
+ ?line false = code:purge(code_b_test),
+ ?line [] = erlang:get_stacktrace()
+ end
+ end,
+ try code_b_test:call(nofun, 2)
+ catch
+ error:function_clause ->
+ ?line code:load_file(code_b_test),
+ ?line case erlang:get_stacktrace() of
+ [{code_b_test,call,[nofun,2]},
+ {?MODULE,purge_stacktrace,1}|_] ->
+ ?line false = code:purge(code_b_test),
+ ?line [] = erlang:get_stacktrace()
+ end
+ end,
+ Args = [erlang,error,[badarg]],
+ try code_b_test:call(erlang, error, [badarg,Args])
+ catch
+ error:badarg ->
+ ?line code:load_file(code_b_test),
+ ?line case erlang:get_stacktrace() of
+ [{code_b_test,call,Args},
+ {?MODULE,purge_stacktrace,1}|_] ->
+ ?line false = code:purge(code_b_test),
+ ?line [] = erlang:get_stacktrace()
+ end
+ end,
+ ok.
+
+mult_lib_roots(Config) when is_list(Config) ->
+ ?line DataDir = filename:join(?config(data_dir, Config), "mult_lib_roots"),
+ ?line mult_lib_compile(DataDir, "my_dummy_app-b/ebin/lists"),
+ ?line mult_lib_compile(DataDir,
+ "my_dummy_app-c/ebin/code_SUITE_mult_root_module"),
+
+ %% Set up ERL_LIBS and start a slave node.
+ ErlLibs = filename:join(DataDir, first_root) ++ mult_lib_sep() ++
+ filename:join(DataDir, second_root),
+
+ ?line {ok,Node} =
+ ?t:start_node(mult_lib_roots, slave,
+ [{args,"-env ERL_LIBS "++ErlLibs}]),
+
+ ?line {ok,Cwd} = file:get_cwd(),
+ ?line Path0 = rpc:call(Node, code, get_path, []),
+ ?line [Cwd,"."|Path1] = Path0,
+ ?line [Kernel|Path2] = Path1,
+ ?line [Stdlib|Path3] = Path2,
+ ?line mult_lib_verify_lib(Kernel, "kernel"),
+ ?line mult_lib_verify_lib(Stdlib, "stdlib"),
+ ?line [Lib1,Lib2,Lib3,Lib4,Lib5|Path] = Path3,
+
+
+ ["first_root/my_dummy_app-a/ebin",
+ "first_root/my_dummy_app-b/ebin",
+ "first_root/my_dummy_app-c/ebin",
+ "second_root/my_dummy_app-d/ebin",
+ "second_root/my_dummy_app-e/ebin"] =
+ [mult_lib_remove_prefix(E, DataDir) ||
+ E <- lists:sort([Lib1,Lib2,Lib3,Lib4,Lib5])],
+ io:format("~p\n", [Path]),
+
+ ?line true = rpc:call(Node, code_SUITE_mult_root_module, works_fine, []),
+
+ ?line ?t:stop_node(Node),
+ ok.
+
+mult_lib_compile(Root, Last) ->
+ Mod = list_to_atom(filename:basename(Last)),
+ Name = filename:join([Root,"first_root",Last]),
+ Dir = filename:dirname(Name),
+ {ok,Mod} = compile:file(Name, [report,{outdir,Dir}]),
+ ok.
+
+mult_lib_sep() ->
+ case os:type() of
+ {win32,_} -> ";";
+ _ -> ":"
+ end.
+
+mult_lib_verify_lib(Path, Expected) ->
+ Dir = filename:basename(filename:dirname(Path)),
+ true = lists:prefix(Expected, Dir).
+
+mult_lib_remove_prefix([H|T1], [H|T2]) ->
+ mult_lib_remove_prefix(T1, T2);
+mult_lib_remove_prefix([$/|T], []) -> T.
+
+bad_erl_libs(Config) when is_list(Config) ->
+ ?line {ok,Node} =
+ ?t:start_node(mult_lib_roots, slave,
+ [{args,"-env ERL_LIBS "}]),
+
+ ?line ?t:stop_node(Node),
+
+ ?line {ok,Node2} =
+ ?t:start_node(mult_lib_roots, slave,
+ [{args,"-env ERL_LIBS /no/such/dir"}]),
+
+ ?line ?t:stop_node(Node2),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Create an archive file containing an application and make use of it.
+
+code_archive(Config) when is_list(Config) ->
+ do_code_archive(Config, "code_archive_libs", false).
+
+code_archive2(Config) when is_list(Config) ->
+ do_code_archive(Config, "code_archive_libs2", true).
+
+do_code_archive(Config, Root, StripVsn) when is_list(Config) ->
+ %% Copy the orig files to priv_dir
+ DataDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ App = code_archive_dict,
+ VsnBase = atom_to_list(App) ++ "-1.0",
+ Base =
+ case StripVsn of
+ true -> atom_to_list(App);
+ false -> VsnBase
+ end,
+ Ext = init:archive_extension(),
+ RootDir = filename:join([PrivDir, Root]),
+ ?line ok = file:make_dir(RootDir),
+ Archive = filename:join([RootDir, VsnBase ++ Ext]),
+ ?line {ok, _} = zip:create(Archive, [VsnBase],
+ [{compress, []}, {cwd, DataDir}]),
+ ?line {ok, _} = zip:extract(Archive, [{cwd, PrivDir}]),
+
+ case StripVsn of
+ true ->
+ ?line ok = file:rename(filename:join([PrivDir, VsnBase]),
+ filename:join([PrivDir, Base]));
+ false ->
+ ok
+ end,
+
+ io:format("DEBUG: ~p\n", [?LINE]),
+ %% Compile the code
+ ?line ok = compile_app(PrivDir, Base),
+
+ %% Create the archive
+ ?line ok = file:delete(Archive),
+ ?line {ok, _} = zip:create(Archive, [Base],
+ [{compress, []}, {cwd, PrivDir}]),
+
+ %% Set up ERL_LIBS and start a slave node.
+ ?line {ok, Node} =
+ ?t:start_node(code_archive, slave,
+ [{args,"-env ERL_LIBS " ++ RootDir}]),
+ ?line CodePath = rpc:call(Node, code, get_path, []),
+ AppEbin = filename:join([Archive, Base, "ebin"]),
+ io:format("AppEbin: ~p\n", [AppEbin]),
+ io:format("CodePath: ~p\n", [CodePath]),
+ io:format("Archive: ~p\n", [erl_prim_loader:read_file_info(Archive)]),
+ ?line true = lists:member(AppEbin, CodePath),
+
+ %% Start the app
+ ?line ok = rpc:call(Node, application, start, [App]),
+
+ %% Access the app priv dir
+ AppPrivDir = rpc:call(Node, code, priv_dir, [App]),
+ ?line AppPrivFile = filename:join([AppPrivDir, "code_archive.txt"]),
+ io:format("AppPrivFile: ~p\n", [AppPrivFile]),
+ ?line {ok, _Bin, _Path} =
+ rpc:call(Node, erl_prim_loader, get_file, [AppPrivFile]),
+
+ %% Use the app
+ Tab = code_archive_tab,
+ Key = foo,
+ Val = bar,
+ {ok, _Pid} = rpc:call(Node, App, new, [Tab]),
+ error = rpc:call(Node, App, find, [Tab, Key]),
+ ok = rpc:call(Node, App, store, [Tab, Key, Val]),
+ {ok, Val} = rpc:call(Node, App, find, [Tab, Key]),
+ ok = rpc:call(Node, App, erase, [Tab, Key]),
+ error = rpc:call(Node, App, find, [Tab, Key]),
+ ok = rpc:call(Node, App, erase, [Tab]),
+
+ ?line ?t:stop_node(Node),
+ ok.
+
+compile_app(TopDir, AppName) ->
+ AppDir = filename:join([TopDir, AppName]),
+ SrcDir = filename:join([AppDir, "src"]),
+ OutDir = filename:join([AppDir, "ebin"]),
+ ?line {ok, Files} = file:list_dir(SrcDir),
+ compile_files(Files, SrcDir, OutDir).
+
+compile_files([File | Files], SrcDir, OutDir) ->
+ case filename:extension(File) of
+ ".erl" ->
+ AbsFile = filename:join([SrcDir, File]),
+ case compile:file(AbsFile, [{outdir, OutDir}]) of
+ {ok, _Mod} ->
+ compile_files(Files, SrcDir, OutDir);
+ Error ->
+ {compilation_error, AbsFile, OutDir, Error}
+ end;
+ _ ->
+ compile_files(Files, SrcDir, OutDir)
+ end;
+compile_files([], _, _) ->
+ ok.
+
+on_load(Config) when is_list(Config) ->
+ Master = on_load_test_case_process,
+
+ ?line Data = filename:join([?config(data_dir, Config),"on_load"]),
+ ?line ok = file:set_cwd(Data),
+ ?line up_to_date = make:all([{d,'MASTER',Master}]),
+
+ %% Register a name for this process.
+ ?line register(Master, self()),
+
+ ?line {_,Ref} = spawn_monitor(fun() ->
+ exit(on_load_a:data())
+ end),
+ receive
+ {on_load_a,start} -> ok
+ end,
+ receive
+ {on_load_b,start} -> ok
+ end,
+ receive
+ {on_load_c,PidC} -> ok
+ end,
+
+ ?line Refs = on_load_massive_spawn(lists:seq(1, 50)),
+ receive after 7 -> ok end,
+
+ PidC ! go,
+
+ KernelLibDir = code:lib_dir(kernel),
+ receive
+ {on_load_c,done} -> ok
+ end,
+ receive
+ {on_load_b,done} -> ok
+ end,
+ receive
+ {on_load_a,KernelLibDir} -> ok
+ end,
+
+ receive
+ {'DOWN',Ref,process,_,Res} ->
+ ?line [a,b,c] = Res
+ end,
+
+ on_load_wait_for_all(Refs),
+ receive
+ Any ->
+ ?line ?t:fail({unexpected,Any})
+ after 10 ->
+ ok
+ end.
+
+on_load_massive_spawn([_|T]) ->
+ {_,Ra} = spawn_monitor(fun() -> [a,b,c] = on_load_a:data() end),
+ {_,Rb} = spawn_monitor(fun() -> [b,c] = on_load_b:data() end),
+ {_,Rc} = spawn_monitor(fun() -> [c] = on_load_c:data() end),
+ [Ra,Rb,Rc|on_load_massive_spawn(T)];
+on_load_massive_spawn([]) -> [].
+
+on_load_wait_for_all([Ref|T]) ->
+ receive
+ {'DOWN',Ref,process,_,normal} ->
+ on_load_wait_for_all(T)
+ end;
+on_load_wait_for_all([]) -> ok.
+
+on_load_embedded(Config) when is_list(Config) ->
+ try
+ on_load_embedded_1(Config)
+ catch
+ throw:{skip,_}=Skip ->
+ Skip
+ end.
+
+on_load_embedded_1(Config) ->
+ ?line DataDir = ?config(data_dir, Config),
+
+ %% Link the on_load_app application into the lib directory.
+ ?line LibRoot = code:lib_dir(),
+ ?line LinkName = filename:join(LibRoot, "on_load_app-1.0"),
+ ?line OnLoadApp = filename:join(DataDir, "on_load_app-1.0"),
+ ?line file:delete(LinkName),
+ case file:make_symlink(OnLoadApp, LinkName) of
+ {error,enotsup} ->
+ throw({skip,"Support for symlinks required"});
+ ok -> ok
+ end,
+
+ %% Compile the code.
+ ?line OnLoadAppEbin = filename:join(LinkName, "ebin"),
+ ?line {ok,_ } = compile:file(filename:join([OnLoadApp,"src",
+ "on_load_embedded"]),
+ [{outdir,OnLoadAppEbin}]),
+
+ %% Create and compile a boot file.
+ ?line true = code:add_pathz(OnLoadAppEbin),
+ Options = case is_source_dir() of
+ true -> [local];
+ false -> []
+ end,
+ ?line BootScript = create_boot(Config, Options),
+ ?line true = code:del_path(OnLoadAppEbin),
+
+ %% Start the node and check that the on_load function was run.
+ ?line {ok,Node} = start_node(on_load_embedded,
+ "-mode embedded -boot " ++ BootScript),
+ ok = rpc:call(Node, on_load_embedded, status, []),
+
+ %% Clean up.
+ ?line stop_node(Node),
+ ?line ok = file:delete(LinkName).
+
+create_boot(Config, Options) ->
+ ?line {ok, OldDir} = file:get_cwd(),
+ ?line {LatestDir,LatestName} = create_script(Config),
+ ?line ok = file:set_cwd(LatestDir),
+ ?line ok = systools:make_script(LatestName, Options),
+ ?line ok = file:set_cwd(OldDir),
+ filename:join(LatestDir, LatestName).
+
+create_script(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Name = PrivDir ++ "on_load_test",
+ ?line Apps = application_controller:which_applications(),
+ ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel, 1, Apps),
+ ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib, 1, Apps),
+ ?line {ok,Fd} = file:open(Name ++ ".rel", write),
+ ?line io:format(Fd,
+ "{release, {\"Test release 3\", \"P2A\"}, \n"
+ " {erts, \"9.42\"}, \n"
+ " [{kernel, \"~s\"}, {stdlib, \"~s\"},"
+ " {on_load_app, \"1.0\"}]}.\n",
+ [KernelVer,StdlibVer]),
+ ?line file:close(Fd),
+ {filename:dirname(Name),filename:basename(Name)}.
+
+is_source_dir() ->
+ filename:basename(code:lib_dir(kernel)) =:= "kernel" andalso
+ filename:basename(code:lib_dir(stdlib)) =:= "stdlib".
+
+start_node(Name, Param) ->
+ ?t:start_node(Name, slave, [{args, Param}]).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
diff --git a/lib/kernel/test/code_SUITE_data/calendar.erl b/lib/kernel/test/code_SUITE_data/calendar.erl
new file mode 100644
index 0000000000..c1a4a1c12a
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/calendar.erl
@@ -0,0 +1,23 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(calendar).
+-export([test/1]).
+
+test(apa) ->
+ {error, this_function_should_not_be_called}.
diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/ebin/code_archive_dict.app b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/ebin/code_archive_dict.app
new file mode 100644
index 0000000000..e3b5a5ce03
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/ebin/code_archive_dict.app
@@ -0,0 +1,12 @@
+{application, code_archive_dict,
+ [{description, "code_archive_dict"},
+ {vsn, "1.0"},
+ {modules, [
+ code_archive_dict,
+ code_archive_dict_sup
+ ]},
+ {registered, [
+ code_archive_dict_sup
+ ]},
+ {applications, [kernel, stdlib]},
+ {mod, {code_archive_dict_app, [[]]}}]}.
diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/priv/code_archive.txt b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/priv/code_archive.txt
new file mode 100644
index 0000000000..8fa2c8c064
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/priv/code_archive.txt
@@ -0,0 +1 @@
+Some private data...
diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict.erl b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict.erl
new file mode 100644
index 0000000000..ccc954ee17
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict.erl
@@ -0,0 +1,125 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code_archive_dict).
+-behaviour(sys).
+
+%% Public
+-export([new/1, store/3, erase/2, find/2, foldl/3, erase/1]).
+
+%% Internal
+-export([init/3, loop/3]).
+
+%% supervisor callback
+-export([start_link/2]).
+
+%% sys callback functions
+-export([
+ system_continue/3,
+ system_terminate/4,
+ system_code_change/4
+ ]).
+
+-define(SUPERVISOR, code_archive_dict_sup).
+
+start_link(Name, Debug) ->
+ proc_lib:start_link(?MODULE, init, [self(), Name, Debug], infinity, []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Client
+
+new(Name) ->
+ supervisor:start_child(?SUPERVISOR, [Name]).
+
+store(Pid, Key, Val) ->
+ call(Pid, {store, Key, Val}).
+
+erase(Pid, Key) ->
+ call(Pid, {erase, Key}).
+
+find(Pid, Key) ->
+ call(Pid, {find, Key}).
+
+foldl(Pid, Fun, Acc) ->
+ call(Pid, {foldl, Fun, Acc}).
+
+erase(Pid) ->
+ call(Pid, stop).
+
+call(Name, Msg) when is_atom(Name) ->
+ call(whereis(Name), Msg);
+call(Pid, Msg) when is_pid(Pid) ->
+ Ref = erlang:monitor(process, Pid),
+ Pid ! {self(), Ref, Msg},
+ receive
+ {Ref, Reply} ->
+ erlang:demonitor(Ref, [flush]),
+ Reply;
+ {'DOWN', Ref, _, _, Reason} ->
+ {error, Reason}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Server
+
+init(Parent, Name, Debug) ->
+ register(Name, self()),
+ Dict = dict:new(),
+ proc_lib:init_ack(Parent, {ok, self()}),
+ loop(Dict, Parent, Debug).
+
+loop(Dict, Parent, Debug) ->
+ receive
+ {system, From, Msg} ->
+ sys:handle_system_msg(Msg, From, Parent, ?MODULE, Debug, Dict);
+ {ReplyTo, Ref, {store, Key, Val}} ->
+ Dict2 = dict:store(Key, Val, Dict),
+ ReplyTo ! {Ref, ok},
+ ?MODULE:loop(Dict2, Parent, Debug);
+ {ReplyTo, Ref, {erase, Key}} ->
+ Dict2 = dict:erase(Key, Dict),
+ ReplyTo ! {Ref, ok},
+ ?MODULE:loop(Dict2, Parent, Debug);
+ {ReplyTo, Ref, {find, Key}} ->
+ Res = dict:find(Key, Dict),
+ ReplyTo ! {Ref, Res},
+ ?MODULE:loop(Dict, Parent, Debug);
+ {ReplyTo, Ref, {foldl, Fun, Acc}} ->
+ Acc2 = dict:foldl(Fun, Acc, Dict),
+ ReplyTo ! {Ref, {ok, Acc2}},
+ ?MODULE:loop(Dict, Parent, Debug);
+ {ReplyTo, Ref, stop} ->
+ ReplyTo ! {Ref, ok},
+ exit(normal);
+ Msg ->
+ error_logger:format("~p got unexpected message: ~p\n",
+ [self(), Msg]),
+ ?MODULE:loop(Dict, Parent, Debug)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% sys callbacks
+
+system_continue(Parent, Debug, Dict) ->
+ ?MODULE:loop(Dict, Parent, Debug).
+
+system_terminate(Reason, _Parent, _Debug, _Dict) ->
+ exit(Reason).
+
+system_code_change(Dict,_Module,_OldVsn,_Extra) ->
+ {ok, Dict}.
diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_app.erl b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_app.erl
new file mode 100644
index 0000000000..a23ef7001d
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_app.erl
@@ -0,0 +1,29 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code_archive_dict_app).
+-behaviour(application).
+
+%% Public
+-export([start/2, stop/1]).
+
+start(_Type, Args) ->
+ code_archive_dict_sup:start_link(Args).
+
+stop(_State) ->
+ ok.
diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_sup.erl b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_sup.erl
new file mode 100644
index 0000000000..3e427ed34a
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_sup.erl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code_archive_dict_sup).
+-behaviour(supervisor).
+
+%% Public
+-export([start_link/1]).
+
+%% Internal
+-export([init/1, start_simple_child/2]).
+
+-define(CHILD_MOD, code_archive_dict).
+
+start_link(Debug) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, [Debug]).
+
+init([Debug]) ->
+ Flags = {simple_one_for_one, 0, 3600},
+ MFA = {?MODULE, start_simple_child, [Debug]},
+ {ok, {Flags, [{?MODULE, MFA, transient, timer:seconds(3), worker, [?CHILD_MOD]}]}}.
+
+start_simple_child(Debug, Name) ->
+ ?CHILD_MOD:start_link(Name, Debug).
diff --git a/lib/kernel/test/code_SUITE_data/dummy_app-1.0/ebin/dummy_file b/lib/kernel/test/code_SUITE_data/dummy_app-1.0/ebin/dummy_file
new file mode 100644
index 0000000000..5b1ed2e49c
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/dummy_app-1.0/ebin/dummy_file
@@ -0,0 +1 @@
+dummy_file
diff --git a/lib/kernel/test/code_SUITE_data/dummy_app-1.0/priv/dummy_file b/lib/kernel/test/code_SUITE_data/dummy_app-1.0/priv/dummy_file
new file mode 100644
index 0000000000..5b1ed2e49c
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/dummy_app-1.0/priv/dummy_file
@@ -0,0 +1 @@
+dummy_file
diff --git a/lib/kernel/test/code_SUITE_data/dummy_app-2.0/ebin/dummy_file b/lib/kernel/test/code_SUITE_data/dummy_app-2.0/ebin/dummy_file
new file mode 100644
index 0000000000..5b1ed2e49c
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/dummy_app-2.0/ebin/dummy_file
@@ -0,0 +1 @@
+dummy_file
diff --git a/lib/kernel/test/code_SUITE_data/dummy_app-2.0/priv/dummy_file b/lib/kernel/test/code_SUITE_data/dummy_app-2.0/priv/dummy_file
new file mode 100644
index 0000000000..5b1ed2e49c
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/dummy_app-2.0/priv/dummy_file
@@ -0,0 +1 @@
+dummy_file
diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-a/ebin/.gitignore b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-a/ebin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-a/ebin/.gitignore
diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-b/ebin/lists.erl b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-b/ebin/lists.erl
new file mode 100644
index 0000000000..e97dde2703
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-b/ebin/lists.erl
@@ -0,0 +1,24 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(lists).
+
+-export([not_your_standard_lists_module/0]).
+
+not_your_standard_lists_module() ->
+ ok.
diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module.erl b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module.erl
new file mode 100644
index 0000000000..3c9cd75f34
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module.erl
@@ -0,0 +1,24 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code_SUITE_mult_root_module).
+
+-export([works_fine/0]).
+
+works_fine() ->
+ true.
diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-d/ebin/.gitignore b/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-d/ebin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-d/ebin/.gitignore
diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-e/ebin/.gitignore b/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-e/ebin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-e/ebin/.gitignore
diff --git a/lib/kernel/test/code_SUITE_data/on_load/on_load_a.erl b/lib/kernel/test/code_SUITE_data/on_load/on_load_a.erl
new file mode 100644
index 0000000000..660000df46
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/on_load/on_load_a.erl
@@ -0,0 +1,28 @@
+-module(on_load_a).
+-on_load(on_load/0).
+-export([data/0]).
+
+on_load() ->
+ ?MASTER ! {?MODULE,start},
+ on_load_b:data(),
+
+ %% Call local function.
+ 120 = fact(5),
+
+ %% Call remote function.
+ LibDir = code:lib_dir(kernel),
+
+ ?MASTER ! {?MODULE,LibDir},
+ true.
+
+data() ->
+ [a|on_load_b:data()].
+
+fact(N) ->
+ fact(N, 1).
+
+fact(0, P) -> P;
+fact(1, P) -> P;
+fact(N, P) -> fact(N-1, P*N).
+
+
diff --git a/lib/kernel/test/code_SUITE_data/on_load/on_load_b.erl b/lib/kernel/test/code_SUITE_data/on_load/on_load_b.erl
new file mode 100644
index 0000000000..5c4d676e2d
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/on_load/on_load_b.erl
@@ -0,0 +1,12 @@
+-module(on_load_b).
+-on_load(on_load/0).
+-export([on_load/0,data/0]).
+
+on_load() ->
+ ?MASTER ! {?MODULE,start},
+ on_load_c:data(),
+ ?MASTER ! {?MODULE,done},
+ true.
+
+data() ->
+ [b|on_load_c:data()].
diff --git a/lib/kernel/test/code_SUITE_data/on_load/on_load_c.erl b/lib/kernel/test/code_SUITE_data/on_load/on_load_c.erl
new file mode 100644
index 0000000000..4b2edbfb5a
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/on_load/on_load_c.erl
@@ -0,0 +1,14 @@
+-module(on_load_c).
+-on_load(on_load/0).
+-export([data/0]).
+
+on_load() ->
+ ?MASTER ! {?MODULE,self()},
+ receive
+ go ->
+ ?MASTER ! {?MODULE,done},
+ true
+ end.
+
+data() ->
+ [c].
diff --git a/lib/kernel/test/code_SUITE_data/on_load_app-1.0/ebin/on_load_app.app b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/ebin/on_load_app.app
new file mode 100644
index 0000000000..6b79a74c0a
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/ebin/on_load_app.app
@@ -0,0 +1,10 @@
+{application, on_load_app,
+ [
+ {description, "ERTS CXC 138 10"},
+ {vsn, "1.0"},
+ {modules, [on_load_embedded]},
+ {applications, []},
+ {registered, []},
+ {env, []}
+ ]
+}.
diff --git a/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl
new file mode 100644
index 0000000000..bfc26864d5
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl
@@ -0,0 +1,18 @@
+-module(on_load_embedded).
+-export([status/0]).
+-on_load(run_me/0).
+
+run_me() ->
+ spawn(fun() ->
+ register(everything_is_fine, self()),
+ receive Any ->
+ ok
+ end
+ end),
+ true.
+
+status() ->
+ case whereis(everything_is_fine) of
+ Pid when is_pid(Pid) ->
+ ok
+ end.
diff --git a/lib/kernel/test/code_SUITE_data/pa/dummy b/lib/kernel/test/code_SUITE_data/pa/dummy
new file mode 100644
index 0000000000..8b13789179
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/pa/dummy
@@ -0,0 +1 @@
+
diff --git a/lib/kernel/test/code_SUITE_data/pz/dummy b/lib/kernel/test/code_SUITE_data/pz/dummy
new file mode 100644
index 0000000000..8b13789179
--- /dev/null
+++ b/lib/kernel/test/code_SUITE_data/pz/dummy
@@ -0,0 +1 @@
+
diff --git a/lib/kernel/test/code_a_test.erl b/lib/kernel/test/code_a_test.erl
new file mode 100644
index 0000000000..745bbf032c
--- /dev/null
+++ b/lib/kernel/test/code_a_test.erl
@@ -0,0 +1,28 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code_b_test).
+
+%% This module has wrong module name in file.
+
+-export([a/0]).
+
+a() -> ok.
+
+
+
diff --git a/lib/kernel/test/code_b_test.erl b/lib/kernel/test/code_b_test.erl
new file mode 100644
index 0000000000..0f0107a2b4
--- /dev/null
+++ b/lib/kernel/test/code_b_test.erl
@@ -0,0 +1,47 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(code_b_test).
+
+-export([do_spawn/0, loop/0, check_exit/1, call/2, call/3]).
+
+do_spawn() ->
+ spawn_link(code_b_test, loop, []).
+
+loop() ->
+ receive
+ dummy -> loop()
+ end.
+
+check_exit(Pid) ->
+ receive
+ {'EXIT',Pid,_} ->
+ true
+ after 10 ->
+ %% We used to wait 1 ms. That is not always enough when
+ %% running the SMP emulator on a slow computer.
+ false
+ end.
+
+call({M,F}=Fun, Arg) when is_atom(M), is_atom(F) ->
+ [Fun(Arg)];
+call(Fun, Arg) when is_function(Fun) ->
+ [Fun(Arg)].
+
+call(M, F, Args) ->
+ [erlang:apply(M, F, Args)].
diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl
new file mode 100644
index 0000000000..ade9644c15
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE.erl
@@ -0,0 +1,5162 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(disk_log_SUITE).
+
+%-define(debug, true).
+
+-ifdef(debug).
+-define(format(S, A), io:format(S, A)).
+-define(line, put(line, ?LINE), ).
+-define(privdir(_), "./disk_log_SUITE_priv").
+-define(datadir(_), "./disk_log_SUITE_data").
+-define(config(X,Y), foo).
+-define(t,test_server).
+-else.
+-include("test_server.hrl").
+-define(format(S, A), ok).
+-define(privdir(Conf), ?config(priv_dir, Conf)).
+-define(datadir(Conf), ?config(data_dir, Conf)).
+-endif.
+
+-export([all/1,
+
+ halt_int/1, halt_int_inf/1, halt_int_sz/1,
+ halt_int_sz_1/1, halt_int_sz_2/1,
+
+ read_mode/1, halt_int_ro/1, halt_ext_ro/1, wrap_int_ro/1,
+ wrap_ext_ro/1, halt_trunc/1, halt_misc/1, halt_ro_alog/1,
+ halt_ro_balog/1, halt_ro_crash/1,
+
+ wrap_int/1, wrap_int_1/1, wrap_int_2/1, inc_wrap_file/1,
+
+ halt_ext/1, halt_ext_inf/1,
+
+ halt_ext_sz/1, halt_ext_sz_1/1, halt_ext_sz_2/1,
+
+ wrap_ext/1, wrap_ext_1/1, wrap_ext_2/1,
+
+ head/1, head_func/1, plain_head/1, one_header/1,
+
+ notif/1, wrap_notif/1, full_notif/1, trunc_notif/1, blocked_notif/1,
+
+ new_idx_vsn/1,
+
+ reopen/1,
+
+ block/1, block_blocked/1, block_queue/1, block_queue2/1,
+
+ unblock/1,
+
+ open/1, open_overwrite/1, open_size/1, open_truncate/1, open_error/1,
+
+ close/1, close_race/1, close_block/1, close_deadlock/1,
+
+ error/1, error_repair/1, error_log/1, error_index/1,
+
+ chunk/1,
+
+ truncate/1,
+
+ many_users/1,
+
+ info/1, info_current/1,
+
+ change_size/1, change_size_before/1, change_size_during/1,
+ change_size_after/1, default_size/1, change_size2/1,
+ change_size_truncate/1,
+
+ change_attribute/1,
+
+ distribution/1, dist_open/1, dist_error_open/1, dist_notify/1,
+ dist_terminate/1, dist_accessible/1, dist_deadlock/1,
+ dist_open2/1, other_groups/1,
+
+ evil/1,
+
+ otp_6278/1]).
+
+-export([head_fun/1, hf/0, lserv/1,
+ measure/0, init_m/1, xx/0, head_exit/0, slow_header/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+-export([try_unblock/1]).
+
+-export([client/4]).
+
+-define(default_timeout, ?t:minutes(1)).
+
+%% error_logger
+-export([init/1,
+ handle_event/2, handle_call/2, handle_info/2,
+ terminate/2]).
+
+-include_lib("kernel/include/file.hrl").
+-include_lib("kernel/src/disk_log.hrl").
+
+%% TODO (old):
+%% - global logs
+%% - badarg
+%% - force file:write fail (how?)
+%% - kill logging proc while he is logging
+%% - kill logging node while he is logging
+%% - test chunk_step
+
+%% These are all tests, the list to be returned by all().
+-define(ALL_TESTS,
+ [halt_int, wrap_int, halt_ext, wrap_ext, read_mode, head,
+ notif, new_idx_vsn, reopen, block, unblock, open, close,
+ error, chunk, truncate, many_users, info, change_size,
+ change_attribute, distribution, evil, otp_6278]).
+
+%% The following two lists should be mutually exclusive. To skip a case
+%% on VxWorks altogether, use the kernel.spec.vxworks file instead.
+%% PLEASE don't skip out of laziness, the goal is to make every
+%% testcase runnable on VxWorks.
+
+%% These test cases should be skipped if the VxWorks card is
+%% configured without NFS cache.
+-define(SKIP_NO_CACHE,[distribution]).
+%% These tests should be skipped if the VxWorks card is configured *with*
+%% nfs cache.
+-define(SKIP_LARGE_CACHE,[inc_wrap_file, halt_ext, wrap_ext, read_mode,
+ head, wrap_notif, open_size, error_log,
+ error_index, chunk,
+ change_size_before, change_size_during,
+ change_size_after, default_size]).
+
+
+all(suite) ->
+ ?ALL_TESTS.
+
+
+init_per_testcase(Case, Config) ->
+ case should_skip(Case,Config) of
+ true ->
+ CS = check_nfs(Config),
+ {skipped, lists:flatten
+ (io_lib:format
+ ("The test does not work "
+ "with current NFS cache size (~w),"
+ " to get this test to run, "
+ "~s the NFS cache size~n",
+ [CS, case CS of
+ 0 ->
+ "enlarge";
+ _ ->
+ "zero"
+ end]))};
+ _ ->
+ Dog=?t:timetrap(?t:minutes(2)),
+ [{watchdog, Dog}|Config]
+ end.
+
+fin_per_testcase(_Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+halt_int(suite) -> [halt_int_inf, halt_int_sz].
+
+halt_int_inf(suite) -> [];
+halt_int_inf(doc) -> ["Test simple halt disk log, size infinity"];
+halt_int_inf(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ ?line ok = disk_log:start(),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal},
+ {file, File}]),
+ ?line simple_log(a),
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+halt_int_sz(suite) -> [halt_int_sz_1, halt_int_sz_2].
+
+halt_int_sz_1(suite) -> [];
+halt_int_sz_1(doc) -> ["Test simple halt disk log, size defined"];
+halt_int_sz_1(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,18000},
+ {format,internal},
+ {file, File}]),
+ ?line simple_log(a),
+ ?line ok = disk_log:truncate(a),
+ ?line [] = get_all_terms(a),
+ T1 = mk_bytes(10000),
+ T2 = mk_bytes(5000),
+ ?line ok = disk_log:log(a, T1),
+ ?line case get_all_terms(a) of
+ [T1] ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1, [T1]})
+ end,
+ ?line ok = disk_log:log(a, T2),
+ ?line {error, {full, a}} = disk_log:log(a, T1),
+ ?line ok = disk_log:alog(a, T1),
+ ?line case get_all_terms(a) of
+ [T1, T2] ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2, [T1, T2]})
+ end,
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+halt_int_sz_2(suite) -> [];
+halt_int_sz_2(doc) -> ["Test simple halt disk log, size ~8192"];
+halt_int_sz_2(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File1 = filename:join(Dir, "a.LOG"),
+ File2 = filename:join(Dir, "b.LOG"),
+ File3 = filename:join(Dir, "c.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,8191},
+ {format,internal},
+ {file, File1}]),
+ ?line {ok, b} = disk_log:open([{name,b}, {type,halt}, {size,8192},
+ {format,internal},
+ {file, File2}]),
+ ?line {ok, c} = disk_log:open([{name,c}, {type,halt}, {size,8193},
+ {format,internal},
+ {file, File3}]),
+ T1 = mk_bytes(8191-16), % 16 is size of header + magics for 1 item
+ T2 = mk_bytes(8192-16),
+ T3 = mk_bytes(8193-16),
+ ?line ok = disk_log:log(a, T1),
+ ?line ok = disk_log:log(b, T2),
+ ?line ok = disk_log:log(c, T3),
+ ?line case get_all_terms(a) of
+ [T1] ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1, [T1]})
+ end,
+ ?line case get_all_terms(b) of
+ [T2] ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2, [T2]})
+ end,
+ ?line case get_all_terms(c) of
+ [T3] ->
+ ok;
+ E3 ->
+ test_server_fail({bad_terms, E3, [T3]})
+ end,
+ ?line ok = disk_log:truncate(a),
+ ?line ok = disk_log:truncate(b),
+ ?line {error, {full, a}} = disk_log:log(a, T2),
+ ?line {error, {full, b}} = disk_log:log(b, T3),
+ ?line [] = get_all_terms(a),
+ ?line [] = get_all_terms(b),
+ ?line ok = disk_log:close(a),
+ ?line ok = disk_log:close(b),
+ ?line ok = disk_log:close(c),
+ ?line ok = file:delete(File1),
+ ?line ok = file:delete(File2),
+ ?line ok = file:delete(File3),
+ ok.
+
+read_mode(suite) -> [halt_int_ro, halt_ext_ro,
+ wrap_int_ro, wrap_ext_ro,
+ halt_trunc, halt_misc, halt_ro_alog, halt_ro_balog,
+ halt_ro_crash].
+
+halt_int_ro(suite) -> [];
+halt_int_ro(doc) -> ["Test simple halt disk log, read only, internal"];
+halt_int_ro(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File}]),
+ simple_log(a),
+ ?line ok = disk_log:close(a),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File},
+ {mode,read_only}]),
+ T1 = "not allowed to write",
+ ?line {error, {read_only_mode, a}} = disk_log:log(a, T1),
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+halt_ext_ro(suite) -> [];
+halt_ext_ro(doc) -> ["Test simple halt disk log, read only, external"];
+halt_ext_ro(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,external}, {file, File}]),
+ xsimple_log(File, a),
+ ?line ok = disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,external}, {file, File},
+ {mode,read_only}]),
+ T1 = "not allowed to write",
+ ?line {error, {read_only_mode, a}} = disk_log:blog(a, T1),
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+wrap_int_ro(suite) -> [];
+wrap_int_ro(doc) -> ["Test simple wrap disk log, read only, internal"];
+wrap_int_ro(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}},
+ {format,internal}, {file, File}]),
+ simple_log(a),
+ ?line ok = disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}},
+ {format,internal}, {file, File}, {mode,read_only}]),
+ T1 = "not allowed to write",
+ ?line {error, {read_only_mode, a}} = disk_log:log(a, T1),
+ ?line ok = disk_log:close(a),
+ ?line del(File, 4).
+
+wrap_ext_ro(suite) -> [];
+wrap_ext_ro(doc) -> ["Test simple wrap disk log, read only, external"];
+wrap_ext_ro(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}},
+ {format,external}, {file, File}]),
+ x2simple_log(File ++ ".1", a),
+ ?line ok = disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}},
+ {format,external}, {file, File},
+ {mode,read_only}]),
+ T1 = "not allowed to write",
+ ?line {error, {read_only_mode, a}} = disk_log:blog(a, T1),
+ ?line {error, {read_only_mode, a}} = disk_log:inc_wrap_file(a),
+ ?line ok = disk_log:close(a),
+ del(File, 4).
+
+halt_trunc(suite) -> [];
+halt_trunc(doc) -> ["Test truncation of halt disk log"];
+halt_trunc(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File}]),
+ simple_log(a),
+ ?line ok = disk_log:close(a),
+ ?line {error,{badarg,repair_read_only}} =
+ disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {repair, truncate}, {format,internal},
+ {file, File}, {mode,read_only}]),
+ ?line ok = file:delete(File).
+
+halt_misc(suite) -> [];
+halt_misc(doc) -> ["Test truncation of halt disk log"];
+halt_misc(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File}]),
+ simple_log(a),
+ ?line ok = disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File},
+ {mode,read_only}]),
+ T1 = "not allowed to write",
+ ?line {error, {read_only_mode, a}} = disk_log:log(a, T1),
+ ?line {error, {read_only_mode, a}} = disk_log:sync(a),
+ ?line {error, {read_only_mode, a}} = disk_log:reopen(a, "b.LOG"),
+ ?line {error, {read_only_mode, a}} =
+ disk_log:change_header(a, {head,header}),
+ ?line {error, {read_only_mode, a}} =
+ disk_log:change_size(a, inifinity),
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+halt_ro_alog(suite) -> [];
+halt_ro_alog(doc) -> ["Test truncation of halt disk log, read only"];
+halt_ro_alog(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File}]),
+ simple_log(a),
+ ?line ok = disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {notify,true}, {format,internal},
+ {file, File}, {mode,read_only}]),
+ T1 = "not allowed to write",
+ ?line ok = disk_log:alog(a, T1),
+ ?line ok = halt_ro_alog_wait_notify(a, T1),
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+halt_ro_alog_wait_notify(Log, T) ->
+ Term = term_to_binary(T),
+ receive
+ {disk_log, _, Log,{read_only, Term}} ->
+ ok;
+ Other ->
+ Other
+ after 5000 ->
+ failed
+ end.
+
+halt_ro_balog(suite) -> [];
+halt_ro_balog(doc) -> ["Test truncation of halt disk log, read only"];
+halt_ro_balog(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File}]),
+ simple_log(a),
+ ?line ok = disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {notify,true}, {format,external},
+ {file, File}, {mode,read_only}]),
+ T1 = "not allowed to write",
+ ?line ok = disk_log:balog(a, T1),
+ ?line ok = halt_ro_balog_wait_notify(a, T1),
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+halt_ro_balog_wait_notify(Log, T) ->
+ Term = list_to_binary(T),
+ receive
+ {disk_log, _, Log,{read_only, Term}} ->
+ ok;
+ Other ->
+ Other
+ after 5000 ->
+ failed
+ end.
+
+halt_ro_crash(suite) -> [];
+halt_ro_crash(doc) -> ["Test truncation of halt disk log, read only, repair"];
+halt_ro_crash(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+
+ ?line file:delete(File),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal},{file, File}]),
+ simple_log(a),
+ ?line ok = disk_log:close(a),
+ crash(File, 10),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {notify,true}, {format,internal},
+ {file, File}, {mode,read_only}]),
+
+ ?line Error1 = {error, {read_only_mode, a}} = disk_log:truncate(a),
+ ?line "The disk log" ++ _ = format_error(Error1),
+
+ %% crash/1 sets the length of the first item to something big (2.5 kb).
+ %% In R6B, binary_to_term accepts garbage at the end of the binary,
+ %% which means that the first item is recognized!
+ %% This is how it was before R6B:
+ %% ?line {C1,T1,15} = disk_log:chunk(a,start),
+ %% ?line {C2,T2} = disk_log:chunk(a,C1),
+ {C1,_OneItem,7478} = disk_log:chunk(a,start),
+ {C2, [], 7} = disk_log:chunk(a,C1),
+ ?line eof = disk_log:chunk(a,C2),
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+
+
+
+wrap_int(suite) -> [wrap_int_1, wrap_int_2, inc_wrap_file].
+
+wrap_int_1(suite) -> [];
+wrap_int_1(doc) -> ["Test wrap disk log, internal"];
+wrap_int_1(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}},
+ {format,internal},
+ {file, File}]),
+ ?line [_] =
+ lists:filter(fun(P) -> disk_log:pid2name(P) =/= undefined end,
+ erlang:processes()),
+ simple_log(a),
+ ?line ok = disk_log:close(a),
+ del(File, 4),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}},
+ {format,internal},
+ {file, File}]),
+ ?line [] = get_all_terms(a),
+ T1 = mk_bytes(10000), % file 2
+ T2 = mk_bytes(5000), % file 3
+ T3 = mk_bytes(4000), % file 4
+ T4 = mk_bytes(2000), % file 4
+ T5 = mk_bytes(5000), % file 1
+ T6 = mk_bytes(5000), % file 2
+ ?line ok = disk_log:log(a, T1),
+ ?line ok = disk_log:log(a, T2),
+ ?line ok = disk_log:log(a, T3),
+ ?line ok = disk_log:log_terms(a, [T4, T5, T6]),
+ ?line case get_all_terms(a) of
+ [T2,T3,T4,T5,T6] ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1, [T2,T3,T4,T5,T6]})
+ end,
+ ?line ok = disk_log:close(a),
+ del(File, 4).
+
+wrap_int_2(suite) -> [];
+wrap_int_2(doc) -> ["Test wrap disk log, internal"];
+wrap_int_2(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File1 = filename:join(Dir, "a.LOG"),
+ File2 = filename:join(Dir, "b.LOG"),
+ File3 = filename:join(Dir, "c.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8191,3}},
+ {format,internal},
+ {file, File1}]),
+ ?line {ok, b} = disk_log:open([{name,b}, {type,wrap}, {size,{8192,3}},
+ {format,internal},
+ {file, File2}]),
+ ?line {ok, c} = disk_log:open([{name,c}, {type,wrap}, {size,{8193,3}},
+ {format,internal},
+ {file, File3}]),
+ T1 = mk_bytes(8191-16), % 16 is size of header + magics for 1 item
+ T2 = mk_bytes(8192-16),
+ T3 = mk_bytes(8193-16),
+ ?line ok = disk_log:log(a, T1),
+ ?line ok = disk_log:log(b, T2),
+ ?line ok = disk_log:log(c, T3),
+ ?line case get_all_terms(a) of
+ [T1] ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1, [T1]})
+ end,
+ ?line case get_all_terms(b) of
+ [T2] ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2, [T2]})
+ end,
+ ?line case get_all_terms(c) of
+ [T3] ->
+ ok;
+ E3 ->
+ test_server_fail({bad_terms, E3, [T3]})
+ end,
+ ?line ok = disk_log:close(a),
+ ?line ok = disk_log:close(b),
+ ?line ok = disk_log:close(c),
+ del(File1, 3),
+ del(File2, 3),
+ del(File3, 3).
+
+inc_wrap_file(suite) -> [];
+inc_wrap_file(doc) -> ["Test disk log, force a change to next file"];
+inc_wrap_file(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File1 = filename:join(Dir, "a.LOG"),
+ File2 = filename:join(Dir, "b.LOG"),
+ File3 = filename:join(Dir, "c.LOG"),
+
+ %% Test that halt logs gets an error message
+ ?line {ok, a} = disk_log:open([{name, a}, {type, halt},
+ {format, internal},
+ {file, File1}]),
+ ?line ok = disk_log:log(a, "message one"),
+ ?line {error, {halt_log, a}} = disk_log:inc_wrap_file(a),
+
+ %% test an internally formatted wrap log file
+ ?line {ok, b} = disk_log:open([{name, b}, {type, wrap}, {size, {100,3}},
+ {format, internal}, {head, 'thisisahead'},
+ {file, File2}]),
+ ?line ok = disk_log:log(b, "message one"),
+ ?line ok = disk_log:inc_wrap_file(b),
+ ?line ok = disk_log:log(b, "message two"),
+ ?line ok = disk_log:inc_wrap_file(b),
+ ?line ok = disk_log:log(b, "message three"),
+ ?line ok = disk_log:inc_wrap_file(b),
+ ?line ok = disk_log:log(b, "message four"),
+ ?line T1 = get_all_terms(b),
+ ?line ['thisisahead', "message two",
+ 'thisisahead', "message three",
+ 'thisisahead', "message four"] = T1,
+
+ %% test an externally formatted wrap log file
+ ?line {ok, c} = disk_log:open([{name, c}, {type, wrap}, {size, {100,3}},
+ {format,external}, {head,"this is a head "},
+ {file, File3}]),
+ ?line ok = disk_log:blog(c, "message one"),
+ ?line ok = disk_log:inc_wrap_file(c),
+ ?line ok = disk_log:blog(c, "message two"),
+ ?line ok = disk_log:inc_wrap_file(c),
+ ?line ok = disk_log:blog(c, "message three"),
+ ?line ok = disk_log:inc_wrap_file(c),
+ ?line ok = disk_log:blog(c, "message four"),
+ ?line ok = disk_log:sync(c),
+ ?line {ok, Fd31} = file:open(File3 ++ ".1", [read]),
+ ?line {ok,"this is a head message four"} = file:read(Fd31, 200),
+ ?line {ok, Fd32} = file:open(File3 ++ ".2", [read]),
+ ?line {ok,"this is a head message two"} = file:read(Fd32, 200),
+ ?line {ok, Fd33} = file:open(File3 ++ ".3", [read]),
+ ?line {ok,"this is a head message three"} = file:read(Fd33, 200),
+ ?line ok = file:close(Fd31),
+ ?line ok = file:close(Fd32),
+ ?line ok = file:close(Fd33),
+
+ ?line ok = disk_log:close(a),
+ ?line ok = disk_log:close(b),
+ ?line ok = disk_log:close(c),
+ ?line ok = file:delete(File1),
+ del(File2, 3),
+ del(File3, 3).
+
+
+
+halt_ext(suite) -> [halt_ext_inf, halt_ext_sz].
+
+halt_ext_inf(suite) -> [];
+halt_ext_inf(doc) -> ["Test halt disk log, external, infinity"];
+halt_ext_inf(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,external},
+ {file, File}]),
+ ?line xsimple_log(File, a),
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+halt_ext_sz(suite) -> [halt_ext_sz_1, halt_ext_sz_2].
+
+halt_ext_sz_1(suite) -> [];
+halt_ext_sz_1(doc) -> ["Test halt disk log, external, size defined"];
+halt_ext_sz_1(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,18000},
+ {format,external},
+ {file, File}]),
+ xsimple_log(File, a),
+ ?line ok = disk_log:truncate(a),
+ ?line [] = get_list(File, a),
+ {B1, T1} = x_mk_bytes(10000),
+ {B2, T2} = x_mk_bytes(5000),
+ {B3, T3} = x_mk_bytes(1000),
+ ?line ok = disk_log:blog(a, B1),
+ ?line case get_list(File, a) of
+ T1 ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1, T1})
+ end,
+ ?line ok = disk_log:blog(a, B2),
+ ?line {error, {full, a}} = disk_log:blog_terms(a, [B3,B3,B1]),
+ ?line ok = disk_log:balog(a, B1),
+ ?line Tmp = T1 ++ T2 ++ T3 ++ T3,
+ ?line case get_list(File, a) of
+ Tmp ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2, Tmp})
+ end,
+ ?line ok = disk_log:close(a),
+ ?line ok = file:delete(File).
+
+halt_ext_sz_2(suite) -> [];
+halt_ext_sz_2(doc) -> ["Test halt disk log, external, size defined"];
+halt_ext_sz_2(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File1 = filename:join(Dir, "a.LOG"),
+ File2 = filename:join(Dir, "b.LOG"),
+ File3 = filename:join(Dir, "c.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,8191},
+ {format,external},
+ {file, File1}]),
+ ?line {ok, b} = disk_log:open([{name,b}, {type,halt}, {size,8192},
+ {format,external},
+ {file, File2}]),
+ ?line {ok, c} = disk_log:open([{name,c}, {type,halt}, {size,8193},
+ {format,external},
+ {file, File3}]),
+ {B1, T1} = x_mk_bytes(8191),
+ {B2, T2} = x_mk_bytes(8192),
+ {B3, T3} = x_mk_bytes(8193),
+ ?line ok = disk_log:blog(a, B1),
+ ?line ok = disk_log:blog(b, B2),
+ ?line ok = disk_log:blog(c, B3),
+ ?line case get_list(File1, a) of
+ T1 ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1, T1})
+ end,
+ ?line case get_list(File2, b) of
+ T2 ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2, T2})
+ end,
+ ?line case get_list(File3, c) of
+ T3 ->
+ ok;
+ E3 ->
+ test_server_fail({bad_terms, E3, T3})
+ end,
+ ?line ok = disk_log:truncate(a),
+ ?line ok = disk_log:truncate(b),
+ ?line {error, {full, a}} = disk_log:blog(a, B2),
+ ?line Error1 = {error, {full, b}} = disk_log:blog(b, B3),
+ ?line "The halt log" ++ _ = format_error(Error1),
+ ?line true = info(b, full, false),
+ ?line [] = get_list(File1, a),
+ ?line [] = get_list(File2, b),
+ ?line ok = disk_log:close(a),
+ ?line ok = disk_log:close(b),
+ ?line ok = disk_log:close(c),
+ ?line ok = file:delete(File1),
+ ?line ok = file:delete(File2),
+ ?line ok = file:delete(File3),
+ ok.
+
+wrap_ext(suite) -> [wrap_ext_1, wrap_ext_2].
+
+wrap_ext_1(suite) -> [];
+wrap_ext_1(doc) -> ["Test wrap disk log, external, size defined"];
+wrap_ext_1(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}},
+ {format,external},
+ {file, File}]),
+ x2simple_log(File ++ ".1", a),
+ ?line ok = disk_log:close(a),
+% del(File, 4),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}},
+ {format,external},
+ {file, File}]),
+ {B1, _T1} = x_mk_bytes(10000), % file 2
+ {B2, T2} = x_mk_bytes(5000), % file 3
+ {B3, T3} = x_mk_bytes(4000), % file 4
+ {B4, T4} = x_mk_bytes(2000), % file 4
+ {B5, T5} = x_mk_bytes(5000), % file 1
+ {B6, T6} = x_mk_bytes(5000), % file 2
+ ?line ok = disk_log:blog(a, B1),
+ ?line ok = disk_log:blog(a, B2),
+ ?line ok = disk_log:blog(a, B3),
+ ?line ok = disk_log:blog_terms(a, [B4, B5, B6]),
+ ?line case get_list(File ++ ".3", a) of
+ T2 ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2, T2})
+ end,
+ ?line T34 = T3 ++ T4,
+ ?line case get_list(File ++ ".4", a) of
+ T34 ->
+ ok;
+ E34 ->
+ test_server_fail({bad_terms, E34, T34})
+ end,
+ ?line case get_list(File ++ ".1", a) of
+ T5 ->
+ ok;
+ E5 ->
+ test_server_fail({bad_terms, E5, T5})
+ end,
+ ?line case get_list(File ++ ".2", a) of
+ T6 ->
+ ok;
+ E6 ->
+ test_server_fail({bad_terms, E6, T6})
+ end,
+ ?line ok = disk_log:close(a),
+ del(File, 4).
+
+wrap_ext_2(suite) -> [];
+wrap_ext_2(doc) -> ["Test wrap disk log, external, size defined"];
+wrap_ext_2(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File1 = filename:join(Dir, "a.LOG"),
+ File2 = filename:join(Dir, "b.LOG"),
+ File3 = filename:join(Dir, "c.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8191,3}},
+ {format,external},
+ {file, File1}]),
+ ?line {ok, b} = disk_log:open([{name,b}, {type,wrap}, {size,{8192,3}},
+ {format,external},
+ {file, File2}]),
+ ?line {ok, c} = disk_log:open([{name,c}, {type,wrap}, {size,{8193,3}},
+ {format,external},
+ {file, File3}]),
+ {B1, T1} = x_mk_bytes(8191),
+ {B2, T2} = x_mk_bytes(8192),
+ {B3, T3} = x_mk_bytes(8193),
+ ?line ok = disk_log:blog(a, B1),
+ ?line ok = disk_log:blog(b, B2),
+ ?line ok = disk_log:blog(c, B3),
+ ?line case get_list(File1 ++ ".1", a) of
+ T1 ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1, T1})
+ end,
+ ?line case get_list(File2 ++ ".1", b) of
+ T2 ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2, T2})
+ end,
+ ?line case get_list(File3 ++ ".1", c) of
+ T3 ->
+ ok;
+ E3 ->
+ test_server_fail({bad_terms, E3, T3})
+ end,
+ ?line ok = disk_log:close(a),
+ ?line ok = disk_log:close(b),
+ ?line ok = disk_log:close(c),
+ ?line del(File1, 3),
+ ?line del(File2, 3),
+ ?line del(File3, 3),
+ ok.
+
+simple_log(Log) ->
+ T1 = "hej",
+ T2 = hopp,
+ T3 = {tjena, 12},
+ T4 = mk_bytes(10000),
+ ?line ok = disk_log:log(Log, T1),
+ ?line ok = disk_log:log_terms(Log, [T2, T3]),
+ ?line case get_all_terms(Log) of
+ [T1, T2, T3] ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1, [T1, T2, T3]})
+ end,
+ ?line ok = disk_log:log(a, T4),
+ ?line case get_all_terms(Log) of
+ [T1, T2, T3, T4] ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2, [T1, T2, T3, T4]})
+ end.
+
+xsimple_log(File, Log) ->
+ T1 = "hej",
+ T2 = list_to_binary("hopp"),
+ T3 = list_to_binary(["sena", list_to_binary("sejer")]),
+ T4 = list_to_binary(By = mk_bytes(10000)),
+ ?line ok = disk_log:blog(Log, T1),
+ ?line ok = disk_log:blog_terms(Log, [T2, T3]),
+ ?line X = "hejhoppsenasejer",
+ ?line X2 = get_list(File, Log),
+ ?line case X2 of
+ X -> ok;
+ Z1 -> test_server_fail({bad_terms, Z1, X2})
+ end,
+ ?line ok = disk_log:blog(Log, T4),
+ ?line Tmp = get_list(File, Log),
+ ?line case X ++ By of
+ Tmp -> ok;
+ Z2 -> test_server_fail({bad_terms, Z2, X ++ By})
+ end.
+
+x2simple_log(File, Log) ->
+ T1 = "hej",
+ T2 = list_to_binary("hopp"),
+ T3 = list_to_binary(["sena", list_to_binary("sejer")]),
+ T4 = list_to_binary(By = mk_bytes(1000)),
+ ?line ok = disk_log:blog(Log, T1),
+ ?line ok = disk_log:blog_terms(Log, [T2, T3]),
+ ?line X = "hejhoppsenasejer",
+ ?line X2 = get_list(File, Log),
+ ?line case X2 of
+ X -> ok;
+ Z1 -> test_server_fail({bad_terms, Z1, X2})
+ end,
+ ?line ok = disk_log:blog(Log, T4),
+ ?line Tmp = get_list(File, Log),
+ ?line case X ++ By of
+ Tmp -> ok;
+ Z2 -> test_server_fail({bad_terms, Z2, X ++ By})
+ end.
+
+x_mk_bytes(N) ->
+ X = lists:duplicate(N, $a),
+ {list_to_binary(X), X}.
+
+mk_bytes(N) when N > 4 ->
+ X = lists:duplicate(N-4, $a),
+ case byte_size(term_to_binary(X)) of
+ N -> X;
+ Z -> test_server_fail({bad_terms, Z, N})
+ end.
+
+get_list(File, Log) ->
+ ?t:format(0, "File ~p~n",[File]),
+ ok = disk_log:sync(Log),
+ {ok, B} = file:read_file(File),
+ binary_to_list(B).
+
+
+get_all_terms(Log, File, Type) ->
+ {ok, _Log} = disk_log:open([{name,Log}, {type,Type}, {size,infinity},
+ {format,internal}, {file, File},
+ {mode, read_only}]),
+ Ts = get_all_terms(Log),
+ ok = disk_log:close(Log),
+ Ts.
+
+get_all_terms(Log) ->
+ get_all_terms1(Log, start, []).
+
+get_all_terms1(Log, Cont, Res) ->
+ case disk_log:chunk(Log, Cont) of
+ {error, _R} ->
+ test_server_fail({bad_chunk, Log, Cont});
+ {Cont2, Terms} ->
+ get_all_terms1(Log, Cont2, Res ++ Terms);
+ eof ->
+ Res
+ end.
+
+get_all_terms_and_bad(Log, File, Type) ->
+ {ok, _Log} = disk_log:open([{name,Log}, {type,Type}, {size,infinity},
+ {format,internal}, {file, File},
+ {mode, read_only}]),
+ Ts = get_all_terms_and_bad(Log),
+ ok = disk_log:close(Log),
+ Ts.
+
+get_all_terms_and_bad(Log) ->
+ ?line read_only = info(Log, mode, foo),
+ get_all_terms_and_bad1(Log, start, [], 0).
+
+%%
+get_all_terms_and_bad1(Log, Cont, Res, Bad0) ->
+ case disk_log:chunk(Log, Cont) of
+ {Cont2, Terms} ->
+ get_all_terms_and_bad1(Log, Cont2, Res ++ Terms, Bad0);
+ {Cont2, Terms, Bad} ->
+ get_all_terms_and_bad1(Log, Cont2, Res ++ Terms, Bad0+Bad);
+ eof ->
+ {Res, Bad0}
+ end.
+
+get_all_binary_terms_and_bad(Log, File, Type) ->
+ {ok, _Log} = disk_log:open([{name,Log}, {type,Type}, {size,infinity},
+ {format,internal}, {file, File},
+ {mode, read_only}]),
+ Ts = get_all_binary_terms_and_bad(Log),
+ ok = disk_log:close(Log),
+ Ts.
+
+get_all_binary_terms_and_bad(Log) ->
+ read_only = info(Log, mode, foo),
+ get_all_binary_terms_and_bad1(Log, start, [], 0).
+
+%%
+get_all_binary_terms_and_bad1(Log, Cont, Res, Bad0) ->
+ case disk_log:bchunk(Log, Cont) of
+ {Cont2, BinTerms} ->
+ get_all_binary_terms_and_bad1(Log, Cont2, Res ++ BinTerms, Bad0);
+ {Cont2, BinTerms, Bad} ->
+ get_all_binary_terms_and_bad1(Log, Cont2, Res ++ BinTerms,
+ Bad0+Bad);
+ eof ->
+ {Res, Bad0}
+ end.
+
+del(File, 0) ->
+ file:delete(File ++ ".siz"),
+ file:delete(File ++ ".idx");
+del(File, N) ->
+ file:delete(File ++ "." ++ integer_to_list(N)),
+ del(File, N-1).
+
+test_server_fail(R) ->
+ exit({?MODULE, get(line), R}).
+
+xx() ->
+ File = "a.LOG",
+ {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File}]),
+ W = xwr(a, 400),
+ disk_log:close(a),
+% file:delete(File),
+ W.
+
+%% old: 6150
+%% new: 5910
+xwr(Log, BytesItem) ->
+ NoW = 1000,
+ Item1 = mk_bytes(BytesItem),
+ Item2 = mk_bytes(BytesItem),
+ Item3 = mk_bytes(BytesItem),
+ Item4 = mk_bytes(BytesItem),
+ Item5 = mk_bytes(BytesItem),
+ Item6 = mk_bytes(BytesItem),
+ Item7 = mk_bytes(BytesItem),
+ Item8 = mk_bytes(BytesItem),
+ Item9 = mk_bytes(BytesItem),
+ Item0 = mk_bytes(BytesItem),
+ Term = [Item1,Item2,Item3,Item4,Item5,Item6,Item7,Item8,Item9,Item0],
+ {W, _} = timer:tc(?MODULE, wr, [Log, Term, NoW]),
+ W/NoW.
+
+measure() ->
+ proc_lib:start_link(?MODULE, init_m, [self()]).
+
+init_m(Par) ->
+ process_flag(trap_exit, true),
+ Res = m(),
+ proc_lib:init_ack(Par, Res).
+
+m() ->
+ {W10, R10, Rep10, C10} = m_halt_int(10),
+ {W11, R11, Rep11, C11} = m_halt_int(100),
+ {W12, R12, Rep12, C12} = m_halt_int(400),
+ {W13, R13, Rep13, C13} = m_halt_int(1000),
+ {W14, R14, Rep14, C14} = m_halt_int(10000),
+ {W2, R2, Rep2, C2} = m_wrap_int(400),
+ {W3, R3, Rep3, C3} = m_many_halt_int(10, 400),
+ {W4, R4, Rep4, C4} = m_many_halt_int(20, 400),
+ {W5, R5, Rep5, C5} = m_many_halt_int(10, 1000),
+ {W6, R6, Rep6, C6} = m_many_halt_int(10, 10),
+ {W7, R7, Rep7, C7} = m_many_halt_int(20, 10),
+
+ io:format("Type of log mysec/write mysec/read"
+ " mysec/repair byte cpu/write\n"),
+ io:format("=========== =========== =========="
+ " ================= =========\n"),
+ one_line("halt,int.inf. (10)", W10, R10, Rep10, C10),
+ one_line("halt,int.inf. (100)", W11, R11, Rep11, C11),
+ one_line("halt,int.inf. (400)", W12, R12, Rep12, C12),
+ one_line("halt,int.inf. (1000)", W13, R13, Rep13, C13),
+ one_line("halt,int.inf. (10000)", W14, R14, Rep14, C14),
+ one_line("wrap,int. 4. (400)", W2, R2, Rep2, C2),
+ one_line("halt,int.inf. (10,10)", W6, R6, Rep6, C6),
+ one_line("halt,int.inf. (20,10)", W7, R7, Rep7, C7),
+ one_line("halt,int.inf. (10,400)", W3, R3, Rep3, C3),
+ one_line("halt,int.inf. (20,400)", W4, R4, Rep4, C4),
+ one_line("halt,int.inf. (10,1000)", W5, R5, Rep5, C5),
+ io:format("\n"),
+ io:format("\tWrap log time depends on how often the log wraps, as this\n"),
+ io:format("\tinvolves opening of new files, which costs alot."),
+ io:format("\n").
+
+one_line(Txt, W, R, Rep, C) ->
+ io:format("~.22s ~.10w ~.10w ~.17w ~.9w\n", [Txt, W, R, Rep, C]).
+
+m_halt_int(BytesItem) ->
+ File = "a.LOG",
+ {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File}]),
+ {T,W} = wr(a, BytesItem),
+ R = r(a),
+ [{_,P}] = ets:lookup(?DISK_LOG_NAME_TABLE, a),
+ exit(P, kill),
+ receive after 100 -> ok end,
+ crash(File, 10),
+ Sz = file_size(File),
+ Start = start_times(),
+ {repaired, a, {recovered, Rec}, {badbytes, Bad}} =
+ disk_log:open([{name,a}, {type,halt}, {size,infinity},
+ {format,internal}, {file, File}]),
+ {_,Rep} = end_times(Start),
+ io:format("m_halt_int: Rep = ~p, Rec = ~p, Bad = ~p~n", [Rep, Rec, Bad]),
+ disk_log:close(a),
+ file:delete(File),
+ {W,R,1000*Rep/Sz,T}.
+
+m_wrap_int(BytesItem) ->
+ File = "a.LOG",
+ {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{405*1000, 4}},
+ {format,internal}, {file, File}]),
+ {T,W} = wr(a, BytesItem),
+ R = r(a),
+ [{_,P}] = ets:lookup(?DISK_LOG_NAME_TABLE, a),
+ exit(P, kill),
+ receive after 100 -> ok end,
+ del(File, 4),
+ {W,R,'n/a',T}.
+
+m_many_halt_int(NoClients, BytesItem) ->
+ Name = 'log.LOG',
+ File = "log.LOG",
+ {ok, _} = disk_log:open([{name,Name}, {type,halt},
+ {size,infinity},
+ {format,internal}, {file,File}]),
+ NoW = round(lists:max([lists:min([5000000/BytesItem/NoClients,
+ 50000/NoClients]),
+ 1000])),
+ {T,W} = many_wr(NoClients, Name, NoW, BytesItem),
+ ok = disk_log:close(Name),
+ file:delete(File),
+ {1000*W/NoW/NoClients,'n/a','n/a',1000*T/NoW/NoClients}.
+
+many_wr(NoClients, Log, NoW, BytesItem) ->
+ Item = mk_bytes(BytesItem),
+ Fun = fun(Name, _Pid, _I) -> disk_log:log(Name, Item) end,
+ Start = start_times(),
+ Pids = spawn_clients(NoClients, client, [self(), Log, NoW, Fun]),
+ check_clients(Pids),
+ end_times(Start).
+
+wr(Log, BytesItem) ->
+ NoW = round(lists:max([lists:min([5000000/BytesItem,50000]),1000])),
+ Item = mk_bytes(BytesItem),
+ Start = start_times(),
+ wr(Log, Item, NoW),
+ {T,W} = end_times(Start),
+ {1000*T/NoW, 1000*W/NoW}.
+
+wr(Log, _Item, 0) ->
+ disk_log:sync(Log),
+ ok;
+wr(Log, Item, N) ->
+ ok = disk_log:log(Log, Item),
+ wr(Log, Item, N-1).
+
+r(_) ->
+ nyi.
+
+start_times() ->
+ {T1, _} = statistics(runtime),
+ {W1, _} = statistics(wall_clock),
+ {T1, W1}.
+
+end_times({T1,W1}) ->
+ {T2, _} = statistics(runtime),
+ {W2, _} = statistics(wall_clock),
+ {T2-T1, W2-W1}.
+
+head(suite) -> [head_func, plain_head, one_header].
+
+head_func(suite) -> [];
+head_func(doc) -> ["Test head parameter"];
+head_func(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ets:new(xxx, [named_table, set, public]),
+ ets:insert(xxx, {wrapc, 0}),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,4}},
+ {head_func, {?MODULE, hf, []}}]),
+ ?line B = mk_bytes(60),
+ ?line disk_log:log(a, B),
+ ?line disk_log:alog(a, B),
+ ?line disk_log:alog(a, B),
+ ?line disk_log:log(a, B),
+ H = [1,2,3],
+ ?line [{wrapc, 4}] = ets:lookup(xxx, wrapc),
+ ets:delete(xxx),
+ ?line case get_all_terms(a) of
+ [H,B,H,B,H,B,H,B] ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1,
+ [H,B,H,B,H,B,H,B]})
+ end,
+ ?line 8 = no_written_items(a),
+ disk_log:close(a),
+ del(File, 4),
+
+ % invalid header function
+ ?line {error, {invalid_header, {_, {term}}}} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, external},
+ {head_func, {?MODULE, head_fun, [{term}]}}]),
+ file:delete(File),
+
+ ?line {error, {invalid_header, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, external},
+ {head_func, {?MODULE, head_fun, [{ok,{term}}]}}]),
+ file:delete(File),
+
+ ?line {ok,n} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, external},
+ {head_func, {?MODULE, head_fun, [{ok,<<"head">>}]}}]),
+ ?line ok = disk_log:close(n),
+ ?line {ok,<<"head">>} = file:read_file(File),
+ file:delete(File),
+
+ ?line {ok,n} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, external},
+ {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]),
+ ?line ok = disk_log:close(n),
+ ?line {ok,<<"head">>} = file:read_file(File),
+ file:delete(File),
+
+ ?line Error1 = {error, {badarg, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {head_func, {tjo,hej,san}},{size, {100, 4}}]),
+ ?line "The argument " ++ _ = format_error(Error1),
+
+ ?line Error2 = {error, {invalid_header, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {head_func, {tjo,hej,[san]}}]),
+ ?line "The disk log header" ++ _ = format_error(Error2),
+ file:delete(File).
+
+
+head_fun(H) ->
+ H.
+
+hf() ->
+ ets:update_counter(xxx, wrapc, 1),
+ {ok, [1,2,3]}.
+
+plain_head(suite) -> [];
+plain_head(doc) -> ["Test head parameter"];
+plain_head(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ H = [1,2,3],
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,4}}, {head, H}]),
+ %% This one is not "counted".
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,4}}, {head, H}]),
+ ?line B = mk_bytes(60),
+ ?line disk_log:log(a, B),
+ ?line disk_log:alog(a, B),
+ ?line disk_log:alog(a, B),
+ ?line disk_log:log(a, B),
+ ?line case get_all_terms(a) of
+ [H,B,H,B,H,B,H,B] ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1,
+ [H,B,H,B,H,B,H,B]})
+ end,
+ ?line 8 = no_written_items(a),
+ ?line ok = disk_log:close(a),
+ ?line {error, no_such_log} = disk_log:close(a),
+ del(File, 4).
+
+
+
+one_header(suite) -> [];
+one_header(doc) -> ["Test that a header is just printed once in a log file"];
+one_header(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ H = [1,2,3],
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,4}}, {head, H}]),
+ ?line B = mk_bytes(60),
+ ?line ok = disk_log:log(a, B),
+ ?line ok = disk_log:alog(a, B),
+ ?line ok = disk_log:alog(a, B),
+ ?line ok = disk_log:log(a, B),
+ ?line case get_all_terms(a) of
+ [H,B,H,B,H,B,H,B] ->
+ ok;
+ E1 ->
+ test_server_fail({bad_terms, E1,
+ [H,B,H,B,H,B,H,B]})
+ end,
+ ?line 8 = no_written_items(a),
+ ?line ok = disk_log:close(a),
+ del(File, 4),
+
+ Fileb = filename:join(Dir, "b.LOG"),
+ ?line {ok, b} = disk_log:open([{name,b}, {file, Fileb}, {head, H}]),
+ ?line ok = disk_log:close(b),
+ ?line {ok, b} = disk_log:open([{name,b}, {file, Fileb}, {head, H}]),
+ ?line ok = disk_log:log(b, "first log"),
+ ?line ok = disk_log:alog(b, "second log"),
+ ?line ok = disk_log:close(b),
+ ?line {ok, b} = disk_log:open([{name,b}, {file, Fileb}, {head, H}]),
+ ?line ok = disk_log:alog(b, "3rd log"),
+ ?line ok = disk_log:log(b, "4th log"),
+ ?line case get_all_terms(b) of
+ [H, "first log", "second log", "3rd log", "4th log"] ->
+ ok;
+ E2 ->
+ test_server_fail({bad_terms, E2,
+ [H, "first log", "second log",
+ "3rd log", "4th log"]})
+ end,
+ ?line 2 = no_written_items(b),
+ ?line ok = disk_log:close(b),
+ ?line ok = file:delete(Fileb),
+
+ Filec = filename:join(Dir, "c.LOG"),
+ H2 = "this is a header ",
+ ?line {ok, c} = disk_log:open([{name,c}, {format, external},
+ {file, Filec}, {head, H2}]),
+ ?line ok = disk_log:close(c),
+ ?line {ok, c} = disk_log:open([{name,c}, {format, external},
+ {file, Filec}, {head, H2}]),
+ ?line ok = disk_log:blog(c, "first log"),
+ ?line ok = disk_log:balog(c, "second log"),
+ ?line ok = disk_log:close(c),
+ ?line {ok, c} = disk_log:open([{name,c}, {format, external},
+ {file, Filec}, {head, H2}]),
+ ?line ok = disk_log:balog(c, "3rd log"),
+ ?line ok = disk_log:blog(c, "4th log"),
+ ?line ok = disk_log:sync(c),
+ ?line {ok, Fdc} = file:open(Filec, [read]),
+ ?line {ok,"this is a header first logsecond log3rd log4th log"} =
+ file:read(Fdc, 200),
+ ?line ok = file:close(Fdc),
+ ?line 2 = no_written_items(c),
+ ?line disk_log:close(c),
+ ?line ok = file:delete(Filec),
+ ok.
+
+
+notif(suite) -> [wrap_notif, full_notif, trunc_notif,
+ blocked_notif].
+
+wrap_notif(suite) -> [];
+wrap_notif(doc) -> ["Test notify parameter, wrap"];
+wrap_notif(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,4}}, {notify, true}]),
+ ?line B = mk_bytes(60),
+ ?line disk_log:log(a, B),
+ ?line disk_log:alog(a, B),
+ ?line disk_log:alog(a, B),
+ ?line disk_log:log(a, B),
+ ?line disk_log:log(a, B),
+ ?line rec(3, {disk_log, node(), a, {wrap, 0}}),
+ ?line rec(1, {disk_log, node(), a, {wrap, 1}}),
+ disk_log:close(a),
+ del(File, 4).
+
+full_notif(suite) -> [];
+full_notif(doc) -> ["Test notify parameter, wrap, filled file"];
+full_notif(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ file:delete(File),
+
+ ?line {ok, a} = disk_log:open([{name, a}, {file, File}, {type, halt},
+ {size, 100}, {notify, true}]),
+ ?line B = mk_bytes(60),
+ ?line disk_log:log(a, B),
+ ?line disk_log:alog(a, B),
+ ?line rec(1, {disk_log, node(), a, full}),
+ disk_log:close(a),
+ file:delete(File).
+
+trunc_notif(suite) -> [];
+trunc_notif(doc) -> ["Test notify parameter, wrap, truncated file"];
+trunc_notif(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ File2 = filename:join(Dir, "a.DUMP"),
+ ?line {ok, a} = disk_log:open([{name, a}, {file, File}, {type, halt},
+ {size, 100}, {notify, true}]),
+ ?line B = mk_bytes(60),
+ ?line disk_log:log(a, B),
+ ?line disk_log:truncate(a),
+ ?line rec(1, {disk_log, node(), a, {truncated, 1}}),
+ ?line disk_log:log(a, B),
+ ?line ok = disk_log:reopen(a, File2),
+ ?line rec(1, {disk_log, node(), a, {truncated, 1}}),
+ disk_log:close(a),
+ file:delete(File),
+ file:delete(File2).
+
+blocked_notif(suite) -> [];
+blocked_notif(doc) ->
+ ["Test notify parameters 'format_external' and 'blocked_log"];
+blocked_notif(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "n.LOG"),
+ No = 4,
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {notify, true},
+ {format, external}]),
+ ?line B = mk_bytes(60),
+ ?line Error1 = {error,{format_external,n}} = disk_log:log(n, B),
+ ?line "The requested operation" ++ _ = format_error(Error1),
+ ?line ok = disk_log:blog(n, B),
+ ?line ok = disk_log:alog(n, B),
+ ?line rec(1, {disk_log, node(), n, {format_external, term_to_binary(B)}}),
+ ?line ok = disk_log:alog_terms(n, [B,B,B,B]),
+ ?line rec(1, {disk_log, node(), n, {format_external,
+ lists:map(fun term_to_binary/1, [B,B,B,B])}}),
+ ?line ok = disk_log:block(n, false),
+ ?line ok = disk_log:alog(n, B),
+ ?line rec(1, {disk_log, node(), n, {blocked_log, term_to_binary(B)}}),
+ ?line ok = disk_log:balog(n, B),
+ ?line rec(1, {disk_log, node(), n, {blocked_log, list_to_binary(B)}}),
+ ?line ok = disk_log:balog_terms(n, [B,B,B,B]),
+ ?line disk_log:close(n),
+ ?line rec(1, {disk_log, node(), n, {blocked_log,
+ lists:map(fun list_to_binary/1, [B,B,B,B])}}),
+ ?line del(File, No).
+
+
+new_idx_vsn(suite) -> [];
+new_idx_vsn(doc) -> ["Test the new version of the .idx file"];
+new_idx_vsn(Conf) when is_list(Conf) ->
+ DataDir = ?datadir(Conf),
+ PrivDir = ?privdir(Conf),
+ File = filename:join(PrivDir, "new_vsn.LOG"),
+ Kurt = filename:join(PrivDir, "kurt.LOG"),
+ Kurt2 = filename:join(PrivDir, "kurt2.LOG"),
+
+ %% Test that a wrap log file can have more than 255 files
+ ?line {ok, new_vsn} = disk_log:open([{file, File}, {name, new_vsn},
+ {type, wrap}, {size, {40, 270}}]),
+ ?line ok = log(new_vsn, 280),
+ ?line {ok, Bin} = file:read_file(add_ext(File, "idx")),
+ ?line <<0,0:32,2,10:32,1:64,1:64,_/binary>> = Bin,
+ ?line disk_log:close(new_vsn),
+ ?line del(File, 270),
+
+ %% convert a very old version (0) of wrap log file to the new format (2)
+ copy_wrap_log("kurt.LOG", 4, DataDir, PrivDir),
+
+ ?line {repaired, kurt, {recovered, 1}, {badbytes, 0}} =
+ disk_log:open([{file, Kurt}, {name, kurt},
+ {type, wrap}, {size, {40, 4}}]),
+ ?line ok = disk_log:log(kurt, "this is a logged message number X"),
+ ?line ok = disk_log:log(kurt, "this is a logged message number Y"),
+ ?line {ok, BinK} = file:read_file(add_ext(Kurt, "idx")),
+ ?line <<0,0:32,2,2:32,1:64,1:64,1:64,1:64>> = BinK,
+ ?line {{40,4}, 2} = disk_log_1:read_size_file_version(Kurt),
+ disk_log:close(kurt),
+ ?line del(Kurt, 4),
+
+ %% keep the old format (1)
+ copy_wrap_log("kurt2.LOG", 4, DataDir, PrivDir),
+
+ ?line {repaired, kurt2, {recovered, 1}, {badbytes, 0}} =
+ disk_log:open([{file, Kurt2}, {name, kurt2},
+ {type, wrap}, {size, {40, 4}}]),
+ ?line ok = disk_log:log(kurt2, "this is a logged message number X"),
+ ?line ok = disk_log:log(kurt2, "this is a logged message number Y"),
+ ?line {ok, BinK2} = file:read_file(add_ext(Kurt2, "idx")),
+ ?line <<0,2:32,1:32,1:32,1:32,1:32>> = BinK2,
+ ?line {{40,4}, 1} = disk_log_1:read_size_file_version(Kurt2),
+ disk_log:close(kurt2),
+ ?line del(Kurt2, 4),
+
+ ok.
+
+reopen(suite) -> [];
+reopen(doc) ->
+ ["Test reopen/1 on halt and wrap logs."];
+reopen(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line NewFile = filename:join(Dir, "nn.LOG"),
+ ?line B = mk_bytes(60),
+
+ ?line file:delete(File), % cleanup
+ ?line file:delete(NewFile), % cleanup
+ ?line Q = qlen(),
+
+ %% External halt log.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {notify, true}, {head, "header"},
+ {size, infinity},{format, external}]),
+ ?line ok = disk_log:blog(n, B),
+ ?line ok = disk_log:breopen(n, NewFile, "head"),
+ ?line rec(1, {disk_log, node(), n, {truncated, 2}}),
+ ?line ok = disk_log:blog(n, B),
+ ?line ok = disk_log:blog(n, B),
+ ?line ok = disk_log:breopen(n, NewFile, "head"),
+ ?line rec(1, {disk_log, node(), n, {truncated, 3}}),
+ ?line ok = disk_log:close(n),
+ ?line {ok,BinaryFile} = file:read_file(File),
+ ?line "head" = binary_to_list(BinaryFile),
+ ?line file:delete(File),
+ ?line file:delete(NewFile),
+
+ %% Internal halt log.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {notify, true}, {head, header},
+ {size, infinity}]),
+ ?line ok = disk_log:log(n, B),
+ ?line Error1 = {error, {same_file_name, n}} = disk_log:reopen(n, File),
+ ?line "Current and new" ++ _ = format_error(Error1),
+ ?line ok = disk_log:reopen(n, NewFile),
+ ?line rec(1, {disk_log, node(), n, {truncated, 2}}),
+ ?line ok = disk_log:log(n, B),
+ ?line ok = disk_log:log(n, B),
+ ?line ok = disk_log:reopen(n, NewFile),
+ ?line rec(1, {disk_log, node(), n, {truncated, 3}}),
+ ?line ok = disk_log:close(n),
+ ?line [header, _B, _B] = get_all_terms(nn, NewFile, halt),
+ ?line file:delete(File),
+ ?line file:delete(NewFile),
+
+ %% Internal wrap log.
+ ?line No = 4,
+ ?line del(File, No), % cleanup
+ ?line del(NewFile, No), % cleanup
+
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {notify, true},
+ {head, header}, {size, {100, No}}]),
+ ?line ok = disk_log:log(n, B),
+ ?line ok = disk_log:log_terms(n, [B,B,B]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(3, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:log_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line ok = disk_log:log_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line ok = disk_log:reopen(n, NewFile, new_header),
+ ?line rec(1, {disk_log, node(), n, {truncated, 8}}),
+ ?line ok = disk_log:log_terms(n, [B,B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:log_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:close(n),
+ ?line [header, _, header, _, header, _, header, _] =
+ get_all_terms(nn, NewFile, wrap),
+ ?line [new_header, _, header, _, header, _] = get_all_terms(n, File, wrap),
+
+ ?line del(NewFile, No),
+ ?line file:delete(File ++ ".2"),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {notify, true},
+ {head, header}, {size, {100, No}}]),
+ %% One file is missing...
+ ?line ok = disk_log:reopen(n, NewFile),
+ ?line rec(1, {disk_log, node(), n, {truncated, 6}}),
+ ?line ok = disk_log:close(n),
+
+ ?line del(File, No),
+ ?line del(NewFile, No),
+ ?line Q = qlen(),
+ ok.
+
+block(suite) -> [block_blocked, block_queue, block_queue2].
+
+block_blocked(suite) -> [];
+block_blocked(doc) ->
+ ["Test block/1 on external and internal logs."];
+block_blocked(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line B = mk_bytes(60),
+ Halt = join(Dir, "halt.LOG"),
+
+ % External logs.
+ ?line file:delete(Halt), % cleanup
+ ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt},
+ {format, external}, {file, Halt}]),
+ ?line ok = disk_log:sync(halt),
+ ?line ok = disk_log:block(halt, false),
+ ?line Error1 = {error, {blocked_log, halt}} = disk_log:block(halt),
+ ?line "The blocked disk" ++ _ = format_error(Error1),
+ ?line {error, {blocked_log, halt}} = disk_log:sync(halt),
+ ?line {error, {blocked_log, halt}} = disk_log:truncate(halt),
+ ?line {error, {blocked_log, halt}} = disk_log:change_size(halt, inifinity),
+ ?line {error, {blocked_log, halt}} =
+ disk_log:change_notify(halt, self(), false),
+ ?line {error, {blocked_log, halt}} =
+ disk_log:change_header(halt, {head, header}),
+ ?line {error, {blocked_log, halt}} = disk_log:reopen(halt, "foo"),
+ ?line ok = disk_log:close(halt),
+
+ ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt},
+ {format, external}]),
+ ?line ok = disk_log:sync(halt),
+ ?line ok = disk_log:block(halt, true),
+ ?line {error, {blocked_log, halt}} = disk_log:blog(halt, B),
+ ?line {error, {blocked_log, halt}} = disk_log:blog(halt, B),
+ ?line {error, {blocked_log, halt}} = disk_log:block(halt),
+ ?line {error, {blocked_log, halt}} = disk_log:sync(halt),
+ ?line {error, {blocked_log, halt}} = disk_log:truncate(halt),
+ ?line {error, {blocked_log, halt}} = disk_log:change_size(halt, infinity),
+ ?line {error, {blocked_log, halt}} =
+ disk_log:change_notify(halt, self(), false),
+ ?line {error, {blocked_log, halt}} =
+ disk_log:change_header(halt, {head, header}),
+ ?line {error, {blocked_log, halt}} = disk_log:reopen(halt, "foo"),
+
+ ?line ok = disk_log:unblock(halt),
+ ?line ok = disk_log:close(halt),
+ ?line file:delete(Halt),
+
+ % Internal logs.
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line del(File, No), % cleanup
+ ?line {ok, halt} = disk_log:open([{name, halt}, {file, File}, {type, wrap},
+ {size, {100, No}}]),
+ ?line ok = disk_log:block(halt, true),
+ ?line eof = disk_log:chunk(halt, start),
+ ?line Error2 = {error, end_of_log} = disk_log:chunk_step(halt, start, 1),
+ ?line "An attempt" ++ _ = format_error(Error2),
+ ?line {error, {blocked_log, halt}} = disk_log:log(halt, B),
+ ?line {error, {blocked_log, halt}} = disk_log:inc_wrap_file(halt),
+ ?line ok = disk_log:unblock(halt),
+ ?line ok = disk_log:block(halt, false),
+ ?line {error, {blocked_log, halt}} = disk_log:log(halt, B),
+ ?line {error, {blocked_log, halt}} = disk_log:inc_wrap_file(halt),
+ ?line Parent = self(),
+ ?line Pid =
+ spawn_link(fun() ->
+ {error, {blocked_log, halt}} =
+ disk_log:chunk(halt, start),
+ {error, {blocked_log, halt}} =
+ disk_log:chunk_step(halt, start, 1),
+ Parent ! {self(), stopped}
+ end),
+ ?line receive {Pid,stopped} -> ok end,
+ ?line ok = disk_log:close(halt),
+ ?line del(File, No).
+
+block_queue(suite) -> [];
+block_queue(doc) ->
+ ["Run commands from the queue by unblocking."];
+block_queue(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line Q = qlen(),
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line del(File, No), % cleanup
+ ?line B = mk_bytes(60),
+
+ ?line Pid = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid, {open, File}),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {blog, B}),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+ ?line 1 = no_written_items(n),
+ ?line Error1 = {error,{not_blocked,n}} = disk_log:unblock(n),
+ ?line "The disk log" ++ _ = format_error(Error1),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {balog, "one string"}),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+ ?line 2 = no_written_items(n),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, sync),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, truncate),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+ ?line 0 = no_items(n),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {block, false}),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+ ?line {error, {blocked_log, _}} = disk_log:blog(n, B),
+ ?line ok = sync_do(Pid, unblock),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {change_notify, Pid, true}),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+ ?line [{_, true}] = owners(n),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {change_notify, Pid, false}),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+ ?line [{_, false}] = owners(n),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {change_header, {head, header}}),
+ ?line ok = disk_log:unblock(n),
+ ?line {error, {badarg, head}} = get_reply(),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {change_size, 17}),
+ ?line ok = disk_log:unblock(n),
+ ?line {error, {badarg, size}} = get_reply(),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, inc_wrap_file),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+
+ ?line ok = sync_do(Pid, close),
+ ?line del(File, No),
+
+ ?line _Pid2 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid, {int_open, File}),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {chunk, start}),
+ ?line ok = disk_log:unblock(n),
+ ?line eof = get_reply(),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {chunk_step, start, 100}),
+ ?line ok = disk_log:unblock(n),
+ ?line {ok, _Cont} = get_reply(),
+
+ ?line ok = disk_log:block(n, true),
+ ?line async_do(Pid, {log,a_term}),
+ ?line ok = disk_log:unblock(n),
+ ?line ok = get_reply(),
+ ?line 1 = no_written_items(n),
+
+ ?line ok = sync_do(Pid, close),
+ ?line sync_do(Pid, terminate),
+ ?line del(File, No),
+
+ %% Test of the queue. Three processes involved here. Pid1's block
+ %% request is queued. Pid2's log requests are put in the queue.
+ %% When unblock is executed, Pid1's block request is granted.
+ %% Pid2's log requests are executed when Pid1 unblocks.
+ %% (This example should show that the pair 'queue' and 'messages'
+ %% in State does the trick - one does not need a "real" queue.)
+ ?line P0 = pps(),
+ Name = n,
+ ?line Pid1 = spawn_link(?MODULE, lserv, [Name]),
+ ?line {ok, Name} = sync_do(Pid1, {int_open, File, {1000,2}}),
+ ?line Pid2 = spawn_link(?MODULE, lserv, [Name]),
+ ?line {ok, Name} = sync_do(Pid2, {int_open, File, {1000,2}}),
+ ?line ok = disk_log:block(Name),
+ ?line async_do(Pid1, {alog,{1,a}}),
+ ?line ok = get_reply(),
+ ?line async_do(Pid1, {alog,{2,b}}),
+ ?line ok = get_reply(),
+ ?line async_do(Pid1, {alog,{3,c}}),
+ ?line ok = get_reply(),
+ ?line async_do(Pid1, {alog,{4,d}}),
+ ?line ok = get_reply(),
+ ?line async_do(Pid1, block),
+ ?line async_do(Pid2, {alog,{5,e}}),
+ ?line ok = get_reply(),
+ ?line async_do(Pid2, {alog,{6,f}}),
+ ?line ok = get_reply(),
+ ?line ok = disk_log:unblock(Name),
+ ?line ok = get_reply(),
+ ?line async_do(Pid2, {alog,{7,g}}),
+ ?line ok = get_reply(),
+ ?line async_do(Pid2, {alog,{8,h}}),
+ ?line ok = get_reply(),
+ ?line async_do(Pid1, unblock),
+ ?line ok = get_reply(),
+ ?line ok = sync_do(Pid1, close),
+ ?line ok = sync_do(Pid2, close),
+ ?line sync_do(Pid1, terminate),
+ ?line sync_do(Pid2, terminate),
+ Terms = get_all_terms(Name, File, wrap),
+ ?line true = [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g},{8,h}] == Terms,
+ del(File, 2),
+ ?line Q = qlen(),
+ ?line true = (P0 == pps()),
+ ok.
+
+block_queue2(suite) -> [];
+block_queue2(doc) ->
+ ["OTP-4880. Blocked processes did not get disk_log_stopped message."];
+block_queue2(Conf) when is_list(Conf) ->
+ ?line Q = qlen(),
+ ?line P0 = pps(),
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+
+ %% log requests are queued, and processed when the log is closed
+ ?line Pid = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid, {open, File}),
+ ?line ok = sync_do(Pid, block),
+ %% Asynchronous stuff is ignored.
+ ?line ok = disk_log:balog_terms(n, [<<"foo">>,<<"bar">>]),
+ ?line ok = disk_log:balog_terms(n, [<<"more">>,<<"terms">>]),
+ ?line Fun =
+ fun() -> {error,disk_log_stopped} = disk_log:sync(n)
+ end,
+ ?line spawn(Fun),
+ ?line ok = sync_do(Pid, close),
+ ?line sync_do(Pid, terminate),
+ ?line {ok,<<>>} = file:read_file(File ++ ".1"),
+ ?line del(File, No),
+ ?line Q = qlen(),
+ ?line true = (P0 == pps()),
+ ok.
+
+
+unblock(suite) -> [];
+unblock(doc) ->
+ ["Test unblock/1."];
+unblock(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "n.LOG"),
+ No = 1,
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {notify, true},
+ {format, external}]),
+ ?line ok = disk_log:block(n),
+ ?line spawn_link(?MODULE, try_unblock, [n]),
+ ?line timer:sleep(100),
+ ?line disk_log:close(n),
+ ?line del(File, No).
+
+try_unblock(Log) ->
+ ?line Error = {error, {not_blocked_by_pid, n}} = disk_log:unblock(Log),
+ ?line "The disk log" ++ _ = format_error(Error).
+
+open(suite) -> [open_overwrite, open_size,
+ open_truncate, open_error].
+
+open_overwrite(suite) -> [];
+open_overwrite(doc) ->
+ ["Test open/1 when old files exist."];
+open_overwrite(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line del(File, No), % cleanup
+
+ % read write
+ ?line First = "n.LOG.1",
+ ?line make_file(Dir, First, 8),
+
+ ?line Error1 = {error, {not_a_log_file, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {100, No}}]),
+ ?line "The file" ++ _ = format_error(Error1),
+ ?line del(File, No),
+
+ ?line make_file(Dir, First, 4),
+
+ ?line {error, {not_a_log_file, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {100, No}}]),
+ ?line del(File, No),
+
+ ?line make_file(Dir, First, 0),
+
+ ?line {error, {not_a_log_file, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {100, No}}]),
+ % read only
+ ?line make_file(Dir, First, 6),
+
+ ?line {error, {not_a_log_file, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},{mode, read_only},
+ {format, internal}, {size, {100, No}}]),
+ ?line del(File, No),
+
+ ?line make_file(Dir, First, 0),
+
+ ?line {error, {not_a_log_file, _}} =
+ disk_log:open([{name, n}, {file, File},{type, wrap},
+ {mode, read_only}, {format, internal},
+ {size, {100, No}}]),
+ ?line del(File, No),
+
+ ?line {error, _} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {mode, read_only},
+ {format, internal},{size, {100, No}}]),
+
+ file:delete(File),
+ ?line {ok,n} = disk_log:open([{name,n},{file,File},
+ {mode,read_write},{type,halt}]),
+ ?line ok = disk_log:close(n),
+ ?line ok = unwritable(File),
+ ?line {error, {file_error, File, _}} =
+ disk_log:open([{name,n},{file,File},{mode,read_write},{type,halt}]),
+ ?line ok = writable(File),
+ file:delete(File),
+
+ ?line {ok,n} = disk_log:open([{name,n},{file,File},{format,external},
+ {mode,read_write},{type,halt}]),
+ ?line ok = disk_log:close(n),
+ ?line ok = unwritable(File),
+ ?line {error, {file_error, File, _}} =
+ disk_log:open([{name,n},{file,File},{format,external},
+ {mode,read_write},{type,halt}]),
+ ?line ok = writable(File),
+ file:delete(File),
+
+ ok.
+
+
+make_file(Dir, File, N) ->
+ {ok, F} = file:open(filename:join(Dir, File),
+ [raw, binary, read, write]),
+ ok = file:truncate(F),
+ case N of
+ 0 ->
+ true;
+ _Else ->
+ ok = file:write(F, [lists:seq(1,N)])
+ end,
+ ok = file:close(F).
+
+open_size(suite) -> [];
+open_size(doc) ->
+ ["Test open/1 option size."];
+open_size(Conf) when is_list(Conf) ->
+
+ ?line Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+
+ ?line No = 4,
+ ?line file:delete(File),
+ ?line del(File, No), % cleanup
+
+ %% missing size option
+ ?line {error, {badarg, size}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal},{size, {100, No}}]),
+ ?line B = mk_bytes(60),
+ ?line ok = disk_log:log_terms(n, [B, B, B, B]),
+ ?line ok = disk_log:sync(n),
+ ?line ok = disk_log:block(n),
+
+ %% size option does not match existing size file, read_only
+ ?line Error1 = {error, {size_mismatch, _, _}} =
+ disk_log:open([{name, nn}, {file, File}, {type, wrap},
+ {mode, read_only}, {format, internal},
+ {size, {100, No + 1}}]),
+ ?line "The given size" ++ _ = format_error(Error1),
+ ?line {ok, nn} = disk_log:open([{name, nn}, {file, File}, {type, wrap},
+ {mode, read_only},
+ {format, internal},{size, {100, No}}]),
+ ?line [_, _, _, _] = get_all_terms1(nn, start, []),
+ ?line disk_log:close(nn),
+
+ ?line ok = disk_log:unblock(n),
+ ?line ok = disk_log:close(n),
+
+ %% size option does not match existing size file, read_write
+ ?line {error, {size_mismatch, _, _}} =
+ disk_log:open([{name, nn}, {file, File}, {type, wrap},
+ {format, internal}, {size, {100, No + 1}}]),
+ %% size option does not match existing size file, truncating
+ ?line {ok, nn} =
+ disk_log:open([{name, nn}, {file, File}, {type, wrap},
+ {repair, truncate}, {format, internal},
+ {size, {100, No + 1}}]),
+ ?line ok = disk_log:close(nn),
+
+ ?line del(File, No),
+ ok.
+
+
+open_truncate(suite) -> [];
+open_truncate(doc) ->
+ ["Test open/1 with {repair, truncate}."];
+open_truncate(Conf) when is_list(Conf) ->
+
+ ?line Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line del(File, No), % cleanup
+
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal},{size, {100, No}}]),
+ ?line B = mk_bytes(60),
+ ?line ok = disk_log:log_terms(n, [B, B, B, B]),
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {repair,truncate},
+ {format, internal},{size, {100, No}}]),
+ ?line ok = disk_log:close(n),
+ ?line [] = get_all_terms(n, File, wrap),
+ ?line del(File, No),
+ ok.
+
+
+open_error(suite) -> [];
+open_error(doc) ->
+ ["Try some invalid open/1 options."];
+open_error(Conf) when is_list(Conf) ->
+ ?line Dir = ?privdir(Conf),
+
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line del(File, No), % cleanup
+
+ ?line {error, {badarg, name}} = disk_log:open([{file, File}]),
+ ?line {error, {badarg, file}} = disk_log:open([{name,{foo,bar}}]),
+ ?line {error, {badarg, [{foo,bar}]}} = disk_log:open([{foo,bar}]),
+
+ %% external logs, read_only.
+ ?line {error, {file_error, _, enoent}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}},
+ {format, external}, {mode, read_only}]),
+ ?line Error5 = {error, {file_error, _, enoent}} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {size, 100},
+ {format, external}, {mode, read_only}]),
+ ?line true = lists:prefix("\"" ++ File, format_error(Error5)),
+
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external},{size, {100, No}}]),
+ %% Already owner, ignored.
+ ?line {ok, n} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {size, {100, No}}]),
+ ?line Error2 = {error, {name_already_open, n}} =
+ disk_log:open([{name, n}, {file, another_file}, {type, wrap},
+ {format, external}, {size, {100, No}}]),
+ ?line "The disk log" ++ _ = format_error(Error2),
+ ?line Error1 = {error, {arg_mismatch, notify, false, true}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {size, {100, No}}, {notify, true}]),
+ ?line "The value" ++ _ = format_error(Error1),
+ ?line Error3 = {error, {open_read_write, n}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {mode, read_only},
+ {format, external}, {size, {100, No}}]),
+ ?line "The disk log" ++ _ = format_error(Error3),
+ ?line {error, {badarg, size}} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, external}, {size, {100, No}}]),
+ ?line {error, {arg_mismatch, type, wrap, halt}} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, external}]),
+ ?line {error, {arg_mismatch, format, external, internal}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {100, No}}]),
+ ?line {error, {arg_mismatch, repair, true, false}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {repair, false}]),
+ ?line {error, {size_mismatch, {100,4}, {1000,4}}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {size, {1000, No}}]),
+ ?line {error, {arg_mismatch, head, none, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {head, "header"},
+ {format, external}, {size, {100, No}}]),
+ ?line {error, {badarg, size}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {size, 100}]),
+
+ ?line ok = disk_log:close(n),
+
+ ?line {ok, n} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {mode, read_only},
+ {format, external}, {size, {100, No}}]),
+ ?line Error4 = {error, {open_read_only, n}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {mode, read_write},
+ {format, external}, {size, {100, No}}]),
+ ?line "The disk log" ++ _ = format_error(Error4),
+ ?line ok = disk_log:close(n),
+
+ ?line del(File, No).
+
+close(suite) -> [close_race, close_block, close_deadlock].
+
+close_race(suite) -> [];
+close_race(doc) ->
+ ["Do something quickly after close/1"];
+close_race(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 1,
+ ?line del(File, No), % cleanup
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {notify, true},
+ {format, internal}]),
+ ?line ok = disk_log:close(n),
+ ?line Error1 = {error, no_such_log} = disk_log:close(n),
+ ?line "There is no disk" ++ _ = format_error(Error1),
+
+ % Pid1 blocks, Pid2 closes without being suspended.
+ ?line Pid1 = spawn_link(?MODULE, lserv, [n]),
+ ?line Pid2 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid1, {open, File}),
+ ?line {ok, n} = sync_do(Pid2, {open, File}),
+ ?line ok = sync_do(Pid1, block),
+ ?line [{_, false}, {_, false}] = sync_do(Pid1, owners),
+ ?line ok = sync_do(Pid2, close),
+ ?line [{_, false}] = sync_do(Pid1, owners),
+ ?line ok = sync_do(Pid1, close),
+ ?line sync_do(Pid1, terminate),
+ ?line sync_do(Pid2, terminate),
+ ?line {error, no_such_log} = disk_log:info(n),
+
+ % Pid3 blocks, Pid3 closes. Pid4 should still be ablo to use log.
+ ?line Pid3 = spawn_link(?MODULE, lserv, [n]),
+ ?line Pid4 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid3, {open, File}),
+ ?line {ok, n} = sync_do(Pid4, {open, File}),
+ ?line ok = sync_do(Pid3, block),
+ ?line ok = sync_do(Pid3, close),
+ ?line [{_Pid4, false}] = sync_do(Pid4, owners),
+ ?line sync_do(Pid3, terminate),
+ ?line sync_do(Pid4, terminate),
+ ?line {error, no_such_log} = disk_log:info(n),
+
+ % Pid5 blocks, Pid5 terminates. Pid6 should still be ablo to use log.
+ ?line Pid5 = spawn_link(?MODULE, lserv, [n]),
+ ?line Pid6 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid5, {open, File}),
+ ?line {ok, n} = sync_do(Pid6, {open, File}),
+ ?line ok = sync_do(Pid5, block),
+ ?line sync_do(Pid5, terminate),
+ ?line [{_Pid6, false}] = sync_do(Pid6, owners),
+ ?line sync_do(Pid6, terminate),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line del(File, No), % cleanup
+ ok.
+
+close_block(suite) -> [];
+close_block(doc) ->
+ ["Block, unblock, close, terminate."];
+close_block(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ No = 1,
+ del(File, No), % cleanup
+
+ P0 = pps(),
+ %% One of two owners terminates.
+ ?line Pid1 = spawn_link(?MODULE, lserv, [n]),
+ ?line Pid2 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid1, {open, File}),
+ ?line {ok, n} = sync_do(Pid2, {open, File}),
+ ?line [_, _] = sync_do(Pid1, owners),
+ ?line [_, _] = sync_do(Pid2, owners),
+ ?line 0 = sync_do(Pid1, users),
+ ?line 0 = sync_do(Pid2, users),
+ ?line sync_do(Pid1, terminate),
+ ?line [_] = sync_do(Pid2, owners),
+ ?line 0 = sync_do(Pid2, users),
+ ?line sync_do(Pid2, terminate),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line true = (P0 == pps()),
+
+ %% Users terminate (no link...).
+ ?line Pid3 = spawn_link(?MODULE, lserv, [n]),
+ ?line Pid4 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid3, {open, File, none}),
+ ?line {ok, n} = sync_do(Pid4, {open, File, none}),
+ ?line [] = sync_do(Pid3, owners),
+ ?line [] = sync_do(Pid4, owners),
+ ?line 2 = sync_do(Pid3, users),
+ ?line 2 = sync_do(Pid4, users),
+ ?line sync_do(Pid3, terminate),
+ ?line [] = sync_do(Pid4, owners),
+ ?line 2 = sync_do(Pid4, users),
+ ?line sync_do(Pid4, terminate),
+ ?line disk_log:close(n),
+ ?line disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line true = (P0 == pps()),
+
+ % Blocking owner terminates.
+ ?line Pid5 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {linkto, none},{size, {100,No}},
+ {format, external}]),
+ ?line {ok, n} = sync_do(Pid5, {open, File}),
+ ?line ok = sync_do(Pid5, block),
+ ?line {blocked, true} = status(n),
+ ?line [_] = owners(n),
+ ?line sync_do(Pid5, terminate),
+ ?line ok = status(n),
+ ?line [] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line true = (P0 == pps()),
+
+ % Blocking user terminates.
+ ?line Pid6 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {format, external}]),
+ ?line {ok, n} = sync_do(Pid6, {open, File, none}),
+ ?line ok = sync_do(Pid6, block),
+ ?line {blocked, true} = status(n),
+ ?line [_] = owners(n),
+ ?line 1 = users(n),
+ ?line sync_do(Pid6, terminate), % very silently...
+ ?line ok = status(n),
+ ?line [_] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = disk_log:close(n),
+ ?line [] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line true = (P0 == pps()),
+
+ % Blocking owner terminates.
+ ?line Pid7 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {linkto, none},
+ {size, {100,No}}, {format, external}]),
+ ?line {ok, n} = sync_do(Pid7, {open, File}),
+ ?line ok = sync_do(Pid7, block),
+ ?line {blocked, true} = status(n),
+ ?line [_] = owners(n),
+ ?line 1 = users(n),
+ ?line sync_do(Pid7, terminate),
+ ?line ok = status(n),
+ ?line [] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line true = (P0 == pps()),
+
+ %% Two owners, the blocking one terminates.
+ ?line Pid8 = spawn_link(?MODULE, lserv, [n]),
+ ?line Pid9 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = sync_do(Pid8, {open, File}),
+ ?line {ok, n} = sync_do(Pid9, {open, File}),
+ ?line ok = sync_do(Pid8, block),
+ ?line {blocked, true} = status(n),
+ ?line sync_do(Pid8, terminate),
+ ?line ok = status(n),
+ ?line [_] = sync_do(Pid9, owners),
+ ?line 0 = sync_do(Pid9, users),
+ ?line sync_do(Pid9, terminate),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line true = (P0 == pps()),
+
+ % Blocking user closes.
+ ?line Pid10 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {format, external}]),
+ ?line {ok, n} = sync_do(Pid10, {open, File, none}),
+ ?line ok = sync_do(Pid10, block),
+ ?line {blocked, true} = status(n),
+ ?line [_] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = sync_do(Pid10, close),
+ ?line ok = status(n),
+ ?line [_] = owners(n),
+ ?line 0 = users(n),
+ ?line ok = disk_log:close(n),
+ ?line sync_do(Pid10, terminate),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line true = (P0 == pps()),
+
+ % Blocking user unblocks and closes.
+ ?line Pid11 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {format, external}]),
+ ?line {ok, n} = sync_do(Pid11, {open, File, none}),
+ ?line ok = sync_do(Pid11, block),
+ ?line {blocked, true} = status(n),
+ ?line [_] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = sync_do(Pid11, unblock),
+ ?line ok = sync_do(Pid11, close),
+ ?line ok = status(n),
+ ?line [_] = owners(n),
+ ?line 0 = users(n),
+ ?line ok = disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line sync_do(Pid11, terminate),
+ ?line true = (P0 == pps()),
+
+ % Blocking owner closes.
+ ?line Pid12 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {linkto, none},
+ {size, {100,No}}, {format, external}]),
+ ?line {ok, n} = sync_do(Pid12, {open, File}),
+ ?line ok = sync_do(Pid12, block),
+ ?line {blocked, true} = status(n),
+ ?line [_] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = sync_do(Pid12, close),
+ ?line ok = status(n),
+ ?line [] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line sync_do(Pid12, terminate),
+ ?line true = (P0 == pps()),
+
+ % Blocking owner unblocks and closes.
+ ?line Pid13 = spawn_link(?MODULE, lserv, [n]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {linkto, none},
+ {size, {100,No}}, {format, external}]),
+ ?line {ok, n} = sync_do(Pid13, {open, File}),
+ ?line ok = sync_do(Pid13, block),
+ ?line {blocked, true} = status(n),
+ ?line [_] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = sync_do(Pid13, unblock),
+ ?line ok = sync_do(Pid13, close),
+ ?line ok = status(n),
+ ?line [] = owners(n),
+ ?line 1 = users(n),
+ ?line ok = disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line sync_do(Pid13, terminate),
+ ?line true = (P0 == pps()),
+
+ del(File, No), % cleanup
+ ok.
+
+close_deadlock(suite) -> [];
+close_deadlock(doc) ->
+ ["OTP-4745. Deadlock with just an ordinary log could happen."];
+close_deadlock(Conf) when is_list(Conf) ->
+ ?line true = is_alive(),
+
+ ?line PrivDir = ?privdir(Conf),
+
+ ?line F1 = filename:join(PrivDir, "a.LOG"),
+ ?line file:delete(F1),
+ Self = self(),
+
+ %% One process opens the log at the same time as another process
+ %% closes the log. Used to always cause deadlock before OTP-4745.
+ Name = a,
+ Fun = fun() -> open_close(Self, Name, F1) end,
+ P = spawn(Fun),
+ ?line receive {P, Name} -> ok end,
+ ?line {ok, L} = disk_log:open([{name,Name},{file,F1}]),
+ ?line ok = disk_log:close(L),
+ ?line receive {P, done} -> ok end,
+ ?line file:delete(F1),
+
+ %% One process opens the log at the same time as another process
+ %% closes the log due to file error while truncating.
+ %% This test is time dependent, but does not fail when it does not
+ %% "work". When it works, as it seems to do right now :), the
+ %% disk_log_server gets {error, no_such_log}, receives the EXIT
+ %% message caused by truncate, and tries to open the log again.
+ ?line No = 4,
+ ?line LDir = F1 ++ ".2",
+ ?line file:del_dir(LDir),
+ ?line del(F1, No),
+ ?line ok = file:make_dir(LDir),
+ Fun2 = fun() -> open_truncate(Self, Name, F1, No) end,
+ P2 = spawn(Fun2),
+ ?line receive {P2, Name} -> ok end,
+ ?line {ok, L} = disk_log:open([{name, Name}, {file, F1}, {type, wrap},
+ {format, external}]),
+ %% Note: truncate causes the disk log process to terminate. One
+ %% cannot say if open above happened before, after, or during the
+ %% termination. The link to the owner is removed before termination.
+ ?line case disk_log:close(L) of
+ ok -> ok;
+ {error,no_such_log} ->
+ ok
+ end,
+ ?line receive {P2, done} -> ok end,
+ ?line del(F1, No),
+ ?line file:del_dir(LDir),
+
+ %% To the same thing, this time using distributed logs.
+ %% (Does not seem to work very well, unfortunately.)
+ FunD = fun() -> open_close_dist(Self, Name, F1) end,
+ PD = spawn(FunD),
+ receive {PD, Name} -> ok end,
+ ?line {[_], []} = disk_log:open([{name,Name},{file,F1},
+ {distributed,[node()]}]),
+ ?line ok = disk_log:close(L),
+ receive {PD, done} -> ok end,
+ ?line file:delete(F1),
+
+ ok.
+
+open_close(Pid, Name, File) ->
+ {ok, L} = disk_log:open([{name,Name},{file,File}]),
+ Pid ! {self(), Name},
+ ok = disk_log:close(L),
+ Pid ! {self(), done}.
+
+open_truncate(Pid, Name, File, No) ->
+ {ok, L} = disk_log:open([{name, Name}, {file, File}, {type, wrap},
+ {format, external},{size, {100, No}}]),
+ Pid ! {self(), Name},
+ {error, {file_error, _, _}} = disk_log:truncate(L),
+ %% The file has been closed, the disklog process has terminated.
+ Pid ! {self(), done}.
+
+open_close_dist(Pid, Name, File) ->
+ {[{_,{ok,L}}], []} = disk_log:open([{name,Name},{file,File},
+ {distributed,[node()]}]),
+ Pid ! {self(), Name},
+ ok = disk_log:close(L),
+ Pid ! {self(), done}.
+
+async_do(Pid, Req) ->
+ Pid ! {self(), Req},
+ %% make sure the request is queued
+ timer:sleep(100).
+
+get_reply() ->
+ receive Reply ->
+ Reply
+ end.
+
+sync_do(Pid, Req) ->
+ Pid ! {self(), Req},
+ receive
+ Reply ->
+ Reply
+ end.
+
+lserv(Log) ->
+ ?line receive
+ {From, {open, File}} ->
+ From ! disk_log:open([{name, Log}, {file, File}, {type, wrap},
+ {size, {100,1}}, {format, external}]);
+ {From, {open, File, LinkTo}} ->
+ From ! disk_log:open([{name, Log}, {file, File}, {type, wrap},
+ {linkto, LinkTo}, {size, {100,1}},
+ {format, external}]);
+ {From, {int_open, File}} ->
+ From ! disk_log:open([{name, Log}, {file, File}, {type, wrap},
+ {size, {100,1}}]);
+ {From, {int_open, File, Size}} ->
+ From ! disk_log:open([{name, Log}, {file, File}, {type, wrap},
+ {size, Size}]);
+ {From, {dist_open, File, Node}} ->
+ From ! disk_log:open([{name, Log}, {file, File}, {type, wrap},
+ {size, {100,1}}, {distributed, [Node]}]);
+ {From, {dist_open, File, LinkTo, Node}} ->
+ From ! disk_log:open([{name, Log}, {file, File}, {type, wrap},
+ {linkto, LinkTo}, {size, {100,1}},
+ {distributed, [Node]}]);
+ {From, block} ->
+ From ! disk_log:block(Log);
+ {From, {block, Bool}} ->
+ From ! disk_log:block(Log, Bool);
+ {From, unblock} ->
+ From ! disk_log:unblock(Log);
+ {From, close} ->
+ From ! disk_log:close(Log);
+ {From, owners} ->
+ From ! owners(Log);
+ {From, users} ->
+ From ! users(Log);
+ {From, sync} ->
+ From ! disk_log:sync(Log);
+ {From, truncate} ->
+ From ! disk_log:truncate(Log);
+ {From, terminate} ->
+ From ! terminated,
+ exit(normal);
+ {From, {log, B}} ->
+ From ! disk_log:log(Log, B);
+ {From, {blog, B}} ->
+ From ! disk_log:blog(Log, B);
+ {From, {alog, B}} ->
+ From ! disk_log:alog(Log, B);
+ {From, {balog, B}} ->
+ From ! disk_log:balog(Log, B);
+ {From, {change_notify, Pid, Bool}} ->
+ From ! disk_log:change_notify(Log, Pid, Bool);
+ {From, {change_header, Header}} ->
+ From ! disk_log:change_header(Log, Header);
+ {From, {change_size, Size}} ->
+ From ! disk_log:change_size(Log, Size);
+ {From, inc_wrap_file} ->
+ From ! disk_log:inc_wrap_file(Log);
+ {From, {chunk, Cont}} ->
+ From ! disk_log:chunk(Log, Cont);
+ {From, {chunk_step, Cont, N}} ->
+ From ! disk_log:chunk_step(Log, Cont, N);
+ Any ->
+ io:format("invalid request ~p~n", [Any]),
+ exit(abnormal)
+ end,
+ lserv(Log).
+
+error(suite) -> [error_repair, error_log, error_index].
+
+error_repair(suite) -> [];
+error_repair(doc) ->
+ ["Error while repairing."];
+error_repair(Conf) when is_list(Conf) ->
+ % not all error situations are covered by this test
+
+ DataDir = ?datadir(Conf),
+ PrivDir = ?privdir(Conf),
+
+ ?line File = filename:join(PrivDir, "n.LOG"),
+ ?line No = 4,
+ ?line file:delete(File),
+ ?line del(File, No), % cleanup
+
+ % kurt.LOG is not closed and has four logged items, one is recovered
+ ?line copy_wrap_log("kurt.LOG", "n.LOG", No, DataDir, PrivDir),
+ ?line {repaired,n,{recovered,1},{badbytes,0}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap}, {size,{40,No}}]),
+ ?line 1 = cur_cnt(n),
+ ?line 53 = curb(n),
+ ?line 4 = no_items(n),
+ ?line ok = disk_log:close(n),
+
+ % temporary repair file cannot be created
+ ?line copy_wrap_log("kurt.LOG", "n.LOG", No, DataDir, PrivDir),
+ ?line Dir = File ++ ".4" ++ ".TMP",
+ ?line ok = file:make_dir(Dir),
+ ?line P0 = pps(),
+ ?line {error, {file_error, _, _}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap}, {size,{40,4}}]),
+ ?line true = (P0 == pps()),
+ ?line del(File, No),
+ ?line ok = file:del_dir(Dir),
+
+ %% repair a file
+ ?line P1 = pps(),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {40,No}}]),
+ ?line ok = disk_log:log_terms(n, [{this,is}]), % first file full
+ ?line ok = disk_log:log_terms(n, [{some,terms}]), % second file full
+ ?line ok = disk_log:close(n),
+ ?line BadFile = add_ext(File, 2), % current file
+ ?line set_opened(BadFile),
+ ?line crash(BadFile, 28), % the binary is now invalid
+ ?line {repaired,n,{recovered,0},{badbytes,26}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {40,No}}]),
+ ?line ok = disk_log:close(n),
+ ?line true = (P1 == pps()),
+ ?line del(File, No),
+
+ %% yet another repair
+ ?line P2 = pps(),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {4000,No}}]),
+ ?line ok = disk_log:log_terms(n, [{this,is},{some,terms}]),
+ ?line ok = disk_log:close(n),
+ ?line BadFile2 = add_ext(File, 1), % current file
+ ?line set_opened(BadFile2),
+ ?line crash(BadFile2, 51), % the second binary is now invalid
+ ?line {repaired,n,{recovered,1},{badbytes,26}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {4000,No}}]),
+ ?line ok = disk_log:close(n),
+ ?line true = (P2 == pps()),
+ ?line del(File, No),
+
+ %% Repair, large term
+ ?line Big = term_to_binary(lists:duplicate(66000,$a)),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {40,No}}]),
+ ?line ok = disk_log:log_terms(n, [Big]),
+ ?line ok = disk_log:close(n),
+ ?line set_opened(add_ext(File, 1)),
+ ?line {repaired,n,{recovered,1},{badbytes,0}} =
+ disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {40,No}}]),
+ ?line {_, [Got]} = disk_log:chunk(n, start),
+ ?line ok = disk_log:close(n),
+ ?line Got = Big,
+ ?line del(File, No),
+
+ %% A term a little smaller than a chunk, then big terms.
+ ?line BigSmall = mk_bytes(1024*64-8-12),
+ ?line file:delete(File),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line ok = disk_log:log_terms(n, [BigSmall, Big, Big]),
+ ?line ok = disk_log:close(n),
+ ?line set_opened(File),
+ ?line FileSize = file_size(File),
+ ?line crash(File, FileSize-byte_size(Big)-4),
+ ?line Error1 = {error, {need_repair, _}} =
+ disk_log:open([{name, n}, {file, File}, {repair, false},
+ {type, halt}, {format, internal}]),
+ ?line "The disk log" ++ _ = format_error(Error1),
+ ?line {repaired,n,{recovered,2},{badbytes,132013}} =
+ disk_log:open([{name, n}, {file, File}, {repair, true},
+ {type, halt}, {format, internal}]),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File),
+
+ %% The header is recovered.
+ ?line {ok,n} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal},
+ {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]),
+ ?line ok = disk_log:log_terms(n, [list,'of',terms]),
+ ?line ["head",list,'of',terms] = get_all_terms(n),
+ ?line ok = disk_log:close(n),
+ ?line set_opened(File),
+ ?line crash(File, 30),
+ ?line {repaired,n,{recovered,3},{badbytes,16}} =
+ disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal},{repair,true},
+ {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]),
+ ?line ["head",'of',terms] = get_all_terms(n),
+ ?line ok = disk_log:close(n),
+
+ file:delete(File),
+
+ ok.
+
+set_opened(File) ->
+ {ok, Fd} = file:open(File, [raw, binary, read, write]),
+ ok = file:write(Fd, [?LOGMAGIC, ?OPENED]),
+ ok = file:close(Fd).
+
+error_log(suite) -> [];
+error_log(doc) ->
+ ["Error while repairing."];
+error_log(Conf) when is_list(Conf) ->
+ ?line Dir = ?privdir(Conf),
+
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line file:delete(File),
+ ?line del(File, No), % cleanup
+ ?line LDir = File ++ ".2",
+
+ ?line Q = qlen(),
+ % dummy just to get all processes "above" disk_log going
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external},{size, {100, No}}]),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ % inc_wrap_file fails, the external log is not terminated
+ ?line P0 = pps(),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external},{size, {100, No}}]),
+ ?line ok = file:make_dir(LDir),
+ ?line {error, {file_error, _, _}} = disk_log:inc_wrap_file(n),
+ ?line timer:sleep(500),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ % inc_wrap_file fails, the internal log is not terminated, ./File.2/ exists
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal},{size, {100, No}}]),
+ ?line {error, {file_error, _, _}} = disk_log:inc_wrap_file(n),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ % truncate fails, the log is terminated, ./File.2/ exists
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external},{size, {100, No}}]),
+ ?line {error, {file_error, _, _}} = disk_log:truncate(n),
+ ?line true = (P0 == pps()),
+ ?line del(File, No),
+
+ %% OTP-4880.
+ % reopen (rename) fails, the log is terminated, ./File.2/ exists
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, external},{size, 100000}]),
+ ?line {error, eisdir} = disk_log:reopen(n, LDir),
+ ?line true = (P0 == pps()),
+ ?line file:delete(File),
+
+ ?line B = mk_bytes(60),
+
+ %% OTP-4880. reopen a wrap log, rename fails
+ ?line File2 = filename:join(Dir, "n.LOG2"),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File2}, {type, wrap},
+ {format, external},{size, {100, No}}]),
+ ?line ok = disk_log:blog_terms(n, [B,B,B]),
+ ?line {error, eisdir} = disk_log:reopen(n, File),
+ ?line {error, no_such_log} = disk_log:close(n),
+ ?line del(File2, No),
+ ?line del(File, No),
+
+ % log, external wrap log, ./File.2/ exists
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external},{size, {100, No}}]),
+ ?line {error, {file_error, _, _}} = disk_log:blog_terms(n, [B,B,B]),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ % log, internal wrap log, ./File.2/ exists
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal},{size, {100, No}}]),
+ ?line {error, {file_error, _, _}} = disk_log:log_terms(n, [B,B,B]),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ ?line ok = file:del_dir(LDir),
+
+ % can't remove file when changing size
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal},{size, {100, No}}]),
+ ?line ok = disk_log:log_terms(n, [B,B,B,B]),
+ ?line ok = disk_log:change_size(n, {100, No-2}),
+ ?line Three = File ++ ".3",
+ ?line ok = file:delete(Three),
+ ?line ok = file:make_dir(Three),
+ ?line {error, {file_error, _, _}} = disk_log:log_terms(n, [B,B,B]),
+ ?line timer:sleep(500),
+ ?line ok = disk_log:close(n),
+ ?line ok = file:del_dir(Three),
+ ?line del(File, No),
+ ?line Q = qlen(),
+ ok.
+
+chunk(suite) -> [];
+chunk(doc) ->
+ ["Test chunk and chunk_step."];
+chunk(Conf) when is_list(Conf) ->
+ %% See also halt_ro_crash/1 above.
+
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ No = 4,
+ ?line B = mk_bytes(60),
+ ?line BB = mk_bytes(64000), % 64 kB chunks
+ ?line del(File, No),% cleanup
+
+ %% Make sure chunk_step skips the rest of the binary.
+ %% OTP-3716. This was a bug...
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {50,No}}]),
+ %% 1, 2 and 3 on file one, 4 on file two.
+ ?line ok = disk_log:log_terms(n, [1,2,3,4]),
+ ?line {I1, [1]} = disk_log:chunk(n, start, 1),
+ ?line [{node,Node}] = disk_log:chunk_info(I1),
+ ?line Node = node(),
+ ?line Error1 = {error, {no_continuation, foobar}} =
+ disk_log:chunk_info(foobar),
+ ?line "The term" ++ _ = format_error(Error1),
+ ?line {ok, I2} = disk_log:chunk_step(n, I1, 1),
+ ?line {error, {badarg, continuation}} = disk_log:chunk_step(n, foobar, 1),
+ ?line {I3, [4]} = disk_log:chunk(n, I2, 1),
+ ?line {ok, I4} = disk_log:chunk_step(n, I3, -1),
+ ?line {_, [1]} = disk_log:chunk(n, I4, 1),
+ ?line {error, {badarg, continuation}} = disk_log:bchunk(n, 'begin'),
+ ?line {Ib1, [Bin1,Bin2]} = disk_log:bchunk(n, start, 2),
+ ?line 1 = binary_to_term(Bin1),
+ ?line 2 = binary_to_term(Bin2),
+ ?line {ok, Ib2} = disk_log:chunk_step(n, Ib1, 1),
+ ?line {Ib3, [Bin3]} = disk_log:bchunk(n, Ib2, 1),
+ ?line 4 = binary_to_term(Bin3),
+ ?line {ok, Ib4} = disk_log:chunk_step(n, Ib3, -1),
+ ?line {_, [Bin4]} = disk_log:bchunk(n, Ib4, 1),
+ ?line 1 = binary_to_term(Bin4),
+ ?line {Ib5, [Bin1, Bin2, Bin17]} = disk_log:bchunk(n, start),
+ ?line 3 = binary_to_term(Bin17),
+ ?line {Ib6, [Bin3]} = disk_log:bchunk(n, Ib5, infinity),
+ ?line eof = disk_log:bchunk(n, Ib6, infinity),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No), % cleanup
+
+ %% external log, cannot read chunks
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {size, {100,No}}]),
+ ?line {error, {badarg, continuation}} = disk_log:chunk(n, 'begin'),
+ ?line {error, {format_external, n}} = disk_log:chunk(n, start),
+ ?line Error2 = {error, {not_internal_wrap, n}} =
+ disk_log:chunk_step(n, start, 1),
+ ?line "The requested" ++ _ = format_error(Error2),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ %% wrap, read_write
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {100,No}}]),
+ ?line ok = disk_log:log_terms(n, [B,B,B,B]),
+ ?line {C1, [_]} = disk_log:chunk(n, start),
+ ?line {C2, [_]} = disk_log:chunk(n, C1),
+ ?line {C3, [_]} = disk_log:chunk(n, C2),
+ ?line {C4, [_]} = disk_log:chunk(n, C3, 1),
+ ?line eof = disk_log:chunk(n, C4),
+ ?line {C5, [_]} = disk_log:chunk(n, start),
+ ?line {ok, C6} = disk_log:chunk_step(n, C5, 1),
+ ?line {C7, [_]} = disk_log:chunk(n, C6),
+ ?line {ok, C8} = disk_log:chunk_step(n, C7, 1),
+ ?line {_, [_]} = disk_log:chunk(n, C8),
+ ?line ok = disk_log:close(n),
+
+ %% wrap, read_only
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {mode, read_only},
+ {format, internal}, {size, {100,No}}]),
+ ?line {CC1, [_]} = disk_log:chunk(n, start),
+ ?line {CC2, [_]} = disk_log:chunk(n, CC1),
+ ?line {CC3, [_]} = disk_log:chunk(n, CC2),
+ ?line {CC4, [_]} = disk_log:chunk(n, CC3, 1),
+ ?line eof = disk_log:chunk(n, CC4),
+ ?line {CC5, [_]} = disk_log:chunk(n, start),
+ ?line {ok, CC6} = disk_log:chunk_step(n, CC5, 1),
+ ?line {CC7, [_]} = disk_log:chunk(n, CC6),
+ ?line {ok, CC8} = disk_log:chunk_step(n, CC7, 1),
+ ?line {_, [_]} = disk_log:chunk(n, CC8),
+ ?line ok = disk_log:close(n),
+
+ %% OTP-3716. A bug: {Error, List} and {Error, List, Bad} could be
+ %% returned from chunk/2.
+ %% Magic bytes not OK.
+ %% File header (8 bytes) OK, item header not OK.
+ ?line InvalidFile = add_ext(File, 1),
+ ?line crash(InvalidFile, 15),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {mode, read_only},
+ {format, internal}, {size, {100,No}}]),
+ ?line {_, [], 61} = disk_log:chunk(n, start),
+ ?line ok = disk_log:close(n),
+ %% read_write...
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {100,No}}]),
+ ?line Error3 = {error, {corrupt_log_file, Culprit}} =
+ disk_log:chunk(n, start),
+ ?line "The disk log file" ++ _ = format_error(Error3),
+ ?line Culprit = InvalidFile,
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ %% Two wrap log files, writing the second one, then reading the first
+ %% one, where a bogus term resides.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {40,No}}]),
+ ?line ok = disk_log:log_terms(n, [{this,is}]), % first file full
+ ?line ok = disk_log:log_terms(n, [{some,terms}]), % second file full
+ ?line 2 = curf(n),
+ ?line BadFile = add_ext(File, 1),
+ ?line crash(BadFile, 28), % the _binary_ is now invalid
+ ?line {error, {corrupt_log_file, BFile}} = disk_log:chunk(n, start, 1),
+ ?line BadFile = BFile,
+ ?line ok = disk_log:close(n),
+ %% The same, with a halt log.
+ ?line file:delete(File), % cleanup
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line ok = disk_log:log_terms(n, [{this,is}]),
+ ?line ok = disk_log:sync(n),
+ ?line crash(File, 28), % the _binary_ is now invalid
+ ?line {error, {corrupt_log_file, File2}} = disk_log:chunk(n, start, 1),
+ ?line crash(File, 10),
+ ?line {error,{corrupt_log_file,_}} = disk_log:bchunk(n, start, 1),
+ ?line true = File == File2,
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ %% halt, read_write
+ ?line file:delete(File), % cleanup
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line ok = disk_log:log_terms(n, [BB,BB,BB,BB]),
+ ?line {D1, [Ch1]} = disk_log:chunk(n, start, 1),
+ ?line Ch1 = BB,
+ ?line {D2, [Ch2]} = disk_log:chunk(n, D1, 1),
+ ?line Ch2 = BB,
+ ?line {D3, [Ch3]} = disk_log:chunk(n, D2, 1),
+ ?line Ch3 = BB,
+ ?line {D4, [Ch4]} = disk_log:chunk(n, D3, 1),
+ ?line Ch4 = BB,
+ ?line eof = disk_log:chunk(n, D4),
+ ?line ok = disk_log:close(n),
+
+ %% halt, read_only
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal},{mode,read_only}]),
+ ?line {E1, [Ch5]} = disk_log:chunk(n, start, 1),
+ ?line Ch5 = BB,
+ ?line {E2, [Ch6]} = disk_log:chunk(n, E1, 1),
+ ?line Ch6 = BB,
+ ?line {E3, [Ch7]} = disk_log:chunk(n, E2, 1),
+ ?line Ch7 = BB,
+ ?line {E4, [Ch8]} = disk_log:chunk(n, E3, 1),
+ ?line Ch8 = BB,
+ ?line eof = disk_log:chunk(n, E4),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File), % cleanup
+
+ %% More than 64 kB term.
+ ?line BBB = term_to_binary(lists:duplicate(66000,$a)),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line ok = disk_log:log_terms(n, [BBB]),
+ ?line {F1, [BBB1]} = disk_log:chunk(n, start),
+ ?line BBB1 = BBB,
+ ?line eof = disk_log:chunk(n, F1),
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}, {mode, read_only}]),
+ ?line {F1r, [BBB2]} = disk_log:chunk(n, start),
+ ?line BBB2 = BBB,
+ ?line eof = disk_log:chunk(n, F1r),
+ ?line ok = disk_log:close(n),
+
+ ?line truncate(File, 8192),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line {error, {corrupt_log_file, _}} = disk_log:chunk(n, start),
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}, {mode, read_only}]),
+ ?line {K1, [], 8176} = disk_log:chunk(n, start),
+ ?line eof = disk_log:chunk(n, K1),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File), % cleanup
+
+ %% OTP-3716. A bug: eof in the middle of the last element is not ok.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line ok = disk_log:log_terms(n, [B,BB]),
+ ?line ok = disk_log:close(n),
+ ?line truncate(File, 80),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line {G1, [_]} = disk_log:chunk(n, start, 1),
+ ?line {error, {corrupt_log_file, _}} = disk_log:chunk(n, G1, 1),
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}, {mode, read_only}]),
+ ?line {G1r, [_]} = disk_log:chunk(n, start, 1),
+ ?line {_, [], 4} = disk_log:chunk(n, G1r, 1),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File), % cleanup
+
+ %% Opening a wrap log read-only. The second of four terms is destroyed.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {size, {4000,No}}]),
+ ?line ok = disk_log:log_terms(n,
+ [{this,is},{some,terms},{on,a},{wrap,file}]),
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, internal}, {mode, read_only}]),
+ ?line CrashFile = add_ext(File, 1),
+ ?line crash(CrashFile, 51), % the binary term {some,terms} is now bad
+ ?line {H1, [{this,is}], 18} = disk_log:chunk(n, start, 10),
+ ?line {H2, [{on,a},{wrap,file}]} = disk_log:chunk(n, H1),
+ ?line eof = disk_log:chunk(n, H2),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ %% The same as last, but with a halt log.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}, {mode, read_write}]),
+ ?line ok = disk_log:alog_terms(n, [{this,is},{some,terms}]),
+ ?line ok = disk_log:log_terms(n, [{on,a},{halt,file}]),
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}, {mode, read_only}]),
+ ?line crash(File, 51), % the binary term {some,terms} is now bad
+ ?line {J1, [{this,is}], 18} = disk_log:chunk(n, start, 10),
+ ?line {J2, [{on,a},{halt,file}]} = disk_log:chunk(n, J1),
+ ?line eof = disk_log:chunk(n, J2),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File),
+
+ %% OTP-7641. Same as last one, but the size of the bad term is
+ %% less than ?HEADERSz (8) bytes.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}, {mode, read_write}]),
+ ?line ok = disk_log:alog_terms(n, [{this,is},{s}]),
+ ?line ok = disk_log:log_terms(n, [{on,a},{halt,file}]),
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}, {mode, read_only}]),
+ ?line crash(File, 44), % the binary term {s} is now bad
+ ?line {J11, [{this,is}], 7} = disk_log:chunk(n, start, 10),
+ ?line {J21, [{on,a},{halt,file}]} = disk_log:chunk(n, J11),
+ ?line eof = disk_log:chunk(n, J21),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File),
+
+ %% Minimal MD5-proctected term, and maximal unprotected term.
+ %% A chunk ends in the middle of the MD5-sum.
+ ?line MD5term = mk_bytes(64*1024-8),
+ ?line NotMD5term = mk_bytes((64*1024-8)-1),
+ ?line Term2 = mk_bytes((64*1024-8)-16),
+ ?line MD5L = [MD5term,NotMD5term,Term2,MD5term,MD5term,NotMD5term],
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line ok = disk_log:log_terms(n, MD5L),
+ ?line true = MD5L == get_all_terms(n),
+ ?line ok = disk_log:close(n),
+ ?line true = MD5L == get_all_terms(n, File, halt),
+ ?line crash(File, 21), % the MD5-sum of the first term is now bad
+ ?line true = {tl(MD5L),64*1024-8} == get_all_terms_and_bad(n, File, halt),
+ ?line {_,64*1024-8} = get_all_binary_terms_and_bad(n, File, halt),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {format, internal}]),
+ ?line {error, {corrupt_log_file, _}} = disk_log:chunk(n, start),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File),
+
+ %% A file with "old" terms (magic word is MAGICINT).
+ DataDir = ?datadir(Conf),
+ OldTermsFileOrig = filename:join(DataDir, "old_terms.LOG"),
+ OldTermsFile = filename:join(Dir, "old_terms.LOG"),
+ ?line copy_file(OldTermsFileOrig, OldTermsFile),
+ ?line {[_,_,_,_],0} = get_all_terms_and_bad(n, OldTermsFile, halt),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, OldTermsFile},
+ {type, halt}, {format, internal}]),
+ ?line [_,_,_,_] = get_all_terms(n),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(OldTermsFile),
+
+ ok.
+
+error_index(suite) -> [];
+error_index(doc) ->
+ ["OTP-5558. Keep the contents of index files after disk crash."];
+error_index(Conf) when is_list(Conf) ->
+ ?line Dir = ?privdir(Conf),
+
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line IdxFile = File ++ ".idx",
+ ?line No = 4,
+ ?line file:delete(File),
+ ?line del(File, No), % cleanup
+
+ Args = [{name,n},{type,wrap},{size,{100,No}},{file,File}],
+ ?line {ok, n} = disk_log:open(Args),
+ ?line ok = disk_log:close(n),
+ ?line Q = qlen(),
+ P0 = pps(),
+ ?line ok = file:write_file(IdxFile, <<"abc">>),
+ ?line {error, {invalid_index_file, _}} = disk_log:open(Args),
+ ?line {error, {invalid_index_file, _}} = disk_log:open(Args),
+ ?line {error, {invalid_index_file, _}} = disk_log:open(Args),
+
+ ?line del(File, No),
+ ?line true = (P0 == pps()),
+ ?line true = (Q == qlen()),
+ ok.
+
+truncate(suite) -> [];
+truncate(doc) ->
+ ["Test truncate/1 on halt and wrap logs."];
+truncate(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+
+ ?line Q = qlen(),
+ Halt = join(Dir, "halt.LOG"),
+ % Halt logs.
+
+ ?line file:delete(Halt), % cleanup
+ ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt}, {file, Halt},
+ {head, header}, {notify, true}]),
+ ?line infinity = sz(halt),
+ ?line ok = disk_log:truncate(halt, tjohej),
+ ?line rec(1, {disk_log, node(), halt, {truncated, 1}}),
+ ?line ok = disk_log:change_size(halt, 10000),
+ ?line 10000 = sz(halt),
+ ?line disk_log:close(halt),
+ ?line [tjohej] = get_all_terms(halt, Halt, halt),
+ ?line file:delete(Halt),
+
+ ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt}, {file, Halt},
+ {head, header}, {notify, true}]),
+ ?line ok = disk_log:truncate(halt),
+ ?line rec(1, {disk_log, node(), halt, {truncated, 1}}),
+ ?line disk_log:close(halt),
+ ?line [header] = get_all_terms(halt, Halt, halt),
+ ?line file:delete(Halt),
+
+ ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt},
+ {file, Halt}, {format, external},
+ {head, "header"}, {notify, false}]),
+ ?line ok = disk_log:btruncate(halt, "apa"),
+ ?line disk_log:close(halt),
+ ?line 3 = file_size(Halt),
+ ?line file:delete(Halt),
+
+ %% Wrap logs.
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line B = mk_bytes(60),
+ ?line del(File, No), % cleanup
+
+ %% Internal with header.
+ ?line Size = {100, No},
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {head, header}, {notify, true},
+ {size, Size}]),
+ ?line ok = disk_log:log_terms(n, [B,B,B]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(2, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:truncate(n, apa),
+ ?line rec(1, {disk_log, node(), n, {truncated, 6}}),
+ ?line {0, 0} = no_overflows(n),
+ ?line 23 = curb(n),
+ ?line 1 = curf(n),
+ ?line 1 = cur_cnt(n),
+ ?line true = (Size == sz(n)),
+
+ ?line ok = disk_log:log_terms(n, [B, B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:close(n),
+ ?line [apa, _, header, _] = get_all_terms(n, File, wrap),
+ ?line del(File, No),
+
+ %% Internal without general header.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {notify, true},
+ {size, {100, No}}]),
+ ?line ok = disk_log:log_terms(n, [B,B,B]),
+ ?line rec(2, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:truncate(n, apa),
+ ?line rec(1, {disk_log, node(), n, {truncated, 3}}),
+ ?line {0, 0} = no_overflows(n),
+ ?line 23 = curb(n),
+ ?line 1 = curf(n),
+ ?line 1 = cur_cnt(n),
+ ?line true = (Size == sz(n)),
+
+ ?line ok = disk_log:log_terms(n, [B, B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:close(n),
+ ?line [apa, _, _] = get_all_terms(n, File, wrap),
+ ?line del(File, No),
+
+ %% Internal without any header.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {notify, true},
+ {size, {100, No}}]),
+ ?line ok = disk_log:log_terms(n, [B,B,B]),
+ ?line rec(2, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:truncate(n),
+ ?line rec(1, {disk_log, node(), n, {truncated, 3}}),
+ ?line {0, 0} = no_overflows(n),
+ ?line 8 = curb(n),
+ ?line 1 = curf(n),
+ ?line 0 = cur_cnt(n),
+ ?line true = (Size == sz(n)),
+
+ ?line ok = disk_log:log_terms(n, [B, B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:close(n),
+ ?line [_, _] = get_all_terms(n, File, wrap),
+ ?line del(File, No),
+ ?line Q = qlen(),
+ ok.
+
+
+many_users(suite) -> [];
+many_users(doc) ->
+ ["Test many users logging and sync:ing at the same time."];
+many_users(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ N = 100,
+ NoClients = 10,
+ Fun1 = fun(Name, Pid, I) -> disk_log:log(Name, {Pid, I}) end,
+ Fun2 = fun(Name, Pid, I) -> ok = disk_log:log(Name, {Pid, I}),
+ disk_log:sync(Name) end,
+ ?line {C1, T1} = many(Fun2, NoClients, N, halt, internal, infinity, Dir),
+ ?line true = lists:duplicate(NoClients, ok) == C1,
+ ?line true = length(T1) == N*NoClients,
+ ?line {C2, T2} = many(Fun1, NoClients, N, halt, internal, 1000, Dir),
+ ?line true = lists:duplicate(NoClients, {error, {full,'log.LOG'}}) == C2,
+ ?line true = length(T2) > 0,
+ ?line {C3, T3} = many(Fun2, NoClients, N, wrap, internal,
+ {300*NoClients,20}, Dir),
+ ?line true = lists:duplicate(NoClients, ok) == C3,
+ ?line true = length(T3) == N*NoClients,
+ ok.
+
+many(Fun, NoClients, N, Type, Format, Size, Dir) ->
+ Name = 'log.LOG',
+ File = filename:join(Dir, Name),
+ del_files(Size, File),
+ ?line Q = qlen(),
+ ?line {ok, _} = disk_log:open([{name,Name}, {type,Type}, {size,Size},
+ {format,Format}, {file,File}]),
+ ?line Pids = spawn_clients(NoClients, client, [self(), Name, N, Fun]),
+ ?line Checked = check_clients(Pids),
+ ?line ok = disk_log:close(Name),
+ ?line Terms = get_all_terms(Name, File, Type),
+ ?line del_files(Size, File),
+ ?line Q = qlen(),
+ ?line {Checked, Terms}.
+
+spawn_clients(0, _F, _A) ->
+ [];
+spawn_clients(I, F, A) ->
+ [spawn_link(?MODULE, F, A) | spawn_clients(I-1, F, A)].
+
+check_clients(Pids) ->
+ lists:map(fun(Pid) -> receive {Pid, Reply} -> Reply end end, Pids).
+
+client(From, _Name, 0, _Fun) ->
+ From ! {self(), ok};
+client(From, Name, N, Fun) ->
+ %% Fun is called N times.
+ case Fun(Name, self(), N) of
+ ok -> client(From, Name, N-1, Fun);
+ Else -> From ! {self(), Else}
+ end.
+
+del_files({_NoBytes,NoFiles}, File) ->
+ del(File, NoFiles);
+del_files(_Size, File) ->
+ file:delete(File).
+
+
+
+info(suite) -> [info_current].
+
+info_current(suite) -> [];
+info_current(doc) ->
+ ["Test no_current_{bytes, items} as returned by info/0."];
+info_current(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ No = 4,
+ B = mk_bytes(60),
+ BB = mk_bytes(160), % bigger than a single wrap log file
+ SB = mk_bytes(10), % much smaller than a single wrap log file
+ ?line del(File, No),% cleanup
+
+ ?line Q = qlen(),
+ %% Internal with header.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {head, header}, {size, {100,No}}]),
+ ?line {26, 1} = {curb(n), cur_cnt(n)},
+ ?line {1, 1} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log(n, B),
+ ?line {94, 2} = {curb(n), cur_cnt(n)},
+ ?line {2, 2} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {notify, true},
+ {head, header}, {size, {100,No}}]),
+ ?line {94, 2} = {curb(n), cur_cnt(n)},
+ ?line {0, 2} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log(n, B),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line {94, 2} = {curb(n), cur_cnt(n)},
+ ?line {2, 4} = {no_written_items(n), no_items(n)},
+ ?line disk_log:inc_wrap_file(n),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line {26, 1} = {curb(n), cur_cnt(n)},
+ ?line {3, 4} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log_terms(n, [B,B,B]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line {94, 2} = {curb(n), cur_cnt(n)},
+ ?line {8, 7} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line ok = disk_log:log_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line {94, 2} = {curb(n), cur_cnt(n)},
+ ?line {12, 7} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log_terms(n, [BB,BB]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(2, {disk_log, node(), n, {wrap, 2}}),
+ ?line {194, 2} = {curb(n), cur_cnt(n)},
+ ?line {16, 7} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log_terms(n, [SB,SB,SB]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line {80, 4} = {curb(n), cur_cnt(n)},
+ ?line {20, 9} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ %% Internal without header.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}]),
+ ?line {8, 0} = {curb(n), cur_cnt(n)},
+ ?line {0, 0} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log(n, B),
+ ?line {76, 1} = {curb(n), cur_cnt(n)},
+ ?line {1, 1} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {notify, true}, {size, {100,No}}]),
+ ?line {76, 1} = {curb(n), cur_cnt(n)},
+ ?line {0, 1} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log(n, B),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line {76, 1} = {curb(n), cur_cnt(n)},
+ ?line {1, 2} = {no_written_items(n), no_items(n)},
+ ?line disk_log:inc_wrap_file(n),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line {8, 0} = {curb(n), cur_cnt(n)},
+ ?line {1, 2} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log_terms(n, [B,B,B]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line {76, 1} = {curb(n), cur_cnt(n)},
+ ?line {4, 4} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line ok = disk_log:log_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line {76, 1} = {curb(n), cur_cnt(n)},
+ ?line {6, 4} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log_terms(n, [BB,BB]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(2, {disk_log, node(), n, {wrap, 1}}),
+ ?line {176, 1} = {curb(n), cur_cnt(n)},
+ ?line {8, 4} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:log_terms(n, [SB,SB,SB]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line {62, 3} = {curb(n), cur_cnt(n)},
+ ?line {11, 6} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ %% External with header.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {head, "header"},
+ {size, {100,No}}]),
+ ?line {6, 1} = {curb(n), cur_cnt(n)},
+ ?line {1, 1} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog(n, B),
+ ?line {62, 2} = {curb(n), cur_cnt(n)},
+ ?line {2, 2} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {head, "header"},
+ {notify, true}, {size, {100,No}}]),
+ ?line {62, 2} = {curb(n), cur_cnt(n)},
+ ?line {0, 2} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog(n, B),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line {62, 2} = {curb(n), cur_cnt(n)},
+ ?line {2, 4} = {no_written_items(n), no_items(n)},
+ ?line disk_log:inc_wrap_file(n),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line {6, 1} = {curb(n), cur_cnt(n)},
+ ?line {3, 4} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog_terms(n, [B,B,B]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line {62, 2} = {curb(n), cur_cnt(n)},
+ ?line {8, 7} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line ok = disk_log:blog_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line {62, 2} = {curb(n), cur_cnt(n)},
+ ?line {12, 7} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog_terms(n, [BB,BB]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(2, {disk_log, node(), n, {wrap, 2}}),
+ ?line {162, 2} = {curb(n), cur_cnt(n)},
+ ?line {16, 7} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog_terms(n, [SB,SB,SB]),
+
+ ?line rec(1, {disk_log, node(), n, {wrap, 2}}),
+ ?line {24, 4} = {curb(n), cur_cnt(n)},
+ ?line {20, 9} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ %% External without header.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {format, external}, {size, {100,No}}]),
+ ?line {0, 0} = {curb(n), cur_cnt(n)},
+ ?line {0, 0} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog(n, B),
+ ?line {56, 1} = {curb(n), cur_cnt(n)},
+ ?line {1, 1} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:close(n),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {notify, true},
+ {format, external}, {size, {100,No}}]),
+ ?line {56, 1} = {curb(n), cur_cnt(n)},
+ ?line {0, 1} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog(n, B),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line {56, 1} = {curb(n), cur_cnt(n)},
+ ?line {1, 2} = {no_written_items(n), no_items(n)},
+ ?line disk_log:inc_wrap_file(n),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line {0, 0} = {curb(n), cur_cnt(n)},
+ ?line {1, 2} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog_terms(n, [B,B,B]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line {56, 1} = {curb(n), cur_cnt(n)},
+ ?line {4, 4} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line ok = disk_log:blog_terms(n, [B]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line {56, 1} = {curb(n), cur_cnt(n)},
+ ?line {6, 4} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog_terms(n, [BB,BB]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(2, {disk_log, node(), n, {wrap, 1}}),
+ ?line {156, 1} = {curb(n), cur_cnt(n)},
+ ?line {8, 4} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:blog_terms(n, [SB,SB,SB]),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line {18, 3} = {curb(n), cur_cnt(n)},
+ ?line {11, 6} = {no_written_items(n), no_items(n)},
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ ?line Q = qlen(),
+ ok.
+
+
+change_size(suite) -> [change_size_before,
+ change_size_during,
+ change_size_after,
+ default_size, change_size2,
+ change_size_truncate].
+
+change_size_before(suite) -> [];
+change_size_before(doc) ->
+ ["Change size of a wrap log file before we have reached "
+ "to the file index corresponding to the new size"];
+change_size_before(Conf) when is_list(Conf) ->
+
+ Log_1_1 = "first log first message",
+ Log_1_2 = "first log second message",
+ Log_2_1 = "second log first message",
+ Log_2_2 = "second log second message",
+ Log_3_1 = "third log first message",
+ Log_3_2 = "third log second message",
+ Log_4_1 = "fourth log first message",
+ Log_4_2 = "fourth log second message",
+ Log_5_1 = "fifth log first message",
+ Log_5_2 = "fifth log second message",
+ Log_1_2_1 = "first log second round 1",
+ Log_1_2_2 = "first log second round 2",
+
+
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ del(File, 5),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File},
+ {type, wrap}, {size, {100,5}}]),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:change_size(a, {100, 3}),
+ ?line [Log_1_1, Log_1_2,
+ Log_2_1, Log_2_2] = get_all_terms(a),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_1_2_1),
+ ?line disk_log:log(a, Log_1_2_2),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_1_2_1, Log_1_2_2] = get_all_terms(a),
+
+ ?line disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,3}}]),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_1_2_1, Log_1_2_2] = get_all_terms(a),
+ disk_log:close(a),
+ del(File, 5),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {60,5}}, {format, external}]),
+ ?line disk_log:blog(a, Log_1_1),
+ ?line disk_log:blog(a, Log_1_2),
+ ?line disk_log:blog(a, Log_2_1),
+ ?line disk_log:blog(a, Log_2_2),
+ ?line disk_log:change_size(a, {60, 3}),
+ ?line ok = disk_log:sync(a),
+ ?line {ok, Fd1} = file:open(File ++ ".1", [read]),
+ ?line Log11_12 = Log_1_1 ++ Log_1_2,
+ ?line {ok,Log11_12} = file:read(Fd1, 200),
+ ?line ok = file:close(Fd1),
+ ?line {ok, Fd2} = file:open(File ++ ".2", [read]),
+% ?t:format(0, "~p~n",[file:read(Fd2, 200)]),
+ ?line Log21_22 = Log_2_1 ++ Log_2_2,
+ ?line {ok,Log21_22} = file:read(Fd2, 200),
+ ?line ok = file:close(Fd2),
+ ?line disk_log:blog(a, Log_3_1),
+ ?line disk_log:blog(a, Log_3_2),
+ ?line disk_log:blog(a, Log_1_2_1),
+ ?line disk_log:blog(a, Log_1_2_2),
+ ?line ok = disk_log:sync(a),
+ ?line {ok, Fd2a} = file:open(File ++ ".2", [read]),
+ ?line {ok,Log21_22} = file:read(Fd2a, 200),
+ ?line ok = file:close(Fd2a),
+ ?line {ok, Fd3a} = file:open(File ++ ".3", [read]),
+ ?line Log31_32 = Log_3_1 ++ Log_3_2,
+ ?line {ok,Log31_32} = file:read(Fd3a, 200),
+ ?line ok = file:close(Fd3a),
+ ?line {ok, Fd1a} = file:open(File ++ ".1", [read]),
+ ?line Log121_122 = Log_1_2_1 ++ Log_1_2_2,
+ ?line {ok,Log121_122} = file:read(Fd1a, 200),
+ ?line ok = file:close(Fd1a),
+
+ ?line disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {60,3}}, {format, external}]),
+ ?line {ok, Fd2b} = file:open(File ++ ".2", [read]),
+ ?line {ok,Log21_22} = file:read(Fd2b, 200),
+ ?line ok = file:close(Fd2b),
+ ?line {ok, Fd3b} = file:open(File ++ ".3", [read]),
+ ?line {ok,Log31_32} = file:read(Fd3b, 200),
+ ?line ok = file:close(Fd3b),
+ ?line {ok, Fd1b} = file:open(File ++ ".1", [read]),
+ ?line {ok,Log121_122} = file:read(Fd1b, 200),
+ ?line ok = file:close(Fd1b),
+ disk_log:close(a),
+ del(File, 5),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,5}}]),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:change_size(a, {60, 3}),
+ ?line [Log_1_1, Log_1_2,
+ Log_2_1, Log_2_2] = get_all_terms(a),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_1_2_1),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1,
+ Log_1_2_1] = get_all_terms(a),
+
+ ?line disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {60,3}}]),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1,
+ Log_1_2_1] = get_all_terms(a),
+ disk_log:close(a),
+ del(File, 5),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {60, 3}}]),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:change_size(a, {100, 5}),
+ ?line [Log_1_1,
+ Log_2_1] = get_all_terms(a),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_4_1),
+ ?line disk_log:log(a, Log_4_2),
+ ?line disk_log:log(a, Log_5_1),
+ ?line disk_log:log(a, Log_5_2),
+ ?line disk_log:log(a, Log_1_2_1),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_4_1, Log_4_2,
+ Log_5_1, Log_5_2,
+ Log_1_2_1] = get_all_terms(a),
+
+ ?line disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100, 5}}]),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_4_1, Log_4_2,
+ Log_5_1, Log_5_2,
+ Log_1_2_1] = get_all_terms(a),
+ disk_log:close(a),
+ del(File, 5).
+
+
+
+change_size_during(suite) -> [];
+change_size_during(doc) -> ["Change size of a wrap log file while logging "
+ "to a file index between the old and the new size"];
+change_size_during(Conf) when is_list(Conf) ->
+
+ Log_1_1 = "first log first message",
+ Log_1_2 = "first log second message",
+ Log_2_1 = "second log first message",
+ Log_2_2 = "second log second message",
+ Log_3_1 = "third log first message",
+ Log_3_2 = "third log second message",
+ Log_4_1 = "fourth log first message",
+ Log_4_2 = "fourth log second message",
+ Log_5_1 = "fifth log first message",
+ Log_5_2 = "fifth log second message",
+ Log_1_2_1 = "first log second round 1",
+ Log_1_2_2 = "first log second round 2",
+ Log_2_2_1 = "second log second round 1",
+ Log_2_2_2 = "second log second round 2",
+ Log_3_2_1 = "third log second round 1",
+ Log_3_2_2 = "third log second round 2",
+ Log_1_3_1 = "first log third round 1",
+ Log_1_3_2 = "first log third round 2",
+
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,5}}]),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_4_1),
+ ?line disk_log:log(a, Log_4_2),
+ ?line disk_log:log(a, Log_5_1),
+ ?line disk_log:log(a, Log_5_2),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_4_1),
+ ?line disk_log:log(a, Log_4_2),
+ ?line disk_log:change_size(a, {100, 3}),
+ ?line [Log_5_1, Log_5_2,
+ Log_1_1, Log_1_2,
+ Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_4_1, Log_4_2] = get_all_terms(a),
+ ?line disk_log:log(a, Log_1_2_1),
+ ?line disk_log:log(a, Log_1_2_2),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_4_1, Log_4_2,
+ Log_1_2_1, Log_1_2_2] = get_all_terms(a),
+
+ ?line disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,3}}]),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_4_1, Log_4_2,
+ Log_1_2_1, Log_1_2_2] = get_all_terms(a),
+ ?line disk_log:log(a, Log_2_2_1),
+ ?line disk_log:log(a, Log_2_2_2),
+ ?line disk_log:log(a, Log_3_2_1),
+ ?line disk_log:log(a, Log_3_2_2),
+ ?line disk_log:log(a, Log_1_3_1),
+ ?line disk_log:log(a, Log_1_3_2),
+ ?line [Log_2_2_1, Log_2_2_2,
+ Log_3_2_1, Log_3_2_2,
+ Log_1_3_1, Log_1_3_2] = get_all_terms(a),
+ disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,3}}]),
+ ?line [Log_2_2_1, Log_2_2_2,
+ Log_3_2_1, Log_3_2_2,
+ Log_1_3_1, Log_1_3_2] = get_all_terms(a),
+ disk_log:close(a),
+ del(File, 5),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,5}}]),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_4_1),
+ ?line disk_log:log(a, Log_4_2),
+ ?line disk_log:log(a, Log_5_1),
+ ?line disk_log:log(a, Log_5_2),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_4_1),
+ ?line disk_log:log(a, Log_4_2),
+ ?line disk_log:log(a, Log_5_1),
+ ?line disk_log:log(a, Log_5_2),
+ ?line disk_log:change_size(a, {100, 3}),
+ ?line [Log_1_1, Log_1_2,
+ Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_4_1, Log_4_2,
+ Log_5_1, Log_5_2] = get_all_terms(a),
+ ?line disk_log:log(a, Log_1_2_1),
+ ?line disk_log:log(a, Log_1_2_2),
+ ?line disk_log:log(a, Log_2_2_1),
+ ?line disk_log:log(a, Log_2_2_2),
+ ?line disk_log:log(a, Log_3_2_1),
+ ?line disk_log:log(a, Log_3_2_2),
+ ?line disk_log:log(a, Log_1_3_1),
+ ?line disk_log:log(a, Log_1_3_2),
+ ?line [Log_2_2_1, Log_2_2_2,
+ Log_3_2_1, Log_3_2_2,
+ Log_1_3_1, Log_1_3_2] = get_all_terms(a),
+
+ ?line disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,3}}]),
+ ?line [Log_2_2_1, Log_2_2_2,
+ Log_3_2_1, Log_3_2_2,
+ Log_1_3_1, Log_1_3_2] = get_all_terms(a),
+ disk_log:close(a),
+ del(File, 5).
+
+
+change_size_after(suite) -> [];
+change_size_after(doc) ->
+ ["Change size of a wrap log file before we have reached "
+ "(on the second round) "
+ "to the file index corresponding to the new size"];
+change_size_after(Conf) when is_list(Conf) ->
+
+ Log_1_1 = "first log first message",
+ Log_1_2 = "first log second message",
+ Log_2_1 = "second log first message",
+ Log_2_2 = "second log second message",
+ Log_3_1 = "third log first message",
+ Log_3_2 = "third log second message",
+ Log_4_1 = "fourth log first message",
+ Log_4_2 = "fourth log second message",
+ Log_5_1 = "fifth log first message",
+ Log_5_2 = "fifth log second message",
+ Log_1_2_1 = "first log second round 1",
+ Log_1_2_2 = "first log second round 2",
+
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "a.LOG"),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,5}}]),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_4_1),
+ ?line disk_log:log(a, Log_4_2),
+ ?line disk_log:log(a, Log_5_1),
+ ?line disk_log:log(a, Log_5_2),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:change_size(a, {100, 3}),
+ ?line [Log_3_1,Log_3_2,
+ Log_4_1, Log_4_2,
+ Log_5_1, Log_5_2,
+ Log_1_1, Log_1_2,
+ Log_2_1, Log_2_2] = get_all_terms(a),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_1_2_1),
+ ?line disk_log:log(a, Log_1_2_2),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_1_2_1, Log_1_2_2] = get_all_terms(a),
+
+ ?line disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,3}}]),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1, Log_3_2,
+ Log_1_2_1, Log_1_2_2] = get_all_terms(a),
+ disk_log:close(a),
+ del(File, 5),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,5}}]),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_3_2),
+ ?line disk_log:log(a, Log_4_1),
+ ?line disk_log:log(a, Log_4_2),
+ ?line disk_log:log(a, Log_5_1),
+ ?line disk_log:log(a, Log_5_2),
+ ?line disk_log:log(a, Log_1_1),
+ ?line disk_log:log(a, Log_1_2),
+ ?line disk_log:log(a, Log_2_1),
+ ?line disk_log:log(a, Log_2_2),
+ ?line disk_log:change_size(a, {60, 3}),
+ ?line [Log_3_1,Log_3_2,
+ Log_4_1, Log_4_2,
+ Log_5_1, Log_5_2,
+ Log_1_1, Log_1_2,
+ Log_2_1, Log_2_2] = get_all_terms(a),
+ ?line disk_log:log(a, Log_3_1),
+ ?line disk_log:log(a, Log_1_2_1),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1,
+ Log_1_2_1] = get_all_terms(a),
+
+ ?line disk_log:close(a),
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {60,3}}]),
+ ?line [Log_2_1, Log_2_2,
+ Log_3_1,
+ Log_1_2_1] = get_all_terms(a),
+ disk_log:close(a),
+ del(File, 5).
+
+
+
+default_size(suite) -> [];
+default_size(doc) -> ["Open an existing wrap log without size option "];
+default_size(Conf) when is_list(Conf) ->
+ ?line Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "a.LOG"),
+ ?line {error, {badarg, size}} = disk_log:open([{name,a}, {file, File},
+ {type, wrap}]),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap},
+ {size, {100,5}}]),
+ ?line disk_log:close(a),
+
+ ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}]),
+ ?line {100, 5} = disk_log_1:read_size_file(File),
+ ?line ok = disk_log:close(a),
+ ?line del(File, 5).
+
+change_size2(suite) -> [];
+change_size2(doc) -> ["Testing change_size/2 a bit more..."];
+change_size2(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line del(File, No), % cleanup
+
+ %% External halt.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {size, 100000},
+ {format, external}, {type, halt}]),
+ ?line B = mk_bytes(60), % 56 actually...
+ ?line ok = disk_log:blog_terms(n, [B,list_to_binary(B),B]),
+ ?line Error1 = {error, {new_size_too_small,n,168}} =
+ disk_log:change_size(n, 167),
+ ?line "The current size" ++ _ = format_error(Error1),
+ ?line ok = disk_log:change_size(n, infinity),
+ ?line ok = disk_log:change_size(n, 168),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File), % cleanup
+
+ %% External wrap.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {notify, true},
+ {format, external}]),
+ ?line BB = mk_bytes(160),
+ ?line ok = disk_log:blog_terms(n, [BB, BB, BB, BB]), % create all files
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(3, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:blog_terms(n, [BB, BB]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(2, {disk_log, node(), n, {wrap, 1}}),
+ ?line ok = disk_log:change_size(n, {100, 2}),
+ ?line ok = disk_log:change_size(n, {100, 2}),
+ ?line {100, 2} = sz(n),
+ ?line ok = disk_log:balog_terms(n, [BB, BB]),
+ ?line ok = disk_log:balog_terms(n, [BB]),
+ ?line ok = disk_log:blog_terms(n, [BB]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(4, {disk_log, node(), n, {wrap, 1}}),
+ ?line ok = disk_log:change_size(n, {100, 4}),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+
+ %% Internal wrap.
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {notify, true},
+ {format, internal}]),
+ ?line ok = disk_log:blog_terms(n, [BB, BB, BB, BB]), % create all files
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(3, {disk_log, node(), n, {wrap, 0}}),
+ ?line ok = disk_log:blog_terms(n, [BB, BB]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(2, {disk_log, node(), n, {wrap, 1}}),
+ ?line ok = disk_log:change_size(n, {100, 2}),
+ ?line {100, 2} = sz(n),
+ ?line ok = disk_log:blog_terms(n, [BB, BB, BB, BB]),
+ %% Used to be one message, but now one per wrapped file.
+ ?line rec(4, {disk_log, node(), n, {wrap, 1}}),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No).
+
+change_size_truncate(suite) -> [];
+change_size_truncate(doc) -> ["OTP-3484: truncating index file"];
+change_size_truncate(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "bert.LOG"),
+ ?line No = 3,
+ ?line B = mk_bytes(60),
+
+ %% The problem here is truncation of the index file. One cannot easily
+ %% check that the index file is correctly updated, but print_index_file()
+ %% can be used to follow the progress more closely.
+
+ %% Part 1.
+ %% Change the size immediately after creating the log, while there
+ %% are no log files. This used to write stuff a negative offset
+ %% from the beginning of the file.
+ ?line del(File, No+1),
+ ?line {ok, bert} = disk_log:open([{name,bert}, {type,wrap}, {file, File},
+ {notify, true}, {size,{1000,255}}]),
+ ?line ok = disk_log:change_size(bert,{100,No}),
+ ?line ok = disk_log:blog(bert, B),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 0}}),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 0}}),
+ ?line 3 = curf(bert),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ ?line 1 = curf(bert),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+
+ % Three items expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+ ?line 3 = curf(bert),
+ ?line ok = disk_log:change_size(bert,{100,1}),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ % Three items expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ % One item expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ ?line ok = disk_log:close(bert),
+ ?line del(File, No),
+
+ %% Part 2.
+ %% Change the size twice, the second time while the the effects of
+ %% the first changed have not yet been handled. Finally close before
+ %% the index file has been truncated.
+
+ ?line del(File, No),
+ ?line {ok, bert} = disk_log:open([{name,bert}, {type,wrap}, {file, File},
+ {notify, true}, {size,{100,No}}]),
+ ?line ok = disk_log:blog(bert, B),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 0}}),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 0}}),
+
+ ?line 3 = curf(bert),
+ ?line ok = disk_log:change_size(bert,{100,No-1}),
+
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+
+ ?line 1 = curf(bert),
+ ?line ok = disk_log:change_size(bert,{100,No+1}),
+
+ % Three items expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+
+ % Three items expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+
+ ?line 2 = curf(bert),
+ ?line ok = disk_log:change_size(bert,{100,1}),
+
+ % Three items expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+
+ ?line ok = disk_log:close(bert),
+
+ % State: .siz is 1, current file is 2, index file size is 3...
+
+ ?line {ok, bert} = disk_log:open([{name,bert}, {file, File},
+ {type,wrap}, {notify, true}]),
+
+ % Three items expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+
+ ?line 2 = curf(bert),
+ ?line ok = disk_log:blog(bert, B),
+ ?line rec(1, {disk_log, node(), bert, {wrap, 1}}),
+ ?line ok = disk_log:close(bert),
+
+ ?line {ok, bert} = disk_log:open([{name,bert}, {file, File},
+ {type,wrap}, {notify, true}]),
+
+ % Two items expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+
+ ?line 1 = curf(bert),
+ ?line ok = disk_log:blog(bert, B),
+ %% Expect {wrap 0}. Nothing lost now, last wrap notification
+ %% reported one lost item.
+ ?line rec(1, {disk_log, node(), bert, {wrap, 0}}),
+
+ % One item expected.
+ % disk_log_1:print_index_file("bert.LOG.idx"),
+ ?line ok = disk_log:close(bert),
+
+ ?line del(File, No),
+ ok.
+
+change_attribute(suite) -> [];
+change_attribute(doc) ->
+ ["Change notify and head"];
+change_attribute(Conf) when is_list(Conf) ->
+
+ Dir = ?privdir(Conf),
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line No = 4,
+ ?line del(File, No), % cleanup
+ ?line B = mk_bytes(60),
+
+ ?line Q = qlen(),
+
+ % test change_notify
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}]),
+ ?line {ok, n} = disk_log:open([{name, n}]), % ignored...
+ ?line ok = disk_log:log_terms(n, [B,B]),
+ ?line {error, {badarg, notify}} = disk_log:change_notify(n, self(), wrong),
+ ?line ok = disk_log:change_notify(n, self(), false),
+ ?line ok = disk_log:change_notify(n, self(), true),
+ ?line Error1 = {error, {not_owner, _}} =
+ disk_log:change_notify(n, none, true),
+ ?line "The pid" ++ _ = format_error(Error1),
+ ?line 2 = no_written_items(n),
+ ?line 0 = users(n),
+ ?line Parent = self(),
+ ?line Pid = spawn(fun() -> disk_log:close(n), Parent ! {self(),done} end),
+ ?line receive {Pid, done} -> ok end,
+ ?line 0 = users(n),
+ ?line 1 = length(owners(n)),
+
+ % test change_header
+ ?line {error, {badarg, head}} = disk_log:change_header(n, none),
+ ?line {error, {badarg, head}} =
+ disk_log:change_header(n, {head_func, {1,2,3}}),
+ ?line ok = disk_log:change_header(n, {head, header}),
+ ?line ok = disk_log:log(n, B),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line 4 = no_written_items(n),
+ ?line ok = disk_log:change_header(n, {head, none}),
+ ?line ok = disk_log:log(n, B),
+ ?line rec(1, {disk_log, node(), n, {wrap, 0}}),
+ ?line 5 = no_written_items(n),
+ ?line ok = disk_log:change_header(n,
+ {head_func, {?MODULE, head_fun, [{ok,header}]}}),
+ ?line ok = disk_log:log(n, B),
+ ?line rec(1, {disk_log, node(), n, {wrap, 1}}),
+ ?line 7 = no_written_items(n),
+ ?line ok = disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:close(n),
+ ?line del(File, No),
+ ?line file:delete(File), % cleanup
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {format, external},
+ {type, halt}]),
+ ?line {error, {badarg, head}} = disk_log:change_header(n, {head, header}),
+ ?line ok = disk_log:change_header(n, {head, "header"}),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File),
+
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}]),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}]),
+ ?line ok = disk_log:change_notify(n, self(), true),
+ ?line ok = disk_log:change_header(n, {head, tjolahopp}),
+ ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap},
+ {size, {100,No}}, {notify, true}]),
+ ?line ok = disk_log:close(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line Q = qlen(),
+ ?line del(File, No).
+
+distribution(suite) -> [dist_open, dist_error_open,
+ dist_notify,
+ dist_terminate,
+ dist_accessible,
+ dist_deadlock,
+ dist_open2,
+ other_groups].
+
+dist_open(suite) -> [];
+dist_open(doc) ->
+ ["Open a distributed log"];
+dist_open(Conf) when is_list(Conf) ->
+ ?line PrivDir = ?privdir(Conf),
+ ?line true = is_alive(),
+
+ ?line Q = qlen(),
+ ?line File = filename:join(PrivDir, "n.LOG"),
+ ?line File1 = filename:join(PrivDir, "n1.LOG"),
+ ?line No = 3,
+ ?line file:delete(File),
+ ?line del(File, No), % cleanup
+ ?line del(File1, No), % cleanup
+ ?line B = mk_bytes(60),
+
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA),
+ ?line wait_for_ready_net(),
+
+ %% open non-distributed on this node:
+ ?line {ok,n} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {distributed, []}]),
+
+ ?line Error1 = {error, {halt_log, n}} = disk_log:inc_wrap_file(n),
+ ?line "The halt log" ++ _ = format_error(Error1),
+ ?line ok = disk_log:lclose(n),
+ ?line file:delete(File),
+
+ %% open distributed on this node:
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {distributed, [node()]}]),
+ %% the error message is ignored:
+ ?line ok = disk_log:inc_wrap_file(n),
+ ?line ok = disk_log:close(n),
+ ?line file:delete(File),
+
+ %% open a wrap log on this node, write something on this node
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [node()]}]),
+ ?line ok = disk_log:log(n, B),
+ ?line ok = disk_log:close(n),
+
+ %% open a wrap log on this node and aother node, write something
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [node()]}]),
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File1},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [Node]}]),
+ ?line ok = disk_log:log(n, B),
+ ?line ok = rpc:call(Node, disk_log, log, [n, B]),
+ ?line ok = disk_log:close(n),
+ ?line del(File, No),
+ ?line del(File1, No),
+ ?line file:delete(File),
+
+ %% open a wrap log on this node and another node, use lclose
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [node()]}]),
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [node()]},
+ {linkto,none}]),
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File1},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [Node]}]),
+ ?line [_, _] = distributed(n),
+ ?line ok = disk_log:lclose(n, Node),
+ ?line [_] = distributed(n),
+ ?line ok = disk_log:lclose(n),
+ ?line ok = disk_log:lclose(n),
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line del(File, No),
+ ?line del(File1, No),
+ ?line file:delete(File),
+
+ % open an invalid log file, and see how error are handled
+ ?line First = "n.LOG.1",
+ ?line make_file(PrivDir, First, 8),
+
+ ?line {[], [_,_]} = disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [Node,node()]}]),
+ ?line del(File, No),
+ ?line file:delete(File),
+
+ % open a wrap on one other node (not on this node)
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [Node]}]),
+ ?line ok = rpc:call(Node, disk_log, log, [n, B]),
+ ?line {error, no_such_log} = disk_log:lclose(n),
+ ?line ok = disk_log:close(n),
+
+ ?line Q = qlen(),
+
+ ?line {error, no_such_log} = disk_log:info(n),
+ ?line del(File, No),
+ ?line file:delete(File),
+ ?line stop_node(Node),
+ ok.
+
+dist_error_open(suite) -> [];
+dist_error_open(doc) ->
+ ["Open a log distributed and not distributed"];
+dist_error_open(Conf) when is_list(Conf) ->
+ ?line PrivDir = ?privdir(Conf),
+ ?line true = is_alive(),
+
+ ?line Q = qlen(),
+ ?line File = filename:join(PrivDir, "bert.LOG"),
+ ?line File1 = filename:join(PrivDir, "bert1.LOG"),
+ ?line No = 3,
+ ?line file:delete(File),
+ ?line del(File, No), % cleanup
+ ?line del(File1, No), % cleanup
+
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA),
+ ?line wait_for_ready_net(),
+
+ % open non-distributed on this node:
+ ?line {ok,n} = disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}}]),
+
+ % trying to open distributed on this node (error):
+ ?line {[],[Error1={ENode,{error,{node_already_open,n}}}]} =
+ disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [node()]}]),
+ ?line true =
+ lists:prefix(lists:flatten(io_lib:format("~p: The distribution",
+ [ENode])),
+ format_error(Error1)),
+ ?line ok = disk_log:lclose(n),
+
+ % open distributed on this node:
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [node()]}]),
+
+ % trying to open non-distributed on this node (error):
+ ?line {_,{node_already_open,n}} =
+ disk_log:open([{name, n}, {file, File},
+ {type, wrap}, {size, {50, No}}]),
+
+ ?line ok = disk_log:close(n),
+ ?line Q = qlen(),
+
+ ?line del(File, No),
+ ?line del(File1, No),
+ ?line file:delete(File),
+ ?line stop_node(Node),
+ ok.
+
+dist_notify(suite) -> [];
+dist_notify(doc) ->
+ ["Notification from other node"];
+dist_notify(Conf) when is_list(Conf) ->
+ ?line PrivDir = ?privdir(Conf),
+ ?line true = is_alive(),
+
+ ?line File = filename:join(PrivDir, "bert.LOG"),
+ ?line File1 = filename:join(PrivDir, "bert1.LOG"),
+ ?line No = 3,
+ ?line B = mk_bytes(60),
+ ?line file:delete(File),
+ ?line file:delete(File1),
+ ?line del(File, No), % cleanup
+ ?line del(File1, No),
+
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA),
+ ?line wait_for_ready_net(),
+
+ % opening distributed on this node:
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, {notify, false},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [node()]}]),
+
+ % opening distributed on other node:
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File1},
+ {notify, true}, {linkto, self()},
+ {type, wrap}, {size, {50, No}},
+ {distributed, [Node]}]),
+ ?line disk_log:alog(n, B),
+ ?line disk_log:alog(n, B),
+ ?line ok = disk_log:sync(n),
+ ?line rec(1, {disk_log, Node, n, {wrap, 0}}),
+ ?line ok = disk_log:close(n),
+
+ ?line del(File, No),
+ ?line del(File1, No),
+ ?line file:delete(File),
+ ?line stop_node(Node),
+ ok.
+
+dist_terminate(suite) -> [];
+dist_terminate(doc) ->
+ ["Terminating nodes with distributed logs"];
+dist_terminate(Conf) when is_list(Conf) ->
+ ?line Dir = ?privdir(Conf),
+ ?line true = is_alive(),
+
+ ?line File = filename:join(Dir, "n.LOG"),
+ ?line File1 = filename:join(Dir, "n1.LOG"),
+ No = 1,
+ del(File, No), % cleanup
+ del(File1, No), % cleanup
+
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA),
+ ?line wait_for_ready_net(),
+
+ %% Distributed versions of two of the situations in close_block(/1.
+
+ %% One of two owners terminates.
+ ?line Pid1 = spawn_link(?MODULE, lserv, [n]),
+ ?line Pid2 = spawn_link(?MODULE, lserv, [n]),
+ ?line {[{_, {ok, n}}], []} = sync_do(Pid1, {dist_open, File, node()}),
+ ?line {[{_, {ok, n}}], []} = sync_do(Pid2, {dist_open, File1, Node}),
+ ?line [_] = sync_do(Pid1, owners),
+ ?line [_] = sync_do(Pid2, owners),
+ ?line 0 = sync_do(Pid1, users),
+ ?line 0 = sync_do(Pid2, users),
+ ?line sync_do(Pid1, terminate),
+ ?line timer:sleep(500),
+ ?line [_] = sync_do(Pid2, owners),
+ ?line 0 = sync_do(Pid2, users),
+ ?line sync_do(Pid2, terminate),
+ ?line timer:sleep(500),
+ ?line {error, no_such_log} = disk_log:info(n),
+
+ %% Users terminate (no link...).
+ ?line Pid3 = spawn_link(?MODULE, lserv, [n]),
+ ?line Pid4 = spawn_link(?MODULE, lserv, [n]),
+ ?line {[{_, {ok, n}}], []} =
+ sync_do(Pid3, {dist_open, File, none, node()}),
+ ?line {[{_, {ok, n}}], []} =
+ sync_do(Pid4, {dist_open, File1, none, Node}),
+ ?line [] = sync_do(Pid3, owners),
+ ?line [] = sync_do(Pid4, owners),
+ ?line 1 = sync_do(Pid3, users),
+ ?line 1 = sync_do(Pid4, users),
+ ?line sync_do(Pid3, terminate),
+ ?line [] = sync_do(Pid4, owners),
+ ?line 1 = sync_do(Pid4, users),
+ ?line sync_do(Pid4, terminate),
+ ?line ok = disk_log:close(n), % closing all nodes
+ ?line {error, no_such_log} = disk_log:info(n),
+
+ ?line del(File, No),
+ ?line del(File1, No),
+ ?line stop_node(Node),
+ ok.
+
+dist_accessible(suite) -> [];
+dist_accessible(doc) ->
+ ["Accessible logs on nodes"];
+dist_accessible(Conf) when is_list(Conf) ->
+ ?line PrivDir = ?privdir(Conf),
+
+ ?line true = is_alive(),
+
+ ?line F1 = filename:join(PrivDir, "a.LOG"),
+ ?line file:delete(F1),
+ ?line F2 = filename:join(PrivDir, "b.LOG"),
+ ?line file:delete(F2),
+ ?line F3 = filename:join(PrivDir, "c.LOG"),
+ ?line file:delete(F3),
+ ?line F4 = filename:join(PrivDir, "d.LOG"),
+ ?line file:delete(F1),
+ ?line F5 = filename:join(PrivDir, "e.LOG"),
+ ?line file:delete(F2),
+ ?line F6 = filename:join(PrivDir, "f.LOG"),
+ ?line file:delete(F3),
+
+ ?line {[],[]} = disk_log:accessible_logs(),
+ ?line {ok, a} = disk_log:open([{name, a}, {type, halt}, {file, F1}]),
+ ?line {[a],[]} = disk_log:accessible_logs(),
+ ?line {ok, b} = disk_log:open([{name, b}, {type, halt}, {file, F2}]),
+ ?line {[a,b],[]} = disk_log:accessible_logs(),
+ ?line {ok, c} = disk_log:open([{name, c}, {type, halt}, {file, F3}]),
+ ?line {[a,b,c],[]} = disk_log:accessible_logs(),
+
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA),
+ ?line wait_for_ready_net(),
+
+ ?line {[_],[]} = disk_log:open([{name, a}, {file, F4}, {type, halt},
+ {distributed, [Node]}]),
+ ?line {[a,b,c],[]} = disk_log:accessible_logs(),
+ ?line {[],[a]} = rpc:call(Node, disk_log, accessible_logs, []),
+ ?line {[_],[]} = disk_log:open([{name, b}, {file, F5}, {type, halt},
+ {distributed, [Node]}]),
+ ?line {[],[a,b]} = rpc:call(Node, disk_log, accessible_logs, []),
+ ?line {[_],[]} = disk_log:open([{name, c}, {file, F6}, {type, halt},
+ {distributed, [Node]}]),
+ ?line {[],[a,b,c]} = rpc:call(Node, disk_log, accessible_logs, []),
+ ?line {[a,b,c],[]} = disk_log:accessible_logs(),
+ ?line ok = disk_log:close(a),
+ ?line {[b,c],[a]} = disk_log:accessible_logs(),
+ ?line ok = disk_log:close(b),
+ ?line {[c],[a,b]} = disk_log:accessible_logs(),
+ ?line ok = disk_log:close(b),
+ ?line {[c],[a]} = disk_log:accessible_logs(),
+ ?line {[],[a,c]} = rpc:call(Node, disk_log, accessible_logs, []),
+ ?line ok = disk_log:close(c),
+ ?line {[],[a,c]} = disk_log:accessible_logs(),
+ ?line ok = disk_log:close(c),
+ ?line {[],[a]} = disk_log:accessible_logs(),
+ ?line {[],[a]} = rpc:call(Node, disk_log, accessible_logs, []),
+ ?line ok = disk_log:close(a),
+ ?line {[],[]} = disk_log:accessible_logs(),
+ ?line {[],[]} = rpc:call(Node, disk_log, accessible_logs, []),
+
+ ?line file:delete(F1),
+ ?line file:delete(F2),
+ ?line file:delete(F3),
+ ?line file:delete(F4),
+ ?line file:delete(F5),
+ ?line file:delete(F6),
+
+ ?line stop_node(Node),
+ ok.
+
+dist_deadlock(suite) -> [];
+dist_deadlock(doc) ->
+ ["OTP-4405. Deadlock between two nodes could happen."];
+dist_deadlock(Conf) when is_list(Conf) ->
+ ?line PrivDir = ?privdir(Conf),
+
+ ?line true = is_alive(),
+
+ ?line F1 = filename:join(PrivDir, "a.LOG"),
+ ?line file:delete(F1),
+ ?line F2 = filename:join(PrivDir, "b.LOG"),
+ ?line file:delete(F2),
+
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node1} = start_node(disk_log_node1, "-pa " ++ PA),
+ ?line {ok, Node2} = start_node(disk_log_node2, "-pa " ++ PA),
+ ?line wait_for_ready_net(),
+
+ Self = self(),
+ Fun1 = fun() -> dist_dl(Node2, a, F1, Self) end,
+ Fun2 = fun() -> dist_dl(Node1, b, F2, Self) end,
+ P1 = spawn(Node1, Fun1),
+ P2 = spawn(Node2, Fun2),
+ receive {P1, a} -> ok end,
+ receive {P2, b} -> ok end,
+
+ ?line stop_node(Node1),
+ ?line stop_node(Node2),
+
+ ?line file:delete(F1),
+ ?line file:delete(F2),
+ ok.
+
+dist_dl(Node, Name, File, Pid) ->
+ {[{Node,{ok,Log}}], []} =
+ disk_log:open([{name,Name},{file,File},{distributed,[Node]}]),
+ timer:sleep(50), % give the nodes chance to exchange pg2 information
+ ok = disk_log:close(Log),
+ Pid ! {self(), Name},
+ ok.
+
+dist_open2(suite) -> [];
+dist_open2(doc) ->
+ ["OTP-4480. Opening several logs simultaneously."];
+dist_open2(Conf) when is_list(Conf) ->
+ ?line true = is_alive(),
+ ?line {ok, _Pg2} = pg2:start(),
+
+ dist_open2_1(Conf, 0),
+ dist_open2_1(Conf, 100),
+
+ dist_open2_2(Conf, 0),
+ dist_open2_2(Conf, 100),
+
+ PrivDir = ?privdir(Conf),
+ Log = n,
+
+ %% Open a log three times (very fast). Two of the opening
+ %% processes will be put on hold (pending). The first one failes
+ %% to open the log. The second one succeeds, and the third one is
+ %% attached.
+ P0 = pps(),
+ ?line File0 = "n.LOG",
+ ?line File = filename:join(PrivDir, File0),
+ ?line make_file(PrivDir, File0, 8),
+
+ Parent = self(),
+ F1 = fun() -> R = disk_log:open([{name, Log}, {file, File},
+ {type, halt}, {format,internal},
+ {distributed, [node()]}]),
+ Parent ! {self(), R}
+ end,
+ F2 = fun() -> R = disk_log:open([{name, Log}, {file, File},
+ {type, halt}, {format,external},
+ {distributed, [node()]}]),
+ Parent ! {self(), R},
+ timer:sleep(300)
+ end,
+ ?line Pid1 = spawn(F1),
+ timer:sleep(10),
+ ?line Pid2 = spawn(F2),
+ ?line Pid3 = spawn(F2),
+
+ ?line receive {Pid1,R1} -> {[],[_]} = R1 end,
+ ?line receive {Pid2,R2} -> {[_],[]} = R2 end,
+ ?line receive {Pid3,R3} -> {[_],[]} = R3 end,
+
+ timer:sleep(500),
+ ?line file:delete(File),
+ ?line true = (P0 == pps()),
+
+ %% This time the first process has a naughty head_func. This test
+ %% does not add very much. Perhaps it should be removed. However,
+ %% a head_func like this is why it's necessary to have an separate
+ %% process calling disk_log:internal_open: the server cannot wait
+ %% for the reply, but the call must be monitored, and this is what
+ %% is accomplished by having a proxy process.
+ F3 = fun() ->
+ R = disk_log:open([{name,Log},{file,File},
+ {format,internal},
+ {head_func,{?MODULE,head_exit,[]}},
+ {type,halt}, {linkto,none}]),
+ Parent ! {self(), R}
+ end,
+ F4 = fun() ->
+ R = disk_log:open([{name,Log},{file,File},
+ {format,internal},
+ {type,halt}]),
+ Parent ! {self(), R}
+ end,
+ ?line Pid4 = spawn(F3),
+ timer:sleep(10),
+ ?line Pid5 = spawn(F4),
+ ?line Pid6 = spawn(F4),
+ %% The timing is crucial here.
+ ?line R = case receive {Pid4,R4} -> R4 end of
+ {error, no_such_log} ->
+ ?line R5 = receive {Pid5, R5a} -> R5a end,
+ ?line R6 = receive {Pid6, R6a} -> R6a end,
+ case {R5, R6} of
+ {{repaired, _, _, _}, {ok, Log}} -> ok;
+ {{ok, Log}, {repaired, _, _, _}} -> ok;
+ _ -> test_server_fail({bad_replies, R5, R6})
+ end,
+ ok;
+ {ok, Log} -> % uninteresting case
+ ?line receive {Pid5,_R5} -> ok end,
+ ?line receive {Pid6,_R6} -> ok end,
+ {comment,
+ "Timing dependent test did not check anything."}
+ end,
+
+ timer:sleep(100),
+ ?line {error, no_such_log} = disk_log:close(Log),
+ file:delete(File),
+ ?line true = (P0 == pps()),
+
+ No = 2,
+ Log2 = n2,
+ File2 = filename:join(PrivDir, "b.LOG"),
+ file:delete(File2),
+ del(File, No),
+
+ %% If a client takes a long time when writing the header, other
+ %% processes should be able to attach to other log without having to
+ %% wait.
+
+ ?line {ok,Log} =
+ disk_log:open([{name,Log},{file,File},{type,wrap},{size,{100,No}}]),
+ Pid = spawn(fun() ->
+ receive {HeadPid, start} -> ok end,
+ {ok,Log2} = disk_log:open([{name,Log2},{file,File2},
+ {type,halt}]),
+ HeadPid ! {self(), done}
+ end),
+ HeadFunc = {?MODULE, slow_header, [Pid]},
+ ?line ok = disk_log:change_header(Log, {head_func, HeadFunc}),
+ ?line ok = disk_log:inc_wrap_file(Log), % header is written
+
+ timer:sleep(100),
+ ?line ok = disk_log:close(Log),
+
+ file:delete(File2),
+ del(File, No),
+ ?line true = (P0 == pps()),
+
+ R.
+
+dist_open2_1(Conf, Delay) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "n.LOG"),
+ Log = n,
+
+ A0 = [{name,Log},{file,File},{type,halt}],
+ ?line create_opened_log(File, A0),
+ P0 = pps(),
+
+ Log2 = log2,
+ File2 = "log2.LOG",
+ ?line file:delete(File2),
+ ?line {ok,Log2} = disk_log:open([{name,Log2},{file,File2},{type,halt}]),
+
+ Parent = self(),
+ F = fun() ->
+ R = disk_log:open(A0),
+ timer:sleep(Delay),
+ Parent ! {self(), R}
+ end,
+ ?line Pid1 = spawn(F),
+ timer:sleep(10),
+ ?line Pid2 = spawn(F),
+ ?line Pid3 = spawn(F),
+ ?line {error, no_such_log} = disk_log:log(Log, term), % is repairing now
+ ?line 0 = qlen(),
+
+ %% The file is already open, so this will not take long.
+ ?line {ok,Log2} = disk_log:open([{name,Log2},{file,File2},{type,halt}]),
+ ?line 0 = qlen(), % still repairing
+ ?line ok = disk_log:close(Log2),
+ ?line {error, no_such_log} = disk_log:close(Log2),
+ ?line file:delete(File2),
+
+ ?line receive {Pid1,R1} -> {repaired,_,_,_} = R1 end,
+ ?line receive {Pid2,R2} -> {ok,_} = R2 end,
+ ?line receive {Pid3,R3} -> {ok,_} = R3 end,
+ timer:sleep(500),
+ ?line {error, no_such_log} = disk_log:info(Log),
+
+ file:delete(File),
+ ?line true = (P0 == pps()),
+
+ ok.
+
+dist_open2_2(Conf, Delay) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "n.LOG"),
+ Log = n,
+
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node1} = start_node(disk_log_node2, "-pa " ++ PA),
+ ?line wait_for_ready_net(),
+ P0 = pps(),
+
+ A0 = [{name,Log},{file,File},{type,halt}],
+ ?line create_opened_log(File, A0),
+
+ Log2 = log2,
+ File2 = "log2.LOG",
+ ?line file:delete(File2),
+ ?line {[{Node1,{ok,Log2}}],[]} =
+ disk_log:open([{name,Log2},{file,File2},{type,halt},
+ {distributed,[Node1]}]),
+
+ Parent = self(),
+ F = fun() ->
+ %% It would be nice to slow down the repair. head_func
+ %% cannot be used since it is not called when repairing.
+ R = disk_log:open([{distributed,[Node1]} | A0]),
+ timer:sleep(Delay),
+ Parent ! {self(), R}
+ end,
+ %% And {priority, ...} probably has no effect either.
+ ?line Pid1 = spawn_opt(F, [{priority, low}]),
+ % timer:sleep(1), % no guarantee that Pid1 will return {repaired, ...}
+ ?line Pid2 = spawn_opt(F, [{priority, low}]),
+ ?line {error, no_such_log} =
+ disk_log:log(Log, term), % maybe repairing now
+ ?line 0 = qlen(),
+
+ %% The file is already open, so this will not take long.
+ ?line {[{Node1,{ok,Log2}}],[]} =
+ disk_log:open([{name,Log2},{file,File2},{type,halt},
+ {distributed,[Node1]}]),
+ ?line 0 = qlen(), % probably still repairing
+ ?line ok = disk_log:close(Log2),
+ ?line file:delete(File2),
+
+ ?line receive {Pid1,R1} -> R1 end,
+ ?line receive {Pid2,R2} -> R2 end,
+ ?line case {R1, R2} of
+ {{[{Node1,{repaired,_,_,_}}],[]},
+ {[{Node1,{ok,Log}}],[]}} -> ok;
+ {{[{Node1,{ok,Log}}],[]},
+ {[{Node1,{repaired,_,_,_}}],[]}} -> ok
+ end,
+
+ ?line true = (P0 == pps()),
+ ?line stop_node(Node1),
+ file:delete(File),
+ ok.
+
+head_exit() ->
+ process_flag(trap_exit, false), % Don't do like this!
+ spawn_link(fun() -> exit(helfel) end),
+ {ok,"123"}.
+
+slow_header(Pid) ->
+ Pid ! {self(), start},
+ receive {Pid, done} -> ok end,
+ {ok, <<>>}.
+
+create_opened_log(File, Args) ->
+ Log = n,
+ file:delete(File),
+ {ok, Log} = disk_log:open(Args),
+ log_terms(Log, 400000),
+ ok = disk_log:close(Log),
+ mark(File, ?OPENED),
+ ok.
+
+log_terms(_Log, 0) ->
+ ok;
+log_terms(Log, N) when N > 100 ->
+ Terms = [{term,I} || I <- lists:seq(N-99, N)],
+ ok = disk_log:log_terms(Log, Terms),
+ log_terms(Log, N-100);
+log_terms(Log, N) ->
+ ok = disk_log:log(Log, {term, N}),
+ log_terms(Log, N-1).
+
+other_groups(suite) -> [];
+other_groups(doc) ->
+ ["OTP-5810. Cope with pg2 groups that are not disk logs."];
+other_groups(Conf) when is_list(Conf) ->
+ ?line true = is_alive(),
+ ?line PrivDir = ?privdir(Conf),
+
+ ?line File = filename:join(PrivDir, "n.LOG"),
+ ?line file:delete(File),
+
+ ?line {[],[]} = disk_log:accessible_logs(),
+ ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, {type, halt},
+ {distributed, [node()]}]),
+ ?line {[],[n]} = disk_log:accessible_logs(),
+ Group = grupp,
+ ?line pg2:create(Group),
+ ?line ok = pg2:join(Group, self()),
+ ?line {[],[n]} = disk_log:accessible_logs(),
+ ?line [_] =
+ lists:filter(fun(P) -> disk_log:pid2name(P) =/= undefined end,
+ erlang:processes()),
+ ?line pg2:delete(Group),
+ ?line {[],[n]} = disk_log:accessible_logs(),
+ ?line ok = disk_log:close(n),
+ ?line {[],[]} = disk_log:accessible_logs(),
+ ?line file:delete(File),
+
+ ok.
+
+-define(MAX, 16384). % MAX in disk_log_1.erl
+evil(suite) -> [];
+evil(doc) -> ["Evil cases such as closed file descriptor port."];
+evil(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "n.LOG"),
+ Log = n,
+
+ %% Not a very thorough test.
+
+ ?line ok = setup_evil_filled_cache_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:log(Log, apa),
+ ?line ok = disk_log:close(Log),
+
+ ?line ok = setup_evil_filled_cache_halt(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:truncate(Log, apa),
+ ?line ok = stop_evil(Log),
+
+ %% White box test.
+ file:delete(File),
+ ?line Ports0 = erlang:ports(),
+ ?line {ok, Log} = disk_log:open([{name,Log},{file,File},{type,halt},
+ {size,?MAX+50},{format,external}]),
+ ?line [Fd] = erlang:ports() -- Ports0,
+ ?line {B,_} = x_mk_bytes(30),
+ ?line ok = disk_log:blog(Log, <<0:(?MAX+1)/unit:8>>),
+ ?line exit(Fd, kill),
+ ?line {error, {file_error,_,einval}} = disk_log:blog_terms(Log, [B,B]),
+ ?line ok= disk_log:close(Log),
+ file:delete(File),
+
+ ?line ok = setup_evil_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:close(Log),
+
+ ?line ok = setup_evil_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:log(Log, apa),
+ ?line ok = stop_evil(Log),
+
+ ?line ok = setup_evil_halt(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:log(Log, apa),
+ ?line ok = stop_evil(Log),
+
+ ?line ok = setup_evil_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:reopen(Log, apa),
+ ?line {error, {file_error,_,einval}} = disk_log:reopen(Log, apa),
+ ?line ok = stop_evil(Log),
+
+ ?line ok = setup_evil_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:reopen(Log, apa),
+ ?line ok = stop_evil(Log),
+
+ ?line ok = setup_evil_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:inc_wrap_file(Log),
+ ?line ok = stop_evil(Log),
+
+ ?line ok = setup_evil_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:chunk(Log, start),
+ ?line ok = stop_evil(Log),
+
+ ?line ok = setup_evil_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:truncate(Log),
+ ?line ok = stop_evil(Log),
+
+ ?line ok = setup_evil_wrap(Log, Dir),
+ ?line {error, {file_error,_,einval}} = disk_log:chunk_step(Log, start, 1),
+ ?line ok = stop_evil(Log),
+
+ io:format("messages: ~p~n", [erlang:process_info(self(), messages)]),
+ del(File, 2),
+ file:delete(File),
+ ok.
+
+setup_evil_wrap(Log, Dir) ->
+ setup_evil(Log, [{type,wrap},{size,{100,2}}], Dir).
+
+setup_evil_halt(Log, Dir) ->
+ setup_evil(Log, [{type,halt},{size,10000}], Dir).
+
+setup_evil(Log, Args, Dir) ->
+ File = filename:join(Dir, lists:concat([Log, ".LOG"])),
+ file:delete(File),
+ del(File, 2),
+ ok = disk_log:start(),
+ Ports0 = erlang:ports(),
+ {ok, Log} = disk_log:open([{name,Log},{file,File} | Args]),
+ [Fd] = erlang:ports() -- Ports0,
+ exit(Fd, kill),
+ ok = disk_log:log_terms(n, [<<0:10/unit:8>>]),
+ timer:sleep(2500), % TIMEOUT in disk_log_1.erl is 2000
+ ok.
+
+stop_evil(Log) ->
+ {error, _} = disk_log:close(Log),
+ ok.
+
+setup_evil_filled_cache_wrap(Log, Dir) ->
+ setup_evil_filled_cache(Log, [{type,wrap},{size,{?MAX,2}}], Dir).
+
+setup_evil_filled_cache_halt(Log, Dir) ->
+ setup_evil_filled_cache(Log, [{type,halt},{size,infinity}], Dir).
+
+%% The cache is filled, and the file descriptor port gone.
+setup_evil_filled_cache(Log, Args, Dir) ->
+ File = filename:join(Dir, lists:concat([Log, ".LOG"])),
+ file:delete(File),
+ del(File, 2),
+ ok = disk_log:start(),
+ Ports0 = erlang:ports(),
+ {ok, Log} = disk_log:open([{name,Log},{file,File} | Args]),
+ [Fd] = erlang:ports() -- Ports0,
+ ok = disk_log:log_terms(n, [<<0:?MAX/unit:8>>]),
+ exit(Fd, kill),
+ ok.
+
+otp_6278(suite) -> [];
+otp_6278(doc) -> ["OTP-6278. open/1 creates no status or crash report."];
+otp_6278(Conf) when is_list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = filename:join(Dir, "no_such_dir/no_such_file"),
+ ?line error_logger:add_report_handler(?MODULE, self()),
+ ?line {error, {file_error, _, _}} =
+ disk_log:open([{name,n},{file,File}]),
+ receive
+ {crash_report,_Pid,Report} ->
+ ?line io:format("Unexpected: ~p\n", [Report]),
+ ?line ?t:fail()
+ after 1000 ->
+ ok
+ end,
+ ?line error_logger:delete_report_handler(?MODULE).
+
+mark(FileName, What) ->
+ {ok,Fd} = file:open(FileName, [raw, binary, read, write]),
+ {ok,_} = file:position(Fd, 4),
+ ok = file:write(Fd, What),
+ ok = file:close(Fd).
+
+crash(File, Where) ->
+ {ok, Fd} = file:open(File, read_write),
+ file:position(Fd, Where),
+ ok = file:write(Fd, [10]),
+ ok = file:close(Fd).
+
+unwritable(Fname) ->
+ {ok, Info} = file:read_file_info(Fname),
+ Mode = Info#file_info.mode - 8#00200,
+ file:write_file_info(Fname, Info#file_info{mode = Mode}).
+
+writable(Fname) ->
+ {ok, Info} = file:read_file_info(Fname),
+ Mode = Info#file_info.mode bor 8#00200,
+ file:write_file_info(Fname, Info#file_info{mode = Mode}).
+
+truncate(File, Where) ->
+ {ok, Fd} = file:open(File, read_write),
+ file:position(Fd, Where),
+ ok = file:truncate(Fd),
+ ok = file:close(Fd).
+
+file_size(File) ->
+ {ok, F} = file:read_file_info(File),
+ F#file_info.size.
+
+copy_wrap_log(FromName, N, FromDir, ToDir) ->
+ copy_wrap_log(FromName, FromName, N, FromDir, ToDir).
+
+copy_wrap_log(FromName, ToName, N, FromDir, ToDir) ->
+ Fun = fun(E) ->
+ From = join(FromDir, io_lib:format("~s.~p", [FromName, E])),
+ To = join(ToDir, io_lib:format("~s.~p", [ToName, E])),
+ case file:read_file_info(From) of
+ {ok, _FileInfo} ->
+ copy_file(From, To);
+ _Else ->
+ ok
+ end
+ end,
+ Exts = [idx, siz | lists:seq(1, N)],
+ lists:foreach(Fun, Exts).
+
+-define(BUFSIZE, 8192).
+
+copy_file(Src, Dest) ->
+ % ?t:format("copying from ~p to ~p~n", [Src, Dest]),
+ {ok, InFd} = file:open(Src, [raw, binary, read]),
+ {ok, OutFd} = file:open(Dest, [raw, binary, write]),
+ ok = copy_file1(InFd, OutFd),
+ file:close(InFd),
+ file:close(OutFd),
+ ok = file:change_mode(Dest, 8#0666).
+
+copy_file1(InFd, OutFd) ->
+ case file:read(InFd, ?BUFSIZE) of
+ {ok, Bin} ->
+ ok = file:write(OutFd, Bin),
+ copy_file1(InFd, OutFd);
+ eof ->
+ ok
+ end.
+
+
+join(A, B) ->
+ filename:nativename(filename:join(A, B)).
+
+add_ext(Name, Ext) ->
+ lists:concat([Name, ".", Ext]).
+
+log(_Name, 0) ->
+ ok;
+log(Name, N) ->
+ ok = disk_log:log(Name, "this is a logged message number " ++
+ integer_to_list(N)),
+ log(Name, N-1).
+
+format_error(E) ->
+ lists:flatten(disk_log:format_error(E)).
+
+pps() ->
+ timer:sleep(100),
+ {erlang:ports(), lists:filter(fun(P) -> erlang:is_process_alive(P) end,
+ processes())}.
+
+qlen() ->
+ {_, {_, N}} = lists:keysearch(message_queue_len, 1, process_info(self())),
+ N.
+
+owners(Log) ->
+%% io:format("owners ~p~n", [info(Log, owners, -1)]),
+ info(Log, owners, -1).
+users(Log) ->
+%% io:format("users ~p~n", [info(Log, users, -1)]),
+ info(Log, users, -1).
+status(Log) ->
+%% io:format("status ~p~n", [info(Log, status, -1)]),
+ info(Log, status, -1).
+distributed(Log) ->
+%% io:format("distributed ~p~n", [info(Log, distributed, -1)]),
+ info(Log, distributed, -1).
+no_items(Log) ->
+%% io:format("no_items ~p~n", [info(Log, no_items, -1)]),
+ info(Log, no_items, -1).
+no_written_items(Log) ->
+%% io:format("no_written_items ~p~n", [info(Log, no_written_items, -1)]),
+ info(Log, no_written_items, -1).
+sz(Log) ->
+%% io:format("sz ~p~n", [info(Log, size, -1)]),
+ info(Log, size, -1).
+curb(Log) ->
+%% io:format("curb ~p~n", [info(Log, no_current_bytes, -1)]),
+ info(Log, no_current_bytes, -1).
+curf(Log) ->
+%% io:format("curf ~p~n", [info(Log, current_file, -1)]),
+ info(Log, current_file, -1).
+cur_cnt(Log) ->
+%% io:format("cur_cnt ~p~n", [info(Log, no_current_items, -1)]),
+ info(Log, no_current_items, -1).
+no_overflows(Log) ->
+%% io:format("no_overflows ~p~n", [info(Log, no_overflows, -1)]),
+ info(Log, no_overflows, -1).
+
+info(Log, What, Undef) ->
+ case lists:keysearch(What, 1, disk_log:info(Log)) of
+ {value, {What, Value}} -> Value;
+ false -> Undef
+ end.
+
+rec(0, _) ->
+ ok;
+rec(N, Msg) ->
+ receive
+ Msg ->
+ rec(N-1, Msg)
+ after 100 ->
+ test_server_fail({no_msg, N, Msg})
+ end.
+
+%% Copied from global_SUITE.erl.
+-define(UNTIL(Seq), loop_until_true(fun() -> Seq end)).
+
+loop_until_true(Fun) ->
+ case Fun() of
+ true ->
+ ok;
+ _ ->
+ timer:sleep(1000),
+ loop_until_true(Fun)
+ end.
+
+wait_for_ready_net() ->
+ Nodes = lists:sort([node() | nodes()]),
+ ?UNTIL(begin
+ lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and
+ lists:all(fun(N) ->
+ LNs = rpc:call(N, erlang, nodes, []),
+ Nodes =:= lists:sort([N | LNs])
+ end, Nodes)
+ end).
+
+get_known(Node) ->
+ case catch gen_server:call({global_name_server,Node}, get_known) of
+ {'EXIT', _} ->
+ [list, without, nodenames];
+ Known ->
+ lists:sort([Node | Known])
+ end.
+
+%% Copied from erl_distribution_SUITE.erl:
+start_node(Name, Param) ->
+ ?t:start_node(Name, slave, [{args, Param}]).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
+
+%from(H, [H | T]) -> T;
+%from(H, [_ | T]) -> from(H, T);
+%from(_H, []) -> [].
+
+
+%% Check for NFS cache size, this is called from init_per_testcase() and
+%% makes different tests run depending on the size of the NFS cache on
+%% VxWorks. Possibly this could be adopted to Windows too, but we seldom use
+%% NFS when testing on windows, so I can find better things to do.
+%% The port program used simply reads the nfsCacheSize variable on the board.
+%% If the board is configured without NFS, the port program will fail to load
+%% and this will return 0, which may or may not be the wrong thing to do.
+
+check_nfs(Config) ->
+ case (catch check_cache(Config)) of
+ N when is_integer(N) ->
+ N;
+ _ ->
+ 0
+ end.
+
+check_cache(Config) ->
+ ?line Check = filename:join(?datadir(Config), "nfs_check"),
+ ?line P = open_port({spawn, Check}, [{line,100}, eof]),
+ ?line Size = receive
+ {P,{data,{eol,S}}} ->
+ list_to_integer(S)
+ after 1000 ->
+ erlang:display(got_timeout),
+ exit(timeout)
+ end,
+ ?line receive
+ {P, eof} ->
+ ok
+ end,
+ ?line P ! {self(), close},
+ ?line receive
+ {P, closed} -> ok
+ end,
+ Size.
+
+skip_expand([]) ->
+ [];
+skip_expand([Case | T]) ->
+ case (catch apply(?MODULE, Case, [suite])) of
+ {'EXIT', _} ->
+ [Case | skip_expand(T)];
+ [] ->
+ [Case | skip_expand(T)];
+ Res ->
+ skip_expand(Res) ++ skip_expand(T)
+ end.
+
+
+skip_list(Config) ->
+ case check_nfs(Config) of
+ 0 ->
+ skip_expand(?SKIP_NO_CACHE);
+ _ ->
+ skip_expand(?SKIP_LARGE_CACHE)
+ end.
+
+should_skip(Test,Config) ->
+ case os:type() of
+ vxworks ->
+ lists:member(Test, skip_list(Config));
+ _ ->
+ false
+ end.
+
+%%-----------------------------------------------------------------
+%% The error_logger handler used.
+%% (Copied from stdlib/test/proc_lib_SUITE.erl.)
+%%-----------------------------------------------------------------
+init(Tester) ->
+ {ok, Tester}.
+
+handle_event({error_report, _GL, {Pid, crash_report, Report}}, Tester) ->
+ Tester ! {crash_report, Pid, Report},
+ {ok, Tester};
+handle_event(_Event, State) ->
+ {ok, State}.
+
+handle_info(_, State) ->
+ {ok, State}.
+
+handle_call(_Query, State) -> {ok, {error, bad_query}, State}.
+
+terminate(_Reason, State) ->
+ State.
diff --git a/lib/kernel/test/disk_log_SUITE_data/Makefile.src b/lib/kernel/test/disk_log_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..cae2f23d29
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/Makefile.src
@@ -0,0 +1,15 @@
+CC = @CC@
+LD = @LD@
+CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@
+CROSSLDFLAGS = @CROSSLDFLAGS@
+
+PROGS = nfs_check@exe@
+
+all: $(PROGS)
+
+nfs_check@exe@: nfs_check@obj@
+ $(LD) $(CROSSLDFLAGS) -o nfs_check nfs_check@obj@ @LIBS@
+
+nfs_check@obj@: nfs_check.c
+ $(CC) -c -o nfs_check@obj@ $(CFLAGS) nfs_check.c
+
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.1 b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.1
new file mode 100644
index 0000000000..4ab4382c54
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.1
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.2 b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.2
new file mode 100644
index 0000000000..491f23d0a2
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.2
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.3 b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.3
new file mode 100644
index 0000000000..d690c59365
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.3
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.4 b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.4
new file mode 100644
index 0000000000..c61526e1b7
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.4
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.idx b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.idx
new file mode 100644
index 0000000000..1250cdcaf3
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.idx
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.1 b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.1
new file mode 100644
index 0000000000..4ab4382c54
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.1
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.2 b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.2
new file mode 100644
index 0000000000..491f23d0a2
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.2
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.3 b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.3
new file mode 100644
index 0000000000..d690c59365
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.3
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.4 b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.4
new file mode 100644
index 0000000000..c61526e1b7
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.4
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.idx b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.idx
new file mode 100644
index 0000000000..2d3456e88d
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.idx
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.siz b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.siz
new file mode 100644
index 0000000000..dea523e149
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.siz
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/nfs_check.c b/lib/kernel/test/disk_log_SUITE_data/nfs_check.c
new file mode 100644
index 0000000000..31e9ba8190
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/nfs_check.c
@@ -0,0 +1,46 @@
+/*
+ * Author: Patrik Nyblom
+ * Purpose: A port program to check the NFS cache size on VxWorks (returns 0
+ * for other platforms).
+ */
+
+#ifdef VXWORKS
+#include <vxWorks.h>
+#include <taskVarLib.h>
+#include <taskLib.h>
+#include <sysLib.h>
+#include <string.h>
+#include <ioLib.h>
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+
+#ifdef VXWORKS
+extern unsigned nfsCacheSize;
+#define MAIN(argc, argv) nfs_check(argc, argv)
+#else
+#define MAIN(argc, argv) main(argc, argv)
+#endif
+
+
+MAIN(argc, argv)
+int argc;
+char *argv[];
+{
+#ifdef VXWORKS
+ char str[100];
+ sprintf(str,"%d\n", nfsCacheSize);
+ write(1, str, strlen(str));
+#else
+ fprintf(stdout,"0");
+ fflush(stdout);
+#endif
+ return 0;
+}
+
diff --git a/lib/kernel/test/disk_log_SUITE_data/old_terms.LOG b/lib/kernel/test/disk_log_SUITE_data/old_terms.LOG
new file mode 100644
index 0000000000..fffd8c1679
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/old_terms.LOG
Binary files differ
diff --git a/lib/kernel/test/disk_log_SUITE_data/wrap_log_test.erl b/lib/kernel/test/disk_log_SUITE_data/wrap_log_test.erl
new file mode 100644
index 0000000000..e5ff70fd49
--- /dev/null
+++ b/lib/kernel/test/disk_log_SUITE_data/wrap_log_test.erl
@@ -0,0 +1,184 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%----------------------------------------------------------------------
+%%% Purpose : Test wrap_log_reader.erl
+%%%----------------------------------------------------------------------
+
+-module(wrap_log_test).
+
+-export([init/0, stop/0]).
+-define(fsize, 80).
+-define(fno, 4).
+
+%-define(debug, true).
+
+-ifdef(debug).
+-define(format(S, A), io:format(S, A)).
+-else.
+-define(format(S, A), ok).
+-endif.
+
+init() ->
+ spawn(fun() -> start(logger) end),
+ spawn(fun() -> start2(wlt) end),
+ wait_registered(logger),
+ wait_registered(wlt),
+ ok.
+
+wait_registered(Name) ->
+ case whereis(Name) of
+ undefined ->
+ timer:sleep(100),
+ wait_registered(Name);
+ _Pid ->
+ ok
+ end.
+
+stop() ->
+ catch logger ! exit,
+ catch wlt ! exit,
+ wait_unregistered(logger),
+ wait_unregistered(wlt),
+ ok.
+
+wait_unregistered(Name) ->
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _Pid ->
+ timer:sleep(100),
+ wait_unregistered(Name)
+ end.
+
+start(Name) ->
+ ?format("Starting ~p~n", [Name]),
+ register(Name, self()),
+ loop().
+
+start2(Name) ->
+ ?format("Starting ~p~n", [Name]),
+ register(Name, self()),
+ loop2(eof, Name).
+
+loop() ->
+ receive
+ {open, Pid, Name, File} ->
+ R = disk_log:open([{name, Name}, {type, wrap}, {file, File},
+ {size, {?fsize, ?fno}}]),
+ ?format("logger: open ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {open_ext, Pid, Name, File} ->
+ R = disk_log:open([{name, Name}, {type, wrap}, {file, File},
+ {format, external}, {size, {?fsize, ?fno}}]),
+ ?format("logger: open ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {close, Pid, Name} ->
+ R = disk_log:close(Name),
+ ?format("logger: close ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {sync, Pid, Name} ->
+ R = disk_log:sync(Name),
+ ?format("logger: sync ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {log_terms, Pid, Name, Terms} ->
+ R = disk_log:log_terms(Name, Terms),
+ ?format("logger: log_terms ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {blog_terms, Pid, Name, Terms} ->
+ R = disk_log:blog_terms(Name, Terms),
+ ?format("logger: blog_terms ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ exit ->
+ ?format("Stopping logger~n", []),
+ exit(normal);
+
+ _Else ->
+ ?format("logger: ignored: ~p~n", [_Else]),
+ loop()
+ end.
+
+loop2(C, Wlt) ->
+ receive
+ {open, Pid, Name} ->
+ case wrap_log_reader:open(Name) of
+ {ok, R} ->
+ ?format("~p: open ~p -> ~p~n", [Wlt, Name, {ok, R}]),
+ Pid ! {ok, R},
+ loop2(R, Wlt);
+ E ->
+ ?format("~p: open ~p -> ~p~n", [Wlt, Name, E]),
+ Pid ! E,
+ loop2(C, Wlt)
+ end;
+
+ {open, Pid, Name, No} ->
+ case wrap_log_reader:open(Name, No) of
+ {ok, R} ->
+ ?format("~p: open ~p, file ~p -> ~p~n",
+ [Wlt, Name, No, {ok, R}]),
+ Pid ! {ok, R},
+ loop2(R, Wlt);
+ E ->
+ ?format("~p: open ~p, file ~p -> ~p~n",
+ [Wlt, Name, No, E]),
+ Pid ! E,
+ loop2(C, Wlt)
+ end;
+
+ {close, Pid, WR} ->
+ R = wrap_log_reader:close(WR),
+ ?format("~p: close -> ~p~n", [Wlt, R]),
+ Pid ! R,
+ loop2(eof, Wlt);
+
+ {chunk, Pid, WR} ->
+ did_chunk(wrap_log_reader:chunk(WR), Pid, Wlt);
+
+ {chunk, Pid, WR, N} ->
+ did_chunk(wrap_log_reader:chunk(WR, N), Pid, Wlt);
+
+ exit ->
+ ?format("Stopping ~p~n", [Wlt]),
+ exit(normal);
+
+ _Else ->
+ ?format("~p: ignored: ~p~n", [Wlt, _Else]),
+ loop2(C, Wlt)
+ end.
+
+did_chunk({C1, L}, Pid, Wlt) ->
+ ?format("~p: chunk -> ~p~n", [Wlt, {C1, L}]),
+ Pid ! {C1, L},
+ loop2(C1, Wlt);
+did_chunk({C1, L, _Bad}, Pid, Wlt) ->
+ ?format("~p: chunk -> ~p (bad)~n", [Wlt, {C1, L, _Bad}]),
+ Pid ! {C1, L},
+ loop2(C1, Wlt).
diff --git a/lib/kernel/test/erl_boot_server_SUITE.erl b/lib/kernel/test/erl_boot_server_SUITE.erl
new file mode 100644
index 0000000000..241d68fef4
--- /dev/null
+++ b/lib/kernel/test/erl_boot_server_SUITE.erl
@@ -0,0 +1,338 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erl_boot_server_SUITE).
+
+-include("test_server.hrl").
+
+-export([all/1]).
+
+-export([start/1, start_link/1, stop/1, add/1, delete/1, responses/1]).
+
+%%-----------------------------------------------------------------
+%% Test suite for erl_boot_server.
+%%
+%% This module is mainly tested in the erl_prim_loader_SUITE,
+%% but the interface functions are tested here.
+%%
+%% Changed for the new erl_boot_server for R3A by Bjorn Gustavsson.
+%%-----------------------------------------------------------------
+
+all(suite) ->
+ [start, start_link, stop, add, delete, responses].
+
+-define(all_ones, {255, 255, 255, 255}).
+
+start(doc) -> "Tests the erl_boot_server:start/1 function.";
+start(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(50)),
+ ?line [Host1, Host2|_] = good_hosts(Config),
+
+ %% Bad arguments.
+ BadHost = "bad__host",
+ ?line {error, {badarg, {}}} = erl_boot_server:start({}),
+ ?line {error, {badarg, atom}} = erl_boot_server:start(atom),
+ ?line {error, {badarg, [atom, BadHost]}} =
+ erl_boot_server:start([atom, BadHost]),
+ ?line {error, {badarg, [Host1, BadHost]}} =
+ erl_boot_server:start([Host1, BadHost]),
+
+ %% Test once.
+ ?line {ok, Pid1} = erl_boot_server:start([Host1]),
+ ?line {error, {already_started, Pid1}} =
+ erl_boot_server:start([Host1]),
+ ?line exit(Pid1, kill),
+
+ %% Test again.
+ test_server:sleep(1),
+ ?line {ok, Pid2} = erl_boot_server:start([Host1, Host2]),
+ ?line {error, {already_started, Pid2}} =
+ erl_boot_server:start([Host1, Host2]),
+ ?line exit(Pid2, kill),
+ test_server:sleep(1),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+start_link(doc) -> "Tests the erl_boot_server:start_link/1 function.";
+start_link(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line [Host1, Host2|_] = good_hosts(Config),
+
+ OldFlag = process_flag(trap_exit, true),
+ ?line {error, {badarg, {}}} = erl_boot_server:start_link({}),
+ ?line {error, {badarg, atom}} = erl_boot_server:start_link(atom),
+ ?line BadHost = "bad__host",
+ ?line {error, {badarg, [atom, BadHost]}} =
+ erl_boot_server:start_link([atom, BadHost]),
+
+ ?line {ok, Pid1} = erl_boot_server:start_link([Host1]),
+ ?line {error, {already_started, Pid1}} =
+ erl_boot_server:start_link([Host1]),
+ ?line shutdown(Pid1),
+
+ ?line {ok, Pid2} = erl_boot_server:start_link([Host1, Host2]),
+ ?line {error, {already_started, Pid2}} =
+ erl_boot_server:start_link([Host1, Host2]),
+ ?line shutdown(Pid2),
+ process_flag(trap_exit, OldFlag),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+stop(doc) -> "Tests that no processes are left if a boot server is killed.";
+stop(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(50)),
+ ?line [Host1|_] = good_hosts(Config),
+
+ %% Start a boot server and kill it. Make sure that any helper processes
+ %% dies.
+ % Make sure the inet_gethost_native server is already started,
+ % otherwise it will make this test fail:
+ ?line inet:getaddr(localhost, inet),
+ ?line Before = processes(),
+ ?line {ok, Pid} = erl_boot_server:start([Host1]),
+ ?line New = processes() -- [Pid|Before],
+ ?line exit(Pid, kill),
+ ?line receive after 100 -> ok end,
+ ?line case [P || P <- New, is_process_alive(P)] of
+ [] ->
+ ok;
+ NotKilled ->
+ test_server:fail({not_killed, NotKilled})
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+add(doc) -> "Tests the erl_boot_server:add/1 function.";
+add(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line OldFlag = process_flag(trap_exit, true),
+ ?line {ok, Pid1} = erl_boot_server:start_link([]),
+ ?line [] = erl_boot_server:which_slaves(),
+ ?line [Host1, Host2, Host3|_] = good_hosts(Config),
+
+ %% Try bad values.
+ ?line {error, {badarg, {}}} = erl_boot_server:add_slave({}),
+ ?line {error, {badarg, [atom]}} = erl_boot_server:add_slave([atom]),
+ ?line BadHost = "bad__host",
+ ?line {error, {badarg, BadHost}} = erl_boot_server:add_slave(BadHost),
+ ?line [] = erl_boot_server:which_slaves(),
+
+ %% Add good host names.
+ ?line {ok, Ip1} = inet:getaddr(Host1, inet),
+ ?line {ok, Ip2} = inet:getaddr(Host2, inet),
+ ?line {ok, Ip3} = inet:getaddr(Host3, inet),
+ ?line MIp1 = {?all_ones, Ip1},
+ ?line MIp2 = {?all_ones, Ip2},
+ ?line MIp3 = {?all_ones, Ip3},
+ ?line ok = erl_boot_server:add_slave(Host1),
+ ?line [MIp1] = erl_boot_server:which_slaves(),
+ ?line ok = erl_boot_server:add_slave(Host2),
+ ?line M_Ip1_Ip2 = lists:sort([MIp1, MIp2]),
+ ?line M_Ip1_Ip2 = lists:sort(erl_boot_server:which_slaves()),
+ ?line ok = erl_boot_server:add_slave(Host3),
+ ?line M_Ip1_Ip2_Ip3 = lists:sort([MIp3|M_Ip1_Ip2]),
+ ?line M_Ip1_Ip2_Ip3 = erl_boot_server:which_slaves(),
+
+ %% Add duplicate names.
+ ?line ok = erl_boot_server:add_slave(Host3),
+ ?line M_Ip1_Ip2_Ip3 = erl_boot_server:which_slaves(),
+
+ %% More bad names.
+ ?line {error, {badarg, BadHost}} = erl_boot_server:add_slave(BadHost),
+ ?line M_Ip1_Ip2_Ip3 = erl_boot_server:which_slaves(),
+
+ %% Cleanup.
+ ?line shutdown(Pid1),
+ ?line process_flag(trap_exit, OldFlag),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+delete(doc) -> "Tests the erl_boot_server:delete/1 function.";
+delete(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line OldFlag = process_flag(trap_exit, true),
+
+ ?line [Host1, Host2, Host3|_] = good_hosts(Config),
+ ?line {ok, Ip1} = inet:getaddr(Host1, inet),
+ ?line {ok, Ip2} = inet:getaddr(Host2, inet),
+ ?line {ok, Ip3} = inet:getaddr(Host3, inet),
+ ?line MIp1 = {?all_ones, Ip1},
+ ?line MIp2 = {?all_ones, Ip2},
+ ?line MIp3 = {?all_ones, Ip3},
+
+ ?line {ok, Pid1} = erl_boot_server:start_link([Host1, Host2, Host3]),
+ ?line M_Ip123 = lists:sort([MIp1, MIp2, MIp3]),
+ ?line M_Ip123 = erl_boot_server:which_slaves(),
+
+ %% Do some bad attempts and check that the list of slaves is intact.
+ ?line {error, {badarg, {}}} = erl_boot_server:delete_slave({}),
+ ?line {error, {badarg, [atom]}} = erl_boot_server:delete_slave([atom]),
+ ?line BadHost = "bad__host",
+ ?line {error, {badarg, BadHost}} = erl_boot_server:delete_slave(BadHost),
+ ?line M_Ip123 = erl_boot_server:which_slaves(),
+
+ %% Delete Host2 and make sure it's gone.
+ ?line ok = erl_boot_server:delete_slave(Host2),
+ ?line M_Ip13 = lists:sort([MIp1, MIp3]),
+ ?line M_Ip13 = erl_boot_server:which_slaves(),
+
+ ?line ok = erl_boot_server:delete_slave(Host1),
+ ?line [MIp3] = erl_boot_server:which_slaves(),
+ ?line ok = erl_boot_server:delete_slave(Host1),
+ ?line [MIp3] = erl_boot_server:which_slaves(),
+
+ ?line {error, {badarg, BadHost}} = erl_boot_server:delete_slave(BadHost),
+ ?line [MIp3] = erl_boot_server:which_slaves(),
+
+ ?line ok = erl_boot_server:delete_slave(Ip3),
+ ?line [] = erl_boot_server:which_slaves(),
+ ?line ok = erl_boot_server:delete_slave(Ip3),
+ ?line [] = erl_boot_server:which_slaves(),
+
+ ?line shutdown(Pid1),
+ ?line process_flag(trap_exit, OldFlag),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+responses(doc) -> "Tests erl_boot_server responses to slave requests.";
+responses(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(30)),
+ ?line process_flag(trap_exit, true),
+ %% Copy from inet_boot.hrl
+ EBOOT_PORT = 4368,
+ EBOOT_REQUEST = "EBOOTQ",
+ EBOOT_REPLY = "EBOOTR",
+
+ ?line {ok,Host} = inet:gethostname(),
+ ?line {ok,Ip} = inet:getaddr(Host, inet),
+
+ ThisVer = erlang:system_info(version),
+
+ ?line {ok,BootPid} = erl_boot_server:start_link([Host]),
+
+ %% Send junk
+ ?line S1 = open_udp(),
+ ?line prim_inet:sendto(S1, Ip, EBOOT_PORT, ["0"]),
+ receive
+ What ->
+ ?line close_udp(S1),
+ ?line ?t:fail({"got unexpected response",What})
+ after 100 ->
+ ok
+ end,
+
+ %% Req from a slave with same erlang vsn.
+ ?line S2 = open_udp(),
+ ?line prim_inet:sendto(S2, Ip, EBOOT_PORT, [EBOOT_REQUEST,ThisVer]),
+ receive
+ {udp,S2,Ip,_Port1,Resp1} ->
+ ?line close_udp(S2),
+ ?line EBOOT_REPLY = string:substr(Resp1, 1, length(EBOOT_REPLY)),
+ ?line Rest1 = string:substr(Resp1, length(EBOOT_REPLY)+1, length(Resp1)),
+ ?line [_,_,_ | ThisVer] = Rest1
+ after 2000 ->
+ ?line close_udp(S2),
+ ?line ?t:fail("no boot server response; same vsn")
+ end,
+
+ %% Req from a slave with other erlang vsn.
+ ?line S3 = open_udp(),
+ ?line prim_inet:sendto(S3, Ip, EBOOT_PORT, [EBOOT_REQUEST,"1.0"]),
+ receive
+ Anything ->
+ ?line close_udp(S3),
+ ?line ?t:fail({"got unexpected response",Anything})
+ after 100 ->
+ ok
+ end,
+
+ %% Kill the boot server and wait for it to disappear.
+ ?line unlink(BootPid),
+ ?line BootPidMref = erlang:monitor(process, BootPid),
+ ?line exit(BootPid, kill),
+ receive
+ {'DOWN',BootPidMref,_,_,_} -> ok
+ end,
+
+ ?line {ok,BootPid2} = erl_boot_server:start_link(["127.0.0.1"]),
+
+ %% Req from slave with invalid ip address.
+ ?line S4 = open_udp(),
+ Ret =
+ case Ip of
+ {127,0,0,1} ->
+ {comment,"IP address for this host is 127.0.0.1"};
+ _ ->
+ ?line prim_inet:sendto(S4, Ip, EBOOT_PORT,
+ [EBOOT_REQUEST,ThisVer]),
+ receive
+ Huh ->
+ ?line close_udp(S4),
+ ?line ?t:fail({"got unexpected response",Huh})
+ after 100 ->
+ ok
+ end
+ end,
+
+ ?line unlink(BootPid2),
+ ?line exit(BootPid2, kill),
+
+ %% Now wait for any late unexpected messages.
+ receive
+ Whatever ->
+ ?line ?t:fail({unexpected_message,Whatever})
+ after 4000 ->
+ ?line close_udp(S1),
+ ?line close_udp(S3),
+ ?line close_udp(S4),
+ ok
+ end,
+
+ ?line test_server:timetrap_cancel(Dog),
+ Ret.
+
+shutdown(Pid) ->
+ exit(Pid, shutdown),
+ receive
+ {'EXIT', Pid, shutdown} ->
+ ok
+ after 1000 ->
+ %% The timeout used to be 1 ms, which could be too short time for the
+ %% SMP emulator on a slow computer with one CPU.
+ test_server:fail(shutdown)
+ end.
+
+good_hosts(_Config) ->
+ %% XXX The hostnames should not be hard-coded like this. Really!
+
+ {ok, GoodHost1} = inet:gethostname(),
+ GoodHost2 = "gandalf",
+ GoodHost3 = "sauron",
+ [GoodHost1, GoodHost2, GoodHost3].
+
+open_udp() ->
+ ?line {ok, S} = prim_inet:open(udp, inet),
+ ?line ok = prim_inet:setopts(S, [{mode,list},{active,true},
+ {deliver,term},{broadcast,true}]),
+ ?line {ok,_} = prim_inet:bind(S, {0,0,0,0}, 0),
+ S.
+
+close_udp(S) ->
+ prim_inet:close(S).
diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl
new file mode 100644
index 0000000000..8f2e2512e0
--- /dev/null
+++ b/lib/kernel/test/erl_distribution_SUITE.erl
@@ -0,0 +1,1235 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erl_distribution_SUITE).
+
+%-define(line_trace, 1).
+-include("test_server.hrl").
+
+-export([all/1]).
+
+-export([tick/1, tick_change/1, illegal_nodenames/1, hidden_node/1,
+ table_waste/1, net_setuptime/1,
+ monitor_nodes/1,
+ monitor_nodes_nodedown_reason/1,
+ monitor_nodes_complex_nodedown_reason/1,
+ monitor_nodes_node_type/1,
+ monitor_nodes_misc/1,
+ monitor_nodes_otp_6481/1,
+ monitor_nodes_errors/1,
+ monitor_nodes_combinations/1,
+ monitor_nodes_cleanup/1,
+ monitor_nodes_many/1]).
+
+%% Performs the test at another node.
+-export([tick_cli_test/1, tick_cli_test1/1,
+ tick_serv_test/2, tick_serv_test1/1,
+ keep_conn/1, time_ping/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+-export([start_node/2]).
+
+-export([pinger/1]).
+
+
+-define(DUMMY_NODE,dummy@test01).
+
+%%-----------------------------------------------------------------
+%% The distribution is mainly tested in the big old test_suite.
+%% This test only tests the net_ticktime configuration flag.
+%% Should be started in a CC view with:
+%% erl -sname master -rsh ctrsh
+%%-----------------------------------------------------------------
+
+all(suite) ->
+ [tick, tick_change, illegal_nodenames, hidden_node,
+ table_waste, net_setuptime,
+ monitor_nodes].
+
+init_per_testcase(Func, Config) when atom(Func), list(Config) ->
+ Dog=?t:timetrap(?t:minutes(4)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog).
+
+tick(suite) -> [];
+tick(doc) -> [];
+tick(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(120)),
+ PaDir = filename:dirname(code:which(erl_distribution_SUITE)),
+
+ %% First check that the normal case is OK!
+ ?line {ok, Node} = start_node(dist_test, "-pa " ++ PaDir),
+ rpc:call(Node, erl_distribution_SUITE, tick_cli_test, [node()]),
+
+ erlang:monitor_node(Node, true),
+ receive
+ {nodedown, Node} ->
+ test_server:fail("nodedown from other node")
+ after 30000 ->
+ erlang:monitor_node(Node, false),
+ stop_node(Node)
+ end,
+
+ %% Now, set the net_ticktime for the other node to 12 secs.
+ %% After the sleep(2sec) and cast the other node shall destroy
+ %% the connection as it has not received anything on the connection.
+ %% The nodedown message should arrive within 8 < T < 16 secs.
+
+ %% We must have two slave nodes as the slave mechanism otherwise
+ %% halts the client node after tick timeout (the connection is down
+ %% and the slave node decides to halt !!
+
+ %% Set the ticktime on the server node to 100 secs so the server
+ %% node doesn't tick the client node within the interval ...
+
+ ?line {ok, ServNode} = start_node(dist_test_server,
+ "-kernel net_ticktime 100 "
+ "-pa " ++ PaDir),
+ rpc:call(ServNode, erl_distribution_SUITE, tick_serv_test, [Node, node()]),
+
+ ?line {ok, _} = start_node(dist_test,
+ "-kernel net_ticktime 12 "
+ "-pa " ++ PaDir),
+ rpc:call(Node, erl_distribution_SUITE, tick_cli_test, [ServNode]),
+
+ spawn_link(erl_distribution_SUITE, keep_conn, [Node]),
+
+ {tick_serv, ServNode} ! {i_want_the_result, self()},
+
+ monitor_node(ServNode, true),
+ monitor_node(Node, true),
+
+ receive
+ {tick_test, T} when integer(T) ->
+ stop_node(ServNode),
+ stop_node(Node),
+ T;
+ {tick_test, Error} ->
+ stop_node(ServNode),
+ stop_node(Node),
+ test_server:fail(Error);
+ {nodedown, Node} ->
+ stop_node(ServNode),
+ test_server:fail("client node died");
+ {nodedown, ServNode} ->
+ stop_node(Node),
+ test_server:fail("server node died")
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+table_waste(doc) ->
+ ["Checks that pinging nonexistyent nodes does not waste space in distribution table"];
+table_waste(suite) ->
+ [];
+table_waste(Config) when list(Config) ->
+ ?line {ok, HName} = inet:gethostname(),
+ F = fun(0,_F) -> [];
+ (N,F) ->
+ ?line Name = list_to_atom("erl_distribution_"++integer_to_list(N)++
+ "@"++HName),
+ ?line pang = net_adm:ping(Name),
+ ?line F(N-1,F)
+ end,
+ ?line F(256,F),
+ ?line {ok, N} = start_node(erl_distribution_300,""),
+ ?line stop_node(N),
+ ok.
+
+
+
+illegal_nodenames(doc) ->
+ ["Test that pinging an illegal nodename does not kill the node"];
+illegal_nodenames(suite) ->
+ [];
+illegal_nodenames(Config) when list(Config) ->
+ ?line Dog=?t:timetrap(?t:minutes(2)),
+ PaDir = filename:dirname(code:which(erl_distribution_SUITE)),
+ ?line {ok, Node}=start_node(illegal_nodenames, "-pa " ++ PaDir),
+ monitor_node(Node, true),
+ ?line RPid=rpc:call(Node, erlang, spawn,
+ [?MODULE, pinger, [self()]]),
+ receive
+ {RPid, pinged} ->
+ ok;
+ {nodedown, Node} ->
+ ?t:fail("Remote node died.")
+ end,
+ stop_node(Node),
+ ?t:timetrap_cancel(Dog),
+ ok.
+
+pinger(Starter) ->
+ io:format("Starter:~p~n",[Starter]),
+ net_adm:ping(a@b@c),
+ Starter ! {self(), pinged},
+ ok.
+
+
+net_setuptime(doc) -> ["Test that you can set the net_setuptime properly"];
+net_setuptime(Config) when is_list(Config) ->
+ %% In this test case, we reluctantly accept shorter times than the given
+ %% setup time, because the connection attempt can end in a
+ %% "Host unreachable" error before the timeout fires.
+
+ Res0 = do_test_setuptime("2"),
+ io:format("Res0 = ~p", [Res0]),
+ ?line true = (Res0 =< 4000),
+ Res1 = do_test_setuptime("0.3"),
+ io:format("Res1 = ~p", [Res1]),
+ ?line true = (Res1 =< 500),
+ ok.
+
+do_test_setuptime(Setuptime) when is_list(Setuptime) ->
+ ?line PaDir = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = start_node(dist_setuptime_test, "-pa " ++ PaDir ++
+ " -kernel net_setuptime " ++ Setuptime),
+ ?line Res = rpc:call(Node,?MODULE,time_ping,[?DUMMY_NODE]),
+ ?line stop_node(Node),
+ Res.
+
+time_ping(Node) ->
+ T0 = erlang:now(),
+ pang = net_adm:ping(Node),
+ T1 = erlang:now(),
+ time_diff(T0,T1).
+
+
+%% Keep the connection with the client node up.
+%% This is neccessary as the client node runs with much shorter
+%% tick time !!
+keep_conn(Node) ->
+ sleep(1),
+ rpc:cast(Node, erlang, time, []),
+ keep_conn(Node).
+
+tick_serv_test(Node, MasterNode) ->
+ spawn(erl_distribution_SUITE, keep_conn, [MasterNode]),
+ spawn(erl_distribution_SUITE, tick_serv_test1, [Node]).
+
+tick_serv_test1(Node) ->
+ register(tick_serv, self()),
+ TestServer = receive {i_want_the_result, TS} -> TS end,
+ monitor_node(Node, true),
+ receive
+ {nodedown, Node} ->
+ net_adm:ping(Node), %% Set up the connection again !!
+
+ {tick_test, Node} ! {whats_the_result, self()},
+ receive
+ {tick_test, Res} ->
+ TestServer ! {tick_test, Res}
+ end
+ end.
+
+tick_cli_test(Node) ->
+ spawn(erl_distribution_SUITE, tick_cli_test1, [Node]).
+
+tick_cli_test1(Node) ->
+ register(tick_test, self()),
+ erlang:monitor_node(Node, true),
+ sleep(2),
+ rpc:call(Node, erlang, time, []), %% simulate action on the connection
+ T1 = now(),
+ receive
+ {nodedown, Node} ->
+ T2 = now(),
+ receive
+ {whats_the_result, From} ->
+ case time_diff(T1, T2) of
+ T when T > 8000, T < 16000 ->
+ From ! {tick_test, T};
+ T ->
+ From ! {tick_test,
+ {"T not in interval 8000 < T < 16000",
+ T}}
+ end
+ end
+ end.
+
+
+tick_change(doc) -> ["OTP-4255"];
+tick_change(suite) -> [];
+tick_change(Config) when list(Config) ->
+ ?line PaDir = filename:dirname(code:which(?MODULE)),
+ ?line [BN, CN] = get_nodenames(2, tick_change),
+ ?line DefaultTT = net_kernel:get_net_ticktime(),
+ ?line case DefaultTT of
+ I when integer(I) -> ?line ok;
+ _ -> ?line ?t:fail(DefaultTT)
+ end,
+
+ % In case other nodes are connected
+ case nodes(connected) of
+ [] -> ?line net_kernel:set_net_ticktime(10, 0);
+ _ -> ?line rpc:multicall(nodes([this, connected]), net_kernel,
+ set_net_ticktime, [10, 5])
+ end,
+
+ ?line wait_until(fun () -> 10 == net_kernel:get_net_ticktime() end),
+ ?line {ok, B} = start_node(BN, "-kernel net_ticktime 10 -pa " ++ PaDir),
+ ?line {ok, C} = start_node(CN, "-kernel net_ticktime 10 -hidden -pa "
+ ++ PaDir),
+
+ ?line OTE = process_flag(trap_exit, true),
+ case catch begin
+ ?line run_tick_change_test(B, C, 10, 1, PaDir),
+ ?line run_tick_change_test(B, C, 1, 10, PaDir)
+ end of
+ {'EXIT', Reason} ->
+ ?line stop_node(B),
+ ?line stop_node(C),
+ %% In case other nodes are connected
+ case nodes(connected) of
+ [] -> ?line net_kernel:set_net_ticktime(DefaultTT, 0);
+ _ -> ?line rpc:multicall(nodes([this, connected]), net_kernel,
+ set_net_ticktime, [DefaultTT, 10])
+ end,
+ ?line wait_until(fun () ->
+ DefaultTT == net_kernel:get_net_ticktime()
+ end),
+ ?line process_flag(trap_exit, OTE),
+ ?t:fail(Reason);
+ _ ->
+ ok
+ end,
+ ?line process_flag(trap_exit, OTE),
+ ?line stop_node(B),
+ ?line stop_node(C),
+
+ % In case other nodes are connected
+ case nodes(connected) of
+ [] -> ?line net_kernel:set_net_ticktime(DefaultTT, 0);
+ _ -> ?line rpc:multicall(nodes([this, connected]), net_kernel,
+ set_net_ticktime, [DefaultTT, 5])
+ end,
+
+ ?line wait_until(fun () -> DefaultTT == net_kernel:get_net_ticktime() end),
+ ?line ok.
+
+
+wait_for_nodedowns(Tester, Ref) ->
+ receive
+ {nodedown, Node} ->
+ ?t:format("~p~n", [{node(), {nodedown, Node}}]),
+ ?line Tester ! {Ref, {node(), {nodedown, Node}}}
+ end,
+ wait_for_nodedowns(Tester, Ref).
+
+run_tick_change_test(B, C, PrevTT, TT, PaDir) ->
+ ?line [DN, EN] = get_nodenames(2, tick_change),
+
+ ?line Tester = self(),
+ ?line Ref = make_ref(),
+ ?line MonitorNodes = fun (Nodes) ->
+ ?line lists:foreach(
+ fun (N) ->
+ ?line monitor_node(N,true)
+ end,
+ Nodes),
+ wait_for_nodedowns(Tester, Ref)
+ end,
+
+ ?line {ok, D} = start_node(DN, "-kernel net_ticktime "
+ ++ integer_to_list(PrevTT) ++ " -pa " ++ PaDir),
+
+ ?line NMA = spawn_link(fun () -> MonitorNodes([B, C, D]) end),
+ ?line NMB = spawn_link(B, fun () -> MonitorNodes([node(), C, D]) end),
+ ?line NMC = spawn_link(C, fun () -> MonitorNodes([node(), B, D]) end),
+
+ ?line MaxTT = case PrevTT > TT of
+ true -> ?line PrevTT;
+ false -> ?line TT
+ end,
+
+ ?line CheckResult = make_ref(),
+ ?line spawn_link(fun () ->
+ receive
+ after (25 + MaxTT)*1000 ->
+ Tester ! CheckResult
+ end
+ end),
+
+ % In case other nodes than these are connected
+ case nodes(connected) -- [B, C, D] of
+ [] -> ?line ok;
+ OtherNodes -> ?line rpc:multicall(OtherNodes, net_kernel,
+ set_net_ticktime, [TT, 20])
+ end,
+
+ ?line change_initiated = net_kernel:set_net_ticktime(TT,20),
+ ?line sleep(3),
+ ?line change_initiated = rpc:call(B,net_kernel,set_net_ticktime,[TT,15]),
+ ?line sleep(7),
+ ?line change_initiated = rpc:call(C,net_kernel,set_net_ticktime,[TT,10]),
+
+ ?line {ok, E} = start_node(EN, "-kernel net_ticktime "
+ ++ integer_to_list(TT) ++ " -pa " ++ PaDir),
+ ?line NME = spawn_link(E, fun () -> MonitorNodes([node(), B, C, D]) end),
+ ?line NMA2 = spawn_link(fun () -> MonitorNodes([E]) end),
+ ?line NMB2 = spawn_link(B, fun () -> MonitorNodes([E]) end),
+ ?line NMC2 = spawn_link(C, fun () -> MonitorNodes([E]) end),
+
+ receive CheckResult -> ?line ok end,
+
+ ?line unlink(NMA), exit(NMA, kill),
+ ?line unlink(NMB), exit(NMB, kill),
+ ?line unlink(NMC), exit(NMC, kill),
+ ?line unlink(NME), exit(NME, kill),
+ ?line unlink(NMA2), exit(NMA2, kill),
+ ?line unlink(NMB2), exit(NMB2, kill),
+ ?line unlink(NMC2), exit(NMC2, kill),
+
+ %% The node not changing ticktime should have been disconnected from the
+ %% other nodes
+ receive {Ref, {Node, {nodedown, D}}} when Node == node() -> ?line ok
+ after 0 -> ?line exit({?LINE, no_nodedown})
+ end,
+ receive {Ref, {B, {nodedown, D}}} -> ?line ok
+ after 0 -> ?line exit({?LINE, no_nodedown})
+ end,
+ receive {Ref, {C, {nodedown, D}}} -> ?line ok
+ after 0 -> ?line exit({?LINE, no_nodedown})
+ end,
+ receive {Ref, {E, {nodedown, D}}} -> ?line ok
+ after 0 -> ?line exit({?LINE, no_nodedown})
+ end,
+
+ %% No other connections should have been broken
+ receive
+ {Ref, Reason} ->
+ ?line stop_node(E),
+ ?line exit({?LINE, Reason});
+ {'EXIT', Pid, Reason} when Pid == NMA;
+ Pid == NMB;
+ Pid == NMC;
+ Pid == NME;
+ Pid == NMA2;
+ Pid == NMB2;
+ Pid == NMC2 ->
+ ?line stop_node(E),
+
+ ?line exit({?LINE, {node(Pid), Reason}})
+ after 0 ->
+ ?line TT = net_kernel:get_net_ticktime(),
+ ?line TT = rpc:call(B, net_kernel, get_net_ticktime, []),
+ ?line TT = rpc:call(C, net_kernel, get_net_ticktime, []),
+ ?line TT = rpc:call(E, net_kernel, get_net_ticktime, []),
+ ?line stop_node(E),
+ ?line ok
+ end.
+
+%%
+%% Basic tests of hidden node.
+%%
+hidden_node(doc) ->
+ ["Basic test of hidden node"];
+hidden_node(suite) ->
+ [];
+hidden_node(Config) when list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(40)),
+ PaDir = filename:dirname(code:which(?MODULE)),
+ VArgs = "-pa " ++ PaDir,
+ HArgs = "-hidden -pa " ++ PaDir,
+ ?line {ok, V} = start_node(visible_node, VArgs),
+ VMN = start_monitor_nodes_proc(V),
+ ?line {ok, H} = start_node(hidden_node, HArgs),
+ % Connect visible_node -> hidden_node
+ connect_nodes(V, H),
+ test_nodes(V, H),
+ stop_node(H),
+ sleep(5),
+ check_monitor_nodes_res(VMN, H),
+ stop_node(V),
+ ?line {ok, H} = start_node(hidden_node, HArgs),
+ HMN = start_monitor_nodes_proc(H),
+ ?line {ok, V} = start_node(visible_node, VArgs),
+ % Connect hidden_node -> visible_node
+ connect_nodes(H, V),
+ test_nodes(V, H),
+ stop_node(V),
+ sleep(5),
+ check_monitor_nodes_res(HMN, V),
+ stop_node(H),
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+connect_nodes(A, B) ->
+ % Check that they haven't already connected.
+ ?line false = lists:member(A, rpc:call(B, erlang, nodes, [connected])),
+ ?line false = lists:member(B, rpc:call(A, erlang, nodes, [connected])),
+ % Connect them.
+ ?line pong = rpc:call(A, net_adm, ping, [B]).
+
+
+test_nodes(V, H) ->
+ % No nodes should be visible on hidden_node
+ ?line [] = rpc:call(H, erlang, nodes, []),
+ % visible_node should be hidden on hidden_node
+ ?line true = lists:member(V, rpc:call(H, erlang, nodes, [hidden])),
+ % hidden_node node shouldn't be visible on visible_node
+ ?line false = lists:member(H, rpc:call(V, erlang, nodes, [])),
+ % hidden_node should be hidden on visible_node
+ ?line true = lists:member(H, rpc:call(V, erlang, nodes, [hidden])).
+
+mn_loop(MNs) ->
+ receive
+ {nodeup, N} ->
+ mn_loop([{nodeup, N}|MNs]);
+ {nodedown, N} ->
+ mn_loop([{nodedown, N}|MNs]);
+ {monitor_nodes_result, Ref, From} ->
+ From ! {Ref, MNs};
+ _ ->
+ mn_loop(MNs)
+ end.
+
+start_monitor_nodes_proc(Node) ->
+ Ref = make_ref(),
+ Starter = self(),
+ Pid = spawn(Node,
+ fun() ->
+ net_kernel:monitor_nodes(true),
+ Starter ! Ref,
+ mn_loop([])
+ end),
+ receive
+ Ref ->
+ ok
+ end,
+ Pid.
+
+
+check_monitor_nodes_res(Pid, Node) ->
+ Ref = make_ref(),
+ Pid ! {monitor_nodes_result, Ref, self()},
+ receive
+ {Ref, MNs} ->
+ ?line false = lists:keysearch(Node, 2, MNs)
+ end.
+
+
+monitor_nodes(doc) ->
+ [];
+monitor_nodes(suite) ->
+ [monitor_nodes_nodedown_reason,
+ monitor_nodes_complex_nodedown_reason,
+ monitor_nodes_node_type,
+ monitor_nodes_misc,
+ monitor_nodes_otp_6481,
+ monitor_nodes_errors,
+ monitor_nodes_combinations,
+ monitor_nodes_cleanup,
+ monitor_nodes_many].
+
+%%
+%% Testcase:
+%% monitor_nodes_nodedown_reason
+%%
+
+monitor_nodes_nodedown_reason(doc) -> [];
+monitor_nodes_nodedown_reason(suite) -> [];
+monitor_nodes_nodedown_reason(Config) when list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok = net_kernel:monitor_nodes(true),
+ ?line ok = net_kernel:monitor_nodes(true, [nodedown_reason]),
+
+ ?line Names = get_numbered_nodenames(5, node),
+ ?line [NN1, NN2, NN3, NN4, NN5] = Names,
+
+ ?line {ok, N1} = start_node(NN1),
+ ?line {ok, N2} = start_node(NN2),
+ ?line {ok, N3} = start_node(NN3),
+ ?line {ok, N4} = start_node(NN4, "-hidden"),
+
+ ?line receive {nodeup, N1} -> ok end,
+ ?line receive {nodeup, N2} -> ok end,
+ ?line receive {nodeup, N3} -> ok end,
+
+ ?line receive {nodeup, N1, []} -> ok end,
+ ?line receive {nodeup, N2, []} -> ok end,
+ ?line receive {nodeup, N3, []} -> ok end,
+
+ ?line stop_node(N1),
+ ?line stop_node(N4),
+ ?line true = net_kernel:disconnect(N2),
+ ?line TickTime = net_kernel:get_net_ticktime(),
+ ?line SleepTime = TickTime + (TickTime div 4),
+ ?line spawn(N3, fun () ->
+ block_emu(SleepTime*1000),
+ halt()
+ end),
+
+ ?line receive {nodedown, N1} -> ok end,
+ ?line receive {nodedown, N2} -> ok end,
+ ?line receive {nodedown, N3} -> ok end,
+
+ ?line receive {nodedown, N1, [{nodedown_reason, R1}]} -> connection_closed = R1 end,
+ ?line receive {nodedown, N2, [{nodedown_reason, R2}]} -> disconnect = R2 end,
+ ?line receive {nodedown, N3, [{nodedown_reason, R3}]} -> net_tick_timeout = R3 end,
+
+ ?line ok = net_kernel:monitor_nodes(false, [nodedown_reason]),
+
+ ?line {ok, N5} = start_node(NN5),
+ ?line stop_node(N5),
+
+ ?line receive {nodeup, N5} -> ok end,
+ ?line receive {nodedown, N5} -> ok end,
+ ?line print_my_messages(),
+ ?line ok = check_no_nodedown_nodeup(1000),
+ ?line ok = net_kernel:monitor_nodes(false),
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok.
+
+
+monitor_nodes_complex_nodedown_reason(doc) -> [];
+monitor_nodes_complex_nodedown_reason(suite) -> [];
+monitor_nodes_complex_nodedown_reason(Config) when list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line Me = self(),
+ ?line ok = net_kernel:monitor_nodes(true, [nodedown_reason]),
+ ?line [Name] = get_nodenames(1, monitor_nodes_complex_nodedown_reason),
+ ?line {ok, Node} = start_node(Name, ""),
+ ?line Pid = spawn(Node,
+ fun() ->
+ Me ! {stuff,
+ self(),
+ [make_ref(),
+ {processes(), erlang:ports()}]}
+ end),
+ ?line receive {nodeup, Node, []} -> ok end,
+ ?line {ok, NodeInfo} = net_kernel:node_info(Node),
+ ?line {value,{owner, Owner}} = lists:keysearch(owner, 1, NodeInfo),
+ ?line ComplexTerm = receive {stuff, Pid, _} = Msg ->
+ {Msg, term_to_binary(Msg)}
+ end,
+ ?line exit(Owner, ComplexTerm),
+ ?line receive
+ {nodedown, Node, [{nodedown_reason, NodeDownReason}]} ->
+ ?line ok
+ end,
+ %% If the complex nodedown_reason messed something up garbage collections
+ %% are likely to dump core
+ ?line garbage_collect(),
+ ?line garbage_collect(),
+ ?line garbage_collect(),
+ ?line ComplexTerm = NodeDownReason,
+ ?line ok = net_kernel:monitor_nodes(false, [nodedown_reason]),
+ ?line no_msgs(),
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok.
+
+
+
+
+%%
+%% Testcase:
+%% monitor_nodes_node_type
+%%
+
+monitor_nodes_node_type(doc) -> [];
+monitor_nodes_node_type(suite) -> [];
+monitor_nodes_node_type(Config) when is_list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok = net_kernel:monitor_nodes(true),
+ ?line ok = net_kernel:monitor_nodes(true, [{node_type, all}]),
+ ?line Names = get_numbered_nodenames(9, node),
+% ?line ?t:format("Names: ~p~n", [Names]),
+ ?line [NN1, NN2, NN3, NN4, NN5, NN6, NN7, NN8, NN9] = Names,
+
+ ?line {ok, N1} = start_node(NN1),
+ ?line {ok, N2} = start_node(NN2),
+ ?line {ok, N3} = start_node(NN3, "-hidden"),
+ ?line {ok, N4} = start_node(NN4, "-hidden"),
+
+ ?line receive {nodeup, N1} -> ok end,
+ ?line receive {nodeup, N2} -> ok end,
+
+ ?line receive {nodeup, N1, [{node_type, visible}]} -> ok end,
+ ?line receive {nodeup, N2, [{node_type, visible}]} -> ok end,
+ ?line receive {nodeup, N3, [{node_type, hidden}]} -> ok end,
+ ?line receive {nodeup, N4, [{node_type, hidden}]} -> ok end,
+
+ ?line stop_node(N1),
+ ?line stop_node(N2),
+ ?line stop_node(N3),
+ ?line stop_node(N4),
+
+ ?line receive {nodedown, N1} -> ok end,
+ ?line receive {nodedown, N2} -> ok end,
+
+ ?line receive {nodedown, N1, [{node_type, visible}]} -> ok end,
+ ?line receive {nodedown, N2, [{node_type, visible}]} -> ok end,
+ ?line receive {nodedown, N3, [{node_type, hidden}]} -> ok end,
+ ?line receive {nodedown, N4, [{node_type, hidden}]} -> ok end,
+
+ ?line ok = net_kernel:monitor_nodes(false, [{node_type, all}]),
+ ?line {ok, N5} = start_node(NN5),
+
+ ?line receive {nodeup, N5} -> ok end,
+ ?line stop_node(N5),
+ ?line receive {nodedown, N5} -> ok end,
+
+ ?line ok = net_kernel:monitor_nodes(true, [{node_type, hidden}]),
+ ?line {ok, N6} = start_node(NN6),
+ ?line {ok, N7} = start_node(NN7, "-hidden"),
+
+
+ ?line receive {nodeup, N6} -> ok end,
+ ?line receive {nodeup, N7, [{node_type, hidden}]} -> ok end,
+ ?line stop_node(N6),
+ ?line stop_node(N7),
+
+ ?line receive {nodedown, N6} -> ok end,
+ ?line receive {nodedown, N7, [{node_type, hidden}]} -> ok end,
+
+ ?line ok = net_kernel:monitor_nodes(true, [{node_type, visible}]),
+ ?line ok = net_kernel:monitor_nodes(false, [{node_type, hidden}]),
+ ?line ok = net_kernel:monitor_nodes(false),
+
+ ?line {ok, N8} = start_node(NN8),
+ ?line {ok, N9} = start_node(NN9, "-hidden"),
+
+ ?line receive {nodeup, N8, [{node_type, visible}]} -> ok end,
+ ?line stop_node(N8),
+ ?line stop_node(N9),
+
+ ?line receive {nodedown, N8, [{node_type, visible}]} -> ok end,
+ ?line print_my_messages(),
+ ?line ok = check_no_nodedown_nodeup(1000),
+ ?line ok = net_kernel:monitor_nodes(false, [{node_type, visible}]),
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok.
+
+
+%%
+%% Testcase:
+%% monitor_nodes
+%%
+
+monitor_nodes_misc(doc) -> [];
+monitor_nodes_misc(suite) -> [];
+monitor_nodes_misc(Config) when is_list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok = net_kernel:monitor_nodes(true),
+ ?line ok = net_kernel:monitor_nodes(true, [{node_type, all}, nodedown_reason]),
+ ?line ok = net_kernel:monitor_nodes(true, [nodedown_reason, {node_type, all}]),
+ ?line Names = get_numbered_nodenames(3, node),
+% ?line ?t:format("Names: ~p~n", [Names]),
+ ?line [NN1, NN2, NN3] = Names,
+
+ ?line {ok, N1} = start_node(NN1),
+ ?line {ok, N2} = start_node(NN2, "-hidden"),
+
+ ?line receive {nodeup, N1} -> ok end,
+
+ ?line receive {nodeup, N1, [{node_type, visible}]} -> ok end,
+ ?line receive {nodeup, N1, [{node_type, visible}]} -> ok end,
+ ?line receive {nodeup, N2, [{node_type, hidden}]} -> ok end,
+ ?line receive {nodeup, N2, [{node_type, hidden}]} -> ok end,
+
+ ?line stop_node(N1),
+ ?line stop_node(N2),
+
+ ?line VisbleDownInfo = lists:sort([{node_type, visible},
+ {nodedown_reason, connection_closed}]),
+ ?line HiddenDownInfo = lists:sort([{node_type, hidden},
+ {nodedown_reason, connection_closed}]),
+
+ ?line receive {nodedown, N1} -> ok end,
+
+ ?line receive {nodedown, N1, Info1A} -> VisbleDownInfo = lists:sort(Info1A) end,
+ ?line receive {nodedown, N1, Info1B} -> VisbleDownInfo = lists:sort(Info1B) end,
+ ?line receive {nodedown, N2, Info2A} -> HiddenDownInfo = lists:sort(Info2A) end,
+ ?line receive {nodedown, N2, Info2B} -> HiddenDownInfo = lists:sort(Info2B) end,
+
+ ?line ok = net_kernel:monitor_nodes(false, [{node_type, all}, nodedown_reason]),
+
+ ?line {ok, N3} = start_node(NN3),
+ ?line receive {nodeup, N3} -> ok end,
+ ?line stop_node(N3),
+ ?line receive {nodedown, N3} -> ok end,
+ ?line print_my_messages(),
+ ?line ok = check_no_nodedown_nodeup(1000),
+ ?line ok = net_kernel:monitor_nodes(false),
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok.
+
+
+monitor_nodes_otp_6481(doc) ->
+ ["Tests that {nodeup, Node} messages are received before "
+ "messages from Node and that {nodedown, Node} messages are"
+ "received after messages from Node"];
+monitor_nodes_otp_6481(suite) ->
+ [];
+monitor_nodes_otp_6481(Config) when is_list(Config) ->
+ ?line ?t:format("Testing nodedown...~n"),
+ ?line monitor_nodes_otp_6481_test(Config, nodedown),
+ ?line ?t:format("ok~n"),
+ ?line ?t:format("Testing nodeup...~n"),
+ ?line monitor_nodes_otp_6481_test(Config, nodeup),
+ ?line ?t:format("ok~n"),
+ ?line ok.
+
+monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line NodeMsg = make_ref(),
+ ?line Me = self(),
+ ?line [Name] = get_nodenames(1, monitor_nodes_otp_6481),
+ ?line case TestType of
+ nodedown -> ?line ok = net_kernel:monitor_nodes(true);
+ nodeup -> ?line ok
+ end,
+ ?line Seq = lists:seq(1,10000),
+ ?line MN = spawn_link(
+ fun () ->
+ ?line lists:foreach(
+ fun (_) ->
+ ?line ok = net_kernel:monitor_nodes(true)
+ end,
+ Seq),
+ ?line Me ! {mon_set, self()},
+ ?line receive after infinity -> ok end
+ end),
+ ?line receive {mon_set, MN} -> ok end,
+ ?line case TestType of
+ nodedown -> ?line ok;
+ nodeup -> ?line ok = net_kernel:monitor_nodes(true)
+ end,
+
+ %% Whitebox:
+ %% nodedown test: Since this process was the first one monitoring
+ %% nodes this process will be the first one notified
+ %% on nodedown.
+ %% nodeup test: Since this process was the last one monitoring
+ %% nodes this process will be the last one notified
+ %% on nodeup
+
+ %% Verify the monitor_nodes order expected
+ ?line TestMonNodeState = monitor_node_state(),
+ %?line ?t:format("~p~n", [TestMonNodeState]),
+ ?line TestMonNodeState =
+ MonNodeState
+ ++ case TestType of
+ nodedown -> [{self(), []}];
+ nodeup -> []
+ end
+ ++ lists:map(fun (_) -> {MN, []} end, Seq)
+ ++ case TestType of
+ nodedown -> [];
+ nodeup -> [{self(), []}]
+ end,
+
+
+ ?line {ok, Node} = start_node(Name, "", this),
+ ?line receive {nodeup, Node} -> ok end,
+
+ ?line spawn(Node,
+ fun () ->
+ receive after 1000 -> ok end,
+ lists:foreach(fun (No) ->
+ Me ! {NodeMsg, No}
+ end,
+ Seq),
+ halt()
+ end),
+
+ ?line net_kernel:disconnect(Node),
+ ?line receive {nodedown, Node} -> ok end,
+
+ %% Verify that '{nodeup, Node}' comes before '{NodeMsg, 1}' (the message
+ %% bringing up the connection).
+ %%?line no_msgs(500), % Why wait? It fails test sometimes /sverker
+ ?line {nodeup, Node} = receive Msg1 -> Msg1 end,
+ ?line {NodeMsg, 1} = receive Msg2 -> Msg2 end,
+
+ %% Verify that '{nodedown, Node}' comes after the last '{NodeMsg, N}'
+ %% message.
+ ?line {nodedown, Node} = flush_node_msgs(NodeMsg, 2),
+ ?line no_msgs(500),
+
+ ?line Mon = erlang:monitor(process, MN),
+ ?line unlink(MN),
+ ?line exit(MN, bang),
+ ?line receive {'DOWN', Mon, process, MN, bang} -> ok end,
+ ?line ok = net_kernel:monitor_nodes(false),
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok.
+
+flush_node_msgs(NodeMsg, No) ->
+ case receive Msg -> Msg end of
+ {NodeMsg, No} -> flush_node_msgs(NodeMsg, No+1);
+ OtherMsg -> OtherMsg
+ end.
+
+monitor_nodes_errors(doc) ->
+ [];
+monitor_nodes_errors(suite) ->
+ [];
+monitor_nodes_errors(Config) when list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line error = net_kernel:monitor_nodes(asdf),
+ ?line {error,
+ {unknown_options,
+ [gurka]}} = net_kernel:monitor_nodes(true,
+ [gurka]),
+ ?line {error,
+ {options_not_a_list,
+ gurka}} = net_kernel:monitor_nodes(true,
+ gurka),
+ ?line {error,
+ {option_value_mismatch,
+ [{node_type,visible},
+ {node_type,hidden}]}}
+ = net_kernel:monitor_nodes(true,
+ [{node_type,hidden},
+ {node_type,visible}]),
+ ?line {error,
+ {option_value_mismatch,
+ [{node_type,visible},
+ {node_type,all}]}}
+ = net_kernel:monitor_nodes(true,
+ [{node_type,all},
+ {node_type,visible}]),
+ ?line {error,
+ {bad_option_value,
+ {node_type,
+ blaha}}}
+ = net_kernel:monitor_nodes(true, [{node_type, blaha}]),
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok.
+
+monitor_nodes_combinations(doc) ->
+ [];
+monitor_nodes_combinations(suite) ->
+ [];
+monitor_nodes_combinations(Config) when list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line monitor_nodes_all_comb(true),
+ ?line [VisibleName, HiddenName] = get_nodenames(2,
+ monitor_nodes_combinations),
+ ?line {ok, Visible} = start_node(VisibleName, ""),
+ ?line receive_all_comb_nodeup_msgs(visible, Visible),
+ ?line no_msgs(),
+ ?line stop_node(Visible),
+ ?line receive_all_comb_nodedown_msgs(visible, Visible, connection_closed),
+ ?line no_msgs(),
+ ?line {ok, Hidden} = start_node(HiddenName, "-hidden"),
+ ?line receive_all_comb_nodeup_msgs(hidden, Hidden),
+ ?line no_msgs(),
+ ?line stop_node(Hidden),
+ ?line receive_all_comb_nodedown_msgs(hidden, Hidden, connection_closed),
+ ?line no_msgs(),
+ ?line monitor_nodes_all_comb(false),
+ ?line MonNodeState = monitor_node_state(),
+ ?line no_msgs(),
+ ?line ok.
+
+monitor_nodes_all_comb(Flag) ->
+ ?line ok = net_kernel:monitor_nodes(Flag),
+ ?line ok = net_kernel:monitor_nodes(Flag,
+ [nodedown_reason]),
+ ?line ok = net_kernel:monitor_nodes(Flag,
+ [{node_type, hidden}]),
+ ?line ok = net_kernel:monitor_nodes(Flag,
+ [{node_type, visible}]),
+ ?line ok = net_kernel:monitor_nodes(Flag,
+ [{node_type, all}]),
+ ?line ok = net_kernel:monitor_nodes(Flag,
+ [nodedown_reason,
+ {node_type, hidden}]),
+ ?line ok = net_kernel:monitor_nodes(Flag,
+ [nodedown_reason,
+ {node_type, visible}]),
+ ?line ok = net_kernel:monitor_nodes(Flag,
+ [nodedown_reason,
+ {node_type, all}]),
+ %% There currently are 8 different combinations
+ ?line 8.
+
+
+receive_all_comb_nodeup_msgs(visible, Node) ->
+ ?t:format("Receive nodeup visible...~n"),
+ Exp = [{nodeup, Node},
+ {nodeup, Node, []}]
+ ++ mk_exp_mn_all_comb_nodeup_msgs_common(visible, Node),
+ receive_mn_msgs(Exp),
+ ?t:format("ok~n"),
+ ok;
+receive_all_comb_nodeup_msgs(hidden, Node) ->
+ ?t:format("Receive nodeup hidden...~n"),
+ Exp = mk_exp_mn_all_comb_nodeup_msgs_common(hidden, Node),
+ receive_mn_msgs(Exp),
+ ?t:format("ok~n"),
+ ok.
+
+mk_exp_mn_all_comb_nodeup_msgs_common(Type, Node) ->
+ InfoNt = [{node_type, Type}],
+ [{nodeup, Node, InfoNt},
+ {nodeup, Node, InfoNt},
+ {nodeup, Node, InfoNt},
+ {nodeup, Node, InfoNt}].
+
+receive_all_comb_nodedown_msgs(visible, Node, Reason) ->
+ ?t:format("Receive nodedown visible...~n"),
+ Exp = [{nodedown, Node},
+ {nodedown, Node, [{nodedown_reason, Reason}]}]
+ ++ mk_exp_mn_all_comb_nodedown_msgs_common(visible,
+ Node,
+ Reason),
+ receive_mn_msgs(Exp),
+ ?t:format("ok~n"),
+ ok;
+receive_all_comb_nodedown_msgs(hidden, Node, Reason) ->
+ ?t:format("Receive nodedown hidden...~n"),
+ Exp = mk_exp_mn_all_comb_nodedown_msgs_common(hidden, Node, Reason),
+ receive_mn_msgs(Exp),
+ ?t:format("ok~n"),
+ ok.
+
+mk_exp_mn_all_comb_nodedown_msgs_common(Type, Node, Reason) ->
+ InfoNt = [{node_type, Type}],
+ InfoNdrNt = lists:sort([{nodedown_reason, Reason}]++InfoNt),
+ [{nodedown, Node, InfoNt},
+ {nodedown, Node, InfoNt},
+ {nodedown, Node, InfoNdrNt},
+ {nodedown, Node, InfoNdrNt}].
+
+receive_mn_msgs([]) ->
+ ok;
+receive_mn_msgs(Msgs) ->
+ ?t:format("Expecting msgs: ~p~n", [Msgs]),
+ receive
+ {_Dir, _Node} = Msg ->
+ ?t:format("received ~p~n", [Msg]),
+ case lists:member(Msg, Msgs) of
+ true -> receive_mn_msgs(lists:delete(Msg, Msgs));
+ false -> ?t:fail({unexpected_message, Msg,
+ expected_messages, Msgs})
+ end;
+ {Dir, Node, Info} ->
+ Msg = {Dir, Node, lists:sort(Info)},
+ ?t:format("received ~p~n", [Msg]),
+ case lists:member(Msg, Msgs) of
+ true -> receive_mn_msgs(lists:delete(Msg, Msgs));
+ false -> ?t:fail({unexpected_message, Msg,
+ expected_messages, Msgs})
+ end;
+ Msg ->
+ ?t:format("received ~p~n", [Msg]),
+ ?t:fail({unexpected_message, Msg,
+ expected_messages, Msgs})
+ end.
+
+monitor_nodes_cleanup(doc) ->
+ [];
+monitor_nodes_cleanup(suite) ->
+ [];
+monitor_nodes_cleanup(Config) when list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line Me = self(),
+ ?line No = monitor_nodes_all_comb(true),
+ ?line Inf = spawn(fun () ->
+ monitor_nodes_all_comb(true),
+ Me ! {mons_set, self()},
+ receive after infinity -> ok end
+ end),
+ ?line TO = spawn(fun () ->
+ monitor_nodes_all_comb(true),
+ Me ! {mons_set, self()},
+ receive after 500 -> ok end
+ end),
+ ?line receive {mons_set, Inf} -> ok end,
+ ?line receive {mons_set, TO} -> ok end,
+ ?line MNLen = length(MonNodeState) + No*3,
+ ?line MNLen = length(monitor_node_state()),
+ ?line MonInf = erlang:monitor(process, Inf),
+ ?line MonTO = erlang:monitor(process, TO),
+ ?line exit(Inf, bang),
+ ?line No = monitor_nodes_all_comb(false),
+ ?line receive {'DOWN', MonInf, process, Inf, bang} -> ok end,
+ ?line receive {'DOWN', MonTO, process, TO, normal} -> ok end,
+ ?line MonNodeState = monitor_node_state(),
+ ?line no_msgs(),
+ ?line ok.
+
+monitor_nodes_many(doc) ->
+ [];
+monitor_nodes_many(suite) ->
+ [];
+monitor_nodes_many(Config) when list(Config) ->
+ ?line MonNodeState = monitor_node_state(),
+ ?line [Name] = get_nodenames(1, monitor_nodes_many),
+ %% We want to perform more than 2^16 net_kernel:monitor_nodes
+ %% since this will wrap an internal counter
+ ?line No = (1 bsl 16) + 17,
+ ?line repeat(fun () -> ok = net_kernel:monitor_nodes(true) end, No),
+ ?line No = length(monitor_node_state()) - length(MonNodeState),
+ ?line {ok, Node} = start_node(Name),
+ ?line repeat(fun () -> receive {nodeup, Node} -> ok end end, No),
+ ?line stop_node(Node),
+ ?line repeat(fun () -> receive {nodedown, Node} -> ok end end, No),
+ ?line ok = net_kernel:monitor_nodes(false),
+ ?line no_msgs(10),
+ ?line MonNodeState = monitor_node_state(),
+ ?line ok.
+
+%% Misc. functions
+
+monitor_node_state() ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ MonitoringNodes = erts_debug:get_internal_state(monitoring_nodes),
+ erts_debug:set_internal_state(available_internal_state, false),
+ MonitoringNodes.
+
+
+check_no_nodedown_nodeup(TimeOut) ->
+ ?line receive
+ {nodeup, _, _} = Msg -> ?line ?t:fail({unexpected_nodeup, Msg});
+ {nodeup, _} = Msg -> ?line ?t:fail({unexpected_nodeup, Msg});
+ {nodedown, _, _} = Msg -> ?line ?t:fail({unexpected_nodedown, Msg});
+ {nodedown, _} = Msg -> ?line ?t:fail({unexpected_nodedown, Msg})
+ after TimeOut ->
+ ok
+ end.
+
+print_my_messages() ->
+ ?line {messages, Messages} = process_info(self(), messages),
+ ?line ?t:format("Messages: ~p~n", [Messages]),
+ ?line ok.
+
+%% Time difference in milliseconds !!
+time_diff({TimeM, TimeS, TimeU}, {CurM, CurS, CurU}) when CurM > TimeM ->
+ ((CurM - TimeM) * 1000000000) + sec_diff({TimeS, TimeU}, {CurS, CurU});
+time_diff({_, TimeS, TimeU}, {_, CurS, CurU}) ->
+ sec_diff({TimeS, TimeU}, {CurS, CurU}).
+
+sec_diff({TimeS, TimeU}, {CurS, CurU}) when CurS > TimeS ->
+ ((CurS - TimeS) * 1000) + micro_diff(TimeU, CurU);
+sec_diff({_, TimeU}, {_, CurU}) ->
+ micro_diff(TimeU, CurU).
+
+micro_diff(TimeU, CurU) ->
+ trunc(CurU/1000) - trunc(TimeU/1000).
+
+sleep(T) -> receive after T * 1000 -> ok end.
+
+start_node(Name, Param, this) ->
+ NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)),
+ ?t:start_node(Name, peer, [{args, NewParam}, {erl, [this]}]);
+start_node(Name, Param, "this") ->
+ NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)),
+ ?t:start_node(Name, peer, [{args, NewParam}, {erl, [this]}]);
+start_node(Name, Param, Rel) when atom(Rel) ->
+ NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)),
+ ?t:start_node(Name, peer, [{args, NewParam}, {erl, [{release, atom_to_list(Rel)}]}]);
+start_node(Name, Param, Rel) when list(Rel) ->
+ NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)),
+ ?t:start_node(Name, peer, [{args, NewParam}, {erl, [{release, Rel}]}]).
+
+start_node(Name, Param) ->
+ NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)),
+ ?t:start_node(Name, slave, [{args, NewParam}]).
+% M = list_to_atom(from($@, atom_to_list(node()))),
+% slave:start_link(M, Name, Param).
+
+start_node(Name) ->
+ start_node(Name, "").
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
+% erlang:monitor_node(Node, true),
+% rpc:cast(Node, init, stop, []),
+% receive
+% {nodedown, Node} ->
+% ok
+% after 10000 ->
+% test_server:fail({stop_node, Node})
+% end.
+
+% from(H, [H | T]) -> T;
+% from(H, [_ | T]) -> from(H, T);
+% from(H, []) -> [].
+
+get_nodenames(N, T) ->
+ get_nodenames(N, T, []).
+
+get_nodenames(0, _, Acc) ->
+ Acc;
+get_nodenames(N, T, Acc) ->
+ {A, B, C} = now(),
+ get_nodenames(N-1, T, [list_to_atom(atom_to_list(T)
+ ++ "-"
+ ++ atom_to_list(?MODULE)
+ ++ "-"
+ ++ integer_to_list(A)
+ ++ "-"
+ ++ integer_to_list(B)
+ ++ "-"
+ ++ integer_to_list(C)) | Acc]).
+
+get_numbered_nodenames(N, T) ->
+ get_numbered_nodenames(N, T, []).
+
+get_numbered_nodenames(0, _, Acc) ->
+ Acc;
+get_numbered_nodenames(N, T, Acc) ->
+ {A, B, C} = now(),
+ NL = [list_to_atom(atom_to_list(T) ++ integer_to_list(N)
+ ++ "-"
+ ++ atom_to_list(?MODULE)
+ ++ "-"
+ ++ integer_to_list(A)
+ ++ "-"
+ ++ integer_to_list(B)
+ ++ "-"
+ ++ integer_to_list(C)) | Acc],
+ get_numbered_nodenames(N-1, T, NL).
+
+wait_until(Fun) ->
+ case Fun() of
+ true ->
+ ok;
+ _ ->
+ receive
+ after 100 ->
+ wait_until(Fun)
+ end
+ end.
+
+repeat(Fun, 0) when function(Fun) ->
+ ok;
+repeat(Fun, N) when function(Fun), integer(N), N > 0 ->
+ Fun(),
+ repeat(Fun, N-1).
+
+no_msgs(Wait) ->
+ receive after Wait -> no_msgs() end.
+
+no_msgs() ->
+ {messages, []} = process_info(self(), messages).
+
+block_emu(Ms) ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ Res = erts_debug:set_internal_state(block, Ms),
+ erts_debug:set_internal_state(available_internal_state, false),
+ Res.
diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl
new file mode 100644
index 0000000000..627fed1fdd
--- /dev/null
+++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl
@@ -0,0 +1,705 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erl_distribution_wb_SUITE).
+
+-include("test_server.hrl").
+-include_lib("kernel/include/inet.hrl").
+
+-export([all/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2, whitebox/1,
+ switch_options/1, missing_compulsory_dflags/1]).
+
+%% 1)
+%%
+%% Connections are now always set up symetrically with respect to
+%% publication. If connecting node doesn't send DFLAG_PUBLISHED
+%% the other node wont send DFLAG_PUBLISHED. If the connecting
+%% node send DFLAG_PUBLISHED but the other node doesn't send
+%% DFLAG_PUBLISHED, the connecting node should consider its
+%% DFLAG_PUBLISHED as dropped, i.e the connecting node wont be
+%% published on the other node.
+
+-define(to_port(Socket, Data),
+ case inet_tcp:send(Socket, Data) of
+ {error, closed} ->
+ self() ! {tcp_closed, Socket},
+ {error, closed};
+ R ->
+ R
+ end).
+
+-define(DFLAG_PUBLISHED,1).
+-define(DFLAG_ATOM_CACHE,2).
+-define(DFLAG_EXTENDED_REFERENCES,4).
+-define(DFLAG_DIST_MONITOR,8).
+-define(DFLAG_FUN_TAGS,16#10).
+-define(DFLAG_DIST_MONITOR_NAME,16#20).
+-define(DFLAG_HIDDEN_ATOM_CACHE,16#40).
+-define(DFLAG_NEW_FUN_TAGS,16#80).
+-define(DFLAG_EXTENDED_PIDS_PORTS,16#100).
+
+%% From R9 and forward extended references is compulsory
+%% From R10 and forward extended pids and ports are compulsory
+-define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor ?DFLAG_EXTENDED_PIDS_PORTS)).
+
+
+-define(shutdown(X), exit(X)).
+-define(int16(X), [((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(int32(X),
+ [((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff,
+ ((X) bsr 8) band 16#ff, (X) band 16#ff]).
+
+-define(i16(X1,X0),
+ (?u16(X1,X0) -
+ (if (X1) > 127 -> 16#10000; true -> 0 end))).
+
+-define(u16(X1,X0),
+ (((X1) bsl 8) bor (X0))).
+
+-define(u32(X3,X2,X1,X0),
+ (((X3) bsl 24) bor ((X2) bsl 16) bor ((X1) bsl 8) bor (X0))).
+
+all(suite) ->
+ [whitebox,switch_options,missing_compulsory_dflags].
+
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ Dog=?t:timetrap(?t:minutes(1)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog).
+
+switch_options(doc) ->
+ ["Tests switching of options for the tcp port, as this is done"
+ " when the distribution port is to be shortcut into the emulator."
+ " Maybe this should be in the inet test suite, but only the distribution"
+ " does such horrible things..."];
+switch_options(Config) when is_list(Config) ->
+ ok = test_switch_active(),
+ ok = test_switch_active_partial() ,
+ ok = test_switch_active_and_packet(),
+ ok.
+
+
+whitebox(doc) ->
+ ["Whitebox testing of distribution handshakes. Tests both BC with R5 and "
+ "the md5 version. Note that after R6B, this should be revised to "
+ "remove BC code."];
+whitebox(Config) when is_list(Config) ->
+ ?line {ok, Node} = start_node(?MODULE,""),
+ ?line Cookie = erlang:get_cookie(),
+ ?line {_,Host} = split(node()),
+ ?line ok = pending_up_md5(Node, join(ccc,Host), Cookie),
+ ?line ok = simultaneous_md5(Node, join('A',Host), Cookie),
+ ?line ok = simultaneous_md5(Node, join(zzzzzzzzzzzzzz,Host), Cookie),
+ ?line stop_node(Node),
+ ok.
+
+%%
+%% The actual tests
+%%
+
+%%
+%% Switch tcp options test
+%%
+
+test_switch_active() ->
+ ?line {Client, Server} = socket_pair(0, 4),
+ ?line ok = write_packets_32(Client, 1, 5),
+ receive after 2000 -> ok end,
+ ?line ok = read_packets(Server, 1, 1),
+ receive after 2000 -> ok end,
+ ?line ok = read_packets(Server, 2, 2),
+ ?line inet:setopts(Server, [{active, true}]),
+ ?line ok = receive_packets(Server, 3, 5),
+ close_pair({Client, Server}),
+ ok.
+
+test_switch_active_partial() ->
+ ?line {Client, Server} = socket_pair(0, 4),
+ ?line ok = write_packets_32(Client, 1, 2),
+ ?line ok = gen_tcp:send(Client,[?int32(4), [0,0,0]]),
+ receive after 2000 -> ok end,
+ ?line ok = read_packets(Server, 1, 1),
+ receive after 2000 -> ok end,
+ ?line ok = read_packets(Server, 2, 2),
+ ?line inet:setopts(Server, [{active, true}]),
+ ?line ok = gen_tcp:send(Client,[3]),
+ ?line ok = write_packets_32(Client, 4, 5),
+ ?line ok = receive_packets(Server, 3, 5),
+ close_pair({Client, Server}),
+ ok.
+
+do_test_switch_active_and_packet(SendBefore, SendAfter) ->
+ ?line {Client, Server} = socket_pair(0, 2),
+ ?line ok = write_packets_16(Client, 1, 2),
+ ?line ok = gen_tcp:send(Client,SendBefore),
+ receive after 2000 -> ok end,
+ ?line ok = read_packets(Server, 1, 1),
+ receive after 2000 -> ok end,
+ ?line ok = read_packets(Server, 2, 2),
+ ?line inet:setopts(Server, [{packet,4}, {active, true}]),
+ ?line ok = gen_tcp:send(Client,SendAfter),
+ ?line ok = write_packets_32(Client, 4, 5),
+ ?line ok = receive_packets(Server, 3, 5),
+ close_pair({Client, Server}),
+ ok.
+
+test_switch_active_and_packet() ->
+ ?line ok = do_test_switch_active_and_packet([0],[0,0,4,0,0,0,3]),
+ ?line ok = do_test_switch_active_and_packet([0,0],[0,4,0,0,0,3]),
+ ?line ok = do_test_switch_active_and_packet([0,0,0],[4,0,0,0,3]),
+ ?line ok = do_test_switch_active_and_packet([0,0,0,4],[0,0,0,3]),
+ ?line ok = do_test_switch_active_and_packet([0,0,0,4,0],[0,0,3]),
+ ?line ok = do_test_switch_active_and_packet([0,0,0,4,0,0],[0,3]),
+ ?line ok = do_test_switch_active_and_packet([0,0,0,4,0,0,0],[3]),
+ ?line ok = do_test_switch_active_and_packet([0,0,0,4,0,0,0,3],[]),
+ ok.
+
+
+%%
+%% Handshake tests
+%%
+pending_up_md5(Node,OurName,Cookie) ->
+ ?line {NA,NB} = split(Node),
+ ?line {port,PortNo,_} = erl_epmd:port_please(NA,NB),
+ ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo,
+ [{active,false},
+ {packet,2}]),
+ ?line send_name(SocketA,OurName,5),
+ ?line ok = recv_status(SocketA),
+ ?line {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1)
+ ?line OurChallengeA = gen_challenge(),
+ ?line OurDigestA = gen_digest(HisChallengeA, Cookie),
+ ?line send_challenge_reply(SocketA, OurChallengeA, OurDigestA),
+ ?line ok = recv_challenge_ack(SocketA, OurChallengeA, Cookie),
+ %%%
+ %%% OK, one connection is up, now lets be nasty and try another up:
+ %%%
+ %%% But wait for a while, the other node might not have done setnode
+ %%% just yet...
+ ?line receive after 1000 -> ok end,
+ ?line {ok, SocketB} = gen_tcp:connect(atom_to_list(NB),PortNo,
+ [{active,false},
+ {packet,2}]),
+ ?line send_name(SocketB,OurName,5),
+ ?line alive = recv_status(SocketB),
+ ?line send_status(SocketB, true),
+ ?line gen_tcp:close(SocketA),
+ ?line {hidden,Node,5,HisChallengeB} = recv_challenge(SocketB), % See 1)
+ ?line OurChallengeB = gen_challenge(),
+ ?line OurDigestB = gen_digest(HisChallengeB, Cookie),
+ ?line send_challenge_reply(SocketB, OurChallengeB, OurDigestB),
+ ?line ok = recv_challenge_ack(SocketB, OurChallengeB, Cookie),
+ %%%
+ %%% Well, are we happy?
+ %%%
+
+ ?line inet:setopts(SocketB, [{active, false},
+ {packet, 4}]),
+ ?line gen_tcp:send(SocketB,build_rex_message('',OurName)),
+ ?line {Header, Message} = recv_message(SocketB),
+ ?line io:format("Received header ~p, data ~p.~n",
+ [Header, Message]),
+ ?line gen_tcp:close(SocketB),
+ ok.
+
+simultaneous_md5(Node, OurName, Cookie) when OurName < Node ->
+ ?line pong = net_adm:ping(Node),
+ ?line LSocket = case gen_tcp:listen(0, [{active, false}, {packet,2}]) of
+ {ok, Socket} ->
+ Socket;
+ Else ->
+ exit(Else)
+ end,
+ ?line EpmdSocket = register(OurName, LSocket, 1, 5),
+ ?line {NA, NB} = split(Node),
+ ?line rpc:cast(Node, net_adm, ping, [OurName]),
+ ?line receive after 1000 -> ok end,
+ ?line {port, PortNo, _} = erl_epmd:port_please(NA,NB),
+ ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo,
+ [{active,false},
+ {packet,2}]),
+ ?line send_name(SocketA,OurName,5),
+ %% We are still not marked up on the other side, as our first message
+ %% is not sent.
+ ?line SocketB = case gen_tcp:accept(LSocket) of
+ {ok, Socket1} ->
+ ?line Socket1;
+ Else2 ->
+ ?line exit(Else2)
+ end,
+ ?line nok = recv_status(SocketA),
+ % Now we are expected to close A
+ ?line gen_tcp:close(SocketA),
+ % But still Socket B will continue
+ ?line {normal,Node,5} = recv_name(SocketB), % See 1)
+ ?line send_status(SocketB, ok_simultaneous),
+ ?line MyChallengeB = gen_challenge(),
+ ?line send_challenge(SocketB, OurName, MyChallengeB,5),
+ ?line HisChallengeB = recv_challenge_reply(SocketB, MyChallengeB, Cookie),
+ ?line DigestB = gen_digest(HisChallengeB,Cookie),
+ ?line send_challenge_ack(SocketB, DigestB),
+ ?line inet:setopts(SocketB, [{active, false},
+ {packet, 4}]),
+ % This should be the ping message.
+ ?line {Header, Message} = recv_message(SocketB),
+ ?line io:format("Received header ~p, data ~p.~n",
+ [Header, Message]),
+ ?line gen_tcp:close(SocketB),
+ ?line gen_tcp:close(LSocket),
+ ?line gen_tcp:close(EpmdSocket),
+ ok;
+
+simultaneous_md5(Node, OurName, Cookie) when OurName > Node ->
+ ?line pong = net_adm:ping(Node),
+ ?line LSocket = case gen_tcp:listen(0, [{active, false}, {packet,2}]) of
+ {ok, Socket} ->
+ ?line Socket;
+ Else ->
+ ?line exit(Else)
+ end,
+ ?line EpmdSocket = register(OurName, LSocket, 1, 5),
+ ?line {NA, NB} = split(Node),
+ ?line rpc:cast(Node, net_adm, ping, [OurName]),
+ ?line receive after 1000 -> ok end,
+ ?line {port, PortNo, _} = erl_epmd:port_please(NA,NB),
+ ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo,
+ [{active,false},
+ {packet,2}]),
+ ?line SocketB = case gen_tcp:accept(LSocket) of
+ {ok, Socket1} ->
+ ?line Socket1;
+ Else2 ->
+ ?line exit(Else2)
+ end,
+ ?line send_name(SocketA,OurName,5),
+ ?line ok_simultaneous = recv_status(SocketA),
+ %% Socket B should die during this
+ ?line case catch begin
+ ?line {normal,Node,5} = recv_name(SocketB), % See 1)
+ ?line send_status(SocketB, ok_simultaneous),
+ ?line MyChallengeB = gen_challenge(),
+ ?line send_challenge(SocketB, OurName, MyChallengeB,
+ 5),
+ ?line HisChallengeB = recv_challenge_reply(
+ SocketB,
+ MyChallengeB,
+ Cookie),
+ ?line DigestB = gen_digest(HisChallengeB,Cookie),
+ ?line send_challenge_ack(SocketB, DigestB),
+ ?line inet:setopts(SocketB, [{active, false},
+ {packet, 4}]),
+ ?line {HeaderB, MessageB} = recv_message(SocketB),
+ ?line io:format("Received header ~p, data ~p.~n",
+ [HeaderB, MessageB])
+ end of
+ {'EXIT', Exitcode} ->
+ ?line io:format("Expected exitsignal caught: ~p.~n",
+ [Exitcode]);
+ Success ->
+ ?line io:format("Unexpected success: ~p~n",
+ [Success]),
+ ?line exit(unexpected_success)
+ end,
+ ?line gen_tcp:close(SocketB),
+ %% But still Socket A will continue
+ ?line {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1)
+ ?line OurChallengeA = gen_challenge(),
+ ?line OurDigestA = gen_digest(HisChallengeA, Cookie),
+ ?line send_challenge_reply(SocketA, OurChallengeA, OurDigestA),
+ ?line ok = recv_challenge_ack(SocketA, OurChallengeA, Cookie),
+
+ ?line inet:setopts(SocketA, [{active, false},
+ {packet, 4}]),
+ ?line gen_tcp:send(SocketA,build_rex_message('',OurName)),
+ ?line {Header, Message} = recv_message(SocketA),
+ ?line io:format("Received header ~p, data ~p.~n",
+ [Header, Message]),
+ ?line gen_tcp:close(SocketA),
+ ?line gen_tcp:close(LSocket),
+ ?line gen_tcp:close(EpmdSocket),
+ ok.
+
+missing_compulsory_dflags(doc) -> [];
+missing_compulsory_dflags(Config) when is_list(Config) ->
+ ?line [Name1, Name2] = get_nodenames(2, missing_compulsory_dflags),
+ ?line {ok, Node} = start_node(Name1,""),
+ ?line {NA,NB} = split(Node),
+ ?line {port,PortNo,_} = erl_epmd:port_please(NA,NB),
+ ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo,
+ [{active,false},
+ {packet,2}]),
+ ?line BadNode = list_to_atom(atom_to_list(Name2)++"@"++atom_to_list(NB)),
+ ?line send_name(SocketA,BadNode,5,0),
+ ?line not_allowed = recv_status(SocketA),
+ ?line gen_tcp:close(SocketA),
+ ?line stop_node(Node),
+ ?line ok.
+
+%%
+%% Here comes the utilities
+%%
+
+%%
+%% Switch option utilities
+%%
+write_packets_32(_, M, N) when M > N ->
+ ok;
+write_packets_32(Sock, M, N) ->
+ ok = gen_tcp:send(Sock,[?int32(4), ?int32(M)]),
+ write_packets_32(Sock, M+1, N).
+
+write_packets_16(_, M, N) when M > N ->
+ ok;
+write_packets_16(Sock, M, N) ->
+ ok = gen_tcp:send(Sock,[?int16(4), ?int32(M)]),
+ write_packets_16(Sock, M+1, N).
+
+read_packets(_, M, N) when M > N ->
+ ok;
+read_packets(Sock, M, N) ->
+ Expected = ?int32(M),
+ case gen_tcp:recv(Sock, 0) of
+ {ok, Expected} ->
+ read_packets(Sock, M+1, N);
+ {ok, Unexpected} ->
+ exit({unexpected_data_read, Unexpected});
+ Error ->
+ exit({error_read, Error})
+ end.
+
+receive_packets(Sock, M, N) when M > N ->
+ receive
+ {tcp, Sock, Data} ->
+ exit({extra_data, Data})
+ after 0 ->
+ ok
+ end;
+
+receive_packets(Sock, M, N) ->
+ Expect = ?int32(M),
+ receive
+ {tcp, Sock, Expect} ->
+ receive_packets(Sock, M+1, N);
+ {tcp, Sock, Unexpected} ->
+ exit({unexpected_data_received, Unexpected})
+ after 500 ->
+ exit({no_data_received_for,M})
+ end.
+
+socket_pair(ClientPack, ServerPack) ->
+ {ok, Listen} = gen_tcp:listen(0, [{active, false},
+ {packet, ServerPack}]),
+ {ok, Host} = inet:gethostname(),
+ {ok, Port} = inet:port(Listen),
+ {ok, Client} = gen_tcp:connect(Host, Port, [{active, false},
+ {packet, ClientPack}]),
+ {ok, Server} = gen_tcp:accept(Listen),
+ gen_tcp:close(Listen),
+ {Client, Server}.
+
+close_pair({Client, Server}) ->
+ gen_tcp:close(Client),
+ gen_tcp:close(Server),
+ ok.
+
+
+%%
+%% Handshake utilities
+%%
+
+%%
+%% MD5 hashing
+%%
+
+%% This is no proper random number, but that is not really important in
+%% this test
+gen_challenge() ->
+ {_,_,N} = erlang:now(),
+ N.
+
+%% Generate a message digest from Challenge number and Cookie
+gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) ->
+ C0 = erlang:md5_init(),
+ C1 = erlang:md5_update(C0, atom_to_list(Cookie)),
+ C2 = erlang:md5_update(C1, integer_to_list(Challenge)),
+ binary_to_list(erlang:md5_final(C2)).
+
+
+%%
+%% The differrent stages of the MD5 handshake
+%%
+
+send_status(Socket, Stat) ->
+ case gen_tcp:send(Socket, [$s | atom_to_list(Stat)]) of
+ {error, _} ->
+ ?shutdown(could_not_send_status);
+ _ ->
+ true
+ end.
+
+
+recv_status(Socket) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok, [$s|StrStat]} ->
+ list_to_atom(StrStat);
+ Bad ->
+ exit(Bad)
+ end.
+
+send_challenge(Socket, Node, Challenge, Version) ->
+ send_challenge(Socket, Node, Challenge, Version, ?COMPULSORY_DFLAGS).
+send_challenge(Socket, Node, Challenge, Version, Flags) ->
+ {ok, {{_Ip1,_Ip2,_Ip3,_Ip4}, _}} = inet:sockname(Socket),
+ ?to_port(Socket, [$n,?int16(Version),?int32(Flags),
+ ?int32(Challenge), atom_to_list(Node)]).
+
+recv_challenge(Socket) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} ->
+ Flags = ?u32(Fl1,Fl2,Fl3,Fl4),
+ Type = case Flags band ?DFLAG_PUBLISHED of
+ 0 ->
+ hidden;
+ _ ->
+ normal
+ end,
+ Node =list_to_atom(Ns),
+ Version = ?u16(V1,V0),
+ Challenge = ?u32(CA3,CA2,CA1,CA0),
+ {Type,Node,Version,Challenge};
+ _ ->
+ ?shutdown(no_node)
+ end.
+
+send_challenge_reply(Socket, Challenge, Digest) ->
+ ?to_port(Socket, [$r,?int32(Challenge),Digest]).
+
+recv_challenge_reply(Socket, ChallengeA, Cookie) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,[$r,CB3,CB2,CB1,CB0 | SumB]} when length(SumB) == 16 ->
+ SumA = gen_digest(ChallengeA, Cookie),
+ ChallengeB = ?u32(CB3,CB2,CB1,CB0),
+ if SumB == SumA ->
+ ChallengeB;
+ true ->
+ ?shutdown(bad_challenge_reply)
+ end;
+ _ ->
+ ?shutdown(no_node)
+ end.
+
+send_challenge_ack(Socket, Digest) ->
+ ?to_port(Socket, [$a,Digest]).
+
+recv_challenge_ack(Socket, ChallengeB, CookieA) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,[$a | SumB]} when length(SumB) == 16 ->
+ SumA = gen_digest(ChallengeB, CookieA),
+ if SumB == SumA ->
+ ok;
+ true ->
+ ?shutdown(bad_challenge_ack)
+ end;
+ _ ->
+ ?shutdown(bad_challenge_ack)
+ end.
+
+send_name(Socket, MyNode0, Version) ->
+ send_name(Socket, MyNode0, Version, ?COMPULSORY_DFLAGS).
+send_name(Socket, MyNode0, Version, Flags) ->
+ MyNode = atom_to_list(MyNode0),
+ ok = ?to_port(Socket, [<<$n,Version:16,Flags:32>>|MyNode]).
+
+%%
+%% recv_name is common for both old and new handshake.
+%%
+recv_name(Socket) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,Data} ->
+ get_name(Data);
+ Res ->
+ ?shutdown({no_node,Res})
+ end.
+
+get_name([$m,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) ->
+ {normal, list_to_atom(OtherNode), ?u16(VersionA,VersionB)};
+get_name([$h,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) ->
+ {hidden, list_to_atom(OtherNode), ?u16(VersionA,VersionB)};
+get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode]) ->
+ Type = case ?u32(Flag1, Flag2, Flag3, Flag4) band ?DFLAG_PUBLISHED of
+ 0 ->
+ hidden;
+ _ ->
+ normal
+ end,
+ {Type, list_to_atom(OtherNode),
+ ?u16(VersionA,VersionB)};
+get_name(Data) ->
+ ?shutdown(Data).
+
+%%
+%% The communication with EPMD follows
+%%
+get_epmd_port() ->
+ case init:get_argument(epmd_port) of
+ {ok, [[PortStr|_]|_]} when is_list(PortStr) ->
+ list_to_integer(PortStr);
+ error ->
+ 4369 % Default epmd port
+ end.
+
+do_register_node(NodeName, TcpPort, VLow, VHigh) ->
+ case gen_tcp:connect({127,0,0,1}, get_epmd_port(), []) of
+ {ok, Socket} ->
+ {N0,_} = split(NodeName),
+ Name = atom_to_list(N0),
+ Extra = "",
+ Elen = length(Extra),
+ Len = 1+2+1+1+2+2+2+length(Name)+2+Elen,
+ gen_tcp:send(Socket, [?int16(Len), $x,
+ ?int16(TcpPort),
+ $M,
+ 0,
+ ?int16(VHigh),
+ ?int16(VLow),
+ ?int16(length(Name)),
+ Name,
+ ?int16(Elen),
+ Extra]),
+ case wait_for_reg_reply(Socket, []) of
+ {error, epmd_close} ->
+ exit(epmd_broken);
+ Other ->
+ Other
+ end;
+ Error ->
+ Error
+ end.
+
+wait_for_reg_reply(Socket, SoFar) ->
+ receive
+ {tcp, Socket, Data0} ->
+ case SoFar ++ Data0 of
+ [$y, Result, A, B] ->
+ case Result of
+ 0 ->
+ {alive, Socket, ?u16(A, B)};
+ _ ->
+ {error, duplicate_name}
+ end;
+ Data when length(Data) < 4 ->
+ wait_for_reg_reply(Socket, Data);
+ Garbage ->
+ {error, {garbage_from_epmd, Garbage}}
+ end;
+ {tcp_closed, Socket} ->
+ {error, epmd_close}
+ after 10000 ->
+ gen_tcp:close(Socket),
+ {error, no_reg_reply_from_epmd}
+ end.
+
+
+register(NodeName, ListenSocket, VLow, VHigh) ->
+ {ok,{_,TcpPort}} = inet:sockname(ListenSocket),
+ case do_register_node(NodeName, TcpPort, VLow, VHigh) of
+ {alive, Socket, _Creation} ->
+ Socket;
+ Other ->
+ exit(Other)
+ end.
+
+
+%%
+%% Utilities
+%%
+
+%% Split a nodename
+split([$@|T],A) ->
+ {lists:reverse(A),T};
+split([H|T],A) ->
+ split(T,[H|A]).
+
+split(Atom) ->
+ {A,B} = split(atom_to_list(Atom),[]),
+ {list_to_atom(A),list_to_atom(B)}.
+
+%% Build a distribution message that will make rex answer
+build_rex_message(Cookie,OurName) ->
+ [$?,term_to_binary({6,self(),Cookie,rex}),
+ term_to_binary({'$gen_cast',
+ {cast,
+ rpc,
+ cast,
+ [OurName, hello, world, []],
+ self()} })].
+
+%% Receive a distribution message
+recv_message(Socket) ->
+ case gen_tcp:recv(Socket, 0) of
+ {ok,Data} ->
+ B0 = list_to_binary(Data),
+ {_,B1} = erlang:split_binary(B0,1),
+ Header = binary_to_term(B1),
+ Siz = byte_size(term_to_binary(Header)),
+ {_,B2} = erlang:split_binary(B1,Siz),
+ Message = case (catch binary_to_term(B2)) of
+ {'EXIT', _} ->
+ could_not_digest_message;
+ Other ->
+ Other
+ end,
+ {Header, Message};
+ Res ->
+ exit({no_message,Res})
+ end.
+
+%% Build a nodename
+join(Name,Host) ->
+ list_to_atom(atom_to_list(Name) ++ "@" ++ atom_to_list(Host)).
+
+%% start/stop slave.
+start_node(Name, Param) ->
+ ?t:start_node(Name, slave, [{args, Param}]).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
+
+
+get_nodenames(N, T) ->
+ get_nodenames(N, T, []).
+
+get_nodenames(0, _, Acc) ->
+ Acc;
+get_nodenames(N, T, Acc) ->
+ {A, B, C} = now(),
+ get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE)
+ ++ "-"
+ ++ atom_to_list(T)
+ ++ "-"
+ ++ integer_to_list(A)
+ ++ "-"
+ ++ integer_to_list(B)
+ ++ "-"
+ ++ integer_to_list(C)) | Acc]).
diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl
new file mode 100644
index 0000000000..4d090f4db5
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE.erl
@@ -0,0 +1,517 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erl_prim_loader_SUITE).
+
+-include_lib("kernel/include/file.hrl").
+-include("test_server.hrl").
+
+-export([all/1]).
+
+-export([get_path/1, set_path/1, get_file/1,
+ inet_existing/1, inet_coming_up/1, inet_disconnects/1,
+ multiple_slaves/1, file_requests/1,
+ local_archive/1, remote_archive/1,
+ primary_archive/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+%%-----------------------------------------------------------------
+%% Test suite for erl_prim_loader. (Most code is run during system start/stop.)
+%%-----------------------------------------------------------------
+
+all(suite) ->
+ [
+ get_path, set_path, get_file,
+ inet_existing, inet_coming_up,
+ inet_disconnects, multiple_slaves,
+ file_requests, local_archive,
+ remote_archive, primary_archive
+ ].
+
+init_per_testcase(Func, Config) when atom(Func), list(Config) ->
+ Dog=?t:timetrap(?t:minutes(3)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog).
+
+get_path(doc) -> [];
+get_path(Config) when is_list(Config) ->
+ ?line case erl_prim_loader:get_path() of
+ {ok, Path} when is_list(Path) ->
+ ok;
+ _ ->
+ test_server:fail(get_path)
+ end,
+ ok.
+
+set_path(doc) -> [];
+set_path(Config) when is_list(Config) ->
+ ?line {ok, Path} = erl_prim_loader:get_path(),
+ ?line ok = erl_prim_loader:set_path(Path),
+ ?line {ok, Path} = erl_prim_loader:get_path(),
+ NewPath = Path ++ ["dummy_dir","/dummy_dir/dummy_dir"],
+ ?line ok = erl_prim_loader:set_path(NewPath),
+ ?line {ok, NewPath} = erl_prim_loader:get_path(),
+
+ ?line ok = erl_prim_loader:set_path(Path), % Reset path.
+ ?line {ok, Path} = erl_prim_loader:get_path(),
+
+ ?line {'EXIT',_} = (catch erl_prim_loader:set_path(not_a_list)),
+ ?line {ok, Path} = erl_prim_loader:get_path(),
+ ok.
+
+get_file(doc) -> [];
+get_file(Config) when is_list(Config) ->
+ ?line case erl_prim_loader:get_file("lists" ++ code:objfile_extension()) of
+ {ok,Bin,File} when binary(Bin), list(File) ->
+ ok;
+ _ ->
+ test_server:fail(get_valid_file)
+ end,
+ ?line error = erl_prim_loader:get_file("duuuuuuummmy_file"),
+ ?line error = erl_prim_loader:get_file(duuuuuuummmy_file),
+ ?line error = erl_prim_loader:get_file({dummy}),
+ ok.
+
+inet_existing(doc) -> ["Start a node using the 'inet' loading method, ",
+ "from an already started boot server."];
+inet_existing(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "VxWorks: tested separately"};
+ _ ->
+ ?line Name = erl_prim_test_inet_existing,
+ ?line Host = host(),
+ ?line Cookie = atom_to_list(erlang:get_cookie()),
+ ?line IpStr = ip_str(Host),
+ ?line LFlag = get_loader_flag(os:type()),
+ ?line Args = LFlag ++ " -hosts " ++ IpStr ++
+ " -setcookie " ++ Cookie,
+ ?line {ok, BootPid} = erl_boot_server:start_link([Host]),
+ ?line {ok, Node} = start_node(Name, Args),
+ ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]),
+ ?line stop_node(Node),
+ ?line unlink(BootPid),
+ ?line exit(BootPid, kill),
+ ok
+ end.
+
+inet_coming_up(doc) -> ["Start a node using the 'inet' loading method, ",
+ "but start the boot server afterwards."];
+inet_coming_up(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "VxWorks: tested separately"};
+ _ ->
+ ?line Name = erl_prim_test_inet_coming_up,
+ ?line Cookie = atom_to_list(erlang:get_cookie()),
+ ?line Host = host(),
+ ?line IpStr = ip_str(Host),
+ ?line LFlag = get_loader_flag(os:type()),
+ ?line Args = LFlag ++
+ " -hosts " ++ IpStr ++
+ " -setcookie " ++ Cookie,
+ ?line {ok, Node} = start_node(Name, Args, [{wait, false}]),
+
+ %% Wait a while, then start boot server, and wait for node to start.
+ ?line test_server:sleep(test_server:seconds(6)),
+ io:format("erl_boot_server:start_link([~p]).", [Host]),
+ ?line {ok, BootPid} = erl_boot_server:start_link([Host]),
+ ?line wait_really_started(Node, 25),
+
+ %% Check loader argument, then cleanup.
+ ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]),
+ ?line stop_node(Node),
+ ?line unlink(BootPid),
+ ?line exit(BootPid, kill),
+ ok
+ end.
+
+wait_really_started(Node, 0) ->
+ test_server:fail({not_booted,Node});
+wait_really_started(Node, N) ->
+ case rpc:call(Node, init, get_status, []) of
+ {started, _} ->
+ ok;
+ _ ->
+ test_server:sleep(1000),
+ wait_really_started(Node, N - 1)
+ end.
+
+inet_disconnects(doc) -> ["Start a node using the 'inet' loading method, ",
+ "then lose the connection."];
+inet_disconnects(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "VxWorks: tested separately"};
+ _ ->
+ ?line Name = erl_prim_test_inet_disconnects,
+ ?line Host = host(),
+ ?line Cookie = atom_to_list(erlang:get_cookie()),
+ ?line IpStr = ip_str(Host),
+ ?line LFlag = get_loader_flag(os:type()),
+ ?line Args = LFlag ++ " -hosts " ++ IpStr ++
+ " -setcookie " ++ Cookie,
+
+ ?line {ok, BootPid} = erl_boot_server:start([Host]),
+ Self = self(),
+ %% This process shuts down the boot server during loading.
+ ?line Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end),
+ ?line receive
+ {Stopper,ready} -> ok
+ end,
+
+ %% Let the loading begin...
+ ?line {ok, Node} = start_node(Name, Args, [{wait, false}]),
+
+ %% When the stopper is ready, the slave node should be
+ %% looking for a boot server again.
+ receive
+ {Stopper,ok} ->
+ ok;
+ {Stopper,{error,Reason}} ->
+ ?line ?t:fail(Reason)
+ after 60000 ->
+ ?line ?t:fail(stopper_died)
+ end,
+
+ %% Start new boot server to see that loading is continued.
+ ?line {ok, BootPid2} = erl_boot_server:start_link([Host]),
+ ?line wait_really_started(Node, 25),
+ ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]),
+ ?line stop_node(Node),
+ ?line unlink(BootPid2),
+ ?line exit(BootPid2, kill),
+ ok
+ end.
+
+%% Trace boot server calls and stop the server before loading is finished.
+stop_boot(BootPid, Super) ->
+ erlang:trace(all, true, [call]),
+ 1 = erlang:trace_pattern({erl_boot_server,send_file_result,3}, true, [local]),
+ BootRef = erlang:monitor(process, BootPid),
+ Super ! {self(),ready},
+ Result = get_calls(100, BootPid),
+ exit(BootPid, kill),
+ erlang:trace_pattern({erl_boot_server,send_file_result,3}, false, [local]),
+ erlang:trace(all, false, [call]),
+ receive
+ {'DOWN',BootRef,_,_, killed} -> ok
+ end,
+ Super ! {self(),Result}.
+
+get_calls(0, _) ->
+ ok;
+get_calls(Count, Pid) ->
+ receive
+ {trace,_,call,_MFA} ->
+ get_calls(Count-1, Pid)
+ after 10000 ->
+ {error,{trace_msg_timeout,Count}}
+ end.
+
+multiple_slaves(doc) ->
+ ["Start nodes in parallell, all using the 'inet' loading method, ",
+ "verify that the boot server manages"];
+multiple_slaves(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "VxWorks: tested separately"};
+ {ose,_} ->
+ {comment, "OSE: multiple nodes not supported"};
+ _ ->
+ ?line Name = erl_prim_test_multiple_slaves,
+ ?line Host = host(),
+ ?line Cookie = atom_to_list(erlang:get_cookie()),
+ ?line IpStr = ip_str(Host),
+ ?line LFlag = get_loader_flag(os:type()),
+ ?line Args = LFlag ++ " -hosts " ++ IpStr ++
+ " -setcookie " ++ Cookie,
+
+ NoOfNodes = 10, % no of slave nodes to be started
+
+ NamesAndNodes =
+ lists:map(fun(N) ->
+ NameN = atom_to_list(Name) ++
+ integer_to_list(N),
+ NodeN = NameN ++ "@" ++ Host,
+ {list_to_atom(NameN),list_to_atom(NodeN)}
+ end, lists:seq(1, NoOfNodes)),
+
+ ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []),
+
+ %% "queue up" the nodes to wait for the boot server to respond
+ %% (note: test_server supervises each node start by accept()
+ %% on a socket, the timeout value for the accept has to be quite
+ %% long for this test to work).
+ ?line test_server:sleep(test_server:seconds(5)),
+ %% start the code loading circus!
+ ?line {ok,BootPid} = erl_boot_server:start_link([Host]),
+ %% give the nodes a chance to boot up before attempting to stop them
+ ?line test_server:sleep(test_server:seconds(10)),
+
+ ?line wait_and_shutdown(lists:reverse(Nodes), 30),
+
+ ?line unlink(BootPid),
+ ?line exit(BootPid, kill),
+ ok
+ end.
+
+start_multiple_nodes([{Name,Node} | NNs], Args, Started) ->
+ ?line {ok,Node} = start_node(Name, Args, [{wait, false}]),
+ start_multiple_nodes(NNs, Args, [Node | Started]);
+start_multiple_nodes([], _, Nodes) ->
+ Nodes.
+
+wait_and_shutdown([Node | Nodes], Tries) ->
+ ?line wait_really_started(Node, Tries),
+ ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]),
+ ?line stop_node(Node),
+ wait_and_shutdown(Nodes, Tries);
+wait_and_shutdown([], _) ->
+ ok.
+
+
+file_requests(suite) -> {req, [{local_slave_nodes, 1}, {time, 10}]};
+file_requests(doc) -> ["Start a node using the 'inet' loading method, ",
+ "verify that the boot server responds to file requests."];
+file_requests(Config) when is_list(Config) ->
+ ?line {ok, Node, BootPid} = complete_start_node(erl_prim_test_file_req),
+
+ %% compare with results from file server calls (the
+ %% boot server uses the same file sys and cwd)
+ {ok,Files} = file:list_dir("."),
+ ?line {ok,Files} = rpc:call(Node, erl_prim_loader, list_dir, ["."]),
+ {ok,Info} = file:read_file_info("test_server.beam"),
+ ?line {ok,Info} = rpc:call(Node, erl_prim_loader, read_file_info, ["test_server.beam"]),
+ {ok,Cwd} = file:get_cwd(),
+ ?line {ok,Cwd} = rpc:call(Node, erl_prim_loader, get_cwd, []),
+ case file:get_cwd("C:") of
+ {error,enotsup} ->
+ ok;
+ {ok,DCwd} ->
+ ?line {ok,DCwd} = rpc:call(Node, erl_prim_loader, get_cwd, ["C:"])
+ end,
+
+ ?line stop_node(Node),
+ ?line unlink(BootPid),
+ ?line exit(BootPid, kill),
+ ok.
+
+complete_start_node(Name) ->
+ ?line Host = host(),
+ ?line Cookie = atom_to_list(erlang:get_cookie()),
+ ?line IpStr = ip_str(Host),
+ ?line LFlag = get_loader_flag(os:type()),
+ ?line Args = LFlag ++ " -hosts " ++ IpStr ++
+ " -setcookie " ++ Cookie,
+
+ ?line {ok,BootPid} = erl_boot_server:start_link([Host]),
+
+ ?line {ok,Node} = start_node(Name, Args),
+ ?line wait_really_started(Node, 25),
+ {ok, Node, BootPid}.
+
+local_archive(suite) ->
+ [];
+local_archive(doc) ->
+ ["Read files from local archive."];
+local_archive(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ KernelDir = filename:basename(code:lib_dir(kernel)),
+ Archive = filename:join([PrivDir, KernelDir ++ init:archive_extension()]),
+ file:delete(Archive),
+ ?line {ok, Archive} = create_archive(Archive, [KernelDir]),
+
+ Node = node(),
+ BeamName = "inet.beam",
+ ?line ok = test_archive(Node, Archive, KernelDir, BeamName),
+ ?line ok = rpc:call(Node, erl_prim_loader, release_archives, []),
+
+ ?line ok = file:delete(Archive),
+ ok.
+
+remote_archive(suite) ->
+ {req, [{local_slave_nodes, 1}, {time, 10}]};
+remote_archive(doc) ->
+ ["Read files from remote archive."];
+remote_archive(Config) when is_list(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ KernelDir = filename:basename(code:lib_dir(kernel)),
+ Archive = filename:join([PrivDir, KernelDir ++ init:archive_extension()]),
+ file:delete(Archive),
+ ?line {ok, Archive} = create_archive(Archive, [KernelDir]),
+
+ ?line {ok, Node, BootPid} = complete_start_node(remote_archive),
+
+ BeamName = "inet.beam",
+ ?line ok = test_archive(Node, Archive, KernelDir, BeamName),
+
+ ?line stop_node(Node),
+ ?line unlink(BootPid),
+ ?line exit(BootPid, kill),
+ ok.
+
+primary_archive(suite) ->
+ {req, [{local_slave_nodes, 1}, {time, 10}]};
+primary_archive(doc) ->
+ ["Read files from primary archive."];
+primary_archive(Config) when is_list(Config) ->
+ %% Copy the orig files to priv_dir
+ PrivDir = ?config(priv_dir, Config),
+ Archive = filename:join([PrivDir, "primary_archive.zip"]),
+ file:delete(Archive),
+ DataDir = ?config(data_dir, Config),
+ ?line {ok, _} = zip:create(Archive, ["primary_archive"],
+ [{compress, []}, {cwd, DataDir}]),
+ ?line {ok, _} = zip:extract(Archive, [{cwd, PrivDir}]),
+ TopDir = filename:join([PrivDir, "primary_archive"]),
+
+ %% Compile the code
+ DictDir = "primary_archive_dict-1.0",
+ DummyDir = "primary_archive_dummy",
+ ?line ok = compile_app(TopDir, DictDir),
+ ?line ok = compile_app(TopDir, DummyDir),
+
+ %% Create the archive
+ {ok, TopFiles} = file:list_dir(TopDir),
+ ?line {ok, {_, ArchiveBin}} = zip:create(Archive, TopFiles,
+ [memory, {compress, []}, {cwd, TopDir}]),
+
+ %% Use temporary node to simplify cleanup
+ ?line Cookie = atom_to_list(erlang:get_cookie()),
+ ?line Args = " -setcookie " ++ Cookie,
+ ?line {ok,Node} = start_node(primary_archive, Args),
+ ?line wait_really_started(Node, 25),
+
+ %% Set primary archive
+ ?line {_,_,_} = rpc:call(Node, erlang, date, []),
+ ?line {ok, Ebins} = rpc:call(Node, erl_prim_loader, set_primary_archive, [Archive, ArchiveBin]),
+ ExpectedEbins = [Archive, DictDir ++ "/ebin", DummyDir ++ "/ebin"],
+ io:format("ExpectedEbins: ~p\n", [ExpectedEbins]),
+ ?line ExpectedEbins = lists:sort(Ebins),
+
+ ?line {ok, TopFiles2} = rpc:call(Node, erl_prim_loader, list_dir, [Archive]),
+ ?line [DictDir, DummyDir] = lists:sort(TopFiles2),
+ BeamName = "primary_archive_dict_app.beam",
+ ?line ok = test_archive(Node, Archive, DictDir, BeamName),
+
+ ?line {ok, []} = rpc:call(Node, erl_prim_loader, set_primary_archive, [undefined, undefined]),
+
+ ?line stop_node(Node),
+ ?line ok = file:delete(Archive),
+ ok.
+
+test_archive(Node, TopDir, AppDir, BeamName) ->
+ %% List dir
+ io:format("test_archive: ~p\n", [rpc:call(Node, erl_prim_loader, list_dir, [TopDir])]),
+ ?line {ok, TopFiles} = rpc:call(Node, erl_prim_loader, list_dir, [TopDir]),
+ ?line true = lists:member(AppDir, TopFiles),
+ AbsAppDir = TopDir ++ "/" ++ AppDir,
+ ?line {ok, AppFiles} = rpc:call(Node, erl_prim_loader, list_dir, [AbsAppDir]),
+ ?line true = lists:member("ebin", AppFiles),
+ Ebin = AbsAppDir ++ "/ebin",
+ ?line {ok, EbinFiles} = rpc:call(Node, erl_prim_loader, list_dir, [Ebin]),
+ Beam = Ebin ++ "/" ++ BeamName,
+ ?line true = lists:member(BeamName, EbinFiles),
+ ?line error = rpc:call(Node, erl_prim_loader, list_dir, [TopDir ++ "/no_such_file"]),
+ ?line error = rpc:call(Node, erl_prim_loader, list_dir, [TopDir ++ "/ebin/no_such_file"]),
+
+ %% File info
+ ?line {ok, #file_info{type = directory}} =
+ rpc:call(Node, erl_prim_loader, read_file_info, [TopDir]),
+ ?line {ok, #file_info{type = directory}} =
+ rpc:call(Node, erl_prim_loader, read_file_info, [Ebin]),
+ ?line {ok, #file_info{type = regular} = FI} =
+ rpc:call(Node, erl_prim_loader, read_file_info, [Beam]),
+ ?line error = rpc:call(Node, erl_prim_loader, read_file_info, [TopDir ++ "/no_such_file"]),
+ ?line error = rpc:call(Node, erl_prim_loader, read_file_info, [TopDir ++ "/ebin/no_such_file"]),
+
+ %% Get file
+ ?line {ok, Bin, Beam} = rpc:call(Node, erl_prim_loader, get_file, [Beam]),
+ ?line if
+ FI#file_info.size =:= byte_size(Bin) -> ok;
+ true -> exit({FI#file_info.size, byte_size(Bin)})
+ end,
+ ?line error = rpc:call(Node, erl_prim_loader, get_file, ["/no_such_file"]),
+ ?line error = rpc:call(Node, erl_prim_loader, get_file, ["/ebin/no_such_file"]),
+ ok.
+
+create_archive(Archive, AppDirs) ->
+ LibDir = code:lib_dir(),
+ Opts = [{compress, []}, {cwd, LibDir}],
+ io:format("zip:create(~p,\n\t~p,\n\t~p).\n", [Archive, AppDirs, Opts]),
+ zip:create(Archive, AppDirs, Opts).
+
+%% Misc. functions
+
+ip_str({A, B, C, D}) ->
+ lists:concat([A, ".", B, ".", C, ".", D]);
+ip_str(Host) ->
+ {ok,Ip} = inet:getaddr(Host, inet),
+ ip_str(Ip).
+
+start_node(Name, Args) ->
+ start_node(Name, Args, []).
+
+start_node(Name, Args, Opts) ->
+ Opts2 = [{args, Args}|Opts],
+ io:format("test_server:start_node(~p, peer, ~p).\n",
+ [Name, Opts2]),
+ Res = test_server:start_node(Name, peer, Opts2),
+ io:format("start_node -> ~p\n", [Res]),
+ Res.
+
+host() ->
+ {ok,Host} = inet:gethostname(),
+ Host.
+
+stop_node(Node) ->
+ test_server:stop_node(Node).
+
+get_loader_flag({ose,_}) ->
+ " -loader ose_inet ";
+get_loader_flag(_) ->
+ " -loader inet ".
+
+compile_app(TopDir, AppName) ->
+ AppDir = filename:join([TopDir, AppName]),
+ SrcDir = filename:join([AppDir, "src"]),
+ OutDir = filename:join([AppDir, "ebin"]),
+ ?line {ok, Files} = file:list_dir(SrcDir),
+ compile_files(Files, SrcDir, OutDir).
+
+compile_files([File | Files], SrcDir, OutDir) ->
+ case filename:extension(File) of
+ ".erl" ->
+ AbsFile = filename:join([SrcDir, File]),
+ case compile:file(AbsFile, [{outdir, OutDir}]) of
+ {ok, _Mod} ->
+ compile_files(Files, SrcDir, OutDir);
+ Error ->
+ {compilation_error, AbsFile, OutDir, Error}
+ end;
+ _ ->
+ compile_files(Files, SrcDir, OutDir)
+ end;
+compile_files([], _, _) ->
+ ok.
+
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/ebin/primary_archive_dict.app b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/ebin/primary_archive_dict.app
new file mode 100644
index 0000000000..2506ae67e8
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/ebin/primary_archive_dict.app
@@ -0,0 +1,12 @@
+{application, primary_archive_dict,
+ [{description, "primary_archive_dict"},
+ {vsn, "1.0"},
+ {modules, [
+ primary_archive_dict,
+ primary_archive_dict_sup
+ ]},
+ {registered, [
+ primary_archive_dict_sup
+ ]},
+ {applications, [kernel, stdlib]},
+ {mod, {primary_archive_dict_app, [[]]}}]}.
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/priv/primary_archive.txt b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/priv/primary_archive.txt
new file mode 100644
index 0000000000..8fa2c8c064
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/priv/primary_archive.txt
@@ -0,0 +1 @@
+Some private data...
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict.erl
new file mode 100644
index 0000000000..2444224810
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict.erl
@@ -0,0 +1,125 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(primary_archive_dict).
+-behaviour(sys).
+
+%% Public
+-export([new/1, store/3, erase/2, find/2, foldl/3, erase/1]).
+
+%% Internal
+-export([init/3, loop/3]).
+
+%% supervisor callback
+-export([start_link/2]).
+
+%% sys callback functions
+-export([
+ system_continue/3,
+ system_terminate/4,
+ system_code_change/4
+ ]).
+
+-define(SUPERVISOR, primary_archive_dict_sup).
+
+start_link(Name, Debug) ->
+ proc_lib:start_link(?MODULE, init, [self(), Name, Debug], infinity, []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Client
+
+new(Name) ->
+ supervisor:start_child(?SUPERVISOR, [Name]).
+
+store(Pid, Key, Val) ->
+ call(Pid, {store, Key, Val}).
+
+erase(Pid, Key) ->
+ call(Pid, {erase, Key}).
+
+find(Pid, Key) ->
+ call(Pid, {find, Key}).
+
+foldl(Pid, Fun, Acc) ->
+ call(Pid, {foldl, Fun, Acc}).
+
+erase(Pid) ->
+ call(Pid, stop).
+
+call(Name, Msg) when is_atom(Name) ->
+ call(whereis(Name), Msg);
+call(Pid, Msg) when is_pid(Pid) ->
+ Ref = erlang:monitor(process, Pid),
+ Pid ! {self(), Ref, Msg},
+ receive
+ {Ref, Reply} ->
+ erlang:demonitor(Ref, [flush]),
+ Reply;
+ {'DOWN', Ref, _, _, Reason} ->
+ {error, Reason}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Server
+
+init(Parent, Name, Debug) ->
+ register(Name, self()),
+ Dict = dict:new(),
+ proc_lib:init_ack(Parent, {ok, self()}),
+ loop(Dict, Parent, Debug).
+
+loop(Dict, Parent, Debug) ->
+ receive
+ {system, From, Msg} ->
+ sys:handle_system_msg(Msg, From, Parent, ?MODULE, Debug, Dict);
+ {ReplyTo, Ref, {store, Key, Val}} ->
+ Dict2 = dict:store(Key, Val, Dict),
+ ReplyTo ! {Ref, ok},
+ ?MODULE:loop(Dict2, Parent, Debug);
+ {ReplyTo, Ref, {erase, Key}} ->
+ Dict2 = dict:erase(Key, Dict),
+ ReplyTo ! {Ref, ok},
+ ?MODULE:loop(Dict2, Parent, Debug);
+ {ReplyTo, Ref, {find, Key}} ->
+ Res = dict:find(Key, Dict),
+ ReplyTo ! {Ref, Res},
+ ?MODULE:loop(Dict, Parent, Debug);
+ {ReplyTo, Ref, {foldl, Fun, Acc}} ->
+ Acc2 = dict:foldl(Fun, Acc, Dict),
+ ReplyTo ! {Ref, {ok, Acc2}},
+ ?MODULE:loop(Dict, Parent, Debug);
+ {ReplyTo, Ref, stop} ->
+ ReplyTo ! {Ref, ok},
+ exit(normal);
+ Msg ->
+ error_logger:format("~p got unexpected message: ~p\n",
+ [self(), Msg]),
+ ?MODULE:loop(Dict, Parent, Debug)
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% sys callbacks
+
+system_continue(Parent, Debug, Dict) ->
+ ?MODULE:loop(Dict, Parent, Debug).
+
+system_terminate(Reason, _Parent, _Debug, _Dict) ->
+ exit(Reason).
+
+system_code_change(Dict,_Module,_OldVsn,_Extra) ->
+ {ok, Dict}.
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_app.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_app.erl
new file mode 100644
index 0000000000..075632ab95
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_app.erl
@@ -0,0 +1,29 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(primary_archive_dict_app).
+-behaviour(application).
+
+%% Public
+-export([start/2, stop/1]).
+
+start(_Type, Args) ->
+ primary_archive_dict_sup:start_link(Args).
+
+stop(_State) ->
+ ok.
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_sup.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_sup.erl
new file mode 100644
index 0000000000..12fe90aaab
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_sup.erl
@@ -0,0 +1,39 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(primary_archive_dict_sup).
+-behaviour(supervisor).
+
+%% Public
+-export([start_link/1]).
+
+%% Internal
+-export([init/1, start_simple_child/2]).
+
+-define(CHILD_MOD, primary_archive_dict).
+
+start_link(Debug) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, [Debug]).
+
+init([Debug]) ->
+ Flags = {simple_one_for_one, 0, 3600},
+ MFA = {?MODULE, start_simple_child, [Debug]},
+ {ok, {Flags, [{?MODULE, MFA, transient, timer:seconds(3), worker, [?CHILD_MOD]}]}}.
+
+start_simple_child(Debug, Name) ->
+ ?CHILD_MOD:start_link(Name, Debug).
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/ebin/primary_archive_dummy.app b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/ebin/primary_archive_dummy.app
new file mode 100644
index 0000000000..e6222a1d9e
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/ebin/primary_archive_dummy.app
@@ -0,0 +1,11 @@
+{application, code_archive_dummy,
+ [{description, "primary_archive_dummy"},
+ {vsn, "0.1"},
+ {modules, [
+ primary_archive_dummy,
+ primary_archive_dummy_app,
+ primary_archive_dummy_sup
+ ]},
+ {registered, []},
+ {applications, [kernel, stdlib, primary_archive_dict]},
+ {mod, {primary_archive_dummy_app, [[]]}}]}.
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy.erl
new file mode 100644
index 0000000000..186e752c3d
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy.erl
@@ -0,0 +1,29 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(primary_archive_dummy).
+-behaviour(application).
+
+%% Public
+-export([start/2, stop/1]).
+
+start(_Type, Args) ->
+ primary_archive_dummy_sup:start_link(Args).
+
+stop(_State) ->
+ ok.
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_app.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_app.erl
new file mode 100644
index 0000000000..4a29c86a89
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_app.erl
@@ -0,0 +1,29 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(primary_archive_dummy_app).
+-behaviour(application).
+
+%% Public
+-export([start/2, stop/1]).
+
+start(_Type, Args) ->
+ primary_archive_dummy_sup:start_link(Args).
+
+stop(_State) ->
+ ok.
diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_sup.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_sup.erl
new file mode 100644
index 0000000000..c8cee46d08
--- /dev/null
+++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_sup.erl
@@ -0,0 +1,33 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(primary_archive_dummy_sup).
+-behaviour(supervisor).
+
+%% Public
+-export([start_link/1]).
+
+%% Internal
+-export([init/1]).
+
+start_link(Debug) ->
+ supervisor:start_link({local, ?MODULE}, ?MODULE, [Debug]).
+
+init([Debug]) ->
+ Flags = {one_for_one, 0, 3600},
+ {ok, {Flags, []}}.
diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl
new file mode 100644
index 0000000000..a737949bbb
--- /dev/null
+++ b/lib/kernel/test/error_logger_SUITE.erl
@@ -0,0 +1,300 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(error_logger_SUITE).
+
+-include("test_server.hrl").
+
+%%-----------------------------------------------------------------
+%% We don't have to test the normal behaviour here, i.e. the tty
+%% handler.
+%% We will add an own error handler in order to verify that the
+%% error_logger deliver the expected events.
+%%-----------------------------------------------------------------
+
+-export([all/1, error_report/1, info_report/1, error/1, info/1,
+ emulator/1, tty/1, logfile/1, add/1, delete/1]).
+
+-export([generate_error/0]).
+
+-export([init/1,
+ handle_event/2, handle_call/2, handle_info/2,
+ terminate/2]).
+
+
+all(suite) ->
+ [error_report, info_report, error, info,
+ emulator, tty, logfile, add, delete].
+
+%%-----------------------------------------------------------------
+
+error_report(suite) -> [];
+error_report(doc) -> [];
+error_report(Config) when list(Config) ->
+ ?line error_logger:add_report_handler(?MODULE, self()),
+ Rep1 = [{tag1,"data1"},{tag2,data2},{tag3,3}],
+ Rep2 = [testing,"testing",{tag1,"tag1"}],
+ Rep3 = "This is a string !",
+ Rep4 = {this,is,a,tuple},
+ ?line ok = error_logger:error_report(Rep1),
+ reported(error_report, std_error, Rep1),
+ ?line ok = error_logger:error_report(Rep2),
+ reported(error_report, std_error, Rep2),
+ ?line ok = error_logger:error_report(Rep3),
+ reported(error_report, std_error, Rep3),
+ ?line ok = error_logger:error_report(Rep4),
+ reported(error_report, std_error, Rep4),
+
+ ?line ok = error_logger:error_report(test_type, Rep1),
+ reported(error_report, test_type, Rep1),
+ ?line ok = error_logger:error_report(test_type, Rep2),
+ reported(error_report, test_type, Rep2),
+ ?line ok = error_logger:error_report(test_type, Rep3),
+ reported(error_report, test_type, Rep3),
+ ?line ok = error_logger:error_report(test_type, Rep4),
+ reported(error_report, test_type, Rep4),
+
+ ?line ok = error_logger:error_report("test_type", Rep1),
+ reported(error_report, "test_type", Rep1),
+ ?line ok = error_logger:error_report({test,type}, Rep2),
+ reported(error_report, {test,type}, Rep2),
+ ?line ok = error_logger:error_report([test,type], Rep3),
+ reported(error_report, [test,type], Rep3),
+ ?line ok = error_logger:error_report(1, Rep4),
+ reported(error_report, 1, Rep4),
+
+ ?line my_yes = error_logger:delete_report_handler(?MODULE),
+ ok.
+
+%%-----------------------------------------------------------------
+
+info_report(suite) -> [];
+info_report(doc) -> [];
+info_report(Config) when list(Config) ->
+ ?line error_logger:add_report_handler(?MODULE, self()),
+ Rep1 = [{tag1,"data1"},{tag2,data2},{tag3,3}],
+ Rep2 = [testing,"testing",{tag1,"tag1"}],
+ Rep3 = "This is a string !",
+ Rep4 = {this,is,a,tuple},
+ ?line ok = error_logger:info_report(Rep1),
+ reported(info_report, std_info, Rep1),
+ ?line ok = error_logger:info_report(Rep2),
+ reported(info_report, std_info, Rep2),
+ ?line ok = error_logger:info_report(Rep3),
+ reported(info_report, std_info, Rep3),
+ ?line ok = error_logger:info_report(Rep4),
+ reported(info_report, std_info, Rep4),
+
+ ?line ok = error_logger:info_report(test_type, Rep1),
+ reported(info_report, test_type, Rep1),
+ ?line ok = error_logger:info_report(test_type, Rep2),
+ reported(info_report, test_type, Rep2),
+ ?line ok = error_logger:info_report(test_type, Rep3),
+ reported(info_report, test_type, Rep3),
+ ?line ok = error_logger:info_report(test_type, Rep4),
+ reported(info_report, test_type, Rep4),
+
+ ?line ok = error_logger:info_report("test_type", Rep1),
+ reported(info_report, "test_type", Rep1),
+ ?line ok = error_logger:info_report({test,type}, Rep2),
+ reported(info_report, {test,type}, Rep2),
+ ?line ok = error_logger:info_report([test,type], Rep3),
+ reported(info_report, [test,type], Rep3),
+ ?line ok = error_logger:info_report(1, Rep4),
+ reported(info_report, 1, Rep4),
+
+ ?line my_yes = error_logger:delete_report_handler(?MODULE),
+ ok.
+
+%%-----------------------------------------------------------------
+
+error(suite) -> [];
+error(doc) -> [];
+error(Config) when list(Config) ->
+ ?line error_logger:add_report_handler(?MODULE, self()),
+ Msg1 = "This is a plain text string~n",
+ Msg2 = "This is a text with arguments ~p~n",
+ Arg2 = "This is the argument",
+ Msg3 = {erroneous,msg},
+
+ ?line ok = error_logger:error_msg(Msg1),
+ reported(error, Msg1, []),
+ ?line ok = error_logger:error_msg(Msg2, Arg2),
+ reported(error, Msg2, Arg2),
+ ?line ok = error_logger:error_msg(Msg3),
+ reported(error, Msg3, []),
+
+ ?line ok = error_logger:error_msg(Msg1, []),
+ reported(error, Msg1, []),
+ ?line ok = error_logger:error_msg(Msg2, Arg2),
+ reported(error, Msg2, Arg2),
+ ?line ok = error_logger:error_msg(Msg3, []),
+ reported(error, Msg3, []),
+
+ ?line ok = error_logger:format(Msg1, []),
+ reported(error, Msg1, []),
+ ?line ok = error_logger:format(Msg2, Arg2),
+ reported(error, Msg2, Arg2),
+ ?line ok = error_logger:format(Msg3, []),
+ reported(error, Msg3, []),
+
+ ?line my_yes = error_logger:delete_report_handler(?MODULE),
+ ok.
+
+%%-----------------------------------------------------------------
+
+info(suite) -> [];
+info(doc) -> [];
+info(Config) when list(Config) ->
+ ?line error_logger:add_report_handler(?MODULE, self()),
+ Msg1 = "This is a plain text string~n",
+ Msg2 = "This is a text with arguments ~p~n",
+ Arg2 = "This is the argument",
+ Msg3 = {erroneous,msg},
+
+ ?line ok = error_logger:info_msg(Msg1),
+ reported(info_msg, Msg1, []),
+ ?line ok = error_logger:info_msg(Msg2, Arg2),
+ reported(info_msg, Msg2, Arg2),
+ ?line ok = error_logger:info_msg(Msg3),
+ reported(info_msg, Msg3, []),
+
+ ?line ok = error_logger:info_msg(Msg1, []),
+ reported(info_msg, Msg1, []),
+ ?line ok = error_logger:info_msg(Msg2, Arg2),
+ reported(info_msg, Msg2, Arg2),
+ ?line ok = error_logger:info_msg(Msg3, []),
+ reported(info_msg, Msg3, []),
+
+ ?line my_yes = error_logger:delete_report_handler(?MODULE),
+ ok.
+
+%%-----------------------------------------------------------------
+
+emulator(suite) -> [];
+emulator(doc) -> [];
+emulator(Config) when list(Config) ->
+ ?line error_logger:add_report_handler(?MODULE, self()),
+ spawn(?MODULE, generate_error, []),
+ reported(emulator),
+ ?line my_yes = error_logger:delete_report_handler(?MODULE),
+ ok.
+
+generate_error() ->
+ erlang:error({badmatch,4}).
+
+%%-----------------------------------------------------------------
+%% We don't enables or disables tty error logging here. We do not
+%% want to interact with the test run.
+%%-----------------------------------------------------------------
+
+tty(suite) -> [];
+tty(doc) -> [];
+tty(Config) when is_list(Config) ->
+ ?line {'EXIT', _Reason} = (catch error_logger:tty(dummy)),
+ ok.
+
+%%-----------------------------------------------------------------
+%% If where already exists a logfile we skip this test case !!
+%%-----------------------------------------------------------------
+
+logfile(suite) -> [];
+logfile(doc) -> [];
+logfile(Config) when list(Config) ->
+ ?line case error_logger:logfile(filename) of
+ {error, no_log_file} -> % Ok, we continues.
+ do_logfile();
+ _ ->
+ ok
+ end.
+
+do_logfile() ->
+ ?line {error, _} = error_logger:logfile(close),
+ ?line {error, _} = error_logger:logfile({open,{error}}),
+ ?line ok = error_logger:logfile({open, "dummy_logfile.log"}),
+ ?line "dummy_logfile.log" = error_logger:logfile(filename),
+ ?line ok = error_logger:logfile(close),
+ ?line {'EXIT',_} = (catch error_logger:logfile(dummy)),
+ ok.
+
+%%-----------------------------------------------------------------
+
+add(suite) -> [];
+add(doc) -> [];
+add(Config) when list(Config) ->
+ ?line {'EXIT',_} = (catch error_logger:add_report_handler("dummy")),
+ ?line {'EXIT',_} = error_logger:add_report_handler(non_existing),
+ ?line my_error = error_logger:add_report_handler(?MODULE, [error]),
+ ok.
+
+%%-----------------------------------------------------------------
+
+delete(suite) -> [];
+delete(doc) -> [];
+delete(Config) when list(Config) ->
+ ?line {'EXIT',_} = (catch error_logger:delete_report_handler("dummy")),
+ ?line {error,_} = error_logger:delete_report_handler(non_existing),
+ ok.
+
+%%-----------------------------------------------------------------
+%% Check that the report has been received.
+%%-----------------------------------------------------------------
+reported(Tag, Type, Report) ->
+ receive
+ {Tag, Type, Report} ->
+ test_server:messages_get(),
+ ok
+ after 1000 ->
+ test_server:fail(no_report_received)
+ end.
+
+reported(emulator) ->
+ receive
+ {error, "~s~n", String} when list(String) ->
+ test_server:messages_get(),
+ ok
+ after 1000 ->
+ test_server:fail(no_report_received)
+ end.
+
+%%-----------------------------------------------------------------
+%% The error_logger handler (gen_event behaviour).
+%% Sends a notification to the Tester process about the events
+%% generated by the Tester process.
+%%-----------------------------------------------------------------
+init(Tester) when pid(Tester) ->
+ {ok, Tester};
+init(Config) when list(Config) ->
+ my_error.
+
+handle_event({Tag, _GL, {_EPid, Type, Report}}, Tester) ->
+ Tester ! {Tag, Type, Report},
+ {ok, Tester};
+handle_event(_Event, Tester) ->
+ {ok, Tester}.
+
+handle_info({emulator, _GL, String}, Tester) ->
+ Tester ! {emulator, String},
+ {ok, Tester};
+handle_info(_, Tester) ->
+ {ok, Tester}.
+
+handle_call(_Query, Tester) -> {ok, {error, bad_query}, Tester}.
+
+terminate(_Reason, _Tester) ->
+ my_yes.
diff --git a/lib/kernel/test/error_logger_warn_SUITE.erl b/lib/kernel/test/error_logger_warn_SUITE.erl
new file mode 100644
index 0000000000..6629eca1ad
--- /dev/null
+++ b/lib/kernel/test/error_logger_warn_SUITE.erl
@@ -0,0 +1,503 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(error_logger_warn_SUITE).
+
+-export([all/1,init_per_testcase/2,fin_per_testcase/2,
+ basic/1,warnings_info/1,warnings_warnings/1,
+ rb_basic/1,rb_warnings_info/1,rb_warnings_warnings/1,
+ rb_trunc/1,rb_utc/1,file_utc/1]).
+
+%% Internal exports.
+-export([init/1,handle_event/2,handle_info/2,handle_call/2]).
+
+-include("test_server.hrl").
+
+-define(EXPECT(Pattern),
+ (fun() ->
+ receive
+ Pattern = X ->
+ erlang:display({got_expected,?MODULE,?LINE,X}),
+ ok
+ after 5000 ->
+ exit({timeout_in_expect,?MODULE,?LINE})
+ end
+ end)()).
+
+% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+
+all(suite) ->
+ [basic, warnings_info, warnings_warnings,
+ rb_basic, rb_warnings_info, rb_warnings_warnings,
+ rb_trunc,rb_utc, file_utc].
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog = ?t:timetrap(?default_timeout),
+ [{watchdog, Dog} | Config].
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+basic(doc) ->
+ ["Tests basic error logger functionality"];
+basic(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ basic().
+
+warnings_info(doc) ->
+ ["Tests mapping warnings to info functionality"];
+warnings_info(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ warnings_info().
+
+warnings_warnings(doc) ->
+ ["Tests mapping warnings to warnings functionality"];
+warnings_warnings(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ warnings_warnings().
+
+rb_basic(doc) ->
+ ["Tests basic rb functionality"];
+rb_basic(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ rb_basic().
+
+rb_warnings_info(doc) ->
+ ["Tests warnings as info rb functionality"];
+rb_warnings_info(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ rb_warnings_info().
+
+rb_warnings_warnings(doc) ->
+ ["Tests warnings as warnings rb functionality"];
+rb_warnings_warnings(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ rb_warnings_warnings().
+
+rb_trunc(doc) ->
+ ["Tests rb functionality on truncated data"];
+rb_trunc(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ rb_trunc().
+
+rb_utc(doc) ->
+ ["Tests UTC mapping in rb (-sasl utc_log true)"];
+rb_utc(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ rb_utc().
+
+file_utc(doc) ->
+ ["Tests UTC mapping in file logger (-stdlib utc_log true)"];
+file_utc(Config) when is_list(Config) ->
+ put(elw_config,Config),
+ file_utc().
+
+
+% a small gen_event
+
+init([Pid]) ->
+ {ok, Pid}.
+
+handle_event(Event,Pid) ->
+ Pid ! {handle_event,Event},
+ {ok,Pid}.
+
+handle_info(Unexpected,Pid) ->
+ Pid ! {unexpected_info,Unexpected},
+ {ok,Pid}.
+
+handle_call(Unexpected, Pid) ->
+ Pid ! {unexpected_call, Unexpected},
+ {ok,Pid}.
+
+start_node(Name,Args) ->
+ MyDir = filename:dirname(code:which(?MODULE)),
+ element(2,test_server:start_node(Name, slave, [{args, Args ++ " -pa " ++ MyDir}])).
+
+stop_node(Name) ->
+ test_server:stop_node(Name).
+
+install_relay(Node) ->
+ rpc:call(Node,error_logger,add_report_handler,[?MODULE,[self()]]).
+
+
+format(Node,A,B) ->
+ rpc:call(Node,error_logger,format,[A,B]).
+error_msg(Node,A,B) ->
+ rpc:call(Node,error_logger,error_msg,[A,B]).
+error_report(Node,B) ->
+ rpc:call(Node,error_logger,error_report,[B]).
+warning_msg(Node,A,B) ->
+ rpc:call(Node,error_logger,warning_msg,[A,B]).
+warning_report(Node,B) ->
+ rpc:call(Node,error_logger,warning_report,[B]).
+info_msg(Node,A,B) ->
+ rpc:call(Node,error_logger,info_msg,[A,B]).
+info_report(Node,B) ->
+ rpc:call(Node,error_logger,info_report,[B]).
+
+nn() ->
+ error_logger_warn_suite_helper.
+
+
+
+
+basic() ->
+ ?line Node = start_node(nn(),[]),
+ ?line ok = install_relay(Node),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line format(Node,"~p~n",[Self]),
+ ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}),
+ ?line error_msg(Node,"~p~n",[Self]),
+ ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}),
+ ?line warning_msg(Node,"~p~n",[Self]),
+ ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}),
+ ?line info_msg(Node,"~p~n",[Self]),
+ ?line ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line error_report(Node,Report),
+ ?line ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}),
+ ?line warning_report(Node,Report),
+ ?line ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}),
+ ?line info_report(Node,Report),
+ ?line ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}),
+
+ ?line stop_node(Node),
+ ok.
+
+warnings_info() ->
+ ?line Node = start_node(nn(),"+Wi"),
+ ?line ok = install_relay(Node),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line warning_msg(Node,"~p~n",[Self]),
+ ?line ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}),
+ ?line warning_report(Node,Report),
+ ?line ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}),
+ ?line stop_node(Node),
+ ok.
+
+warnings_warnings() ->
+ ?line Node = start_node(nn(),"+Ww"),
+ ?line ok = install_relay(Node),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line warning_msg(Node,"~p~n",[Self]),
+ ?line ?EXPECT({handle_event,{warning_msg,GL,{_,"~p~n",[Self]}}}),
+ ?line warning_report(Node,Report),
+ ?line ?EXPECT({handle_event,{warning_report,GL,{_,std_warning,Report}}}),
+ ?line stop_node(Node),
+ ok.
+
+
+% RB...
+
+quote(String) ->
+ case os:type() of
+ {win32,_} ->
+ "\\\""++String++"\\\"";
+ _ ->
+ "'\""++String++"\"'"
+ end.
+
+iquote(String) ->
+ case os:type() of
+ {win32,_} ->
+ "\\\""++String++"\\\"";
+ _ ->
+ "\""++String++"\""
+ end.
+
+oquote(String) ->
+ case os:type() of
+ {win32,_} ->
+ "\""++String++"\"";
+ _ ->
+ "'"++String++"'"
+ end.
+
+
+findstr(String,FileName) ->
+ File=binary_to_list(element(2,file:read_file(FileName))),
+ findstrc(String,File).
+
+findstrc(String,File) ->
+ case string:str(File,String) of
+ N when is_integer(N),
+ N > 0 ->
+ S2 = lists:sublist(File,N,length(File)),
+ case string:str(S2,"\n") of
+ 0 ->
+ 1;
+ M ->
+ S3 = lists:sublist(S2,M,length(S2)),
+ 1 + findstrc(String,S3)
+ end;
+ _ ->
+ 0
+ end.
+
+% Doesn't count empty lines
+lines(File) ->
+ length(
+ string:tokens(
+ binary_to_list(
+ element(2,file:read_file(File))),
+ "\n")).
+
+%directories anf filenames
+ld() ->
+ Config = get(elw_config),
+ PrivDir = ?config(priv_dir, Config),
+ filename:absname(PrivDir).
+
+lf() ->
+ filename:join([ld(),"logfile.txt"]).
+rd() ->
+ Config = get(elw_config),
+ PrivDir = ?config(priv_dir, Config),
+ LogDir = filename:join(PrivDir,"log"),
+ file:make_dir(LogDir),
+ filename:absname(LogDir).
+rf() ->
+ filename:join([rd(),"1"]).
+
+nice_stop_node(Name) ->
+ erlang:monitor_node(Name, true),
+ rpc:call(Name, init, stop, []),
+ receive
+ {nodedown,Name} -> ok
+ end.
+
+%rensa rd() f�re varje rapport-test s� man bara f�r en fil...
+clean_rd() ->
+ {ok,L} = file:list_dir(rd()),
+ lists:foreach(fun(F) ->
+ file:delete(F)
+ end,
+ [filename:append(rd(),X) || X <- L]),
+ ok.
+
+fake_gl(Node,What,A) ->
+ Fun = fun() ->
+ group_leader(self(),self()),
+ error_logger:What(A)
+ end,
+ rpc:call(Node,erlang,apply,[Fun,[]]).
+fake_gl(Node,What,A,B) ->
+ Fun = fun() ->
+ group_leader(self(),self()),
+ error_logger:What(A,B)
+ end,
+ rpc:call(Node,erlang,apply,[Fun,[]]).
+
+
+one_rb_lines(Param) ->
+ file:delete(lf()),
+ rb:start_log(lf()),
+ apply(rb,show,Param),
+ rb:stop_log(),
+ lines(lf()).
+
+one_rb_findstr(Param,String) ->
+ file:delete(lf()),
+ rb:start_log(lf()),
+ apply(rb,show,Param),
+ rb:stop_log(),
+ findstr(String,lf()).
+
+% Tests
+rb_basic() ->
+ ?line clean_rd(),
+ % Behold, the magic parameters to activate rb logging...
+ ?line Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++
+ quote(rd())++" error_logger_mf_maxbytes 5000 "
+ "error_logger_mf_maxfiles 5"),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line fake_gl(Node,warning_msg,"~p~n",[Self]),
+ ?line fake_gl(Node,warning_report,Report),
+ ?line nice_stop_node(Node),
+ ?line application:start(sasl),
+ ?line rb:start([{report_dir, rd()}]),
+ ?line rb:list(),
+ ?line true = (one_rb_lines([error]) > 1),
+ ?line true = (one_rb_lines([error_report]) > 1),
+ ?line 1 = one_rb_findstr([error],pid_to_list(Self)),
+ ?line 1 = one_rb_findstr([error_report],pid_to_list(Self)),
+ ?line 2 = one_rb_findstr([],pid_to_list(Self)),
+ ?line true = (one_rb_findstr([progress],"===") > 4),
+ ?line rb:stop(),
+ ?line application:stop(sasl),
+ ?line stop_node(Node),
+ ok.
+
+rb_warnings_info() ->
+ ?line clean_rd(),
+ ?line Node = start_node(nn(),"+W i -boot start_sasl -sasl error_logger_mf_dir "++
+ quote(rd())++" error_logger_mf_maxbytes 5000 "
+ "error_logger_mf_maxfiles 5"),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line fake_gl(Node,warning_msg,"~p~n",[Self]),
+ ?line fake_gl(Node,warning_report,Report),
+ ?line nice_stop_node(Node),
+ ?line application:start(sasl),
+ ?line rb:start([{report_dir, rd()}]),
+ ?line rb:list(),
+ ?line true = (one_rb_lines([error]) =:= 0),
+ ?line true = (one_rb_lines([error_report]) =:= 0),
+ ?line 0 = one_rb_findstr([error],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([warning_msg],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)),
+ ?line 1 = one_rb_findstr([info_msg],pid_to_list(Self)),
+ ?line 1 = one_rb_findstr([info_report],pid_to_list(Self)),
+ ?line 2 = one_rb_findstr([],pid_to_list(Self)),
+ ?line true = (one_rb_findstr([progress],"===") > 4),
+ ?line rb:stop(),
+ ?line application:stop(sasl),
+ ?line stop_node(Node),
+ ok.
+
+rb_warnings_warnings() ->
+ ?line clean_rd(),
+ ?line Node = start_node(nn(),"+W w -boot start_sasl -sasl error_logger_mf_dir "++
+ quote(rd())++" error_logger_mf_maxbytes 5000 "
+ "error_logger_mf_maxfiles 5"),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line fake_gl(Node,warning_msg,"~p~n",[Self]),
+ ?line fake_gl(Node,warning_report,Report),
+ ?line nice_stop_node(Node),
+ ?line application:start(sasl),
+ ?line rb:start([{report_dir, rd()}]),
+ ?line rb:list(),
+ ?line true = (one_rb_lines([error]) =:= 0),
+ ?line true = (one_rb_lines([error_report]) =:= 0),
+ ?line 0 = one_rb_findstr([error],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)),
+ ?line 1 = one_rb_findstr([warning_msg],pid_to_list(Self)),
+ ?line 1 = one_rb_findstr([warning_report],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)),
+ ?line 2 = one_rb_findstr([],pid_to_list(Self)),
+ ?line true = (one_rb_findstr([progress],"===") > 4),
+ ?line rb:stop(),
+ ?line application:stop(sasl),
+ ?line stop_node(Node),
+ ok.
+
+rb_trunc() ->
+ ?line clean_rd(),
+ ?line Node = start_node(nn(),"+W w -boot start_sasl -sasl error_logger_mf_dir "++
+ quote(rd())++" error_logger_mf_maxbytes 5000 "
+ "error_logger_mf_maxfiles 5"),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line fake_gl(Node,warning_msg,"~p~n",[Self]),
+ ?line fake_gl(Node,warning_report,Report),
+ ?line nice_stop_node(Node),
+ ?line application:start(sasl),
+ ?line {ok,File} = file:read_file(rf()),
+ ?line S=byte_size(File)-2,
+ ?line <<TFile:S/binary,_/binary>>=File,
+ ?line file:write_file(rf(),TFile),
+ ?line rb:start([{report_dir, rd()}]),
+ ?line rb:list(),
+ ?line true = (one_rb_lines([error]) =:= 0),
+ ?line true = (one_rb_lines([error_report]) =:= 0),
+ ?line 0 = one_rb_findstr([error],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)),
+ ?line 1 = one_rb_findstr([warning_msg],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)),
+ ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)),
+ ?line 1 = one_rb_findstr([],pid_to_list(Self)),
+ ?line true = (one_rb_findstr([progress],"===") > 4),
+ ?line rb:stop(),
+ ?line application:stop(sasl),
+ ?line stop_node(Node),
+ ok.
+
+rb_utc() ->
+ ?line clean_rd(),
+ ?line Node = start_node(nn(),"+W w -boot start_sasl -sasl error_logger_mf_dir "++
+ quote(rd())++" error_logger_mf_maxbytes 5000 "
+ "error_logger_mf_maxfiles 5 -sasl utc_log true"),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line fake_gl(Node,warning_msg,"~p~n",[Self]),
+ ?line fake_gl(Node,warning_report,Report),
+ ?line nice_stop_node(Node),
+ ?line application:stop(sasl),
+ ?line UtcLog=case application:get_env(sasl,utc_log) of
+ {ok,true} ->
+ true;
+ _AllOthers ->
+ application:set_env(sasl,utc_log,true),
+ false
+ end,
+ ?line application:start(sasl),
+ ?line rb:start([{report_dir, rd()}]),
+ ?line rb:list(),
+ ?line Pr=one_rb_findstr([progress],"==="),
+ ?line Wm=one_rb_findstr([warning_msg],"==="),
+ ?line Wr=one_rb_findstr([warning_report],"==="),
+ ?line Sum=Pr+Wm+Wr,
+ ?line Sum=one_rb_findstr([],"UTC"),
+ ?line rb:stop(),
+ ?line application:stop(sasl),
+ ?line application:set_env(sasl,utc_log,UtcLog),
+ ?line stop_node(Node),
+ ok.
+
+file_utc() ->
+ ?line file:delete(lf()),
+ ?line SS="+W w -stdlib utc_log true -kernel error_logger "++ oquote("{file,"++iquote(lf())++"}"),
+ %erlang:display(SS),
+ ?line Node = start_node(nn(),SS),
+ %erlang:display(rpc:call(Node,application,get_env,[kernel,error_logger])),
+ ?line Self = self(),
+ ?line GL = group_leader(),
+ ?line fake_gl(Node,error_msg,"~p~n",[Self]),
+ ?line fake_gl(Node,warning_msg,"~p~n",[Self]),
+ ?line fake_gl(Node,info_msg,"~p~n",[Self]),
+ ?line Report = [{self,Self},{gl,GL},make_ref()],
+ ?line fake_gl(Node,error_report,Report),
+ ?line fake_gl(Node,warning_report,Report),
+ ?line fake_gl(Node,info_report,Report),
+ ?line nice_stop_node(Node),
+ ?line receive after 5000 -> ok end, % Let the node die, needed
+ ?line 6 = findstr("UTC",lf()),
+ ?line 2 = findstr("WARNING",lf()),
+ ?line 2 = findstr("ERROR",lf()),
+ ?line 2 = findstr("INFO",lf()),
+ ?line stop_node(Node),
+ ok.
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
new file mode 100644
index 0000000000..c645d0f842
--- /dev/null
+++ b/lib/kernel/test/file_SUITE.erl
@@ -0,0 +1,3716 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% This is a developement feature when developing a new file module,
+%% ugly but practical.
+-ifndef(FILE_MODULE).
+-define(FILE_MODULE, file).
+-endif.
+-ifndef(FILE_SUITE).
+-define(FILE_SUITE, file_SUITE).
+-endif.
+-ifndef(FILE_INIT).
+-define(FILE_INIT(Config), Config).
+-endif.
+-ifndef(FILE_FINI).
+-define(FILE_FINI(Config), Config).
+-endif.
+-ifndef(FILE_INIT_PER_TESTCASE).
+-define(FILE_INIT_PER_TESTCASE(Config), Config).
+-endif.
+-ifndef(FILE_FIN_PER_TESTCASE).
+-define(FILE_FIN_PER_TESTCASE(Config), Config).
+-endif.
+
+-module(?FILE_SUITE).
+
+-export([all/1,
+ init/1, fini/1,
+ init_per_testcase/2, fin_per_testcase/2,
+ read_write_file/1, dirs/1, files/1, names/1]).
+-export([cur_dir_0/1, cur_dir_1/1, make_del_dir/1,
+ pos/1, pos1/1, pos2/1]).
+-export([close/1, consult/1, consult1/1, path_consult/1, delete/1]).
+-export([eval/1, eval1/1, path_eval/1, script/1, script1/1, path_script/1,
+ open/1, open1/1,
+ old_modes/1, new_modes/1, path_open/1, open_errors/1]).
+-export([file_info/1, file_info_basic_file/1, file_info_basic_directory/1,
+ file_info_bad/1, file_info_times/1, file_write_file_info/1]).
+-export([rename/1, access/1, truncate/1, sync/1,
+ read_write/1, pread_write/1, append/1]).
+-export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]).
+-export([otp_5814/1]).
+
+-export([compression/1, read_not_really_compressed/1,
+ read_compressed_cooked/1, read_compressed_cooked_binary/1,
+ read_cooked_tar_problem/1,
+ write_compressed/1, compress_errors/1, catenated_gzips/1]).
+
+-export([links/1, make_link/1, read_link_info_for_non_link/1, symlinks/1]).
+
+-export([copy/1]).
+
+-export([new_slave/2, old_slave/2, run_test/2]).
+
+-export([delayed_write/1, read_ahead/1, segment_read/1, segment_write/1]).
+
+-export([ipread/1]).
+
+-export([pid2name/1]).
+
+-export([interleaved_read_write/1]).
+
+-export([altname/1]).
+
+-export([large_file/1]).
+
+-export([read_line_1/1, read_line_2/1, read_line_3/1,read_line_4/1]).
+
+%% Debug exports
+-export([create_file_slow/2, create_file/2, create_bin/2]).
+-export([verify_file/2, verify_bin/3]).
+-export([bytes/2, iterate/3]).
+
+
+
+-include("test_server.hrl").
+-include_lib("kernel/include/file.hrl").
+
+
+
+all(suite) ->
+ {conf, init,
+ [altname, read_write_file, dirs, files,
+ delete, rename, names, errors,
+ compression, links, copy,
+ delayed_write, read_ahead, segment_read, segment_write,
+ ipread, pid2name, interleaved_read_write,
+ otp_5814, large_file, read_line_1, read_line_2, read_line_3, read_line_4],
+ fini}.
+
+init(Config) when is_list(Config) ->
+ case os:type() of
+ {win32, _} ->
+ Priv = ?config(priv_dir, Config),
+ HasAccessTime =
+ case ?FILE_MODULE:read_file_info(Priv) of
+ {ok, #file_info{atime={_, {0, 0, 0}}}} ->
+ %% This is a unfortunately a FAT file system.
+ [no_access_time];
+ {ok, _} ->
+ []
+ end,
+ ?FILE_INIT(HasAccessTime++Config);
+ _ ->
+ ?FILE_INIT(Config)
+ end.
+
+fini(Config) when is_list(Config) ->
+ case os:type() of
+ {win32, _} ->
+ os:cmd("subst z: /d");
+ _ ->
+ ok
+ end,
+ ?FILE_FINI(Config).
+
+init_per_testcase(_Func, Config) ->
+ %%error_logger:info_msg("~p:~p *****~n", [?MODULE, _Func]),
+ ?FILE_INIT_PER_TESTCASE(Config).
+
+fin_per_testcase(_Func, Config) ->
+ %% error_logger:info_msg("~p:~p END *****~n", [?MODULE, _Func]),
+ ?FILE_FIN_PER_TESTCASE(Config).
+
+%% Matches a term (the last) against alternatives
+expect(X, _, X) ->
+ X;
+expect(_, X, X) ->
+ X.
+
+expect(X, _, _, X) ->
+ X;
+expect(_, X, _, X) ->
+ X;
+expect(_, _, X, X) ->
+ X.
+
+expect(X, _, _, _, X) ->
+ X;
+expect(_, X, _, _, X) ->
+ X;
+expect(_, _, X, _, X) ->
+ X;
+expect(_, _, _, X, X) ->
+ X.
+
+%% Calculate the time difference
+time_dist({YY, MM, DD, H, M, S}, DT) ->
+ time_dist({{YY, MM, DD}, {H, M, S}}, DT);
+time_dist(DT, {YY, MM, DD, H, M, S}) ->
+ time_dist(DT, {{YY, MM, DD}, {H, M, S}});
+time_dist({_D1, _T1} = DT1, {_D2, _T2} = DT2) ->
+ calendar:datetime_to_gregorian_seconds(DT2)
+ - calendar:datetime_to_gregorian_seconds(DT1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+read_write_file(suite) -> [];
+read_write_file(doc) -> [];
+read_write_file(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_read_write_file"),
+
+ %% Try writing and reading back some term
+ ?line SomeTerm = {"This term",{will,be},[written,$t,$o],1,file,[]},
+ ?line ok = ?FILE_MODULE:write_file(Name,term_to_binary(SomeTerm)),
+ ?line {ok,Bin1} = ?FILE_MODULE:read_file(Name),
+ ?line SomeTerm = binary_to_term(Bin1),
+
+ %% Try a "null" term
+ ?line NullTerm = [],
+ ?line ok = ?FILE_MODULE:write_file(Name,term_to_binary(NullTerm)),
+ ?line {ok,Bin2} = ?FILE_MODULE:read_file(Name),
+ ?line NullTerm = binary_to_term(Bin2),
+
+ %% Try some "complicated" types
+ ?line BigNum = 123456789012345678901234567890,
+ ?line ComplTerm = {self(),make_ref(),BigNum,3.14159},
+ ?line ok = ?FILE_MODULE:write_file(Name,term_to_binary(ComplTerm)),
+ ?line {ok,Bin3} = ?FILE_MODULE:read_file(Name),
+ ?line ComplTerm = binary_to_term(Bin3),
+
+ %% Try reading a nonexistent file
+ ?line Name2 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_nonexistent_file"),
+ ?line {error, enoent} = ?FILE_MODULE:read_file(Name2),
+ ?line {error, enoent} = ?FILE_MODULE:read_file(""),
+ ?line {error, enoent} = ?FILE_MODULE:read_file(''),
+
+ % Try writing to a bad filename
+ ?line {error, enoent} =
+ ?FILE_MODULE:write_file("",term_to_binary(NullTerm)),
+
+ % Try writing something else than a binary
+ ?line {error, badarg} = ?FILE_MODULE:write_file(Name,{1,2,3}),
+ ?line {error, badarg} = ?FILE_MODULE:write_file(Name,self()),
+
+ %% Some non-term binaries
+ ?line ok = ?FILE_MODULE:write_file(Name,[]),
+ ?line {ok,Bin4} = ?FILE_MODULE:read_file(Name),
+ ?line 0 = byte_size(Bin4),
+
+ ?line ok = ?FILE_MODULE:write_file(Name,[Bin1,[],[[Bin2]]]),
+ ?line {ok,Bin5} = ?FILE_MODULE:read_file(Name),
+ ?line {Bin1,Bin2} = split_binary(Bin5,byte_size(Bin1)),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+dirs(suite) -> [make_del_dir, cur_dir_0, cur_dir_1].
+
+make_del_dir(suite) -> [];
+make_del_dir(doc) -> [];
+make_del_dir(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_mk-dir"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line {error, eexist} = ?FILE_MODULE:make_dir(NewDir),
+ ?line ok = ?FILE_MODULE:del_dir(NewDir),
+ ?line {error, enoent} = ?FILE_MODULE:del_dir(NewDir),
+
+ %% Check that we get an error when trying to create...
+ %% a deep directory
+ ?line NewDir2 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_mk-dir/foo"),
+ ?line {error, enoent} = ?FILE_MODULE:make_dir(NewDir2),
+ %% a nameless directory
+ ?line {error, enoent} = ?FILE_MODULE:make_dir(""),
+ %% a directory with illegal name
+ ?line {error, badarg} = ?FILE_MODULE:make_dir({1,2,3}),
+
+ %% a directory with illegal name, even if it's a (bad) list
+ ?line {error, badarg} = ?FILE_MODULE:make_dir([1,2,3,{}]),
+
+ %% Maybe this isn't an error, exactly, but worth mentioning anyway:
+ %% ok = ?FILE_MODULE:make_dir([$f,$o,$o,0,$b,$a,$r])),
+ %% The above line works, and created a directory "./foo"
+ %% More elegant would maybe have been to fail, or to really create
+ %% a directory, but with a name that incorporates the "bar" part of
+ %% the list, so that [$f,$o,$o,0,$f,$o,$o] wouldn't refer to the same
+ %% dir. But this would slow it down.
+
+ %% Try deleting some bad directories
+ %% Deleting the parent directory to the current, sounds dangerous, huh?
+ %% Don't worry ;-) the parent directory should never be empty, right?
+ ?line {error, eexist} = ?FILE_MODULE:del_dir('..'),
+ ?line {error, enoent} = ?FILE_MODULE:del_dir(""),
+ ?line {error, badarg} = ?FILE_MODULE:del_dir([3,2,1,{}]),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+cur_dir_0(suite) -> [];
+cur_dir_0(doc) -> [];
+cur_dir_0(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ %% Find out the current dir, and cd to it ;-)
+ ?line {ok,BaseDir} = ?FILE_MODULE:get_cwd(),
+ ?line Dir1 = BaseDir ++ "", %% Check that it's a string
+ ?line ok = ?FILE_MODULE:set_cwd(Dir1),
+
+ %% Make a new dir, and cd to that
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_curdir"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line io:format("cd to ~s",[NewDir]),
+ ?line ok = ?FILE_MODULE:set_cwd(NewDir),
+
+ %% Create a file in the new current directory, and check that it
+ %% really is created there
+ ?line UncommonName = "uncommon.fil",
+ ?line {ok,Fd} = ?FILE_MODULE:open(UncommonName,read_write),
+ ?line ok = ?FILE_MODULE:close(Fd),
+ ?line {ok,NewDirFiles} = ?FILE_MODULE:list_dir("."),
+ ?line true = lists:member(UncommonName,NewDirFiles),
+
+ %% Delete the directory and return to the old current directory
+ %% and check that the created file isn't there (too!)
+ ?line expect({error, einval}, {error, eacces},
+ ?FILE_MODULE:del_dir(NewDir)),
+ ?line ?FILE_MODULE:delete(UncommonName),
+ ?line {ok,[]} = ?FILE_MODULE:list_dir("."),
+ ?line ok = ?FILE_MODULE:set_cwd(Dir1),
+ ?line io:format("cd back to ~s",[Dir1]),
+ ?line ok = ?FILE_MODULE:del_dir(NewDir),
+ ?line {error, enoent} = ?FILE_MODULE:set_cwd(NewDir),
+ ?line ok = ?FILE_MODULE:set_cwd(Dir1),
+ ?line io:format("cd back to ~s",[Dir1]),
+ ?line {ok,OldDirFiles} = ?FILE_MODULE:list_dir("."),
+ ?line false = lists:member(UncommonName,OldDirFiles),
+
+ %% Try doing some bad things
+ ?line {error, badarg} = ?FILE_MODULE:set_cwd({foo,bar}),
+ ?line {error, enoent} = ?FILE_MODULE:set_cwd(""),
+ ?line {error, enoent} = ?FILE_MODULE:set_cwd(".......a......"),
+ ?line {ok,BaseDir} = ?FILE_MODULE:get_cwd(), %% Still there?
+
+ %% On Windows, there should only be slashes, no backslashes,
+ %% in the return value of get_cwd().
+ %% (The test is harmless on Unix, because filenames usually
+ %% don't contain backslashes.)
+
+ ?line {ok, BaseDir} = ?FILE_MODULE:get_cwd(),
+ ?line false = lists:member($\\, BaseDir),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Tests ?FILE_MODULE:get_cwd/1.
+
+cur_dir_1(suite) -> [];
+cur_dir_1(doc) -> [];
+cur_dir_1(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+
+ ?line case os:type() of
+ {unix, _} ->
+ ?line {error, enotsup} = ?FILE_MODULE:get_cwd("d:");
+ vxworks ->
+ ?line {error, enotsup} = ?FILE_MODULE:get_cwd("d:");
+ {win32, _} ->
+ win_cur_dir_1(Config)
+ end,
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+win_cur_dir_1(_Config) ->
+ ?line {ok,BaseDir} = ?FILE_MODULE:get_cwd(),
+
+ %% Get the drive letter from the current directory,
+ %% and try to get current directory for that drive.
+
+ ?line [Drive,$:|_] = BaseDir,
+ ?line {ok,BaseDir} = ?FILE_MODULE:get_cwd([Drive,$:]),
+ io:format("BaseDir = ~s\n", [BaseDir]),
+
+ %% Unfortunately, there is no way to move away from the
+ %% current drive as we can't use the "subst" command from
+ %% a SSH connection. We can't test any more.
+
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+files(suite) -> [open,pos,file_info,consult,eval,script,truncate,sync].
+
+open(suite) -> [open1,old_modes,new_modes,path_open,close,access,read_write,
+ pread_write,append,open_errors].
+
+open1(suite) -> [];
+open1(doc) -> [];
+open1(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_files"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line Name = filename:join(NewDir, "foo1.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,read_write),
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,read),
+ ?line Str = "{a,tuple}.\n",
+ ?line io:format(Fd1,Str,[]),
+ ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof),
+ ?line Str = io:get_line(Fd1,''),
+ ?line Str = io:get_line(Fd2,''),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof),
+ ?line ok = ?FILE_MODULE:truncate(Fd1),
+ ?line eof = io:get_line(Fd1,''),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line {ok,Fd3} = ?FILE_MODULE:open(Name,read),
+ ?line eof = io:get_line(Fd3,''),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Tests all open modes.
+
+old_modes(suite) -> [];
+old_modes(doc) -> [];
+old_modes(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_old_open_modes"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line Name1 = filename:join(NewDir, "foo1.fil"),
+ ?line Marker = "hello, world",
+
+ %% write
+ ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, write),
+ ?line ok = io:write(Fd1, Marker),
+ ?line ok = io:put_chars(Fd1, ".\n"),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+
+ %% read
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Name1, read),
+ ?line {ok, Marker} = io:read(Fd2, prompt),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+
+ %% read_write
+ ?line {ok, Fd3} = ?FILE_MODULE:open(Name1, read_write),
+ ?line {ok, Marker} = io:read(Fd3, prompt),
+ ?line ok = io:write(Fd3, Marker),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+new_modes(suite) -> [];
+new_modes(doc) -> [];
+new_modes(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_new_open_modes"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line Name1 = filename:join(NewDir, "foo1.fil"),
+ ?line Marker = "hello, world",
+
+ %% write
+ ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, [write]),
+ ?line ok = io:write(Fd1, Marker),
+ ?line ok = io:put_chars(Fd1, ".\n"),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+
+ %% read
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Name1, [read]),
+ ?line {ok, Marker} = io:read(Fd2, prompt),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+
+ %% read and write
+ ?line {ok, Fd3} = ?FILE_MODULE:open(Name1, [read, write]),
+ ?line {ok, Marker} = io:read(Fd3, prompt),
+ ?line ok = io:write(Fd3, Marker),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+
+ %% read by default
+ ?line {ok, Fd4} = ?FILE_MODULE:open(Name1, []),
+ ?line {ok, Marker} = io:read(Fd4, prompt),
+ ?line ok = ?FILE_MODULE:close(Fd4),
+
+ %% read and binary
+ ?line {ok, Fd5} = ?FILE_MODULE:open(Name1, [read, binary]),
+ ?line {ok, Marker} = io:read(Fd5, prompt),
+ ?line ok = ?FILE_MODULE:close(Fd5),
+
+ %% read, raw
+ ?line {ok, Fd6} = ?FILE_MODULE:open(Name1, [read, raw]),
+ ?line {ok, [$\[]} = ?FILE_MODULE:read(Fd6, 1),
+ ?line ok = ?FILE_MODULE:close(Fd6),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+path_open(suite) -> [];
+path_open(doc) -> [];
+path_open(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_path_open"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line FileName = "path_open.fil",
+ ?line Name = filename:join(RootDir, FileName),
+ ?line {ok,Fd1,_FullName1} =
+ ?FILE_MODULE:path_open(
+ [RootDir,
+ "nosuch1",
+ NewDir],FileName,write),
+ ?line io:format(Fd1,"ABCDEFGH",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+
+ %% locate it in the last dir
+ ?line {ok,Fd2,_FullName2} =
+ ?FILE_MODULE:path_open(
+ ["nosuch1",
+ NewDir,
+ RootDir],FileName,read),
+ ?line {ok,2} =
+ ?FILE_MODULE:position(Fd2,2), "C" = io:get_chars(Fd2,'',1),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ %% Try a failing path
+ ?line {error, enoent} = ?FILE_MODULE:path_open(
+ ["nosuch1",
+ NewDir],FileName,read),
+ %% Check that it's found regardless of path, if an absolute name given
+ ?line {ok,Fd3,_FullPath3} =
+ ?FILE_MODULE:path_open(
+ ["nosuch1",
+ NewDir],Name,read),
+ ?line {ok,2} =
+ ?FILE_MODULE:position(Fd3,2), "C" = io:get_chars(Fd3,'',1),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+close(suite) -> [];
+close(doc) -> [];
+close(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_close.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,read_write),
+ %% Just closing it is no fun, we did that a million times already
+ %% This is a common error, for code written before Erlang 4.3
+ %% bacause then ?FILE_MODULE:open just returned a Pid, and not everyone
+ %% really checked what they got.
+ ?line {'EXIT',_Msg} = (catch ok = ?FILE_MODULE:close({ok,Fd1})),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+
+ %% Try closing one more time
+ ?line Val = ?FILE_MODULE:close(Fd1),
+ ?line io:format("Second close gave: ~p",[Val]),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+access(suite) -> [];
+access(doc) -> [];
+access(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_access.fil"),
+ ?line Str = "ABCDEFGH",
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd1,Str,[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ %% Check that we can't write when in read only mode
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,read),
+ ?line case catch io:format(Fd2,"XXXX",[]) of
+ ok ->
+ test_server:fail({format,write});
+ _ ->
+ ok
+ end,
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line {ok,Fd3} = ?FILE_MODULE:open(Name,read),
+ ?line Str = io:get_line(Fd3,''),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Tests ?FILE_MODULE:read/2 and ?FILE_MODULE:write/2.
+
+read_write(suite) -> [];
+read_write(doc) -> [];
+read_write(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_read_write"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line Marker = "hello, world",
+ ?line MarkerB = list_to_binary(Marker),
+
+ %% Plain file.
+ ?line Name1 = filename:join(NewDir, "plain.fil"),
+ ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, [read, write]),
+ ?line read_write_test(Fd1, Marker, []),
+
+ %% Raw file.
+ ?line Name2 = filename:join(NewDir, "raw.fil"),
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Name2, [read, write, raw]),
+ ?line read_write_test(Fd2, Marker, []),
+
+ %% Plain binary file.
+ ?line Name3 = filename:join(NewDir, "plain-b.fil"),
+ ?line {ok, Fd3} = ?FILE_MODULE:open(Name3, [read, write, binary]),
+ ?line read_write_test(Fd3, MarkerB, <<>>),
+
+ %% Raw binary file.
+ ?line Name4 = filename:join(NewDir, "raw-b.fil"),
+ ?line {ok, Fd4} = ?FILE_MODULE:open(Name4, [read, write, raw, binary]),
+ ?line read_write_test(Fd4, MarkerB, <<>>),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+read_write_test(File, Marker, Empty) ->
+ ?line ok = ?FILE_MODULE:write(File, Marker),
+ ?line {ok, 0} = ?FILE_MODULE:position(File, 0),
+ ?line {ok, Empty} = ?FILE_MODULE:read(File, 0),
+ ?line {ok, Marker} = ?FILE_MODULE:read(File, 100),
+ ?line eof = ?FILE_MODULE:read(File, 100),
+ ?line {ok, Empty} = ?FILE_MODULE:read(File, 0),
+ ?line ok = ?FILE_MODULE:close(File),
+ ?line [] = flush(),
+ ok.
+
+
+%% Tests ?FILE_MODULE:pread/2 and ?FILE_MODULE:pwrite/2.
+
+pread_write(suite) -> [];
+pread_write(doc) -> [];
+pread_write(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_pread_write"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line List = "hello, world",
+ ?line Bin = list_to_binary(List),
+
+ %% Plain file.
+ ?line Name1 = filename:join(NewDir, "plain.fil"),
+ ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, [read, write]),
+ ?line pread_write_test(Fd1, List),
+
+ %% Raw file.
+ ?line Name2 = filename:join(NewDir, "raw.fil"),
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Name2, [read, write, raw]),
+ ?line pread_write_test(Fd2, List),
+
+ %% Plain file. Binary mode.
+ ?line Name3 = filename:join(NewDir, "plain-binary.fil"),
+ ?line {ok, Fd3} = ?FILE_MODULE:open(Name3, [binary, read, write]),
+ ?line pread_write_test(Fd3, Bin),
+
+ %% Raw file. Binary mode.
+ ?line Name4 = filename:join(NewDir, "raw-binary.fil"),
+ ?line {ok, Fd4} = ?FILE_MODULE:open(Name4, [binary, read, write, raw]),
+ ?line pread_write_test(Fd4, Bin),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+pread_write_test(File, Data) ->
+ ?line io:format("~p:pread_write_test(~p,~p)~n", [?MODULE, File, Data]),
+ ?line Size = if is_binary(Data) -> byte_size(Data);
+ is_list(Data) -> length(Data)
+ end,
+ ?line I = Size + 17,
+ ?line ok = ?FILE_MODULE:pwrite(File, 0, Data),
+ Res = ?FILE_MODULE:pread(File, 0, I),
+ ?line {ok, Data} = Res,
+ ?line eof = ?FILE_MODULE:pread(File, I, 1),
+ ?line ok = ?FILE_MODULE:pwrite(File, [{0, Data}, {I, Data}]),
+ ?line {ok, [Data, eof, Data]} =
+ ?FILE_MODULE:pread(File, [{0, Size}, {2*I, 1}, {I, Size}]),
+ ?line Plist = lists:seq(21*I, 0, -I),
+ ?line Pwrite = lists:map(fun(P)->{P,Data}end, Plist),
+ ?line Pread = [{22*I,Size} | lists:map(fun(P)->{P,Size}end, Plist)],
+ ?line Presult = [eof | lists:map(fun(_)->Data end, Plist)],
+ ?line ok = ?FILE_MODULE:pwrite(File, Pwrite),
+ ?line {ok, Presult} = ?FILE_MODULE:pread(File, Pread),
+ ?line ok = ?FILE_MODULE:close(File),
+ ?line [] = flush(),
+ ok.
+
+append(doc) -> "Test appending to a file.";
+append(suite) -> [];
+append(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_append"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+
+ ?line First = "First line\n",
+ ?line Second = "Seond lines comes here\n",
+ ?line Third = "And here is the third line\n",
+
+ %% Write a small text file.
+ ?line Name1 = filename:join(NewDir, "a_file.txt"),
+ ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, [write]),
+ ?line ok = io:format(Fd1, First, []),
+ ?line ok = io:format(Fd1, Second, []),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+
+ %% Open it a again and a append a line to it.
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Name1, [append]),
+ ?line ok = io:format(Fd2, Third, []),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+
+ %% Read it back and verify.
+ ?line Expected = list_to_binary([First, Second, Third]),
+ ?line {ok, Expected} = ?FILE_MODULE:read_file(Name1),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+open_errors(suite) -> [];
+open_errors(doc) -> [];
+open_errors(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line DataDir =
+ filename:dirname(
+ filename:join(?config(data_dir, Config), "x")),
+ ?line DataDirSlash = DataDir++"/",
+ ?line {error, E1} = ?FILE_MODULE:open(DataDir, [read]),
+ ?line {error, E2} = ?FILE_MODULE:open(DataDirSlash, [read]),
+ ?line {error, E3} = ?FILE_MODULE:open(DataDir, [write]),
+ ?line {error, E4} = ?FILE_MODULE:open(DataDirSlash, [write]),
+ ?line {eisdir,eisdir,eisdir,eisdir} = {E1,E2,E3,E4},
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+pos(suite) -> [pos1,pos2].
+
+pos1(suite) -> [];
+pos1(doc) -> [];
+pos1(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_pos1.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd1,"ABCDEFGH",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,read),
+
+ %% Start pos is first char
+ ?line io:format("Relative positions"),
+ ?line "A" = io:get_chars(Fd2,'',1),
+ ?line {ok,2} = ?FILE_MODULE:position(Fd2,{cur,1}),
+ ?line "C" = io:get_chars(Fd2,'',1),
+ ?line {ok,0} = ?FILE_MODULE:position(Fd2,{cur,-3}),
+ ?line "A" = io:get_chars(Fd2,'',1),
+ %% Backwards from first char should be an error
+ ?line {ok,0} = ?FILE_MODULE:position(Fd2,{cur,-1}),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd2,{cur,-1}),
+ %% Reset position and move again
+ ?line {ok,0} = ?FILE_MODULE:position(Fd2,0),
+ ?line {ok,2} = ?FILE_MODULE:position(Fd2,{cur,2}),
+ ?line "C" = io:get_chars(Fd2,'',1),
+ %% Go a lot forwards
+ ?line {ok,13} = ?FILE_MODULE:position(Fd2,{cur,10}),
+ ?line eof = io:get_chars(Fd2,'',1),
+
+ %% Try some fixed positions
+ ?line io:format("Fixed positions"),
+ ?line {ok,8} =
+ ?FILE_MODULE:position(Fd2,8), eof = io:get_chars(Fd2,'',1),
+ ?line {ok,8} =
+ ?FILE_MODULE:position(Fd2,cur), eof = io:get_chars(Fd2,'',1),
+ ?line {ok,7} =
+ ?FILE_MODULE:position(Fd2,7), "H" = io:get_chars(Fd2,'',1),
+ ?line {ok,0} =
+ ?FILE_MODULE:position(Fd2,0), "A" = io:get_chars(Fd2,'',1),
+ ?line {ok,3} =
+ ?FILE_MODULE:position(Fd2,3), "D" = io:get_chars(Fd2,'',1),
+ ?line {ok,12} =
+ ?FILE_MODULE:position(Fd2,12), eof = io:get_chars(Fd2,'',1),
+ ?line {ok,3} =
+ ?FILE_MODULE:position(Fd2,3), "D" = io:get_chars(Fd2,'',1),
+ %% Try the {bof,X} notation
+ ?line {ok,3} = ?FILE_MODULE:position(Fd2,{bof,3}),
+ ?line "D" = io:get_chars(Fd2,'',1),
+
+ %% Try eof positions
+ ?line io:format("EOF positions"),
+ ?line {ok,8} =
+ ?FILE_MODULE:position(Fd2,{eof,0}), eof=io:get_chars(Fd2,'',1),
+ ?line {ok,7} =
+ ?FILE_MODULE:position(Fd2,{eof,-1}),
+ ?line "H" = io:get_chars(Fd2,'',1),
+ ?line {ok,0} =
+ ?FILE_MODULE:position(Fd2,{eof,-8}), "A"=io:get_chars(Fd2,'',1),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd2,{eof,-9}),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+pos2(suite) -> [];
+pos2(doc) -> [];
+pos2(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_pos2.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd1,"ABCDEFGH",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,read),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd2,-1),
+
+ %% Make sure that we still can search after an error.
+ ?line {ok,0} = ?FILE_MODULE:position(Fd2, 0),
+ ?line {ok,3} = ?FILE_MODULE:position(Fd2, {bof,3}),
+ ?line "D" = io:get_chars(Fd2,'',1),
+
+ ?line [] = flush(),
+ ?line io:format("DONE"),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+file_info(suite) -> [file_info_basic_file, file_info_basic_directory,
+ file_info_bad, file_info_times, file_write_file_info].
+
+file_info_basic_file(suite) -> [];
+file_info_basic_file(doc) -> [];
+file_info_basic_file(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir, Config),
+
+ %% Create a short file.
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_basic_test.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name, write),
+ ?line io:put_chars(Fd1, "foo bar"),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+
+ %% Test that the file has the expected attributes.
+ %% The times are tricky, so we will save them to a separate test case.
+ ?line {ok,#file_info{size=Size,type=Type,access=Access,
+ atime=AccessTime,mtime=ModifyTime}} =
+ ?FILE_MODULE:read_file_info(Name),
+ ?line io:format("Access ~p, Modify ~p", [AccessTime, ModifyTime]),
+ ?line Size = 7,
+ ?line Type = regular,
+ ?line read_write = Access,
+ ?line true = abs(time_dist(filter_atime(AccessTime, Config),
+ filter_atime(ModifyTime,
+ Config))) < 2,
+ ?line all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+file_info_basic_directory(suite) -> [];
+file_info_basic_directory(doc) -> [];
+file_info_basic_directory(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+
+ %% Note: filename:join/1 removes any trailing slash,
+ %% which is essential for ?FILE_MODULE:file_info/1 to work on
+ %% platforms such as Windows95.
+ ?line RootDir = filename:join([?config(priv_dir, Config)]),
+
+ %% Test that the RootDir directory has the expected attributes.
+ ?line test_directory(RootDir, read_write),
+
+ %% Note that on Windows file systems,
+ %% "/" or "c:/" are *NOT* directories.
+ %% Therefore, test that ?FILE_MODULE:file_info/1 behaves as if they were
+ %% directories.
+ ?line case os:type() of
+ {win32, _} ->
+ ?line test_directory("/", read_write),
+ ?line test_directory("c:/", read_write),
+ ?line test_directory("c:\\", read_write);
+ {unix, _} ->
+ ?line test_directory("/", read);
+ vxworks ->
+ %% Check is just done for owner
+ ?line test_directory("/", read_write)
+ end,
+ ?line test_server:timetrap_cancel(Dog).
+
+test_directory(Name, ExpectedAccess) ->
+ ?line {ok,#file_info{size=Size,type=Type,access=Access,
+ atime=AccessTime,mtime=ModifyTime}} =
+ ?FILE_MODULE:read_file_info(Name),
+ ?line io:format("Testing directory ~s", [Name]),
+ ?line io:format("Directory size is ~p", [Size]),
+ ?line io:format("Access ~p", [Access]),
+ ?line io:format("Access time ~p; Modify time~p",
+ [AccessTime, ModifyTime]),
+ ?line Type = directory,
+ ?line Access = ExpectedAccess,
+ ?line all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)),
+ ?line [] = flush(),
+ ok.
+
+all_integers([{A,B,C}|T]) ->
+ all_integers([A,B,C|T]);
+all_integers([Int|Rest]) when is_integer(Int) ->
+ ?line all_integers(Rest);
+all_integers([]) -> ok.
+
+%% Try something nonexistent.
+
+file_info_bad(suite) -> [];
+file_info_bad(doc) -> [];
+file_info_bad(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = filename:join([?config(priv_dir, Config)]),
+ ?line {error, enoent} =
+ ?FILE_MODULE:read_file_info(
+ filename:join(RootDir,
+ atom_to_list(?MODULE)++ "_nonexistent")),
+ ?line {error, enoent} = ?FILE_MODULE:read_file_info(""),
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Test that the file times behave as they should.
+
+file_info_times(suite) -> [];
+file_info_times(doc) -> [];
+file_info_times(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(60)),
+ %% We have to try this twice, since if the test runs across the change
+ %% of a month the time diff calculations will fail. But it won't happen
+ %% if you run it twice in succession.
+ ?line test_server:m_out_of_n(
+ 1,2,
+ fun() -> ?line file_info_int(Config) end),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+file_info_int(Config) ->
+ %% Note: filename:join/1 removes any trailing slash,
+ %% which is essential for ?FILE_MODULE:file_info/1 to work on
+ %% platforms such as Windows95.
+
+ ?line RootDir = filename:join([?config(priv_dir, Config)]),
+ ?line test_server:format("RootDir = ~p", [RootDir]),
+
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_file_info.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ ?line io:put_chars(Fd1,"foo"),
+
+ %% check that the file got a modify date max a few seconds away from now
+ ?line {ok,#file_info{type=regular,atime=AccTime1,mtime=ModTime1}} =
+ ?FILE_MODULE:read_file_info(Name),
+ ?line Now = erlang:localtime(), %???
+ ?line io:format("Now ~p",[Now]),
+ ?line io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]),
+ ?line true = abs(time_dist(filter_atime(Now, Config),
+ filter_atime(AccTime1,
+ Config))) < 8,
+ ?line true = abs(time_dist(Now,ModTime1)) < 8,
+
+ %% Sleep until we can be sure the seconds value has changed.
+ %% Note: FAT-based filesystem (like on Windows 95) have
+ %% a resolution of 2 seconds.
+ ?line test_server:sleep(test_server:seconds(2.2)),
+
+ %% close the file, and watch the modify date change
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line {ok,#file_info{size=Size,type=regular,access=Access,
+ atime=AccTime2,mtime=ModTime2}} =
+ ?FILE_MODULE:read_file_info(Name),
+ ?line io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]),
+ ?line true = time_dist(ModTime1,ModTime2) >= 0,
+
+ %% this file is supposed to be binary, so it'd better keep it's size
+ ?line Size = 3,
+ ?line Access = read_write,
+
+ %% Do some directory checking
+ ?line {ok,#file_info{size=DSize,type=directory,access=DAccess,
+ atime=AccTime3,mtime=ModTime3}} =
+ ?FILE_MODULE:read_file_info(RootDir),
+ %% this dir was modified only a few secs ago
+ ?line io:format("Dir Acc ~p; Mod ~p; Now ~p", [AccTime3, ModTime3, Now]),
+ ?line true = abs(time_dist(Now,ModTime3)) < 5,
+ ?line DAccess = read_write,
+ ?line io:format("Dir size is ~p",[DSize]),
+
+ ?line [] = flush(),
+ ok.
+
+%% Filter access times, to copy with a deficiency of FAT file systems
+%% (on Windows): The access time is actually only a date.
+
+filter_atime(Atime, Config) ->
+ case lists:member(no_access_time, Config) of
+ true ->
+ case Atime of
+ {Date, _} ->
+ {Date, {0, 0, 0}};
+ {Y, M, D, _, _, _} ->
+ {Y, M, D, 0, 0, 0}
+ end;
+ false ->
+ Atime
+ end.
+
+%% Test the write_file_info/2 function.
+
+file_write_file_info(suite) -> [];
+file_write_file_info(doc) -> [];
+file_write_file_info(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = get_good_directory(Config),
+ ?line test_server:format("RootDir = ~p", [RootDir]),
+
+ %% Set the file to read only AND update the file times at the same time.
+ %% (This used to fail on Windows NT/95 for a local filesystem.)
+ %% Note: Seconds must be even; see note in file_info_times/1.
+
+ ?line Name1 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_write_file_info_ro"),
+ ?line ok = ?FILE_MODULE:write_file(Name1, "hello"),
+ ?line Time = {{1997, 01, 02}, {12, 35, 42}},
+ ?line Info = #file_info{mode=8#400, atime=Time, mtime=Time, ctime=Time},
+ ?line ok = ?FILE_MODULE:write_file_info(Name1, Info),
+
+ %% Read back the times.
+
+ ?line {ok, ActualInfo} = ?FILE_MODULE:read_file_info(Name1),
+ ?line #file_info{mode=_Mode, atime=ActAtime, mtime=Time,
+ ctime=ActCtime} = ActualInfo,
+ ?line FilteredAtime = filter_atime(Time, Config),
+ ?line FilteredAtime = filter_atime(ActAtime, Config),
+ ?line case os:type() of
+ {win32, _} ->
+ %% On Windows, "ctime" means creation time and it can
+ %% be set.
+ ActCtime = Time;
+ _ ->
+ ok
+ end,
+ ?line {error, eacces} = ?FILE_MODULE:write_file(Name1, "hello again"),
+
+ %% Make the file writable again.
+
+ ?line ?FILE_MODULE:write_file_info(Name1, #file_info{mode=8#600}),
+ ?line ok = ?FILE_MODULE:write_file(Name1, "hello again"),
+
+ %% And unwritable.
+ ?line ?FILE_MODULE:write_file_info(Name1, #file_info{mode=8#400}),
+ ?line {error, eacces} = ?FILE_MODULE:write_file(Name1, "hello again"),
+
+ %% Write the times again.
+ %% Note: Seconds must be even; see note in file_info_times/1.
+
+ ?line NewTime = {{1997, 02, 15}, {13, 18, 20}},
+ ?line NewInfo = #file_info{atime=NewTime, mtime=NewTime, ctime=NewTime},
+ ?line ok = ?FILE_MODULE:write_file_info(Name1, NewInfo),
+ ?line {ok, ActualInfo2} = ?FILE_MODULE:read_file_info(Name1),
+ ?line #file_info{atime=NewActAtime, mtime=NewTime,
+ ctime=NewActCtime} = ActualInfo2,
+ ?line NewFilteredAtime = filter_atime(NewTime, Config),
+ ?line NewFilteredAtime = filter_atime(NewActAtime, Config),
+ ?line case os:type() of
+ {win32, _} -> NewActCtime = NewTime;
+ _ -> ok
+ end,
+
+ %% The file should still be unwritable.
+ ?line {error, eacces} = ?FILE_MODULE:write_file(Name1, "hello again"),
+
+ %% Make the file writeable again, so that we can remove the
+ %% test suites ... :-)
+ ?line ?FILE_MODULE:write_file_info(Name1, #file_info{mode=8#600}),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Returns a directory on a file system that has correct file times.
+
+get_good_directory(Config) ->
+ ?line ?config(priv_dir, Config).
+
+consult(suite) -> [consult1, path_consult].
+
+consult1(suite) -> [];
+consult1(doc) -> [];
+consult1(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_consult.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ %% note that there is no final \n (only a space)
+ ?line io:format(Fd1,
+ "{this,[is,1.0],'journey'}.\n\"into\". (sound). ",
+ []),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line {ok,[{this,[is,1.0],journey},"into",sound]} =
+ ?FILE_MODULE:consult(Name),
+
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write),
+ %% note the missing double quote
+ ?line io:format(
+ Fd2,"{this,[is,1.0],'journey'}.\n \"into. (sound). ",[]),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line {error, {_, _, _} = Msg} = ?FILE_MODULE:consult(Name),
+ ?line io:format("Errmsg: ~p",[Msg]),
+
+ ?line {error, enoent} = ?FILE_MODULE:consult(Name ++ ".nonexistent"),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+path_consult(suite) -> [];
+path_consult(doc) -> [];
+path_consult(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line FileName = atom_to_list(?MODULE)++"_path_consult.fil",
+ ?line Name = filename:join(RootDir, FileName),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd1,"{this,is,a,journey,into,sound}.\n",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ %% File last in path
+ ?line {ok,[{this,is,a,journey,into,sound}],Dir} =
+ ?FILE_MODULE:path_consult(
+ [filename:join(RootDir, "dir1"),
+ filename:join(RootDir, ".."),
+ filename:join(RootDir, "dir2"),
+ RootDir], FileName),
+ ?line true = lists:prefix(RootDir,Dir),
+
+ %% While maybe not an error, it may be worth noting that
+ %% when the full path to a file is given, it's always found
+ %% regardless of the contents of the path
+ ?line {ok,_,_} = ?FILE_MODULE:path_consult(["nosuch1","nosuch2"],Name),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+eval(suite) -> [eval1,path_eval].
+
+eval1(suite) -> [];
+eval1(doc) -> [];
+eval1(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_eval.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ %% note that there is no final \n (only a space)
+ ?line io:format(Fd1,"put(evaluated_ok,\ntrue). ",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line ok = ?FILE_MODULE:eval(Name),
+ ?line true = get(evaluated_ok),
+
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write),
+ %% note that there is no final \n (only a space)
+ ?line io:format(Fd2,"put(evaluated_ok,\nR). ",[]),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line ok = ?FILE_MODULE:eval(
+ Name,
+ erl_eval:add_binding('R', true, erl_eval:new_bindings())),
+ ?line true = get(evaluated_ok),
+
+ ?line {ok,Fd3} = ?FILE_MODULE:open(Name,write),
+ %% garbled
+ ?line io:format(Fd3,"puGARBLED-GARBLED\ntrue). ",[]),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+ ?line {error, {_, _, _} = Msg} = ?FILE_MODULE:eval(Name),
+ ?line io:format("Errmsg1: ~p",[Msg]),
+
+ ?line {error, enoent} = ?FILE_MODULE:eval(Name ++ ".nonexistent"),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+path_eval(suite) -> [];
+path_eval(doc) -> [];
+path_eval(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line FileName = atom_to_list(?MODULE)++"_path_eval.fil",
+ ?line Name = filename:join(RootDir, FileName),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd1,"put(evaluated_ok,true).\n",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ %% File last in path
+ ?line {ok,Dir} =
+ ?FILE_MODULE:path_eval(
+ [filename:join(RootDir, "dir1"),
+ filename:join(RootDir, ".."),
+ filename:join(RootDir, "dir2"),
+ RootDir],FileName),
+ ?line true = get(evaluated_ok),
+ ?line true = lists:prefix(RootDir,Dir),
+
+ %% While maybe not an error, it may be worth noting that
+ %% when the full path to a file is given, it's always found
+ %% regardless of the contents of the path
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd2,"put(evaluated_ok,R).\n",[]),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line {ok,_} = ?FILE_MODULE:path_eval(
+ ["nosuch1","nosuch2"],
+ Name,
+ erl_eval:add_binding('R', true, erl_eval:new_bindings())),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+script(suite) -> [script1,path_script].
+
+script1(suite) -> [];
+script1(doc) -> "";
+script1(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_script.fil"),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ %% note that there is no final \n (only a space)
+ ?line io:format(Fd1,"A = 11,\nB = 6,\nA+B. ",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line {ok,17} = ?FILE_MODULE:script(Name),
+
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write),
+ %% note that there is no final \n (only a space)
+ ?line io:format(Fd2,"A = 11,\nA+B. ",[]),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line {ok,17} = ?FILE_MODULE:script(
+ Name,
+ erl_eval:add_binding('B', 6, erl_eval:new_bindings())),
+
+ ?line {ok,Fd3} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd3,"A = 11,\nB = six,\nA+B. ",[]),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+ ?line {error, {_, _, _} = Msg} = ?FILE_MODULE:script(Name),
+ ?line io:format("Errmsg1: ~p",[Msg]),
+
+ ?line {error, enoent} = ?FILE_MODULE:script(Name ++ ".nonexistent"),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+path_script(suite) -> [];
+path_script(doc) -> [];
+path_script(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line FileName = atom_to_list(?MODULE)++"_path_script.fil",
+ ?line Name = filename:join(RootDir, FileName),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd1,"A = 11,\nB = 6,\nA+B.\n",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ %% File last in path
+ ?line {ok, 17, Dir} =
+ ?FILE_MODULE:path_script(
+ [filename:join(RootDir, "dir1"),
+ filename:join(RootDir, ".."),
+ filename:join(RootDir, "dir2"),
+ RootDir],FileName),
+ ?line true = lists:prefix(RootDir,Dir),
+
+ %% While maybe not an error, it may be worth noting that
+ %% when the full path to a file is given, it's always found
+ %% regardless of the contents of the path
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write),
+ ?line io:format(Fd2,"A = 11,\nA+B.",[]),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line {ok, 17, Dir} =
+ ?FILE_MODULE:path_script(
+ ["nosuch1","nosuch2"],
+ Name,
+ erl_eval:add_binding('B', 6, erl_eval:new_bindings())),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+truncate(suite) -> [];
+truncate(doc) -> [];
+truncate(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_truncate.fil"),
+
+ %% Create a file with some data.
+ ?line MyData = "0123456789abcdefghijklmnopqrstuvxyz",
+ ?line ok = ?FILE_MODULE:write_file(Name, MyData),
+
+ %% Truncate the file to 10 characters.
+ ?line {ok, Fd} = ?FILE_MODULE:open(Name, read_write),
+ ?line {ok, 10} = ?FILE_MODULE:position(Fd, 10),
+ ?line ok = ?FILE_MODULE:truncate(Fd),
+ ?line ok = ?FILE_MODULE:close(Fd),
+
+ %% Read back the file and check that it has been truncated.
+ ?line Expected = list_to_binary("0123456789"),
+ ?line {ok, Expected} = ?FILE_MODULE:read_file(Name),
+
+ %% Open the file read only and verify that it is not possible to
+ %% truncate it, OTP-1960
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Name, read),
+ ?line {ok, 5} = ?FILE_MODULE:position(Fd2, 5),
+ ?line {error, _} = ?FILE_MODULE:truncate(Fd2),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+sync(suite) -> [];
+sync(doc) -> "Tests that ?FILE_MODULE:sync/1 at least doesn't crash.";
+sync(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Sync = filename:join(PrivDir,
+ atom_to_list(?MODULE)
+ ++"_sync.fil"),
+
+ %% Raw open.
+ ?line {ok, Fd} = ?FILE_MODULE:open(Sync, [write, raw]),
+ ?line ok = ?FILE_MODULE:sync(Fd),
+ ?line ok = ?FILE_MODULE:close(Fd),
+
+ %% Ordinary open.
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Sync, [write]),
+ ?line ok = ?FILE_MODULE:sync(Fd2),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+delete(suite) -> [];
+delete(doc) -> [];
+delete(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_delete.fil"),
+ ?line {ok, Fd1} = ?FILE_MODULE:open(Name, write),
+ ?line io:format(Fd1,"ok.\n",[]),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ %% Check that the file is readable
+ ?line {ok, Fd2} = ?FILE_MODULE:open(Name, read),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line ok = ?FILE_MODULE:delete(Name),
+ %% Check that the file is not readable anymore
+ ?line {error, _} = ?FILE_MODULE:open(Name, read),
+ %% Try deleting a nonexistent file
+ ?line {error, enoent} = ?FILE_MODULE:delete(Name),
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+rename(suite) ->[];
+rename(doc) ->[];
+rename(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line FileName1 = atom_to_list(?MODULE)++"_rename.fil",
+ ?line FileName2 = atom_to_list(?MODULE)++"_rename.ful",
+ ?line Name1 = filename:join(RootDir, FileName1),
+ ?line Name2 = filename:join(RootDir, FileName2),
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name1,write),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ %% Rename, and check that id really changed name
+ ?line ok = ?FILE_MODULE:rename(Name1,Name2),
+ ?line {error, _} = ?FILE_MODULE:open(Name1,read),
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name2,read),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ %% Try renaming something to itself
+ ?line ok = ?FILE_MODULE:rename(Name2,Name2),
+ %% Try renaming something that doesn't exist
+ ?line {error, enoent} = ?FILE_MODULE:rename(Name1,Name2),
+ %% Try renaming to something else than a string
+ ?line {error, badarg} = ?FILE_MODULE:rename(Name1,{foo,bar}),
+
+ %% Move between directories
+ ?line DirName1 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_rename_dir"),
+ ?line DirName2 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_second_rename_dir"),
+ ?line Name1foo = filename:join(DirName1, "foo.fil"),
+ ?line Name2foo = filename:join(DirName2, "foo.fil"),
+ ?line Name2bar = filename:join(DirName2, "bar.dir"),
+ ?line ok = ?FILE_MODULE:make_dir(DirName1),
+ %% The name has to include the full file name, path in not enough
+ ?line expect({error, eisdir}, {error, eexist},
+ ?FILE_MODULE:rename(Name2,DirName1)),
+ ?line ok = ?FILE_MODULE:rename(Name2, Name1foo),
+ %% Now rename the directory
+ ?line ok = ?FILE_MODULE:rename(DirName1,DirName2),
+ %% And check that the file is there now
+ ?line {ok,Fd3} = ?FILE_MODULE:open(Name2foo, read),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+ %% Try some dirty things now: move the directory into itself
+ ?line {error, Msg1} = ?FILE_MODULE:rename(DirName2, Name2bar),
+ ?line io:format("Errmsg1: ~p",[Msg1]),
+ %% move dir into a file in itself
+ ?line {error, Msg2} = ?FILE_MODULE:rename(DirName2, Name2foo),
+ ?line io:format("Errmsg2: ~p",[Msg2]),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+names(suite) -> [];
+names(doc) -> [];
+names(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line FileName = "foo1.fil",
+ ?line Name1 = filename:join(RootDir, FileName),
+ ?line Name2 = [RootDir,"/","foo1",".","fil"],
+ ?line Name3 = [RootDir,"/",foo,$1,[[[],[],'.']],"f",il],
+ ?line Name4 = list_to_atom(Name1),
+ ?line {ok,Fd0} = ?FILE_MODULE:open(Name1,write),
+ ?line ok = ?FILE_MODULE:close(Fd0),
+
+ %% Try some file names
+ ?line {ok,Fd1} = ?FILE_MODULE:open(Name1,read),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line {ok,Fd2f} = ?FILE_MODULE:open(lists:flatten(Name2),read),
+ ?line ok = ?FILE_MODULE:close(Fd2f),
+ ?line {ok,Fd2} = ?FILE_MODULE:open(Name2,read),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line {ok,Fd3} = ?FILE_MODULE:open(Name3,read),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+ ?line {ok,Fd4} = ?FILE_MODULE:open(Name4,read),
+ ?line ok = ?FILE_MODULE:close(Fd4),
+
+ %% Try some path names
+ ?line Path1 = RootDir,
+ ?line Path2 = [RootDir],
+ ?line Path3 = ['',[],[RootDir,[[]]]],
+ ?line Path4 = list_to_atom(Path1),
+ ?line {ok,Fd11,_} = ?FILE_MODULE:path_open([Path1],FileName,read),
+ ?line ok = ?FILE_MODULE:close(Fd11),
+ ?line {ok,Fd12,_} = ?FILE_MODULE:path_open([Path2],FileName,read),
+ ?line ok = ?FILE_MODULE:close(Fd12),
+ ?line {ok,Fd13,_} = ?FILE_MODULE:path_open([Path3],FileName,read),
+ ?line ok = ?FILE_MODULE:close(Fd13),
+ ?line {ok,Fd14,_} = ?FILE_MODULE:path_open([Path4],FileName,read),
+ ?line ok = ?FILE_MODULE:close(Fd14),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+errors(suite) -> [e_delete, e_rename, e_make_dir, e_del_dir].
+
+e_delete(suite) -> [];
+e_delete(doc) -> [];
+e_delete(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_e_delete"),
+ ?line ok = ?FILE_MODULE:make_dir(Base),
+
+ %% Delete a non-existing file.
+ ?line {error, enoent} =
+ ?FILE_MODULE:delete(filename:join(Base, "non_existing")),
+
+ %% Delete a directory.
+ ?line {error, eperm} = ?FILE_MODULE:delete(Base),
+
+ %% Use a path-name with a non-directory component.
+ ?line Afile = filename:join(Base, "a_file"),
+ ?line ok = ?FILE_MODULE:write_file(Afile, "hello\n"),
+ ?line {error, E} =
+ expect({error, enotdir}, {error, enoent},
+ ?FILE_MODULE:delete(filename:join(Afile, "another_file"))),
+ ?line io:format("Result: ~p~n", [E]),
+
+ %% No permission.
+ ?line case os:type() of
+ {unix, _} ->
+ ?line ?FILE_MODULE:write_file_info(
+ Base, #file_info {mode=0}),
+ ?line {error, eacces} = ?FILE_MODULE:delete(Afile),
+ ?line ?FILE_MODULE:write_file_info(
+ Base, #file_info {mode=8#600});
+ {win32, _} ->
+ %% Remove a character device.
+ ?line {error, eacces} = ?FILE_MODULE:delete("nul");
+ vxworks ->
+ ok
+ end,
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%% FreeBSD gives EEXIST when renaming a file to an empty dir, although the
+%%% manual page can be interpreted as saying that EISDIR should be given.
+%%% (What about FreeBSD? We store our nightly build results on a FreeBSD
+%%% file system, that's what.)
+
+e_rename(suite) -> [];
+e_rename(doc) -> [];
+e_rename(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "Windriver: dosFs must be fixed first!"};
+ _ ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_e_rename"),
+ ?line ok = ?FILE_MODULE:make_dir(Base),
+
+ %% Create an empty directory.
+ ?line EmptyDir = filename:join(Base, "empty_dir"),
+ ?line ok = ?FILE_MODULE:make_dir(EmptyDir),
+
+ %% Create a non-empty directory.
+ ?line NonEmptyDir = filename:join(Base, "non_empty_dir"),
+ ?line ok = ?FILE_MODULE:make_dir(NonEmptyDir),
+ ?line ok = ?FILE_MODULE:write_file(
+ filename:join(NonEmptyDir, "a_file"),
+ "hello\n"),
+
+ %% Create another non-empty directory.
+ ?line ADirectory = filename:join(Base, "a_directory"),
+ ?line ok = ?FILE_MODULE:make_dir(ADirectory),
+ ?line ok = ?FILE_MODULE:write_file(
+ filename:join(ADirectory, "a_file"),
+ "howdy\n\n"),
+
+ %% Create a data file.
+ ?line File = filename:join(Base, "just_a_file"),
+ ?line ok = ?FILE_MODULE:write_file(File, "anything goes\n\n"),
+
+ %% Move an existing directory to a non-empty directory.
+ ?line {error, eexist} =
+ ?FILE_MODULE:rename(ADirectory, NonEmptyDir),
+
+ %% Move a root directory.
+ ?line {error, einval} = ?FILE_MODULE:rename("/", "arne"),
+
+ %% Move Base into Base/new_name.
+ ?line {error, einval} =
+ ?FILE_MODULE:rename(Base, filename:join(Base, "new_name")),
+
+ %% Overwrite a directory with a file.
+ ?line expect({error, eexist}, %FreeBSD (?)
+ {error, eisdir},
+ ?FILE_MODULE:rename(File, EmptyDir)),
+ ?line expect({error, eexist}, %FreeBSD (?)
+ {error, eisdir},
+ ?FILE_MODULE:rename(File, NonEmptyDir)),
+
+ %% Move a non-existing file.
+ ?line NonExistingFile =
+ filename:join(Base, "non_existing_file"),
+ ?line {error, enoent} =
+ ?FILE_MODULE:rename(NonExistingFile, NonEmptyDir),
+
+ %% Overwrite a file with a directory.
+ ?line expect({error, eexist}, %FreeBSD (?)
+ {error, enotdir},
+ ?FILE_MODULE:rename(ADirectory, File)),
+
+ %% Move a file to another filesystem.
+ %% XXX - This test case is bogus. We cannot be guaranteed that
+ %% the source and destination are on
+ %% different filesystems.
+ %%
+ %% XXX - Gross hack!
+ ?line Comment =
+ case os:type() of
+ {unix, _} ->
+ OtherFs = "/tmp",
+ ?line NameOnOtherFs =
+ filename:join(OtherFs, filename:basename(File)),
+ ?line {ok, Com} =
+ case ?FILE_MODULE:rename(File, NameOnOtherFs) of
+ {error, exdev} ->
+ %% The file could be in
+ %% the same filesystem!
+ {ok, ok};
+ ok ->
+ {ok, {comment,
+ "Moving between filesystems "
+ "suceeded, files are probably "
+ "in the same filesystem!"}};
+ {error, eperm} ->
+ {ok, {comment, "SBS! You don't "
+ "have the permission to do "
+ "this test!"}};
+ Else ->
+ Else
+ end,
+ Com;
+ {win32, _} ->
+ %% At least Windows NT can
+ %% successfully move a file to
+ %% another drive.
+ ok
+ end,
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ Comment
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+e_make_dir(suite) -> [];
+e_make_dir(doc) -> [];
+e_make_dir(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_e_make_dir"),
+ ?line ok = ?FILE_MODULE:make_dir(Base),
+
+ %% A component of the path does not exist.
+ ?line {error, enoent} =
+ ?FILE_MODULE:make_dir(filename:join([Base, "a", "b"])),
+
+ %% Use a path-name with a non-directory component.
+ ?line Afile = filename:join(Base, "a_directory"),
+ ?line ok = ?FILE_MODULE:write_file(Afile, "hello\n"),
+ ?line case ?FILE_MODULE:make_dir(
+ filename:join(Afile, "another_directory")) of
+ {error, enotdir} -> io:format("Result: enotdir");
+ {error, enoent} -> io:format("Result: enoent")
+ end,
+
+ %% No permission (on Unix only).
+ case os:type() of
+ {unix, _} ->
+ ?line ?FILE_MODULE:write_file_info(Base, #file_info {mode=0}),
+ ?line {error, eacces} =
+ ?FILE_MODULE:make_dir(filename:join(Base, "xxxx")),
+ ?line ?FILE_MODULE:write_file_info(
+ Base, #file_info {mode=8#600});
+ {win32, _} ->
+ ok;
+ vxworks ->
+ ok
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+e_del_dir(suite) -> [];
+e_del_dir(doc) -> [];
+e_del_dir(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = test_server:temp_name(filename:join(RootDir, "e_del_dir")),
+ ?line io:format("Base: ~p", [Base]),
+ ?line ok = ?FILE_MODULE:make_dir(Base),
+
+ %% Delete a non-existent directory.
+ ?line {error, enoent} =
+ ?FILE_MODULE:del_dir(filename:join(Base, "non_existing")),
+
+ %% Use a path-name with a non-directory component.
+ ?line Afile = filename:join(Base, "a_directory"),
+ ?line ok = ?FILE_MODULE:write_file(Afile, "hello\n"),
+ ?line {error, E1} =
+ expect({error, enotdir}, {error, enoent},
+ ?FILE_MODULE:del_dir(
+ filename:join(Afile, "another_directory"))),
+ ?line io:format("Result: ~p", [E1]),
+
+ %% Delete a non-empty directory.
+ ?line {error, E2} =
+ expect({error, enotempty}, {error, eexist}, {error, eacces},
+ ?FILE_MODULE:del_dir(Base)),
+ ?line io:format("Result: ~p", [E2]),
+
+ %% Remove the current directory.
+ ?line {error, E3} =
+ expect({error, einval},
+ {error, eperm}, % Linux and DUX
+ {error, eacces},
+ {error, ebusy},
+ ?FILE_MODULE:del_dir(".")),
+ ?line io:format("Result: ~p", [E3]),
+
+ %% No permission.
+ case os:type() of
+ {unix, _} ->
+ ?line ADirectory = filename:join(Base, "no_perm"),
+ ?line ok = ?FILE_MODULE:make_dir(ADirectory),
+ ?line ?FILE_MODULE:write_file_info(
+ Base, #file_info {mode=0}),
+ ?line {error, eacces} = ?FILE_MODULE:del_dir(ADirectory),
+ ?line ?FILE_MODULE:write_file_info(
+ Base, #file_info {mode=8#600});
+ {win32, _} ->
+ ok;
+ vxworks ->
+ ok
+ end,
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+compression(suite) ->
+ [read_compressed_cooked, read_compressed_cooked_binary,
+ read_cooked_tar_problem,
+ read_not_really_compressed,
+ write_compressed, compress_errors,
+ catenated_gzips].
+
+%% Trying reading and positioning from a compressed file.
+
+read_compressed_cooked(Config) when is_list(Config) ->
+ ?line Data = ?config(data_dir, Config),
+ ?line Real = filename:join(Data, "realmen.html.gz"),
+ ?line {ok, Fd} = ?FILE_MODULE:open(Real, [read,compressed]),
+ ?line try_read_file_list(Fd).
+
+read_compressed_cooked_binary(Config) when is_list(Config) ->
+ ?line Data = ?config(data_dir, Config),
+ ?line Real = filename:join(Data, "realmen.html.gz"),
+ ?line {ok, Fd} = ?FILE_MODULE:open(Real, [read,compressed,binary]),
+ ?line try_read_file_binary(Fd).
+
+%% Trying reading and positioning from an uncompressed file,
+%% but with the compressed flag given.
+
+read_not_really_compressed(Config) when is_list(Config) ->
+ ?line Data = ?config(data_dir, Config),
+ ?line Priv = ?config(priv_dir, Config),
+
+ %% The file realmen.html might have got CRs added (by WinZip).
+ %% Remove them, or the file positions will not be correct.
+
+ ?line Real = filename:join(Data, "realmen.html"),
+ ?line RealPriv = filename:join(Priv,
+ atom_to_list(?MODULE)++"_realmen.html"),
+ ?line {ok, RealDataBin} = ?FILE_MODULE:read_file(Real),
+ ?line RealData = remove_crs(binary_to_list(RealDataBin), []),
+ ?line ok = ?FILE_MODULE:write_file(RealPriv, RealData),
+ ?line {ok, Fd} = ?FILE_MODULE:open(RealPriv, [read, compressed]),
+ ?line try_read_file_list(Fd).
+
+remove_crs([$\r|Rest], Result) ->
+ remove_crs(Rest, Result);
+remove_crs([C|Rest], Result) ->
+ remove_crs(Rest, [C|Result]);
+remove_crs([], Result) ->
+ lists:reverse(Result).
+
+try_read_file_list(Fd) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+
+ %% Seek to the current position (nothing should happen).
+
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, 0),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, {cur, 0}),
+
+ %% Read a few lines from a compressed file.
+
+ ?line ShouldBe = "<TITLE>Real Programmers Don't Use PASCAL</TITLE>\n",
+ ?line ShouldBe = io:get_line(Fd, ''),
+
+ %% Now seek forward.
+
+ ?line {ok, 381} = ?FILE_MODULE:position(Fd, 381),
+ ?line Back = "Back in the good old days -- the \"Golden Era\" " ++
+ "of computers, it was\n",
+ ?line Back = io:get_line(Fd, ''),
+
+ %% Try to search forward relative to the current position.
+
+ ?line {ok, CurPos} = ?FILE_MODULE:position(Fd, {cur, 0}),
+ ?line RealPos = 4273,
+ ?line {ok, RealPos} = ?FILE_MODULE:position(Fd, {cur, RealPos-CurPos}),
+ ?line RealProg = "<LI> Real Programmers aren't afraid to use GOTOs.\n",
+ ?line RealProg = io:get_line(Fd, ''),
+
+ %% Seek backward.
+
+ ?line AfterTitle = length("<TITLE>"),
+ ?line {ok, AfterTitle} = ?FILE_MODULE:position(Fd, AfterTitle),
+ ?line Title = "Real Programmers Don't Use PASCAL</TITLE>\n",
+ ?line Title = io:get_line(Fd, ''),
+
+ %% Done.
+
+ ?line ?FILE_MODULE:close(Fd),
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+try_read_file_binary(Fd) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+
+ %% Seek to the current position (nothing should happen).
+
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, 0),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, {cur, 0}),
+
+ %% Read a few lines from a compressed file.
+
+ ?line ShouldBe = <<"<TITLE>Real Programmers Don't Use PASCAL</TITLE>\n">>,
+ ?line ShouldBe = io:get_line(Fd, ''),
+
+ %% Now seek forward.
+
+ ?line {ok, 381} = ?FILE_MODULE:position(Fd, 381),
+ ?line Back = <<"Back in the good old days -- the \"Golden Era\" "
+ "of computers, it was\n">>,
+ ?line Back = io:get_line(Fd, ''),
+
+ %% Try to search forward relative to the current position.
+
+ ?line {ok, CurPos} = ?FILE_MODULE:position(Fd, {cur, 0}),
+ ?line RealPos = 4273,
+ ?line {ok, RealPos} = ?FILE_MODULE:position(Fd, {cur, RealPos-CurPos}),
+ ?line RealProg = <<"<LI> Real Programmers aren't afraid to use GOTOs.\n">>,
+ ?line RealProg = io:get_line(Fd, ''),
+
+ %% Seek backward.
+
+ ?line AfterTitle = length("<TITLE>"),
+ ?line {ok, AfterTitle} = ?FILE_MODULE:position(Fd, AfterTitle),
+ ?line Title = <<"Real Programmers Don't Use PASCAL</TITLE>\n">>,
+ ?line Title = io:get_line(Fd, ''),
+
+ %% Done.
+
+ ?line ?FILE_MODULE:close(Fd),
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+read_cooked_tar_problem(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+
+ ?line Data = ?config(data_dir, Config),
+ ?line ProblemFile = filename:join(Data, "cooked_tar_problem.tar.gz"),
+ ?line {ok,Fd} = ?FILE_MODULE:open(ProblemFile, [read,compressed,binary]),
+
+ ?line {ok,34304} = file:position(Fd, 34304),
+ ?line {ok,Bin} = file:read(Fd, 512),
+ ?line 512 = byte_size(Bin),
+
+ ?line {ok,34304+512+1024} = file:position(Fd, {cur,1024}),
+
+ ?line ok = file:close(Fd),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+write_compressed(suite) -> [];
+write_compressed(doc) -> [];
+write_compressed(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line Priv = ?config(priv_dir, Config),
+ ?line MyFile = filename:join(Priv,
+ atom_to_list(?MODULE)++"_test.gz"),
+
+ %% Write a file.
+
+ ?line {ok, Fd} = ?FILE_MODULE:open(MyFile, [write, compressed]),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, 0),
+ ?line Prefix = "hello\n",
+ ?line End = "end\n",
+ ?line ok = io:put_chars(Fd, Prefix),
+ ?line {ok, 143} = ?FILE_MODULE:position(Fd, 143),
+ ?line ok = io:put_chars(Fd, End),
+ ?line ok = ?FILE_MODULE:close(Fd),
+
+ %% Read the file and verify the contents.
+
+ ?line {ok, Fd1} = ?FILE_MODULE:open(MyFile, [read, compressed]),
+ ?line Prefix = io:get_line(Fd1, ''),
+ ?line Second = lists:duplicate(143-length(Prefix), 0) ++ End,
+ ?line Second = io:get_line(Fd1, ''),
+ ?line ok = ?FILE_MODULE:close(Fd1),
+
+ %% Verify succesful compression by uncompressing the file
+ %% using zlib:gunzip/1.
+
+ ?line {ok,Contents} = file:read_file(MyFile),
+ ?line <<"hello\n",0:137/unit:8,"end\n">> = zlib:gunzip(Contents),
+
+ %% Ensure that the file is compressed.
+
+ TotalSize = 143 + length(End),
+ case ?FILE_MODULE:read_file_info(MyFile) of
+ {ok, #file_info{size=Size}} when Size < TotalSize ->
+ ok;
+ {ok, #file_info{size=Size}} when Size == TotalSize ->
+ test_server:fail(file_not_compressed)
+ end,
+
+ %% Write again to ensure that the file is truncated.
+
+ ?line {ok, Fd2} = ?FILE_MODULE:open(MyFile, [write, compressed]),
+ ?line NewString = "aaaaaaaaaaa",
+ ?line ok = io:put_chars(Fd2, NewString),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ ?line {ok, Fd3} = ?FILE_MODULE:open(MyFile, [read, compressed]),
+ ?line {ok, NewString} = ?FILE_MODULE:read(Fd3, 1024),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+
+ %% Done.
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+catenated_gzips(Config) when is_list(Config) ->
+ ?line Priv = ?config(priv_dir, Config),
+ ?line MyFile = filename:join(Priv, ?MODULE_STRING++"_test.gz"),
+
+ First = "Hello, all good men going to search parties. ",
+ Second = "Now I really need your help.",
+ All = iolist_to_binary([First|Second]),
+ ?line Cat = [zlib:gzip(First),zlib:gzip(Second)],
+
+ ?line ok = file:write_file(MyFile, Cat),
+
+ ?line {ok,Fd} = file:open(MyFile, [read,compressed,binary]),
+ ?line {ok,All} = file:read(Fd, 100000),
+ ?line ok = file:close(Fd),
+
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+compress_errors(suite) -> [];
+compress_errors(doc) -> [];
+compress_errors(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line DataDir =
+ filename:dirname(
+ filename:join(?config(data_dir, Config), "x")),
+ ?line DataDirSlash = DataDir++"/",
+ ?line {error, enoent} = ?FILE_MODULE:open("non_existing__",
+ [compressed, read]),
+ ?line {error, einval} = ?FILE_MODULE:open("non_existing__",
+ [compressed, read, write]),
+ ?line {error, einval} = ?FILE_MODULE:open("non_existing__",
+ [compressed, read, append]),
+ ?line {error, einval} = ?FILE_MODULE:open("non_existing__",
+ [compressed, write, append]),
+ ?line {error, E1} = ?FILE_MODULE:open(DataDir, [compressed, read]),
+ ?line {error, E2} = ?FILE_MODULE:open(DataDirSlash, [compressed, read]),
+ ?line {error, E3} = ?FILE_MODULE:open(DataDir, [compressed, write]),
+ ?line {error, E4} = ?FILE_MODULE:open(DataDirSlash, [compressed, write]),
+ ?line {eisdir,eisdir,eisdir,eisdir} = {E1,E2,E3,E4},
+
+ %% Read a corrupted .gz file.
+
+ ?line Corrupted = filename:join(DataDir, "corrupted.gz"),
+ ?line {ok, Fd} = ?FILE_MODULE:open(Corrupted, [read, compressed]),
+ ?line {error, eio} = ?FILE_MODULE:read(Fd, 100),
+ ?line ?FILE_MODULE:close(Fd),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+altname(doc) ->
+ "Test the file:altname/1 function";
+altname(suite) ->
+ [];
+altname(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ "long alternative path name with spaces"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+ ?line Name = filename:join(NewDir, "a_file_with_long_name"),
+ ?line ShortName = filename:join(NewDir, "short"),
+ ?line NonexName = filename:join(NewDir, "nonexistent"),
+ ?line ok = ?FILE_MODULE:write_file(Name, "some contents\n"),
+ ?line ok = ?FILE_MODULE:write_file(ShortName, "some contents\n"),
+ ?line Result =
+ case ?FILE_MODULE:altname(NewDir) of
+ {error, enotsup} ->
+ {skipped, "Altname not supported on this platform"};
+ {ok, "LONGAL~1"} ->
+ ?line {ok, "A_FILE~1"} = ?FILE_MODULE:altname(Name),
+ ?line {ok, "C:/"} = ?FILE_MODULE:altname("C:/"),
+ ?line {ok, "C:\\"} = ?FILE_MODULE:altname("C:\\"),
+ ?line {error,enoent} = ?FILE_MODULE:altname(NonexName),
+ ?line {ok, "short"} = ?FILE_MODULE:altname(ShortName),
+ ok
+ end,
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ Result.
+
+links(doc) -> "Test the link functions.";
+links(suite) -> [make_link, read_link_info_for_non_link, symlinks].
+
+make_link(doc) -> "Test creating a hard link.";
+make_link(suite) -> [];
+make_link(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_make_link"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+
+ ?line Name = filename:join(NewDir, "a_file"),
+ ?line ok = ?FILE_MODULE:write_file(Name, "some contents\n"),
+
+ ?line Alias = filename:join(NewDir, "an_alias"),
+ ?line Result =
+ case ?FILE_MODULE:make_link(Name, Alias) of
+ {error, enotsup} ->
+ {skipped, "Links not supported on this platform"};
+ ok ->
+ %% Note: We take the opportunity to test
+ %% ?FILE_MODULE:read_link_info/1,
+ %% which should in behave exactly as
+ %% ?FILE_MODULE:read_file_info/1
+ %% since they are not used on symbolic links.
+
+ ?line {ok, Info} = ?FILE_MODULE:read_link_info(Name),
+ ?line {ok, Info} = ?FILE_MODULE:read_link_info(Alias),
+ ?line #file_info{links = 2, type = regular} = Info,
+ ?line {error, eexist} =
+ ?FILE_MODULE:make_link(Name, Alias),
+ ok
+ end,
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ Result.
+
+read_link_info_for_non_link(doc) ->
+ "Test that reading link info for an ordinary file or directory works "
+ "(on all platforms).";
+read_link_info_for_non_link(suite) -> [];
+read_link_info_for_non_link(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+
+ ?line {ok, #file_info{type=directory}} =
+ ?FILE_MODULE:read_link_info("."),
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+symlinks(doc) -> "Test operations on symbolic links (for Unix).";
+symlinks(suite) -> [];
+symlinks(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_symlinks"),
+ ?line ok = ?FILE_MODULE:make_dir(NewDir),
+
+ ?line Name = filename:join(NewDir, "a_plain_file"),
+ ?line ok = ?FILE_MODULE:write_file(Name, "some stupid content\n"),
+
+ ?line Alias = filename:join(NewDir, "a_symlink_alias"),
+ ?line Result =
+ case ?FILE_MODULE:make_symlink(Name, Alias) of
+ {error, enotsup} ->
+ {skipped, "Links not supported on this platform"};
+ ok ->
+ ?line {ok, Info1} = ?FILE_MODULE:read_file_info(Name),
+ ?line {ok, Info1} = ?FILE_MODULE:read_file_info(Alias),
+ ?line {ok, Info1} = ?FILE_MODULE:read_link_info(Name),
+ ?line #file_info{links = 1, type = regular} = Info1,
+
+ ?line {ok, Info2} = ?FILE_MODULE:read_link_info(Alias),
+ ?line #file_info{links=1, type=symlink} = Info2,
+ ?line {ok, Name} = ?FILE_MODULE:read_link(Alias),
+ ok
+ end,
+
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ Result.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+copy(doc) -> [];
+copy(suite) -> [];
+copy(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ %% Create a text file.
+ ?line Name1 = filename:join(RootDir, atom_to_list(?MODULE)++"_copy_1.txt"),
+ ?line Line = "The quick brown fox jumps over a lazy dog. 0123456789\n",
+ ?line Len = length(Line),
+ ?line {ok, Handle1} = ?FILE_MODULE:open(Name1, [write]),
+ ?line {_, Size1} =
+ iterate({0, 0},
+ done,
+ fun({_, S}) when S >= 128*1024 ->
+ done;
+ ({N, S}) ->
+ H = integer_to_list(N),
+ ok = ?FILE_MODULE:write(Handle1, [H, " ", Line]),
+ {N + 1, S + length(H) + 1 + Len}
+ end),
+ ?line ?FILE_MODULE:close(Handle1),
+ %% Make a copy
+ ?line Name2 = filename:join(RootDir, atom_to_list(?MODULE)++"_copy_2.txt"),
+ ?line {ok, Size1} = ?FILE_MODULE:copy(Name1, Name2),
+ %% Concatenate 1
+ ?line Name3 = filename:join(RootDir, atom_to_list(?MODULE)++"_copy_3.txt"),
+ ?line {ok, Handle3} = ?FILE_MODULE:open(Name3, [raw, write, binary]),
+ ?line {ok, Size1} = ?FILE_MODULE:copy(Name1, Handle3),
+ ?line {ok, Handle2} = ?FILE_MODULE:open(Name2, [read, binary]),
+ ?line {ok, Size1} = ?FILE_MODULE:copy(Handle2, Handle3),
+ ?line ok = ?FILE_MODULE:close(Handle3),
+ ?line ok = ?FILE_MODULE:close(Handle2),
+ %% Concatenate 2
+ ?line Name4 = filename:join(RootDir, atom_to_list(?MODULE)++"_copy_4.txt"),
+ ?line {ok, Handle4} = ?FILE_MODULE:open(Name4, [write, binary]),
+ ?line {ok, Size1} = ?FILE_MODULE:copy(Name1, Handle4),
+ ?line {ok, Handle5} = ?FILE_MODULE:open(Name2, [raw, read, binary]),
+ ?line {ok, Size1} = ?FILE_MODULE:copy(Handle5, Handle4),
+ ?line ok = ?FILE_MODULE:close(Handle5),
+ ?line ok = ?FILE_MODULE:close(Handle4),
+ %% %% Just for test of the test
+ %% ?line {ok, Handle2q} = ?FILE_MODULE:open(Name2, [write, append]),
+ %% ?line ok = ?FILE_MODULE:write(Handle2q, "q"),
+ %% ?line ok = ?FILE_MODULE:close(Handle2q),
+ %% Compare the files
+ ?line {ok, Handle1a} = ?FILE_MODULE:open(Name1, [raw, read]),
+ ?line {ok, Handle2a} = ?FILE_MODULE:open(Name2, [raw, read]),
+ ?line true = stream_cmp(fd_stream_factory([Handle1a]),
+ fd_stream_factory([Handle2a])),
+ ?line {ok, 0} = ?FILE_MODULE:position(Handle1a, 0),
+ ?line {ok, 0} = ?FILE_MODULE:position(Handle2a, 0),
+ ?line {ok, Handle3a} = ?FILE_MODULE:open(Name3, [raw, read]),
+ ?line true = stream_cmp(fd_stream_factory([Handle1a, Handle2a]),
+ fd_stream_factory([Handle2a])),
+ ?line ok = ?FILE_MODULE:close(Handle1a),
+ ?line ok = ?FILE_MODULE:close(Handle2a),
+ ?line ok = ?FILE_MODULE:close(Handle3a),
+ ?line [] = flush(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+fd_stream_factory([]) ->
+ [];
+fd_stream_factory([Fd | T] = L) ->
+ fun() ->
+ case ?FILE_MODULE:read(Fd, 8192) of
+ {ok, Data} when is_binary(Data) ->
+ binary_to_list(Data) ++ fd_stream_factory(L);
+ {ok, Data} when is_list(Data) ->
+ Data ++ fd_stream_factory(L);
+ eof ->
+ fd_stream_factory(T);
+ {error, _} = Error ->
+ Error
+ end
+ end.
+
+
+
+stream_cmp(F1, F2) when is_function(F1), is_function(F2) ->
+ stream_cmp(F1(), F2());
+stream_cmp(F, X) when is_function(F) ->
+ stream_cmp(F(), X);
+stream_cmp(X, F) when is_function(F) ->
+ stream_cmp(X, F());
+stream_cmp({error, _} = Error, _) ->
+ Error;
+stream_cmp(_, {error, _} = Error) ->
+ Error;
+stream_cmp([], []) ->
+ true;
+stream_cmp([], [_|_]) ->
+ false;
+stream_cmp([_|_], []) ->
+ false;
+stream_cmp([H | T1], [H | T2]) ->
+ stream_cmp(T1, T2).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Test the get_cwd(), open(), and copy() file server calls.
+new_slave(_RootDir, Cwd) ->
+ ?line L = "qwertyuiopasdfghjklzxcvbnm",
+ ?line N = length(L),
+ ?line {ok, Cwd} = ?FILE_MODULE:get_cwd(),
+ ?line {error, enotsup} = ?FILE_MODULE:get_cwd("C:"), % Unix only testcase
+ ?line {ok, FD1} = ?FILE_MODULE:open("file1.txt", write),
+ ?line ok = ?FILE_MODULE:close(FD1),
+ ?line {ok, FD2} = ?FILE_MODULE:open("file1.txt",
+ [write, append,
+ binary, compressed,
+ delayed_write,
+ {delayed_write, 0, 0},
+ read_ahead,
+ {read_ahead, 0}]),
+ ?line ok = ?FILE_MODULE:write(FD2, L),
+ ?line ok = ?FILE_MODULE:close(FD2),
+ ?line {ok, N2} = ?FILE_MODULE:copy("file1.txt", "file2.txt"),
+ ?line io:format("Size ~p, compressed ~p.~n", [N, N2]),
+ ?line {ok, FD3} = ?FILE_MODULE:open("file2.txt",
+ [binary, compressed]),
+ %% The file_io_server will translate the binary into a list
+ ?line {ok, L} = ?FILE_MODULE:read(FD3, N+1),
+ ?line ok = ?FILE_MODULE:close(FD3),
+ %%
+ ?line ok = ?FILE_MODULE:delete("file1.txt"),
+ ?line ok = ?FILE_MODULE:delete("file2.txt"),
+ ?line [] = flush(),
+ ok.
+
+
+%% Test the get_cwd() and open() file server calls.
+old_slave(_RootDir, Cwd) ->
+ ?line L = "qwertyuiopasdfghjklzxcvbnm",
+ ?line N = length(L),
+ ?line {ok, Cwd} = ?FILE_MODULE:get_cwd(),
+ ?line {error, enotsup} = ?FILE_MODULE:get_cwd("C:"), % Unix only testcase
+ ?line {ok, FD1} = ?FILE_MODULE:open("file1.txt", write),
+ ?line ok = ?FILE_MODULE:close(FD1),
+ ?line {ok, FD2} = ?FILE_MODULE:open("file1.txt",
+ [write, binary, compressed]),
+ ?line ok = ?FILE_MODULE:write(FD2, L),
+ ?line ok = ?FILE_MODULE:close(FD2),
+ ?line {ok, FD3} = ?FILE_MODULE:open("file1.txt", [write, append]),
+ ?line ok = ?FILE_MODULE:close(FD3),
+ ?line {ok, FD4} = ?FILE_MODULE:open("file1.txt",
+ [binary, compressed]),
+ %% The file_io_server will translate the binary into a list
+ ?line {ok, L} = ?FILE_MODULE:read(FD4, N+1),
+ ?line ok = ?FILE_MODULE:close(FD4),
+ %%
+ ?line ok = ?FILE_MODULE:delete("file1.txt"),
+ ?line [] = flush(),
+ ok.
+
+run_test(Test, Args) ->
+ ?line case (catch apply(?MODULE, Test, Args)) of
+ {'EXIT', _} = Exit ->
+ {done, Exit, get(test_server_loc)};
+ Result ->
+ {done, Result}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+delayed_write(suite) ->
+ [];
+delayed_write(doc) ->
+ ["Tests the file open option {delayed_write, Size, Delay}"];
+
+delayed_write(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(20)),
+ %%
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line File = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_delayed_write.txt"),
+ ?line Data1 = "asdfghjkl",
+ ?line Data2 = "qwertyuio",
+ ?line Data3 = "zxcvbnm,.",
+ ?line Size = length(Data1),
+ ?line Size = length(Data2),
+ ?line Size = length(Data3),
+ ?line Data1Data1 = Data1++Data1,
+ ?line Data1Data1Data1 = Data1Data1++Data1,
+ ?line Data1Data1Data1Data1 = Data1Data1++Data1Data1,
+ %%
+ %% Test caching and normal close of non-raw file
+ ?line {ok, Fd1} =
+ ?FILE_MODULE:open(File, [write, {delayed_write, Size+1, 2000}]),
+ ?line ok = ?FILE_MODULE:write(Fd1, Data1),
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Fd2} = ?FILE_MODULE:open(File, [read]),
+ ?line case os:type() of
+ vxworks ->
+ io:format("Line ~p skipped on vxworks", [?LINE]);
+ _ ->
+ ?line eof = ?FILE_MODULE:read(Fd2, 1)
+ end,
+ ?line ok = ?FILE_MODULE:write(Fd1, Data1), % Data flush on size
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 2*Size+1),
+ ?line ok = ?FILE_MODULE:write(Fd1, Data1),
+ ?line ?t:sleep(3000), % Wait until data flush on timeout
+ ?line {ok, Data1Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 3*Size+1),
+ ?line ok = ?FILE_MODULE:write(Fd1, Data1),
+ ?line ok = ?FILE_MODULE:close(Fd1), % Data flush on close
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Data1Data1Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 4*Size+1),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ %%
+ %% Test implicit close through exit by file owning process,
+ %% raw file, default parameters.
+ ?line Parent = self(),
+ ?line Fun =
+ fun () ->
+ Child = self(),
+ Test =
+ fun () ->
+ ?line {ok, Fd} =
+ ?FILE_MODULE:open(File,
+ [raw, write,
+ delayed_write]),
+ ?line ok = ?FILE_MODULE:write(Fd, Data1),
+ ?line Parent ! {Child, wrote},
+ ?line receive
+ {Parent, continue, Reason} ->
+ {ok, Reason}
+ end
+ end,
+ case (catch Test()) of
+ {ok, Reason} ->
+ exit(Reason);
+ Unknown ->
+ exit({Unknown, get(test_server_loc)})
+ end
+ end,
+ ?line Child1 = spawn(Fun),
+ ?line Mref1 = erlang:monitor(process, Child1),
+ ?line receive
+ {Child1, wrote} ->
+ ok;
+ {'DOWN', Mref1, _, _, _} = Down1a ->
+ ?t:fail(Down1a)
+ end,
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Fd3} = ?FILE_MODULE:open(File, [read]),
+ ?line case os:type() of
+ vxworks ->
+ io:format("Line ~p skipped on vxworks", [?LINE]);
+ _ ->
+ ?line eof = ?FILE_MODULE:read(Fd3, 1)
+ end,
+ ?line Child1 ! {Parent, continue, normal},
+ ?line receive
+ {'DOWN', Mref1, process, Child1, normal} ->
+ ok;
+ {'DOWN', Mref1, _, _, _} = Down1b ->
+ ?t:fail(Down1b)
+ end,
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Data1} = ?FILE_MODULE:pread(Fd3, bof, Size+1),
+ ?line ok = ?FILE_MODULE:close(Fd3),
+ %%
+ %% The same again, but this time with reason 'kill'.
+ ?line Child2 = spawn(Fun),
+ ?line Mref2 = erlang:monitor(process, Child2),
+ ?line receive
+ {Child2, wrote} ->
+ ok;
+ {'DOWN', Mref2, _, _, _} = Down2a ->
+ ?t:fail(Down2a)
+ end,
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Fd4} = ?FILE_MODULE:open(File, [read]),
+ ?line case os:type() of
+ vxworks ->
+ io:format("Line ~p skipped on vxworks", [?LINE]);
+ _ ->
+ ?line eof = ?FILE_MODULE:read(Fd4, 1)
+ end,
+ ?line Child2 ! {Parent, continue, kill},
+ ?line receive
+ {'DOWN', Mref2, process, Child2, kill} ->
+ ok;
+ {'DOWN', Mref2, _, _, _} = Down2b ->
+ ?t:fail(Down2b)
+ end,
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line eof = ?FILE_MODULE:pread(Fd4, bof, 1),
+ ?line ok = ?FILE_MODULE:close(Fd4),
+ %%
+ %% Test if file position works with delayed_write
+ ?line {ok, Fd5} = ?FILE_MODULE:open(File, [raw, read, write,
+ delayed_write]),
+ ?line ok = ?FILE_MODULE:truncate(Fd5),
+ ?line ok = ?FILE_MODULE:write(Fd5, [Data1|Data2]),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd5, bof),
+ ?line ok = ?FILE_MODULE:write(Fd5, [Data3]),
+ ?line {ok, Data2} = ?FILE_MODULE:read(Fd5, Size+1),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd5, bof),
+ ?line Data3Data2 = Data3++Data2,
+ ?line {ok, Data3Data2} = ?FILE_MODULE:read(Fd5, 2*Size+1),
+ ?line ok = ?FILE_MODULE:close(Fd5),
+ %%
+ ?line [] = flush(),
+ ?line ?t:timetrap_cancel(Dog),
+ ?line case os:type() of
+ vxworks ->
+ {comment, "Some lines skipped on vxworks"};
+ _ ->
+ ok
+ end.
+
+
+pid2name(doc) -> "Tests file:pid2name/1.";
+pid2name(suite) -> [];
+pid2name(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = test_server:temp_name(
+ filename:join(RootDir, "pid2name_")),
+ ?line Name1 = [Base, '.txt'],
+ ?line Name2 = Base ++ ".txt",
+ %%
+ ?line {ok, Pid} = file:open(Name1, [write]),
+ ?line {ok, Name2} = file:pid2name(Pid),
+ ?line undefined = file:pid2name(self()),
+ ?line ok = file:close(Pid),
+ ?line test_server:sleep(1000),
+ ?line false = is_process_alive(Pid),
+ ?line undefined = file:pid2name(Pid),
+ %%
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+read_ahead(suite) ->
+ [];
+read_ahead(doc) ->
+ ["Tests the file open option {read_ahead, Size}"];
+
+read_ahead(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(20)),
+ %%
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line File = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_read_ahead.txt"),
+ ?line Data1 = "asdfghjkl", % Must be
+ ?line Data2 = "qwertyuio", % same
+ ?line Data3 = "zxcvbnm,.", % length
+ ?line Size = length(Data1),
+ ?line Size = length(Data2),
+ ?line Size = length(Data3),
+ %%
+ %% Test caching of normal non-raw file
+ ?line {ok, Fd1} = ?FILE_MODULE:open(File, [write]),
+ ?line ok = ?FILE_MODULE:write(Fd1, [Data1|Data1]),
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Fd2} = ?FILE_MODULE:open(File, [read, {read_ahead, 2*Size}]),
+ ?line {ok, Data1} = ?FILE_MODULE:read(Fd2, Size),
+ ?line ok = ?FILE_MODULE:pwrite(Fd1, Size, Data2),
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Data1} = ?FILE_MODULE:read(Fd2, Size), % Will read cached data
+ ?line Data2Data2Data2 = Data2++Data2++Data2,
+ ?line ok = ?FILE_MODULE:pwrite(Fd1, eof, Data2Data2Data2),
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Data2Data2Data2} =
+ ?FILE_MODULE:read(Fd2, 3*Size), % Read more than cache buffer
+ ?line ok = ?FILE_MODULE:close(Fd1),
+ ?line ok = ?FILE_MODULE:close(Fd2),
+ %% Test caching of raw file and default parameters
+ ?line {ok, Fd3} = ?FILE_MODULE:open(File, [raw, write]),
+ ?line ok = ?FILE_MODULE:write(Fd3, [Data1|Data1]),
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Fd4} = ?FILE_MODULE:open(File, [raw, read, read_ahead]),
+ ?line {ok, Data1} = ?FILE_MODULE:read(Fd4, Size),
+ ?line ok = ?FILE_MODULE:pwrite(Fd3, Size, Data2),
+ ?line ?t:sleep(1000), % Just in case the file system is slow
+ ?line {ok, Data1} = ?FILE_MODULE:read(Fd4, Size), % Will read cached data
+ ?line ok = ?FILE_MODULE:close(Fd3),
+ ?line ok = ?FILE_MODULE:close(Fd4),
+ %% Test if the file position works in combination with read_ahead
+ ?line {ok, Fd5} = ?FILE_MODULE:open(File, [raw, read, write, read_ahead]),
+ ?line ok = ?FILE_MODULE:truncate(Fd5),
+ ?line ok = ?FILE_MODULE:write(Fd5, [Data1,Data1|Data3]),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd5, bof),
+ ?line {ok, Data1} = ?FILE_MODULE:read(Fd5, Size),
+ ?line ok = ?FILE_MODULE:write(Fd5, Data2),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd5, bof),
+ ?line Data1Data2Data3 = Data1++Data2++Data3,
+ ?line {ok, Data1Data2Data3} = ?FILE_MODULE:read(Fd5, 3*Size+1),
+ ?line ok = ?FILE_MODULE:close(Fd5),
+ %%
+ ?line [] = flush(),
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+segment_read(suite) ->
+ [];
+segment_read(doc) ->
+ ["Tests the segmenting of large reads"];
+segment_read(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(60)),
+ %%
+ ?line Name = filename:join(?config(priv_dir, Config),
+ ?MODULE_STRING ++ "_segment_read"),
+ ?line SegSize = 256*1024,
+ ?line SegCnt = SegSize div 4,
+ ?line Cnt = 4 * SegCnt,
+ ?line ok = create_file(Name, Cnt),
+ %%
+ %% read_file/1
+ %%
+ ?line {ok, Bin} = ?FILE_MODULE:read_file(Name),
+ ?line true = verify_bin(Bin, 0, Cnt),
+ %%
+ %% read/2
+ %%
+ %% Not segmented
+ ?line {ok, FD1} = ?FILE_MODULE:open(Name, [read, raw, binary]),
+ ?line {ok, B1a} = ?FILE_MODULE:read(FD1, SegSize),
+ ?line {ok, B1b} = ?FILE_MODULE:read(FD1, SegSize),
+ ?line {ok, B1c} = ?FILE_MODULE:read(FD1, SegSize),
+ ?line {ok, B1d} = ?FILE_MODULE:read(FD1, SegSize),
+ ?line ok = ?FILE_MODULE:close(FD1),
+ ?line true = verify_bin(B1a, 0*SegCnt, SegCnt),
+ ?line true = verify_bin(B1b, 1*SegCnt, SegCnt),
+ ?line true = verify_bin(B1c, 2*SegCnt, SegCnt),
+ ?line true = verify_bin(B1d, 3*SegCnt, SegCnt),
+ %%
+ %% Segmented
+ ?line {ok, FD2} = ?FILE_MODULE:open(Name, [read, raw, binary]),
+ ?line {ok, B2a} = ?FILE_MODULE:read(FD2, 1*SegSize),
+ ?line {ok, B2b} = ?FILE_MODULE:read(FD2, 2*SegSize),
+ ?line {ok, B2c} = ?FILE_MODULE:read(FD2, 2*SegSize),
+ ?line ok = ?FILE_MODULE:close(FD2),
+ ?line true = verify_bin(B2a, 0*SegCnt, 1*SegCnt),
+ ?line true = verify_bin(B2b, 1*SegCnt, 2*SegCnt),
+ ?line true = verify_bin(B2c, 3*SegCnt, 1*SegCnt),
+ %%
+ %% pread/3
+ %%
+ ?line {ok, FD3} = ?FILE_MODULE:open(Name, [read, raw, binary]),
+ %%
+ %% Not segmented
+ ?line {ok, B3d} = ?FILE_MODULE:pread(FD3, 3*SegSize, SegSize),
+ ?line {ok, B3c} = ?FILE_MODULE:pread(FD3, 2*SegSize, SegSize),
+ ?line {ok, B3b} = ?FILE_MODULE:pread(FD3, 1*SegSize, SegSize),
+ ?line {ok, B3a} = ?FILE_MODULE:pread(FD3, 0*SegSize, SegSize),
+ ?line true = verify_bin(B3a, 0*SegCnt, SegCnt),
+ ?line true = verify_bin(B3b, 1*SegCnt, SegCnt),
+ ?line true = verify_bin(B3c, 2*SegCnt, SegCnt),
+ ?line true = verify_bin(B3d, 3*SegCnt, SegCnt),
+ %%
+ %% Segmented
+ ?line {ok, B3g} = ?FILE_MODULE:pread(FD3, 3*SegSize, 2*SegSize),
+ ?line {ok, B3f} = ?FILE_MODULE:pread(FD3, 1*SegSize, 2*SegSize),
+ ?line {ok, B3e} = ?FILE_MODULE:pread(FD3, 0*SegSize, 1*SegSize),
+ ?line true = verify_bin(B3e, 0*SegCnt, 1*SegCnt),
+ ?line true = verify_bin(B3f, 1*SegCnt, 2*SegCnt),
+ ?line true = verify_bin(B3g, 3*SegCnt, 1*SegCnt),
+ %%
+ ?line ok = ?FILE_MODULE:close(FD3),
+ %%
+ %% pread/2
+ %%
+ ?line {ok, FD5} = ?FILE_MODULE:open(Name, [read, raw, binary]),
+ %%
+ %% +---+---+---+---+
+ %% | 4 | 3 | 2 | 1 |
+ %% +---+---+---+---+
+ %% < ^ >
+ ?line {ok, [B5d, B5c, B5b, B5a]} =
+ ?FILE_MODULE:pread(FD5, [{3*SegSize, SegSize},
+ {2*SegSize, SegSize},
+ {1*SegSize, SegSize},
+ {0*SegSize, SegSize}]),
+ ?line true = verify_bin(B5a, 0*SegCnt, SegCnt),
+ ?line true = verify_bin(B5b, 1*SegCnt, SegCnt),
+ ?line true = verify_bin(B5c, 2*SegCnt, SegCnt),
+ ?line true = verify_bin(B5d, 3*SegCnt, SegCnt),
+ %%
+ %% +---+-------+-------+
+ %% | 3 | 2 | 1 |
+ %% +---+-------+-------+
+ %% < ^ ^ >
+ ?line {ok, [B5g, B5f, B5e]} =
+ ?FILE_MODULE:pread(FD5, [{3*SegSize, 2*SegSize},
+ {1*SegSize, 2*SegSize},
+ {0*SegSize, 1*SegSize}]),
+ ?line true = verify_bin(B5e, 0*SegCnt, 1*SegCnt),
+ ?line true = verify_bin(B5f, 1*SegCnt, 2*SegCnt),
+ ?line true = verify_bin(B5g, 3*SegCnt, 1*SegCnt),
+ %%
+ %%
+ %% +-------+-----------+
+ %% | 2 | 1 |
+ %% +-------+-----------+
+ %% < ^ ^ >
+ ?line {ok, [B5i, B5h]} =
+ ?FILE_MODULE:pread(FD5, [{2*SegSize, 3*SegSize},
+ {0*SegSize, 2*SegSize}]),
+ ?line true = verify_bin(B5h, 0*SegCnt, 2*SegCnt),
+ ?line true = verify_bin(B5i, 2*SegCnt, 2*SegCnt),
+ %%
+ %% +-------+---+---+
+ %% | 3 | 2 | 1 |
+ %% +-------+---+---+
+ %% < ^ ^ >
+ ?line {ok, [B5l, B5k, B5j]} =
+ ?FILE_MODULE:pread(FD5, [{3*SegSize, 1*SegSize},
+ {2*SegSize, 1*SegSize},
+ {0*SegSize, 2*SegSize}]),
+ ?line true = verify_bin(B5j, 0*SegCnt, 2*SegCnt),
+ ?line true = verify_bin(B5k, 2*SegCnt, 1*SegCnt),
+ ?line true = verify_bin(B5l, 3*SegCnt, 1*SegCnt),
+ %%
+ %% Real time response time test.
+ %%
+ Req = lists:flatten(lists:duplicate(17,
+ [{2*SegSize, 2*SegSize},
+ {0*SegSize, 2*SegSize}])),
+ ?line {{ok, _}, Comment} =
+ response_analysis(?FILE_MODULE, pread, [FD5, Req]),
+ ?line ok = ?FILE_MODULE:close(FD5),
+ %%
+ ?line [] = flush(),
+ ?line ?t:timetrap_cancel(Dog),
+ {comment, Comment}.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+segment_write(suite) ->
+ [];
+segment_write(doc) ->
+ ["Tests the segmenting of large writes"];
+segment_write(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(60)),
+ %%
+ ?line Name = filename:join(?config(priv_dir, Config),
+ ?MODULE_STRING ++ "_segment_write"),
+ ?line SegSize = 256*1024,
+ ?line SegCnt = SegSize div 4,
+ ?line Cnt = 4 * SegCnt,
+ ?line Bin = create_bin(0, Cnt),
+ %%
+ %% write/2
+ %%
+ %% Not segmented
+ ?line {ok, FD1} = ?FILE_MODULE:open(Name, [write, raw, binary]),
+ ?line ok = ?FILE_MODULE:write(FD1, subbin(Bin, 0*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:write(FD1, subbin(Bin, 1*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:write(FD1, subbin(Bin, 2*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:write(FD1, subbin(Bin, 3*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:close(FD1),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% Segmented
+ ?line {ok, FD2} = ?FILE_MODULE:open(Name, [write, raw, binary]),
+ ?line ok = ?FILE_MODULE:write(FD2, subbin(Bin, 0*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:write(FD2, subbin(Bin, 1*SegSize, 2*SegSize)),
+ ?line ok = ?FILE_MODULE:write(FD2, subbin(Bin, 3*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:close(FD2),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% +---+---+---+---+
+ %% | | | | |
+ %% +---+---+---+---+
+ %% < ^ >
+ ?line ok = write_file(Name, [subbin(Bin, 0*SegSize, 1*SegSize),
+ subbin(Bin, 1*SegSize, 1*SegSize),
+ subbin(Bin, 2*SegSize, 1*SegSize),
+ subbin(Bin, 3*SegSize, 1*SegSize)]),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% +---+-------+---+
+ %% | | | |
+ %% +---+-------+---+
+ %% < ^ ^ >
+ ?line ok = write_file(Name, [subbin(Bin, 0*SegSize, 1*SegSize),
+ subbin(Bin, 1*SegSize, 2*SegSize),
+ subbin(Bin, 3*SegSize, 1*SegSize)]),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% +-------+-------+
+ %% | | |
+ %% +-------+-------+
+ %% < ^ ^ >
+ ?line ok = write_file(Name, [subbin(Bin, 0*SegSize, 2*SegSize),
+ subbin(Bin, 2*SegSize, 2*SegSize)]),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% +-------+---+---+
+ %% | | | |
+ %% +-------+---+---+
+ %% < ^ ^ >
+ ?line ok = write_file(Name, [subbin(Bin, 0*SegSize, 2*SegSize),
+ subbin(Bin, 2*SegSize, 1*SegSize),
+ subbin(Bin, 3*SegSize, 1*SegSize)]),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% pwrite/3
+ %%
+ %% Not segmented
+ ?line {ok, FD3} = ?FILE_MODULE:open(Name, [write, raw, binary]),
+ ?line ok = ?FILE_MODULE:pwrite(FD3, 3*SegSize,
+ subbin(Bin, 3*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:pwrite(FD3, 2*SegSize,
+ subbin(Bin, 2*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:pwrite(FD3, 1*SegSize,
+ subbin(Bin, 1*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:pwrite(FD3, 0*SegSize,
+ subbin(Bin, 0*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:close(FD3),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% Segmented
+ ?line {ok, FD4} = ?FILE_MODULE:open(Name, [write, raw, binary]),
+ ?line ok = ?FILE_MODULE:pwrite(FD4, 3*SegSize,
+ subbin(Bin, 3*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:pwrite(FD4, 1*SegSize,
+ subbin(Bin, 1*SegSize, 2*SegSize)),
+ ?line ok = ?FILE_MODULE:pwrite(FD4, 0*SegSize,
+ subbin(Bin, 0*SegSize, 1*SegSize)),
+ ?line ok = ?FILE_MODULE:close(FD4),
+ ?line true = verify_file(Name, Cnt),
+
+
+
+ %%
+ %% pwrite/2
+ %%
+ %% Not segmented
+ ?line {ok, FD5} = ?FILE_MODULE:open(Name, [write, raw, binary]),
+ ?line ok = ?FILE_MODULE:pwrite(FD5, [{3*SegSize,
+ subbin(Bin, 3*SegSize, 1*SegSize)}]),
+ ?line ok = ?FILE_MODULE:pwrite(FD5, [{2*SegSize,
+ subbin(Bin, 2*SegSize, 1*SegSize)}]),
+ ?line ok = ?FILE_MODULE:pwrite(FD5, [{1*SegSize,
+ subbin(Bin, 1*SegSize, 1*SegSize)}]),
+ ?line ok = ?FILE_MODULE:pwrite(FD5, [{0*SegSize,
+ subbin(Bin, 0*SegSize, 1*SegSize)}]),
+ ?line ok = ?FILE_MODULE:close(FD5),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% Segmented
+ ?line {ok, FD6} = ?FILE_MODULE:open(Name, [write, raw, binary]),
+ ?line ok = ?FILE_MODULE:pwrite(FD6, [{3*SegSize,
+ subbin(Bin, 3*SegSize, 1*SegSize)}]),
+ ?line ok = ?FILE_MODULE:pwrite(FD6, [{1*SegSize,
+ subbin(Bin, 1*SegSize, 2*SegSize)}]),
+ ?line ok = ?FILE_MODULE:pwrite(FD6, [{0*SegSize,
+ subbin(Bin, 0*SegSize, 1*SegSize)}]),
+ ?line ok = ?FILE_MODULE:close(FD6),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% +---+---+---+---+
+ %% | 4 | 3 | 2 | 1 |
+ %% +---+---+---+---+
+ %% < ^ >
+ ?line ok = pwrite_file(Name, [{3*SegSize,
+ subbin(Bin, 3*SegSize, 1*SegSize)},
+ {2*SegSize,
+ subbin(Bin, 2*SegSize, 1*SegSize)},
+ {1*SegSize,
+ subbin(Bin, 1*SegSize, 1*SegSize)},
+ {0*SegSize,
+ subbin(Bin, 0*SegSize, 1*SegSize)}]),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% +---+-------+---+
+ %% | 3 | 2 | 1 |
+ %% +---+-------+---+
+ %% < ^ ^ >
+ ?line ok = pwrite_file(Name, [{3*SegSize,
+ subbin(Bin, 3*SegSize, 1*SegSize)},
+ {1*SegSize,
+ subbin(Bin, 1*SegSize, 2*SegSize)},
+ {0*SegSize,
+ subbin(Bin, 0*SegSize, 1*SegSize)}]),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% +-------+-------+
+ %% | 2 | 1 |
+ %% +-------+-------+
+ %% < ^ ^ >
+ ?line ok = pwrite_file(Name, [{2*SegSize,
+ subbin(Bin, 2*SegSize, 2*SegSize)},
+ {0*SegSize,
+ subbin(Bin, 0*SegSize, 2*SegSize)}]),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% +-------+---+---+
+ %% | 3 | 2 | 1 |
+ %% +-------+---+---+
+ %% < ^ ^ >
+ ?line ok = pwrite_file(Name, [{3*SegSize,
+ subbin(Bin, 3*SegSize, 1*SegSize)},
+ {2*SegSize,
+ subbin(Bin, 2*SegSize, 1*SegSize)},
+ {0*SegSize,
+ subbin(Bin, 0*SegSize, 2*SegSize)}]),
+ ?line true = verify_file(Name, Cnt),
+ %%
+ %% Real time response time test.
+ %%
+ ?line {ok, FD7} = ?FILE_MODULE:open(Name, [write, raw, binary]),
+ Req = lists:flatten(lists:duplicate(17,
+ [{2*SegSize,
+ subbin(Bin, 2*SegSize, 2*SegSize)},
+ {0*SegSize,
+ subbin(Bin, 0*SegSize, 2*SegSize)}])),
+ ?line {ok, Comment} =
+ response_analysis(?FILE_MODULE, pwrite, [FD7, Req]),
+ ?line ok = ?FILE_MODULE:close(FD7),
+ %%
+ ?line [] = flush(),
+ ?line ?t:timetrap_cancel(Dog),
+ {comment, Comment}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ipread(suite) ->
+ [];
+ipread(doc) ->
+ ["Test Dets special indirect pread"];
+ipread(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(30)),
+ %%
+ ?line Dir = ?config(priv_dir, Config),
+ ?line ok = ipread_int(Dir, [raw, binary]),
+ ?line ok = ipread_int(Dir, [raw]),
+ ?line ok = ipread_int(Dir, [binary]),
+ ?line ok = ipread_int(Dir, []),
+ ?line ok = ipread_int(Dir, [ram, binary]),
+ ?line ok = ipread_int(Dir, [ram]),
+ %%
+ ?line [] = flush(),
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+ipread_int(Dir, ModeList) ->
+ ?line Name =
+ filename:join(Dir,
+ lists:flatten([?MODULE_STRING, "_ipread",
+ lists:map(fun (X) ->
+ ["_", atom_to_list(X)]
+ end,
+ ModeList)])),
+ ?line io:format("ipread_int<~p, ~p>~n", [Name, ModeList]),
+ ?line {Conv, Sizeof} =
+ case lists:member(binary, ModeList) of
+ true ->
+ {fun (Bin) when is_binary(Bin) -> Bin;
+ (List) when is_list(List) -> list_to_binary(List)
+ end,
+ {erlang, size}};
+ false ->
+ {fun (Bin) when is_binary(Bin) -> binary_to_list(Bin);
+ (List) when is_list(List) -> List
+ end,
+ {erlang, length}}
+ end,
+ ?line Pos = 4711,
+ ?line Data = Conv("THE QUICK BROWN FOX JUMPS OVER A LAZY DOG"),
+ ?line Size = Sizeof(Data),
+ ?line Init = Conv(" "),
+ ?line SizeInit = Sizeof(Init),
+ ?line Head = Conv(<<Size:32/big-unsigned, Pos:32/big-unsigned>>),
+ ?line Filler = Conv(bytes($ , Pos-SizeInit-Sizeof(Head))),
+ ?line Size1 = Size+1,
+ ?line SizePos = Size+Pos,
+ %%
+ ?line {ok, FD} = ?FILE_MODULE:open(Name, [write, read | ModeList]),
+ ?line ok = ?FILE_MODULE:truncate(FD),
+ ?line ok = ?FILE_MODULE:write(FD, Init),
+ ?line ok = ?FILE_MODULE:write(FD, Head),
+ ?line ok = ?FILE_MODULE:write(FD, Filler),
+ ?line ok = ?FILE_MODULE:write(FD, Data),
+ %% Correct read
+ ?line {ok, {Size, Pos, Data}} =
+ ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, infinity),
+ %% Invalid header - size > max
+ ?line eof =
+ ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, Size-1),
+ %% Data block protudes over eof
+ ?line ok =
+ ?FILE_MODULE:pwrite(FD, SizeInit,
+ <<Size1:32/big-unsigned,
+ Pos:32/big-unsigned>>),
+ ?line {ok, {Size1, Pos, Data}} =
+ ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, Size1),
+ %% Data block outside file
+ ?line ok =
+ ?FILE_MODULE:pwrite(FD, SizeInit,
+ <<Size:32/big-unsigned,
+ SizePos:32/big-unsigned>>),
+ ?line {ok, {Size, SizePos, eof}} =
+ ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, Size),
+ %% Zero size
+ ?line ok =
+ ?FILE_MODULE:pwrite(FD, SizeInit,
+ <<0:32/big-unsigned,
+ Pos:32/big-unsigned>>),
+ ?line {ok, {0, Pos, eof}} =
+ ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, Size),
+ %% Invalid header - protudes over eof
+ ?line eof =
+ ?FILE_MODULE:ipread_s32bu_p32bu(FD,
+ Pos+Size-(Sizeof(Head)-1),
+ infinity),
+ %% Header not even in file
+ ?line eof =
+ ?FILE_MODULE:ipread_s32bu_p32bu(FD, Pos+Size, infinity),
+ %%
+ ?line ok = ?FILE_MODULE:close(FD),
+ ok.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+interleaved_read_write(suite) ->
+ [];
+interleaved_read_write(doc) ->
+ ["Tests interleaved read and writes"];
+interleaved_read_write(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(30)),
+ %%
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File =
+ filename:join(Dir, ?MODULE_STRING++"interleaved_read_write.txt"),
+ ?line {ok,F1} = ?FILE_MODULE:open(File, [write]),
+ ?line ok = ?FILE_MODULE:write(F1, "data---r1."), % 10 chars each
+ ?line ok = ?FILE_MODULE:write(F1, "data---r2."),
+ ?line ok = ?FILE_MODULE:write(F1, "data---r3."),
+ ?line ok = ?FILE_MODULE:close(F1),
+ ?line {ok,F2} = ?FILE_MODULE:open(File, [read, write]),
+ ?line {ok, "data---r1."} = ?FILE_MODULE:read(F2, 10),
+ ?line ok = ?FILE_MODULE:write(F2, "data---w2."),
+ ?line ok = ?FILE_MODULE:close(F2),
+ ?line {ok,F3} = ?FILE_MODULE:open(File, [read]),
+ ?line {ok, "data---r1."} = ?FILE_MODULE:read(F3, 10),
+ ?line {ok, "data---w2."} = ?FILE_MODULE:read(F3, 10),
+ ?line {ok, "data---r3."} = ?FILE_MODULE:read(F3, 10),
+ ?line eof = ?FILE_MODULE:read(F3, 1),
+ ?line ok = ?FILE_MODULE:close(F2),
+ %%
+ ?line [] = flush(),
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+otp_5814(suite) ->
+ [];
+otp_5814(doc) ->
+ ["OTP-5814. eval/consult/script return correct line numbers"];
+otp_5814(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(10)),
+ PrivDir = ?config(priv_dir, Config),
+ File = filename:join(PrivDir, "otp_5814"),
+ Path = [PrivDir],
+ ?line ok = file:write_file(File, <<"{a,b,c}.
+ a.
+ b.
+ c.
+ {d,e,
+ [}.">>),
+ ?line {error, {6,erl_parse,_}} = file:eval(File),
+ ?line {error, {6,erl_parse,_}} = file:consult(File),
+ ?line {error, {6,erl_parse,_}} = file:path_consult(Path, File),
+ ?line {error, {6,erl_parse,_}} = file:path_eval(Path, File),
+ ?line {error, {6,erl_parse,_}} = file:script(File),
+ ?line {error, {6,erl_parse,_}} = file:path_script(Path, File),
+
+ ?line ok = file:write_file(File, <<>>),
+ ?line {error, {1,file,undefined_script}} = file:path_script(Path, File),
+
+ %% The error is not propagated...
+ ?line ok = file:write_file(File, <<"a.
+ b.
+ 1/0.">>),
+ ?line {error, {3, file, {error, badarith, _}}} = file:eval(File),
+
+ ?line ok = file:write_file(File, <<"erlang:raise(throw, apa, []).">>),
+ ?line {error, {1, file, {throw, apa, _}}} = file:eval(File),
+
+ file:delete(File),
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+large_file(suite) ->
+ [];
+large_file(doc) ->
+ ["Tests positioning in large files (> 4G)"];
+large_file(Config) when is_list(Config) ->
+ case {os:type(),os:version()} of
+ {{win32,nt},_} ->
+ do_large_file(Config);
+ {{unix,sunos},{A,B,C}}
+ when A == 5, B == 5, C >= 1; A == 5, B >= 6; A >= 6 ->
+ do_large_file(Config);
+ {{unix,Unix},_} when Unix =:= linux; Unix =:= darwin ->
+ N = unix_free(Config),
+ io:format("Free: ~w KByte~n", [N]),
+ if N < 5 * (1 bsl 20) ->
+ %% Less than 5 GByte free
+ {skipped,"Less than 5 GByte free"};
+ true ->
+ do_large_file(Config)
+ end;
+ _ ->
+ {skipped,"Only supported on Win32, Linux, or SunOS >= 5.5.1"}
+ end.
+
+unix_free(Config) ->
+ Cmd = ["df -k '",?config(priv_dir, Config),"'"],
+ DF0 = os:cmd(Cmd),
+ io:format("$ ~s~n~s", [Cmd,DF0]),
+ [$\n|DF1] = lists:dropwhile(fun ($\n) -> false; (_) -> true end, DF0),
+ {ok,[N],_} = io_lib:fread(" ~*s ~d", DF1),
+ N.
+
+do_large_file(Config) ->
+ ?line Watchdog = ?t:timetrap(?t:minutes(4)),
+ %%
+ ?line Name = filename:join(?config(priv_dir, Config),
+ ?MODULE_STRING ++ "_large_file"),
+ ?line Tester = self(),
+ Deleter =
+ spawn(
+ fun() ->
+ Mref = erlang:monitor(process, Tester),
+ receive
+ {'DOWN',Mref,_,_,_} -> ok;
+ {Tester,done} -> ok
+ end,
+ ?FILE_MODULE:delete(Name)
+ end),
+ %%
+ ?line S = "1234567890",
+ L = length(S),
+ R = lists:reverse(S),
+ P = 1 bsl 32,
+ Ss = lists:sort(S),
+ Rs = lists:reverse(Ss),
+ ?line {ok,F} = ?FILE_MODULE:open(Name, [raw,read,write]),
+ ?line ok = ?FILE_MODULE:write(F, S),
+ ?line {ok,P} = ?FILE_MODULE:position(F, P),
+ ?line ok = ?FILE_MODULE:write(F, R),
+ ?line {ok,0} = ?FILE_MODULE:position(F, bof),
+ ?line {ok,S} = ?FILE_MODULE:read(F, L),
+ ?line {ok,P} = ?FILE_MODULE:position(F, {eof,-L}),
+ ?line {ok,R} = ?FILE_MODULE:read(F, L+1),
+ ?line {ok,S} = ?FILE_MODULE:pread(F, 0, L),
+ ?line {ok,R} = ?FILE_MODULE:pread(F, P, L+1),
+ ?line ok = ?FILE_MODULE:pwrite(F, 0, Ss),
+ ?line ok = ?FILE_MODULE:pwrite(F, P, Rs),
+ ?line {ok,0} = ?FILE_MODULE:position(F, bof),
+ ?line {ok,Ss} = ?FILE_MODULE:read(F, L),
+ ?line {ok,P} = ?FILE_MODULE:position(F, {eof,-L}),
+ ?line {ok,Rs} = ?FILE_MODULE:read(F, L+1),
+ ?line ok = ?FILE_MODULE:close(F),
+ %%
+ ?line Mref = erlang:monitor(process, Deleter),
+ ?line Deleter ! {Tester,done},
+ ?line receive {'DOWN',Mref,_,_,_} -> ok end,
+ %%
+ ?line ?t:timetrap_cancel(Watchdog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+response_analysis(Module, Function, Arguments) ->
+ Parent = self(),
+ ?line erlang:yield(), % Schedule out before test
+ ?line Child =
+ spawn_link(
+ fun () ->
+ receive {Parent, start, Ts} -> ok end,
+ Stat =
+ iterate(response_stat(response_stat(init, Ts),
+ erlang:now()),
+ done,
+ fun (S) ->
+ erlang:yield(),
+ receive
+ {Parent, stop} ->
+ done
+ after 0 ->
+ response_stat(S, erlang:now())
+ end
+ end),
+ Parent ! {self(), stopped, response_stat(Stat, erlang:now())}
+ end),
+ ?line Child ! {Parent, start, erlang:now()},
+ ?line Result = apply(Module, Function, Arguments),
+ ?line Child ! {Parent, stop},
+ ?line {N, Sum, _, M, Max} = receive {Child, stopped, X} -> X end,
+ ?line Mean_ms = (0.001*Sum) / (N-1),
+ ?line Max_ms = 0.001 * Max,
+ ?line Comment =
+ lists:flatten(
+ io_lib:format(
+ "Scheduling interval: Mean = ~.3f ms, "
+ ++"Max = ~.3f ms for no ~p of ~p.~n",
+ [Mean_ms, Max_ms, M, (N-1)])),
+ ?line {Result, Comment}.
+
+
+
+response_stat(init, Ts) ->
+ {0, 0, Ts, 0, 0};
+response_stat({N, Sum, {A1, B1, C1}, M, Max}, {A2, B2, C2} = Ts) ->
+ D = C2-C1 + 1000000*((B2-B1) + 1000000*(A2-A1)),
+ if D > Max ->
+ {N+1, Sum+D, Ts, N, D};
+ true ->
+ {N+1, Sum+D, Ts, M, Max}
+ end.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+
+%% This function is kept just for benchmarking reasons.
+%% create_file/2 below is some 44 times faster.
+
+create_file_slow(Name, N) when is_integer(N), N >= 0 ->
+ ?line {ok, FD} =
+ ?FILE_MODULE:open(Name, [raw, write, delayed_write, binary]),
+ ?line ok = create_file_slow(FD, 0, N),
+ ?line ok = ?FILE_MODULE:close(FD),
+ ok.
+
+create_file_slow(_FD, M, M) ->
+ ok;
+create_file_slow(FD, M, N) ->
+ ok = ?FILE_MODULE:write(FD, <<M:32/unsigned>>),
+ create_file_slow(FD, M+1, N).
+
+
+
+%% Creates a file 'Name' containing 'N' unsigned 32 bit integers
+%% from 0 to N-1.
+
+create_file(Name, N) when is_integer(N), N >= 0 ->
+ ?line {ok, FD} =
+ ?FILE_MODULE:open(Name, [raw, write, delayed_write, binary]),
+ ?line ok = create_file(FD, 0, N),
+ ?line ok = ?FILE_MODULE:close(FD),
+ ok.
+
+create_file(_FD, M, M) ->
+ ok;
+create_file(FD, M, N) when M + 1024 =< N ->
+ create_file(FD, M, M + 1024, []),
+ create_file(FD, M + 1024, N);
+create_file(FD, M, N) ->
+ create_file(FD, M, N, []).
+
+create_file(FD, M, M, R) ->
+ ok = ?FILE_MODULE:write(FD, R);
+create_file(FD, M, N0, R) when M + 8 =< N0 ->
+ N1 = N0-1, N2 = N0-2, N3 = N0-3, N4 = N0-4,
+ N5 = N0-5, N6 = N0-6, N7 = N0-7, N8 = N0-8,
+ create_file(FD, M, N8,
+ [<<N8:32/unsigned, N7:32/unsigned,
+ N6:32/unsigned, N5:32/unsigned,
+ N4:32/unsigned, N3:32/unsigned,
+ N2:32/unsigned, N1:32/unsigned>> | R]);
+create_file(FD, M, N0, R) ->
+ N1 = N0-1,
+ create_file(FD, M, N1, [<<N1:32/unsigned>> | R]).
+
+
+
+create_bin(M, N) when is_integer(M), is_integer(N), N >= 0, M >= 0 ->
+ create_bin(M, M+N, []).
+
+create_bin(N, N, R) ->
+ list_to_binary(R);
+create_bin(M, N0, R) when M+8 =< N0 ->
+ N1 = N0-1, N2 = N0-2, N3 = N0-3, N4 = N0-4,
+ N5 = N0-5, N6 = N0-6, N7 = N0-7, N8 = N0-8,
+ create_bin(M, N8,
+ [<<N8:32/unsigned, N7:32/unsigned,
+ N6:32/unsigned, N5:32/unsigned,
+ N4:32/unsigned, N3:32/unsigned,
+ N2:32/unsigned, N1:32/unsigned>> | R]);
+create_bin(M, N0, R) ->
+ N1 = N0-1,
+ create_bin(M, N1, [<<N1:32/unsigned>> | R]).
+
+
+
+
+verify_bin(<<>>, _, 0) ->
+ true;
+verify_bin(<<>>, _, _) ->
+ false;
+verify_bin(Bin, N, Cnt) ->
+ N0 = N + 0, N1 = N + 1, N2 = N + 2, N3 = N + 3,
+ N4 = N + 4, N5 = N + 5, N6 = N + 6, N7 = N + 7,
+ case Bin of
+ <<N0:32/unsigned, N1:32/unsigned, N2:32/unsigned, N3:32/unsigned,
+ N4:32/unsigned, N5:32/unsigned, N6:32/unsigned, N7:32/unsigned,
+ B/binary>> ->
+ verify_bin(B, N+8, Cnt-8);
+ <<N:32/unsigned, B/binary>> ->
+ verify_bin(B, N+1, Cnt-1);
+ _ ->
+ false
+ end.
+
+
+
+verify_file(Name, N) when is_integer(N), N >= 0 ->
+ case ?FILE_MODULE:open(Name, [raw, read, binary]) of
+ {ok, FD} ->
+ Result = verify_file(FD, 0, 64*1024, N),
+ ok = ?FILE_MODULE:close(FD),
+ Result;
+ Error ->
+ Error
+ end.
+
+verify_file(FD, N, _, N) ->
+ case ?FILE_MODULE:read(FD, 1) of
+ eof ->
+ true;
+ {ok, _} ->
+ false
+ end;
+verify_file(FD, M, Cnt, N) when M+Cnt =< N ->
+ case ?FILE_MODULE:read(FD, 4*Cnt) of
+ {ok, Bin} ->
+ case verify_bin(Bin, M, Cnt) of
+ true ->
+ verify_file(FD, M+Cnt, Cnt, N);
+ false ->
+ false
+ end;
+ _ ->
+ false
+ end;
+verify_file(FD, M, _Cnt, N) ->
+ verify_file(FD, M, N-M, N).
+
+
+
+subbin(Bin, M, N) ->
+ <<_:M/binary, B:N/binary, _/binary>> = Bin,
+ B.
+
+
+
+write_file(Name, Data) ->
+ case ?FILE_MODULE:open(Name, [raw, write, binary]) of
+ {ok, FD} ->
+ Result = ?FILE_MODULE:write(FD, Data),
+ case {Result, ?FILE_MODULE:close(FD)} of
+ {ok, R} -> R;
+ _ -> Result
+ end;
+ Error ->
+ Error
+ end.
+
+pwrite_file(Name, Data) ->
+ case ?FILE_MODULE:open(Name, [raw, write, binary]) of
+ {ok, FD} ->
+ Result = ?FILE_MODULE:pwrite(FD, Data),
+ case {Result, ?FILE_MODULE:close(FD)} of
+ {ok, R} -> R;
+ _ -> Result
+ end;
+ Error ->
+ Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Read_line tests
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+
+read_line_testdata(PrivDir) ->
+ All0 = [{fun read_line_create0/1,"Testdata1.txt",5,10},
+ {fun read_line_create1/1,"Testdata2.txt",401,802},
+ {fun read_line_create2/1,"Testdata3.txt",1,2},
+ {fun read_line_create3/1,"Testdata4.txt",601,fail},
+ {fun read_line_create4/1,"Testdata5.txt",601,1002},
+ {fun read_line_create5/1,"Testdata6.txt",601,1202},
+ {fun read_line_create6/1,"Testdata7.txt",601,1202},
+ {fun read_line_create7/1,"Testdata8.txt",4001,8002}],
+ [ {A,filename:join([PrivDir,B]),C,D} || {A,B,C,D} <- All0 ].
+
+read_line_create_files(TestData) ->
+ [ Function(File) || {Function,File,_,_} <- TestData ].
+
+read_line_remove_files(TestData) ->
+ [ file:delete(File) || {Function,File,_,_} <- TestData ].
+
+read_line_1(suite) ->
+ [];
+read_line_1(doc) ->
+ ["read_line with prim_file"];
+read_line_1(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line All = read_line_testdata(PrivDir),
+ ?line read_line_create_files(All),
+ ?line [ begin
+ io:format("read_line_all: ~s~n",[File]),
+ {X,_} = read_line_all(File),
+ true
+ end || {_,File,X,_} <- All ],
+ ?line [ begin
+ io:format("read_line_all_alternating: ~s~n",[File]),
+ {Y,_} = read_line_all_alternating(File),
+ true
+ end || {_,File,_,Y} <- All , Y =/= fail],
+ ?line [ begin
+ io:format("read_line_all_alternating (failing as should): ~s~n",[File]),
+ {'EXIT',_} = (catch read_line_all_alternating(File)),
+ true
+ end || {_,File,_,Y} <- All , Y =:= fail],
+ ?line read_line_remove_files(All),
+ ok.
+read_line_2(suite) ->
+ [];
+read_line_2(doc) ->
+ ["read_line with file"];
+read_line_2(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line All = read_line_testdata(PrivDir),
+ ?line read_line_create_files(All),
+ ?line [ begin
+ io:format("read_line_all: ~s~n",[File]),
+ {X,_} = read_line_all2(File),
+ true
+ end || {_,File,X,_} <- All ],
+ ?line [ begin
+ io:format("read_line_all_alternating: ~s~n",[File]),
+ {Y,_} = read_line_all_alternating2(File),
+ true
+ end || {_,File,_,Y} <- All , Y =/= fail],
+ ?line [ begin
+ io:format("read_line_all_alternating (failing as should): ~s~n",[File]),
+ {'EXIT',_} = (catch read_line_all_alternating2(File)),
+ true
+ end || {_,File,_,Y} <- All , Y =:= fail],
+ ?line read_line_remove_files(All),
+ ok.
+read_line_3(suite) ->
+ [];
+read_line_3(doc) ->
+ ["read_line with raw file"];
+read_line_3(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line All = read_line_testdata(PrivDir),
+ ?line read_line_create_files(All),
+ ?line [ begin
+ io:format("read_line_all: ~s~n",[File]),
+ {X,_} = read_line_all3(File),
+ true
+ end || {_,File,X,_} <- All ],
+ ?line [ begin
+ io:format("read_line_all_alternating: ~s~n",[File]),
+ {Y,_} = read_line_all_alternating3(File),
+ true
+ end || {_,File,_,Y} <- All , Y =/= fail],
+ ?line [ begin
+ io:format("read_line_all_alternating (failing as should): ~s~n",[File]),
+ {'EXIT',_} = (catch read_line_all_alternating3(File)),
+ true
+ end || {_,File,_,Y} <- All , Y =:= fail],
+ ?line read_line_remove_files(All),
+ ok.
+read_line_4(suite) ->
+ [];
+read_line_4(doc) ->
+ ["read_line with raw buffered file"];
+read_line_4(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line All = read_line_testdata(PrivDir),
+ ?line read_line_create_files(All),
+ ?line [ begin
+ io:format("read_line_all: ~s~n",[File]),
+ {X,_} = read_line_all4(File),
+ true
+ end || {_,File,X,_} <- All ],
+ ?line [ begin
+ io:format("read_line_all_alternating: ~s~n",[File]),
+ {Y,_} = read_line_all_alternating4(File),
+ true
+ end || {_,File,_,Y} <- All , Y =/= fail],
+ ?line [ begin
+ io:format("read_line_all_alternating (failing as should): ~s~n",[File]),
+ {'EXIT',_} = (catch read_line_all_alternating4(File)),
+ true
+ end || {_,File,_,Y} <- All , Y =:= fail],
+ ?line read_line_remove_files(All),
+ ok.
+
+rl_lines() ->
+ [ <<"hej">>,<<"hopp">>,<<"i">>,<<"lingon\rskogen">>].
+
+read_line_create0(Filename) ->
+ {ok,F} = file:open(Filename,[write]),
+ L = rl_lines(),
+ [ file:write(F,[R,<<"\r\n">>]) || R <- L ],
+ file:write(F,<<"Inget radslut\r">>),
+ file:close(F).
+read_line_create1(Filename) ->
+ {ok,F} = file:open(Filename,[write]),
+ L = rl_lines(),
+ [ begin
+ [ file:write(F,[R,<<"\r\n">>]) || R <- L ],
+ file:write(F,<<"Inget radslut\r">>)
+ end || _ <- lists:seq(1,100)],
+ file:close(F).
+read_line_create2(Filename) ->
+ {ok,F} = file:open(Filename,[write]),
+ L = rl_lines(),
+ [ begin
+ [ file:write(F,[R]) || R <- L ],
+ file:write(F,<<"Inget radslut\r">>)
+ end || _ <- lists:seq(1,200)],
+ file:write(F,<<"\r\n">>),
+ file:close(F).
+
+read_line_create3(Filename) ->
+ {ok,F} = file:open(Filename,[write]),
+ L = rl_lines(),
+ [ begin
+ file:write(F,<<"\r\n">>),
+ file:write(F,<<"\r\n">>),
+ [ file:write(F,[R,<<"\r\n">>]) || R <- L ],
+ file:write(F,<<"Inget radslut\r">>)
+ end || _ <- lists:seq(1,100)],
+ file:close(F).
+
+read_line_create4(Filename) ->
+ {ok,F} = file:open(Filename,[write]),
+ L = rl_lines(),
+ [ begin
+ file:write(F,<<"\n">>),
+ file:write(F,<<"\n">>),
+ [ file:write(F,[R,<<"\r\n">>]) || R <- L ],
+ file:write(F,<<"Inget radslut\r">>)
+ end || _ <- lists:seq(1,100)],
+ file:close(F).
+
+read_line_create5(Filename) ->
+ {ok,F} = file:open(Filename,[write]),
+ L = rl_lines(),
+ [ begin
+ file:write(F,<<"i\n">>),
+ file:write(F,<<"i\n">>),
+ [ file:write(F,[R,<<"\r\n">>]) || R <- L ],
+ file:write(F,<<"Inget radslut\r">>)
+ end || _ <- lists:seq(1,100)],
+ file:close(F).
+
+read_line_create6(Filename) ->
+ {ok,F} = file:open(Filename,[write]),
+ L = rl_lines(),
+ [ begin
+ file:write(F,<<"i\r\n">>),
+ file:write(F,<<"i\r\n">>),
+ [ file:write(F,[R,<<"\r\n">>]) || R <- L ],
+ file:write(F,<<"Inget radslut\r">>)
+ end || _ <- lists:seq(1,100)],
+ file:close(F).
+read_line_create7(Filename) ->
+ {ok,F} = file:open(Filename,[write]),
+ L = rl_lines(),
+ [ begin
+ [ file:write(F,[R,<<"\r\n">>]) || R <- L ],
+ file:write(F,<<"Inget radslut\r">>)
+ end || _ <- lists:seq(1,1000)],
+ file:close(F).
+
+read_line_all(Filename) ->
+ {ok,F} = prim_file:open(Filename,[read,binary]),
+ X=read_rl_lines(F),
+ prim_file:close(F),
+ Bin = list_to_binary([B || {ok,B} <- X]),
+ Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
+ "\r\n","\n",[global,{return,binary}]),
+ {length(X),Bin}.
+
+read_line_all2(Filename) ->
+ {ok,F} = file:open(Filename,[read,binary]),
+ X=read_rl_lines2(F),
+ file:close(F),
+ Bin = list_to_binary([B || {ok,B} <- X]),
+ Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
+ "\r\n","\n",[global,{return,binary}]),
+ {length(X),Bin}.
+
+read_line_all3(Filename) ->
+ {ok,F} = file:open(Filename,[read,binary,raw]),
+ X=read_rl_lines2(F),
+ file:close(F),
+ Bin = list_to_binary([B || {ok,B} <- X]),
+ Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
+ "\r\n","\n",[global,{return,binary}]),
+ {length(X),Bin}.
+read_line_all4(Filename) ->
+ {ok,F} = file:open(Filename,[read,binary,raw,{read_ahead,8192}]),
+ X=read_rl_lines2(F),
+ file:close(F),
+ Bin = list_to_binary([B || {ok,B} <- X]),
+ Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
+ "\r\n","\n",[global,{return,binary}]),
+ {length(X),Bin}.
+
+read_rl_lines(F) ->
+ case prim_file:read_line(F) of
+ eof ->
+ [];
+ {error,X} ->
+ {error,X};
+ List ->
+ [List | read_rl_lines(F)]
+ end.
+
+read_rl_lines2(F) ->
+ case file:read_line(F) of
+ eof ->
+ [];
+ {error,X} ->
+ {error,X};
+ List ->
+ [List | read_rl_lines2(F)]
+ end.
+
+read_line_all_alternating(Filename) ->
+ {ok,F} = prim_file:open(Filename,[read,binary]),
+ X=read_rl_lines(F,true),
+ prim_file:close(F),
+ Bin = list_to_binary([B || {ok,B} <- X]),
+ Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
+ "\r\n","\n",[global,{return,binary}]),
+ {length(X),Bin}.
+
+read_line_all_alternating2(Filename) ->
+ {ok,F} = file:open(Filename,[read,binary]),
+ X=read_rl_lines2(F,true),
+ file:close(F),
+ Bin = list_to_binary([B || {ok,B} <- X]),
+ Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
+ "\r\n","\n",[global,{return,binary}]),
+ {length(X),Bin}.
+read_line_all_alternating3(Filename) ->
+ {ok,F} = file:open(Filename,[read,binary,raw]),
+ X=read_rl_lines2(F,true),
+ file:close(F),
+ Bin = list_to_binary([B || {ok,B} <- X]),
+ Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
+ "\r\n","\n",[global,{return,binary}]),
+ {length(X),Bin}.
+read_line_all_alternating4(Filename) ->
+ {ok,F} = file:open(Filename,[read,binary,raw,{read_ahead,8192}]),
+ X=read_rl_lines2(F,true),
+ file:close(F),
+ Bin = list_to_binary([B || {ok,B} <- X]),
+ Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]),
+ "\r\n","\n",[global,{return,binary}]),
+ {length(X),Bin}.
+
+read_rl_lines(F,Alternate) ->
+ case begin
+ case Alternate of
+ true -> prim_file:read(F,1);
+ false -> prim_file:read_line(F)
+ end
+ end of
+ eof ->
+ [];
+ {error,X} ->
+ {error,X};
+ List ->
+ [List | read_rl_lines(F,not Alternate)]
+ end.
+read_rl_lines2(F,Alternate) ->
+ case begin
+ case Alternate of
+ true -> file:read(F,1);
+ false -> file:read_line(F)
+ end
+ end of
+ eof ->
+ [];
+ {error,X} ->
+ {error,X};
+ List ->
+ [List | read_rl_lines2(F,not Alternate)]
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+bytes(B, N)
+ when is_integer(B), 0 =< B, B =< 255, is_integer(N), N > 2, N band 1 == 0 ->
+ [bytes(B, N bsr 1), bytes(B, N bsr 1)];
+bytes(B, 0)
+ when is_integer(B), 0 =< B, B =< 255 ->
+ [];
+bytes(B, 2)
+ when is_integer(B), 0 =< B, B =< 255 ->
+ [B, B];
+bytes(B, N)
+ when is_integer(B), 0 =< B, B =< 255, is_integer(N), N > 0 ->
+ [B, bytes(B, N-1)].
+
+
+%% A simple loop construct.
+%%
+%% Calls 'Fun' with argument 'Start' first and then repeatedly with
+%% its returned value (state) until 'Fun' returns 'Stop'. Then
+%% the last state value that was not 'Stop' is returned.
+
+iterate(Start, Done, Fun) when is_function(Fun) ->
+ iterate(Start, Done, Fun, Start).
+
+iterate(Done, Done, _Fun, I) ->
+ I;
+iterate(I, Done, Fun, _) ->
+ iterate(Fun(I), Done, Fun, I).
+
+
+
+flush() ->
+ flush([]).
+
+flush(Msgs) ->
+ receive
+ Msg ->
+ flush([Msg | Msgs])
+ after 0 ->
+ lists:reverse(Msgs)
+ end.
diff --git a/lib/kernel/test/file_SUITE_data/cooked_tar_problem.tar.gz b/lib/kernel/test/file_SUITE_data/cooked_tar_problem.tar.gz
new file mode 100644
index 0000000000..be2490581a
--- /dev/null
+++ b/lib/kernel/test/file_SUITE_data/cooked_tar_problem.tar.gz
Binary files differ
diff --git a/lib/kernel/test/file_SUITE_data/corrupted.gz b/lib/kernel/test/file_SUITE_data/corrupted.gz
new file mode 100644
index 0000000000..16331b350c
--- /dev/null
+++ b/lib/kernel/test/file_SUITE_data/corrupted.gz
@@ -0,0 +1,5 @@
+�
+==========================================
+This file has a correct GZIP magic ID, but the rest of the
+header is corrupt. Reading this file should result in an
+error.
diff --git a/lib/kernel/test/file_SUITE_data/realmen.html b/lib/kernel/test/file_SUITE_data/realmen.html
new file mode 100644
index 0000000000..c810a5d088
--- /dev/null
+++ b/lib/kernel/test/file_SUITE_data/realmen.html
@@ -0,0 +1,520 @@
+<TITLE>Real Programmers Don't Use PASCAL</TITLE>
+
+<H2 align=center>Real Programmers Don't Use PASCAL</H2>
+
+<H4 align=center><em>Ed Post<br>
+Graphic Software Systems<br>
+
+P.O. Box 673<br>
+25117 S.W. Parkway<br>
+Wilsonville, OR 97070<br>
+Copyright (c) 1982<br>
+</H4></EM>
+
+
+<H4 align=center><KBD> (decvax | ucbvax | cbosg | pur-ee | lbl-unix)!teklabs!ogcvax!gss1144!evp</KBD></H4>
+
+
+Back in the good old days -- the "Golden Era" of computers, it was
+easy to separate the men from the boys (sometimes called "Real Men"
+and "Quiche Eaters" in the literature). During this period, the Real
+Men were the ones that understood computer programming, and the Quiche
+Eaters were the ones that didn't. A real computer programmer said
+things like <KBD>"DO 10 I=1,10"</KBD> and <KBD>"ABEND"</KBD> (they
+actually talked in capital letters, you understand), and the rest of
+the world said things like <EM>"computers are too complicated for
+me"</EM> and <EM>"I can't relate to computers -- they're so
+impersonal"</EM>. (A previous work [1] points out that Real Men don't
+"relate" to anything, and aren't afraid of being impersonal.) <P>
+
+But, as usual, times change. We are faced today with a world in which
+little old ladies can get computerized microwave ovens, 12 year old
+kids can blow Real Men out of the water playing Asteroids and Pac-Man,
+and anyone can buy and even understand their very own Personal
+Computer. The Real Programmer is in danger of becoming extinct, of
+being replaced by high-school students with TRASH-80s! <P>
+
+There is a clear need to point out the differences between the typical
+high-school junior Pac-Man player and a Real Programmer. Understanding
+these differences will give these kids something to aspire to -- a
+role model, a Father Figure. It will also help employers of Real
+Programmers to realize why it would be a mistake to replace the Real
+Programmers on their staff with 12 year old Pac-Man players (at a
+considerable salary savings). <P>
+
+
+<H3>LANGUAGES</H3>
+
+The easiest way to tell a Real Programmer from the crowd is by the
+programming language he (or she) uses. Real Programmers use FORTRAN.
+Quiche Eaters use PASCAL. Nicklaus Wirth, the designer of PASCAL, was
+once asked, <EM>"How do you pronounce your name?"</EM>. He replied
+<EM>"You can either call me by name, pronouncing it 'Veert', or call
+me by value, 'Worth'."</EM> One can tell immediately from this comment
+that Nicklaus Wirth is a Quiche Eater. The only parameter passing
+mechanism endorsed by Real Programmers is call-by-value-return, as
+implemented in the IBM/370 FORTRAN G and H compilers. Real
+programmers don't need abstract concepts to get their jobs done: they
+are perfectly happy with a keypunch, a FORTRAN IV compiler, and a
+beer. <P>
+
+<UL>
+<LI> Real Programmers do List Processing in FORTRAN.
+
+<LI> Real Programmers do String Manipulation in FORTRAN.
+
+<LI> Real Programmers do Accounting (if they do it at all) in FORTRAN.
+
+<LI> Real Programmers do Artificial Intelligence programs in FORTRAN.
+</UL> <P>
+
+If you can't do it in FORTRAN, do it in assembly language. If you can't do
+it in assembly language, it isn't worth doing. <P>
+
+
+<H3> STRUCTURED PROGRAMMING</H3>
+
+Computer science academicians have gotten into the "structured pro-
+gramming" rut over the past several years. They claim that programs
+are more easily understood if the programmer uses some special
+language constructs and techniques. They don't all agree on exactly
+which constructs, of course, and the examples they use to show their
+particular point of view invariably fit on a single page of some
+obscure journal or another -- clearly not enough of an example to
+convince anyone. When I got out of school, I thought I was the best
+programmer in the world. I could write an unbeatable tic-tac-toe
+program, use five different computer languages, and create 1000 line
+programs that WORKED. (Really!) Then I got out into the Real
+World. My first task in the Real World was to read and understand a
+200,000 line FORTRAN program, then speed it up by a factor of two. Any
+Real Programmer will tell you that all the Structured Coding in the
+world won't help you solve a problem like that -- it takes actual
+talent. Some quick observations on Real Programmers and Structured
+Programming: <P>
+
+<UL>
+<LI> Real Programmers aren't afraid to use GOTOs.
+
+<LI> Real Programmers can write five page long DO loops without
+getting confused.
+
+<LI> Real Programmers enjoy Arithmetic IF statements because they make
+the code more interesting.
+
+<LI> Real Programmers write self-modifying code, especially if it
+saves them 20 nanoseconds in the middle of a tight loop.
+
+<LI> Programmers don't need comments: the code is obvious.
+
+<LI> Since FORTRAN doesn't have a structured <KBD>IF, REPEAT
+... UNTIL</KBD>, or <KBD>CASE</KBD> statement, Real Programmers don't
+have to worry about not using them. Besides, they can be simulated
+when necessary using assigned <KBD>GOTO</KBD>s.
+
+</UL> <P>
+
+Data structures have also gotten a lot of press lately. Abstract Data
+Types, Structures, Pointers, Lists, and Strings have become popular in
+certain circles. Wirth (the above-mentioned Quiche Eater) actually
+wrote an entire book [2] contending that you could write a program
+based on data structures, instead of the other way around. As all Real
+Programmers know, the only useful data structure is the
+array. Strings, lists, structures, sets -- these are all special cases
+of arrays and and can be treated that way just as easily without
+messing up your programing language with all sorts of
+complications. The worst thing about fancy data types is that you have
+to declare them, and Real Programming Languages, as we all know, have
+implicit typing based on the first letter of the (six character)
+variable name. <P>
+
+
+<H3> OPERATING SYSTEMS</H3>
+
+What kind of operating system is used by a Real Programmer? CP/M? God
+forbid -- CP/M, after all, is basically a toy operating system. Even
+little old ladies and grade school students can understand and use
+CP/M. <P>
+
+Unix is a lot more complicated of course -- the typical Unix hacker
+never can remember what the <KBD>PRINT</KBD> command is called this
+week -- but when it gets right down to it, Unix is a glorified video
+game. People don't do Serious Work on Unix systems: they send jokes
+around the world on USENET and write adventure games and research
+papers. <P>
+
+No, your Real Programmer uses OS/370. A good programmer can find and
+understand the description of the IJK305I error he just got in his JCL
+manual. A great programmer can write JCL without referring to the
+manual at all. A truly outstanding programmer can find bugs buried in
+a 6 megabyte core dump without using a hex calculator. (I have
+actually seen this done.) <P>
+
+OS/370 is a truly remarkable operating system. It's possible to des-
+troy days of work with a single misplaced space, so alertness in the
+programming staff is encouraged. The best way to approach the system
+is through a keypunch. Some people claim there is a Time Sharing
+system that runs on OS/370, but after careful study I have come to the
+conclusion that they are mistaken. <P>
+
+
+<H3> PROGRAMMING TOOLS</H3>
+
+What kind of tools does a Real Programmer use? In theory, a Real
+Programmer could run his programs by keying them into the front panel
+of the computer. Back in the days when computers had front panels,
+this was actually done occasionally. Your typical Real Programmer
+knew the entire bootstrap loader by memory in hex, and toggled it in
+whenever it got destroyed by his program. (Back then, memory was
+memory -- it didn't go away when the power went off. Today, memory
+either forgets things when you don't want it to, or remembers things
+long after they're better forgotten.) Legend has it that Seymour
+Cray, inventor of the Cray I supercomputer and most of Control Data's
+computers, actually toggled the first operating system for the CDC7600
+in on the front panel from memory when it was first powered
+on. Seymour, needless to say, is a Real Programmer. <P>
+
+One of my favorite Real Programmers was a systems programmer for Texas
+Instruments. One day, he got a long distance call from a user whose
+system had crashed in the middle of some important work. Jim was able
+to repair the damage over the phone, getting the user to toggle in
+disk I/O instructions at the front panel, repairing system tables in
+hex, reading register contents back over the phone. The moral of this
+story: while a Real Programmer usually includes a keypunch and
+lineprinter in his toolkit, he can get along with just a front panel
+and a telephone in emergencies. <P>
+
+In some companies, text editing no longer consists of ten engineers
+standing in line to use an 029 keypunch. In fact, the building I work
+in doesn't contain a single keypunch. The Real Programmer in this
+situation has to do his work with a text editor program. Most systems
+supply several text editors to select from, and the Real Programmer
+must be careful to pick one that reflects his personal style. Many
+people believe that the best text editors in the world were written at
+Xerox Palo Alto Research Center for use on their Alto and Dorado
+computers [3]. Unfortunately, no Real Programmer would ever use a
+computer whose operating system is called SmallTalk, and would
+certainly not talk to the computer with a mouse. <P>
+
+Some of the concepts in these Xerox editors have been incorporated
+into editors running on more reasonably named operating systems. EMACS
+and VI are probably the most well known of this class of editors. The
+problem with these editors is that Real Programmers consider "what you
+see is what you get" to be just as bad a concept in text editors as it
+is in women. No, the Real Programmer wants a "you asked for it, you
+got it" text editor -- complicated, cryptic, powerful, unforgiving,
+dangerous. TECO, to be precise. <P>
+
+It has been observed that a TECO command sequence more closely resem-
+bles transmission line noise than readable text [4]. One of the more
+entertaining games to play with TECO is to type your name in as a
+command line and try to guess what it does. Just about any possible
+typing error while talking with TECO will probably destroy your
+program, or even worse -- introduce subtle and mysterious bugs in a
+once working subroutine. <P>
+
+For this reason, Real Programmers are reluctant to actually edit a
+program that is close to working. They find it much easier to just
+patch the binary object code directly, using a wonderful program
+called SUPERZAP (or its equivalent on non-IBM machines). This works so
+well that many working programs on IBM systems bear no relation to
+the original FORTRAN code. In many cases, the original source code is
+no longer available. When it comes time to fix a program like this, no
+manager would even think of sending anything less than a Real
+Programmer to do the job -- no Quiche Eating structured programmer
+would even know where to start. This is called "job security". <P>
+
+Some programming tools NOT used by Real Programmers: <P>
+<UL>
+
+<LI> FORTRAN preprocessors like MORTRAN and RATFOR. The Cuisinarts of
+programming -- great for making Quiche. See comments above on
+structured programming.
+
+<LI> Source language debuggers. Real Programmers can read core dumps.
+
+<LI> Compilers with array bounds checking. They stifle creativity,
+destroy most of the interesting uses for EQUIVALENCE, and make it
+impossible to modify the operating system code with negative
+subscripts. Worst of all, bounds checking is inefficient.
+
+<LI> Source code maintainance systems. A Real Programmer keeps his
+code locked up in a card file, because it implies that its owner
+cannot leave his important programs unguarded [5].
+
+</UL> <P>
+
+
+<H3> THE REAL PROGRAMMER AT WORK</H3>
+
+Where does the typical Real Programmer work? What kind of programs are
+worthy of the efforts of so talented an individual? You can be sure
+that no real Programmer would be caught dead writing
+accounts-receivable programs in COBOL, or sorting mailing lists for
+People magazine. A Real Programmer wants tasks of earth-shaking
+importance (literally!): <P>
+
+<UL>
+
+<LI> Real Programmers work for Los Alamos National Laboratory, writing
+atomic bomb simulations to run on Cray I supercomputers.
+
+<LI> Real Programmers work for the National Security Agency, decoding
+Russian transmissions.
+
+<LI> It was largely due to the efforts of thousands of Real
+Programmers working for NASA that our boys got to the moon and back
+before the cosmonauts.
+
+<LI> The computers in the Space Shuttle were programmed by Real
+Programmers.
+
+<LI> Programmers are at work for Boeing designing the operating
+systems for cruise missiles.
+
+</UL> <P>
+
+Some of the most awesome Real Programmers of all work at the Jet Pro-
+pulsion Laboratory in California. Many of them know the entire
+operating system of the Pioneer and Voyager spacecraft by heart. With
+a combination of large ground-based FORTRAN programs and small
+spacecraft-based assembly language programs, they can to do incredible
+feats of navigation and improvisation, such as hitting ten-kilometer
+wide windows at Saturn after six years in space, and repairing or
+bypassing damaged sensor platforms, radios, and batteries. Allegedly,
+one Real Programmer managed to tuck a pattern-matching program into a
+few hundred bytes of unused memory in a Voyager spacecraft that
+searched for, located, and photographed a new moon of Jupiter. <P>
+
+One plan for the upcoming Galileo spacecraft mission is to use a grav-
+ity assist trajectory past Mars on the way to Jupiter. This trajectory
+passes within 80 +/- 3 kilometers of the surface of Mars. Nobody is
+going to trust a PASCAL program (or PASCAL programmer) for navigation
+to these tolerances. <P>
+
+As you can tell, many of the world's Real Programmers work for the
+U.S. Government, mainly the Defense Department. This is as it should
+be. Recently, however, a black cloud has formed on the Real
+Programmer horizon. <P>
+
+It seems that some highly placed Quiche Eaters at the Defense
+Department decided that all Defense programs should be written in some
+grand unified language called "ADA" (registered trademark, DoD). For
+a while, it seemed that ADA was destined to become a language that
+went against all the precepts of Real Programming -- a language with
+structure, a language with data types, strong typing, and
+semicolons. In short, a language designed to cripple the creativity of
+the typical Real Programmer. Fortunately, the language adopted by DoD
+has enough interesting features to make it approachable: it's
+incredibly complex, includes methods for messing with the operating
+system and rearranging memory, and Edsgar Dijkstra doesn't like it
+[6]. (Dijkstra, as I'm sure you know, was the author of <EM>"GoTos
+Considered Harmful"</EM> -- a landmark work in programming
+methodology, applauded by Pascal Programmers and Quiche Eaters alike.)
+Besides, the determined Real Programmer can write FORTRAN programs in
+any language. <P>
+
+The real programmer might compromise his principles and work on some-
+thing slightly more trivial than the destruction of life as we know
+it, providing there's enough money in it. There are several Real
+Programmers building video games at Atari, for example. (But not
+playing them. A Real Programmer knows how to beat the machine every
+time: no challange in that.) Everyone working at LucasFilm is a Real
+Programmer. (It would be crazy to turn down the money of 50 million
+Star Wars fans.) The proportion of Real Programmers in Computer
+Graphics is somewhat lower than the norm, mostly because nobody has
+found a use for Computer Graphics yet. On the other hand, all
+Computer Graphics is done in FORTRAN, so there are a fair number
+people doing Graphics in order to avoid having to write COBOL
+programs. <P>
+
+
+<H3> THE REAL PROGRAMMER AT PLAY</H3>
+
+Generally, the Real Programmer plays the same way he works -- with
+computers. He is constantly amazed that his employer actually pays
+him to do what he would be doing for fun anyway, although he is
+careful not to express this opinion out loud. Occasionally, the Real
+Programmer does step out of the office for a breath of fresh air and a
+beer or two. Some tips on recognizing real programmers away from the
+computer room: <P>
+<UL>
+
+<LI> At a party, the Real Programmers are the ones in the corner
+talking about operating system security and how to get around it.
+
+<LI> At a football game, the Real Programmer is the one comparing the
+plays against his simulations printed on 11 by 14 fanfold paper.
+
+<LI> At the beach, the Real Programmer is the one drawing flowcharts
+in the sand.
+
+<LI> A Real Programmer goes to a disco to watch the light show.
+
+<LI> At a funeral, the Real Programmer is the one saying <EM>"Poor
+George. And he almost had the sort routine working before the
+coronary."</EM>
+
+<LI> In a grocery store, the Real Programmer is the one who insists on
+running the cans past the laser checkout scanner himself, because he
+never could trust keypunch operators to get it right the first time.
+
+</UL> <P>
+
+
+<H3> THE REAL PROGRAMMER'S NATURAL HABITAT</H3>
+
+What sort of environment does the Real Programmer function best in?
+This is an important question for the managers of Real
+Programmers. Considering the amount of money it costs to keep one on
+the staff, it's best to put him (or her) in an environment where he
+can get his work done. <P>
+
+The typical Real Programmer lives in front of a computer terminal.
+Surrounding this terminal are: <P>
+<UL>
+
+<LI> Listings of all programs the Real Programmer has ever worked on,
+piled in roughly chronological order on every flat surface in the office.
+
+<LI> Some half-dozen or so partly filled cups of cold
+coffee. Occasionally, there will be cigarette butts floating in the
+coffee. In some cases, the cups will contain Orange Crush.
+
+<LI> Unless he is very good, there will be copies of the OS JCL manual
+and the Principles of Operation open to some particularly interesting
+pages.
+
+<LI> Taped to the wall is a line-printer Snoopy calender for the year
+1969.
+
+<LI> Strewn about the floor are several wrappers for peanut butter
+filled cheese bars (the type that are made stale at the bakery so they
+can't get any worse while waiting in the vending machine).
+
+<LI> Hiding in the top left-hand drawer of the desk is a stash of
+double stuff Oreos for special occasions.
+
+<LI> Underneath the Oreos is a flow-charting template, left there by
+the previous occupant of the office. (Real Programmers write programs,
+not documentation. Leave that to the maintainence people.)
+
+</UL> <P>
+
+The Real Programmer is capable of working 30, 40, even 50 hours at a
+stretch, under intense pressure. In fact, he prefers it that way. Bad
+response time doesn't bother the Real Programmer -- it gives him a
+chance to catch a little sleep between compiles. If there is not
+enough schedule pressure on the Real Programmer, he tends to make
+things more challenging by working on some small but interesting part
+of the problem for the first nine weeks, then finishing the rest in
+the last week, in two or three 50-hour marathons. This not only
+inpresses his manager, who was despairing of ever getting the project
+done on time, but creates a convenient excuse for not doing the
+documentation. In general: <P>
+
+<UL>
+
+<LI> No Real Programmer works 9 to 5. (Unless it's 9 in the evening to
+5 in the morning.)
+
+<LI> Real Programmers don't wear neckties.
+
+<LI> Real Programmers don't wear high heeled shoes.
+
+<LI> Real Programmers arrive at work in time for lunch. [9]
+
+<LI> A Real Programmer might or might not know his wife's name. He
+does, however, know the entire ASCII (or EBCDIC) code table.
+
+<LI> Real Programmers don't know how to cook. Grocery stores aren't
+often open at 3 a.m., so they survive on Twinkies and coffee.
+
+</UL> <P>
+
+<H3> THE FUTURE</H3>
+
+What of the future? It is a matter of some concern to Real Programmers
+that the latest generation of computer programmers are not being
+brought up with the same outlook on life as their elders. Many of them
+have never seen a computer with a front panel. Hardly anyone
+graduating from school these days can do hex arithmetic without a
+calculator. College graduates these days are soft -- protected from
+the realities of programming by source level debuggers, text editors
+that count parentheses, and user friendly operating systems. Worst of
+all, some of these alleged computer scientists manage to get degrees
+without ever learning FORTRAN! Are we destined to become an industry
+of Unix hackers and Pascal programmers? <P>
+
+On the contrary. From my experience, I can only report that the
+future is bright for Real Programmers everywhere. Neither OS/370 nor
+FORTRAN show any signs of dying out, despite all the efforts of
+Pascal programmers the world over. Even more subtle tricks, like
+adding structured coding constructs to FORTRAN have failed. Oh sure,
+some computer vendors have come out with FORTRAN 77 compilers, but
+every one of them has a way of converting itself back into a FORTRAN
+66 compiler at the drop of an option card -- to compile DO loops like
+God meant them to be. <P>
+
+Even Unix might not be as bad on Real Programmers as it once was. The
+latest release of Unix has the potential of an operating system worthy
+of any Real Programmer. It has two different and subtly incompatible
+user interfaces, an arcane and complicated terminal driver, virtual
+memory. If you ignore the fact that it's structured, even C
+programming can be appreciated by the Real Programmer: after all,
+there's no type checking, variable names are seven (ten? eight?)
+characters long, and the added bonus of the Pointer data type is
+thrown in. It's like having the best parts of FORTRAN and assembly
+language in one place. (Not to mention some of the more creative uses
+for <KBD>#define</KBD>.) <P>
+
+No, the future isn't all that bad. Why, in the past few years, the
+popular press has even commented on the bright new crop of computer
+nerds and hackers ([7] and [8]) leaving places like Stanford and
+M.I.T. for the Real World. From all evidence, the spirit of Real
+Programming lives on in these young men and women. As long as there
+are ill-defined goals, bizarre bugs, and unrealistic schedules, there
+will be Real Programmers willing to jump in and Solve The Problem,
+saving the documentation for later. Long live FORTRAN! <P>
+
+<H3>ACKNOWLEGEMENT</H3>
+
+I would like to thank Jan E., Dave S., Rich G., Rich E. for their help
+in characterizing the Real Programmer, Heather B. for the
+illustration, Kathy E. for putting up with it, and <kbd>atd!avsdS:mark</kbd> for
+the initial inspriration. <P>
+
+<H3>REFERENCES</H3>
+
+[1] Feirstein, B., <em>Real Men Don't Eat Quiche</em>, New York,
+ Pocket Books, 1982. <P>
+
+[2] Wirth, N., <em>Algorithms + Datastructures = Programs</em>,
+ Prentice Hall, 1976. <P>
+
+[3] Xerox PARC editors . . . <P>
+
+[4] Finseth, C., <em>Theory and Practice of Text Editors -
+ or - a Cookbook for an EMACS</em>, B.S. Thesis,
+ MIT/LCS/TM-165, Massachusetts Institute of Technology,
+ May 1980. <P>
+
+[5] Weinberg, G., <em>The Psychology of Computer Programming</em>,
+ New York, Van Nostrabd Reinhold, 1971, page 110. <P>
+
+[6] Dijkstra, E., <em>On the GREEN Language Submitted to the DoD</em>,
+ Sigplan notices, Volume 3, Number 10, October 1978. <P>
+
+[7] Rose, Frank, <em>Joy of Hacking</em>, Science 82, Volume 3, Number 9,
+ November 1982, pages 58 - 66. <P>
+
+[8] The Hacker Papers, <em>Psychology Today</em>, August 1980. <P>
+
+[9] <em>Datamation</em>, July, 1983, pp. 263-265. <P>
+
+<hr>
+
+<ADDRESS> <a href="index.html">Hacker's Wisdom</a>/ Real Programmers
+Don't Use PASCAL </ADDRESS>
+
+<!-- hhmts start -->
+Last modified: Wed Mar 27 17:48:50 EST 1996
diff --git a/lib/kernel/test/file_SUITE_data/realmen.html.gz b/lib/kernel/test/file_SUITE_data/realmen.html.gz
new file mode 100644
index 0000000000..9c662ff3c0
--- /dev/null
+++ b/lib/kernel/test/file_SUITE_data/realmen.html.gz
Binary files differ
diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl
new file mode 100644
index 0000000000..dd7d5f111a
--- /dev/null
+++ b/lib/kernel/test/gen_sctp_SUITE.erl
@@ -0,0 +1,338 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(gen_sctp_SUITE).
+
+-include("test_server.hrl").
+-include_lib("kernel/include/inet_sctp.hrl").
+
+%%-compile(export_all).
+
+-export([all/1,init_per_testcase/2,fin_per_testcase/2,
+ basic/1,xfer_min/1,xfer_active/1,api_open_close/1,api_listen/1]).
+
+all(suite) ->
+ [basic,xfer_min,xfer_active,api_open_close,api_listen].
+
+init_per_testcase(_Func, Config) ->
+ Dog = test_server:timetrap(test_server:seconds(15)),
+ [{watchdog, Dog}|Config].
+fin_per_testcase(_Func, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+
+
+basic(doc) ->
+ "Hello world";
+basic(suite) ->
+ [];
+basic(Config) when is_list(Config) ->
+ ?line {ok,S} = gen_sctp:open(),
+ ?line ok = gen_sctp:close(S),
+ ok.
+
+xfer_min(doc) ->
+ "Minimal data transfer";
+xfer_min(suite) ->
+ [];
+xfer_min(Config) when is_list(Config) ->
+ ?line Stream = 0,
+ ?line Data = <<"The quick brown fox jumps over a lazy dog 0123456789">>,
+ ?line Loopback = {127,0,0,1},
+ ?line {ok,Sb} = gen_sctp:open(),
+ ?line {ok,Pb} = inet:port(Sb),
+ ?line ok = gen_sctp:listen(Sb, true),
+
+ ?line {ok,Sa} = gen_sctp:open(),
+ ?line {ok,Pa} = inet:port(Sa),
+ ?line {ok,#sctp_assoc_change{state=comm_up,
+ error=0,
+ outbound_streams=SaOutboundStreams,
+ inbound_streams=SaInboundStreams,
+ assoc_id=SaAssocId}=SaAssocChange} =
+ gen_sctp:connect(Sa, Loopback, Pb, []),
+ ?line {ok,{Loopback,
+ Pa,[],
+ #sctp_assoc_change{state=comm_up,
+ error=0,
+ outbound_streams=SbOutboundStreams,
+ inbound_streams=SbInboundStreams,
+ assoc_id=SbAssocId}}} =
+ gen_sctp:recv(Sb, infinity),
+ ?line SaOutboundStreams = SbInboundStreams,
+ ?line SbOutboundStreams = SaInboundStreams,
+ ?line ok = gen_sctp:send(Sa, SaAssocId, 0, Data),
+ ?line case gen_sctp:recv(Sb, infinity) of
+ {ok,{Loopback,
+ Pa,
+ [#sctp_sndrcvinfo{stream=Stream,
+ assoc_id=SbAssocId}],
+ Data}} -> ok;
+ {ok,{Loopback,
+ Pa,[],
+ #sctp_paddr_change{addr = {Loopback,_},
+ state = addr_available,
+ error = 0,
+ assoc_id = SbAssocId}}} ->
+ {ok,{Loopback,
+ Pa,
+ [#sctp_sndrcvinfo{stream=Stream,
+ assoc_id=SbAssocId}],
+ Data}} = gen_sctp:recv(Sb, infinity)
+ end,
+ ?line ok = gen_sctp:send(Sb, SbAssocId, 0, Data),
+ ?line {ok,{Loopback,
+ Pb,
+ [#sctp_sndrcvinfo{stream=Stream,
+ assoc_id=SaAssocId}],
+ Data}} =
+ gen_sctp:recv(Sa, infinity),
+ %%
+ ?line ok = gen_sctp:eof(Sa, SaAssocChange),
+ ?line {ok,{Loopback,
+ Pa,[],
+ #sctp_shutdown_event{assoc_id=SbAssocId}}} =
+ gen_sctp:recv(Sb, infinity),
+ ?line {ok,{Loopback,
+ Pb,[],
+ #sctp_assoc_change{state=shutdown_comp,
+ error=0,
+ assoc_id=SaAssocId}}} =
+ gen_sctp:recv(Sa, infinity),
+ ?line {ok,{Loopback,
+ Pa,[],
+ #sctp_assoc_change{state=shutdown_comp,
+ error=0,
+ assoc_id=SbAssocId}}} =
+ gen_sctp:recv(Sb, infinity),
+ ?line ok = gen_sctp:close(Sa),
+ ?line ok = gen_sctp:close(Sb),
+
+ ?line receive
+ Msg -> test_server:fail({received,Msg})
+ after 17 -> ok
+ end,
+ ok.
+
+xfer_active(doc) ->
+ "Minimal data transfer in active mode";
+xfer_active(suite) ->
+ [];
+xfer_active(Config) when is_list(Config) ->
+ ?line Timeout = 2000,
+ ?line Stream = 0,
+ ?line Data = <<"The quick brown fox jumps over a lazy dog 0123456789">>,
+ ?line Loopback = {127,0,0,1},
+ ?line {ok,Sb} = gen_sctp:open([{active,true}]),
+ ?line {ok,Pb} = inet:port(Sb),
+ ?line ok = gen_sctp:listen(Sb, true),
+
+ ?line {ok,Sa} = gen_sctp:open([{active,true}]),
+ ?line {ok,Pa} = inet:port(Sa),
+ ?line {ok,#sctp_assoc_change{state=comm_up,
+ error=0,
+ outbound_streams=SaOutboundStreams,
+ inbound_streams=SaInboundStreams,
+ assoc_id=SaAssocId}=SaAssocChange} =
+ gen_sctp:connect(Sa, Loopback, Pb, []),
+ ?line io:format("Sa=~p, Pa=~p, Sb=~p, Pb=~p, SaAssocId=~p, "
+ "SaOutboundStreams=~p, SaInboundStreams=~p~n",
+ [Sa,Pa,Sb,Pb,SaAssocId,
+ SaOutboundStreams,SaInboundStreams]),
+ ?line SbAssocId =
+ receive
+ {sctp,Sb,Loopback,Pa,
+ {[],
+ #sctp_assoc_change{state=comm_up,
+ error=0,
+ outbound_streams=SbOutboundStreams,
+ inbound_streams=SbInboundStreams,
+ assoc_id=SBAI}}} ->
+ ?line SaOutboundStreams = SbInboundStreams,
+ ?line SaInboundStreams = SbOutboundStreams,
+ SBAI
+ after Timeout ->
+ ?line test_server:fail({unexpected,flush()})
+ end,
+ ?line io:format("SbAssocId=~p~n", [SbAssocId]),
+ ?line ok = gen_sctp:send(Sa, SaAssocId, 0, Data),
+ ?line receive
+ {sctp,Sb,Loopback,Pa,
+ {[#sctp_sndrcvinfo{stream=Stream,
+ assoc_id=SbAssocId}],
+ Data}} -> ok;
+ {sctp,Sb,Loopback,Pa,
+ {[],
+ #sctp_paddr_change{addr = {Loopback,_},
+ state = addr_available,
+ error = 0,
+ assoc_id = SbAssocId}}} ->
+ ?line receive
+ {sctp,Sb,Loopback,Pa,
+ {[#sctp_sndrcvinfo{stream=Stream,
+ assoc_id=SbAssocId}],
+ Data}} -> ok
+ end
+ after Timeout ->
+ ?line test_server:fail({unexpected,flush()})
+ end,
+ ?line ok = gen_sctp:send(Sb, SbAssocId, 0, Data),
+ ?line receive
+ {sctp,Sa,Loopback,Pb,
+ {[#sctp_sndrcvinfo{stream=Stream,
+ assoc_id=SaAssocId}],
+ Data}} -> ok
+ after Timeout ->
+ ?line test_server:fail({unexpected,flush()})
+ end,
+ %%
+ ?line ok = gen_sctp:abort(Sa, SaAssocChange),
+ ?line receive
+ {sctp,Sb,Loopback,Pa,
+ {[],
+ #sctp_assoc_change{state=comm_lost,
+ assoc_id=SbAssocId}}} -> ok
+ after Timeout ->
+ ?line test_server:fail({unexpected,flush()})
+ end,
+ ?line ok = gen_sctp:close(Sb),
+ ?line receive
+ {sctp,Sa,Loopback,Pb,
+ {[],
+ #sctp_assoc_change{state=comm_lost,
+ assoc_id=SaAssocId}}} -> ok
+ after 17 -> ok %% On Solaris this does not arrive
+ end,
+ ?line ok = gen_sctp:close(Sa),
+ %%
+ ?line receive
+ Msg -> test_server:fail({unexpected,[Msg]++flush()})
+ after 17 -> ok
+ end,
+ ok.
+
+flush() ->
+ receive
+ Msg ->
+ [Msg|flush()]
+ after 17 ->
+ []
+ end.
+
+api_open_close(doc) ->
+ "Test the API function open/1,2 and close/1";
+api_open_close(suite) ->
+ [];
+api_open_close(Config) when is_list(Config) ->
+ ?line {ok,S1} = gen_sctp:open(0),
+ ?line {ok,P} = inet:port(S1),
+ ?line ok = gen_sctp:close(S1),
+
+ ?line {ok,S2} = gen_sctp:open(P),
+ ?line {ok,P} = inet:port(S2),
+ ?line ok = gen_sctp:close(S2),
+
+ ?line {ok,S3} = gen_sctp:open([{port,P}]),
+ ?line {ok,P} = inet:port(S3),
+ ?line ok = gen_sctp:close(S3),
+
+ ?line {ok,S4} = gen_sctp:open(P, []),
+ ?line {ok,P} = inet:port(S4),
+ ?line ok = gen_sctp:close(S4),
+
+ ?line {ok,S5} = gen_sctp:open(P, [{ifaddr,any}]),
+ ?line {ok,P} = inet:port(S5),
+ ?line ok = gen_sctp:close(S5),
+
+ ?line ok = gen_sctp:close(S5),
+
+ ?line try gen_sctp:close(0)
+ catch error:badarg -> ok
+ end,
+
+ ?line try gen_sctp:open({})
+ catch error:badarg -> ok
+ end,
+
+ ?line try gen_sctp:open(-1)
+ catch error:badarg -> ok
+ end,
+
+ ?line try gen_sctp:open(65536)
+ catch error:badarg -> ok
+ end,
+
+ ?line try gen_sctp:open(make_ref(), [])
+ catch error:badarg -> ok
+ end,
+
+ ?line try gen_sctp:open(0, {})
+ catch error:badarg -> ok
+ end,
+
+ ?line try gen_sctp:open(0, [make_ref()])
+ catch error:badarg -> ok
+ end,
+
+ ?line try gen_sctp:open([{invalid_option,0}])
+ catch error:badarg -> ok
+ end,
+
+ ?line try gen_sctp:open(0, [{mode,invalid_mode}])
+ catch error:badarg -> ok
+ end,
+ ok.
+
+api_listen(doc) ->
+ "Test the API function listen/2";
+api_listen(suite) ->
+ [];
+api_listen(Config) when is_list(Config) ->
+ ?line Localhost = {127,0,0,1},
+
+ ?line try gen_sctp:listen(0, true)
+ catch error:badarg -> ok
+ end,
+
+ ?line {ok,S} = gen_sctp:open(),
+ ?line {ok,Pb} = inet:port(S),
+ ?line try gen_sctp:listen(S, not_allowed_for_listen)
+ catch error:badarg -> ok
+ end,
+ ?line ok = gen_sctp:close(S),
+ ?line {error,closed} = gen_sctp:listen(S, true),
+
+ ?line {ok,Sb} = gen_sctp:open(Pb),
+ ?line {ok,Sa} = gen_sctp:open(),
+ ?line case gen_sctp:connect(Sa, localhost, Pb, []) of
+ {error,econnrefused} ->
+ ?line {ok,{Localhost,
+ Pb,[],
+ #sctp_assoc_change{
+ state = comm_lost}}} =
+ gen_sctp:recv(Sa, infinity);
+ {error,#sctp_assoc_change{state=cant_assoc}} -> ok
+ end,
+ ?line ok = gen_sctp:listen(Sb, true),
+ ?line {ok,#sctp_assoc_change{state=comm_up,
+ error=0}} =
+ gen_sctp:connect(Sa, localhost, Pb, []),
+ ?line ok = gen_sctp:close(Sa),
+ ?line ok = gen_sctp:close(Sb),
+ ok.
diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl
new file mode 100644
index 0000000000..11d19aaa82
--- /dev/null
+++ b/lib/kernel/test/gen_tcp_api_SUITE.erl
@@ -0,0 +1,219 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(gen_tcp_api_SUITE).
+
+%% Tests the documented API for the gen_tcp functions. The "normal" cases
+%% are not tested here, because they are tested indirectly in this and
+%% and other test suites.
+
+-include("test_server.hrl").
+-include_lib("kernel/include/inet.hrl").
+
+-export([all/1, init_per_testcase/2, fin_per_testcase/2,
+ t_accept/1, t_connect_timeout/1, t_accept_timeout/1,
+ t_connect/1, t_connect_bad/1,
+ t_recv/1, t_recv_timeout/1, t_recv_eof/1,
+ t_shutdown_write/1, t_shutdown_both/1, t_shutdown_error/1,
+ t_fdopen/1]).
+
+all(suite) -> [t_accept, t_connect, t_recv, t_shutdown_write,
+ t_shutdown_both, t_shutdown_error, t_fdopen].
+
+init_per_testcase(_Func, Config) ->
+ Dog = test_server:timetrap(test_server:seconds(60)),
+ [{watchdog, Dog}|Config].
+fin_per_testcase(_Func, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+%%% gen_tcp:accept/1,2
+
+t_accept(suite) -> [t_accept_timeout].
+
+t_accept_timeout(doc) -> "Test that gen_tcp:accept/2 (with timeout) works.";
+t_accept_timeout(suite) -> [];
+t_accept_timeout(Config) when is_list(Config) ->
+ ?line {ok, L} = gen_tcp:listen(0, []),
+ ?line timeout({gen_tcp, accept, [L, 200]}, 0.2, 1.0).
+
+%%% gen_tcp:connect/X
+
+t_connect(suite) -> [t_connect_timeout, t_connect_bad].
+
+t_connect_timeout(doc) -> "Test that gen_tcp:connect/4 (with timeout) works.";
+t_connect_timeout(Config) when is_list(Config) ->
+ %%?line BadAddr = {134,138,177,16},
+ %%?line TcpPort = 80,
+ ?line {ok, BadAddr} = unused_ip(),
+ ?line TcpPort = 45638,
+ ?line ok = io:format("Connecting to ~p, port ~p", [BadAddr, TcpPort]),
+ ?line connect_timeout({gen_tcp,connect,[BadAddr,TcpPort,[],200]}, 0.2, 5.0).
+
+t_connect_bad(doc) ->
+ ["Test that gen_tcp:connect/3 handles non-existings hosts, and other ",
+ "invalid things."];
+t_connect_bad(suite) -> [];
+t_connect_bad(Config) when is_list(Config) ->
+ ?line NonExistingPort = 45638, % Not in use, I hope.
+ ?line {error, Reason1} = gen_tcp:connect(localhost, NonExistingPort, []),
+ ?line io:format("Error for connection attempt to port not in use: ~p",
+ [Reason1]),
+
+ ?line {error, Reason2} = gen_tcp:connect("non-existing-host-xxx", 7, []),
+ ?line io:format("Error for connection attempt to non-existing host: ~p",
+ [Reason2]),
+ ok.
+
+
+%%% gen_tcp:recv/X
+
+t_recv(suite) -> [t_recv_timeout, t_recv_eof].
+
+t_recv_timeout(doc) -> "Test that gen_tcp:recv/3 (with timeout works).";
+t_recv_timeout(suite) -> [];
+t_recv_timeout(Config) when is_list(Config) ->
+ ?line {ok, L} = gen_tcp:listen(0, []),
+ ?line {ok, Port} = inet:port(L),
+ ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]),
+ ?line {ok, _A} = gen_tcp:accept(L),
+ ?line timeout({gen_tcp, recv, [Client, 0, 200]}, 0.2, 5.0).
+
+t_recv_eof(doc) -> "Test that end of file on a socket is reported correctly.";
+t_recv_eof(suite) -> [];
+t_recv_eof(Config) when is_list(Config) ->
+ ?line {ok, L} = gen_tcp:listen(0, []),
+ ?line {ok, Port} = inet:port(L),
+ ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]),
+ ?line {ok, A} = gen_tcp:accept(L),
+ ?line ok = gen_tcp:close(A),
+ ?line {error, closed} = gen_tcp:recv(Client, 0),
+ ok.
+
+%%% gen_tcp:shutdown/2
+
+t_shutdown_write(Config) when is_list(Config) ->
+ ?line {ok, L} = gen_tcp:listen(0, []),
+ ?line {ok, Port} = inet:port(L),
+ ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]),
+ ?line {ok, A} = gen_tcp:accept(L),
+ ?line ok = gen_tcp:shutdown(A, write),
+ ?line {error, closed} = gen_tcp:recv(Client, 0),
+ ok.
+
+t_shutdown_both(Config) when is_list(Config) ->
+ ?line {ok, L} = gen_tcp:listen(0, []),
+ ?line {ok, Port} = inet:port(L),
+ ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]),
+ ?line {ok, A} = gen_tcp:accept(L),
+ ?line ok = gen_tcp:shutdown(A, read_write),
+ ?line {error, closed} = gen_tcp:recv(Client, 0),
+ ok.
+
+t_shutdown_error(Config) when is_list(Config) ->
+ ?line {ok, L} = gen_tcp:listen(0, []),
+ ?line {error, enotconn} = gen_tcp:shutdown(L, read_write),
+ ?line ok = gen_tcp:close(L),
+ ?line {error, closed} = gen_tcp:shutdown(L, read_write),
+ ok.
+
+
+%%% gen_tcp:fdopen/2
+
+t_fdopen(Config) when is_list(Config) ->
+ ?line Question = "Aaaa... Long time ago in a small town in Germany,",
+ ?line Answer = "there was a shoemaker, Schumacher was his name.",
+ ?line {ok, L} = gen_tcp:listen(0, [{active, false}]),
+ ?line {ok, Port} = inet:port(L),
+ ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]),
+ ?line {ok, A} = gen_tcp:accept(L),
+ ?line {ok, FD} = prim_inet:getfd(A),
+ ?line {ok, Server} = gen_tcp:fdopen(FD, []),
+ ?line ok = gen_tcp:send(Client, Question),
+ ?line {ok, Question} = gen_tcp:recv(Server, length(Question), 2000),
+ ?line ok = gen_tcp:send(Server, Answer),
+ ?line {ok, Answer} = gen_tcp:recv(Client, length(Answer), 2000),
+ ?line ok = gen_tcp:close(Client),
+ ?line {error,closed} = gen_tcp:recv(A, 1, 2000),
+ ?line ok = gen_tcp:close(Server),
+ ?line ok = gen_tcp:close(A),
+ ?line ok = gen_tcp:close(L),
+ ok.
+
+
+
+%%% Utilities
+
+%% Calls M:F/length(A), which should return a timeout error, and complete
+%% within the given time.
+
+timeout({M,F,A}, Lower, Upper) ->
+ case test_server:timecall(M, F, A) of
+ {Time, Result} when Time < Lower ->
+ test_server:fail({too_short_time, Time, Result});
+ {Time, Result} when Time > Upper ->
+ test_server:fail({too_long_time, Time, Result});
+ {_, {error, timeout}} ->
+ ok;
+ {_, Result} ->
+ test_server:fail({unexpected_result, Result})
+ end.
+
+connect_timeout({M,F,A}, Lower, Upper) ->
+ case test_server:timecall(M, F, A) of
+ {Time, Result} when Time < Lower ->
+ case Result of
+ {error,econnrefused=E} ->
+ {comment,"Not tested -- got error "++atom_to_list(E)};
+ {error,enetunreach=E} ->
+ {comment,"Not tested -- got error "++atom_to_list(E)};
+ {ok,Socket} -> % What the...
+ Pinfo = erlang:port_info(Socket),
+ Db = inet_db:lookup_socket(Socket),
+ Peer = inet:peername(Socket),
+ test_server:fail({too_short_time, Time,
+ [Result,Pinfo,Db,Peer]});
+ _ ->
+ test_server:fail({too_short_time, Time, Result})
+ end;
+ {Time, Result} when Time > Upper ->
+ test_server:fail({too_long_time, Time, Result});
+ {_, {error, timeout}} ->
+ ok;
+ {_, Result} ->
+ test_server:fail({unexpected_result, Result})
+ end.
+
+%% Try to obtain an unused IP address in the local network.
+
+unused_ip() ->
+ ?line {ok, Host} = inet:gethostname(),
+ ?line {ok, Hent} = inet:gethostbyname(Host),
+ ?line #hostent{h_addr_list=[{A, B, C, _D}|_]} = Hent,
+ %% Note: In our net, addresses below 16 are reserved for routers and
+ %% other strange creatures.
+ ?line IP = unused_ip(A, B, C, 16),
+ io:format("we = ~p, unused_ip = ~p~n", [Hent, IP]),
+ IP.
+
+unused_ip(_, _, _, 255) -> error;
+unused_ip(A, B, C, D) ->
+ case inet:gethostbyaddr({A, B, C, D}) of
+ {ok, _} -> unused_ip(A, B, C, D+1);
+ {error, _} -> {ok, {A, B, C, D}}
+ end.
diff --git a/lib/kernel/test/gen_tcp_echo_SUITE.erl b/lib/kernel/test/gen_tcp_echo_SUITE.erl
new file mode 100644
index 0000000000..a2e09877af
--- /dev/null
+++ b/lib/kernel/test/gen_tcp_echo_SUITE.erl
@@ -0,0 +1,585 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(gen_tcp_echo_SUITE).
+
+-include("test_server.hrl").
+
+%%-compile(export_all).
+
+-export([all/1, init_per_testcase/2, fin_per_testcase/2,
+ active_echo/1, passive_echo/1, active_once_echo/1,
+ slow_active_echo/1, slow_passive_echo/1,
+ limit_active_echo/1, limit_passive_echo/1,
+ large_limit_active_echo/1, large_limit_passive_echo/1]).
+
+-define(TPKT_VRSN, 3).
+-define(LINE_LENGTH, 1023). % (default value of gen_tcp option 'recbuf') - 1
+
+all(suite) ->
+ [active_echo, passive_echo, active_once_echo,
+ slow_active_echo, slow_passive_echo,
+ limit_active_echo, limit_passive_echo,
+ large_limit_active_echo, large_limit_passive_echo].
+
+init_per_testcase(_Func, Config) ->
+ Dog = test_server:timetrap(test_server:minutes(5)),
+ [{watchdog, Dog}|Config].
+fin_per_testcase(_Func, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+active_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to the echo port and receiving them again (socket in active mode)."];
+active_echo(suite) -> [];
+active_echo(Config) when is_list(Config) ->
+ ?line echo_test([], fun active_echo/4, [{echo, fun echo_server/0}]).
+
+passive_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to the echo port and receiving them again (socket in passive mode)."];
+passive_echo(suite) -> [];
+passive_echo(Config) when is_list(Config) ->
+ ?line echo_test([{active, false}], fun passive_echo/4,
+ [{echo, fun echo_server/0}]).
+
+active_once_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to the echo port and receiving them again (socket in active once mode)."];
+active_once_echo(suite) -> [];
+active_once_echo(Config) when is_list(Config) ->
+ ?line echo_test([{active, once}], fun active_once_echo/4,
+ [{echo, fun echo_server/0}]).
+
+slow_active_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to the echo port and receiving them again (socket in active mode). ",
+ "The echo server is a special one that delays between every character."];
+slow_active_echo(suite) -> [];
+slow_active_echo(Config) when is_list(Config) ->
+ ?line echo_test([], fun active_echo/4,
+ [slow_echo, {echo, fun slow_echo_server/0}]).
+
+slow_passive_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to an echo server and receiving them again (socket in passive mode).",
+ "The echo server is a special one that delays between every character."];
+slow_passive_echo(suite) -> [];
+slow_passive_echo(Config) when is_list(Config) ->
+ ?line echo_test([{active, false}], fun passive_echo/4,
+ [slow_echo, {echo, fun slow_echo_server/0}]).
+
+limit_active_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to the echo port and receiving them again (socket in active mode) "
+ "with packet_size limitation."];
+limit_active_echo(suite) -> [];
+limit_active_echo(Config) when is_list(Config) ->
+ ?line echo_test([{packet_size, 10}],
+ fun active_echo/4,
+ [{packet_size, 10}, {echo, fun echo_server/0}]).
+
+limit_passive_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to the echo port and receiving them again (socket in passive mode) ",
+ "with packet_size limitation."];
+limit_passive_echo(suite) -> [];
+limit_passive_echo(Config) when is_list(Config) ->
+ ?line echo_test([{packet_size, 10},{active, false}],
+ fun passive_echo/4,
+ [{packet_size, 10}, {echo, fun echo_server/0}]).
+
+large_limit_active_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to the echo port and receiving them again (socket in active mode) "
+ "with large packet_size limitation."];
+large_limit_active_echo(suite) -> [];
+large_limit_active_echo(Config) when is_list(Config) ->
+ ?line echo_test([{packet_size, 10}],
+ fun active_echo/4,
+ [{packet_size, (1 bsl 32)-1},
+ {echo, fun echo_server/0}]).
+
+large_limit_passive_echo(doc) ->
+ ["Test sending packets of various sizes and various packet types ",
+ "to the echo port and receiving them again (socket in passive mode) ",
+ "with large packet_size limitation."];
+large_limit_passive_echo(suite) -> [];
+large_limit_passive_echo(Config) when is_list(Config) ->
+ ?line echo_test([{packet_size, 10},{active, false}],
+ fun passive_echo/4,
+ [{packet_size, (1 bsl 32) -1},
+ {echo, fun echo_server/0}]).
+
+echo_test(SockOpts, EchoFun, Config0) ->
+ echo_test_1(SockOpts, EchoFun, Config0),
+ io:format("\nrepeating test with {delay_send,true}"),
+ echo_test_1([{delay_send,true}|SockOpts], EchoFun, Config0).
+
+echo_test_1(SockOpts, EchoFun, Config0) ->
+ ?line EchoSrvFun = ?config(echo, Config0),
+ ?line {ok, EchoPort} = EchoSrvFun(),
+ ?line Config = [{echo_port, EchoPort}|Config0],
+
+ ?line echo_packet([{packet, 1}|SockOpts], EchoFun, Config),
+ ?line echo_packet([{packet, 2}|SockOpts], EchoFun, Config),
+ ?line echo_packet([{packet, 4}|SockOpts], EchoFun, Config),
+ ?line echo_packet([{packet, sunrm}|SockOpts], EchoFun, Config),
+ ?line echo_packet([{packet, cdr}|SockOpts], EchoFun,
+ [{type, {cdr, big}}|Config]),
+ ?line echo_packet([{packet, cdr}|SockOpts], EchoFun,
+ [{type, {cdr, little}}|Config]),
+ ?line case lists:keymember(packet_size, 1, SockOpts) of
+ false ->
+ ?line echo_packet([{packet, line}|SockOpts],
+ EchoFun, Config);
+ true -> ok
+ end,
+ ?line echo_packet([{packet, tpkt}|SockOpts], EchoFun, Config),
+
+ ?line ShortTag = [16#E0],
+ ?line LongTag = [16#1F, 16#83, 16#27],
+ ?line echo_packet([{packet, asn1}|SockOpts], EchoFun,
+ [{type, {asn1, short, ShortTag}}|Config]),
+ ?line echo_packet([{packet, asn1}|SockOpts], EchoFun,
+ [{type, {asn1, long, ShortTag}}|Config]),
+ ?line echo_packet([{packet, asn1}|SockOpts], EchoFun,
+ [{type, {asn1, short, LongTag}}|Config]),
+ ?line echo_packet([{packet, asn1}|SockOpts], EchoFun,
+ [{type, {asn1, long, LongTag}}|Config]),
+
+ ?line echo_packet([{packet, http}|SockOpts], EchoFun, Config),
+ ?line echo_packet([{packet, http_bin}|SockOpts], EchoFun, Config),
+ ok.
+
+echo_packet(SockOpts, EchoFun, Opts) ->
+ ?line Type =
+ case lists:keysearch(type, 1, Opts) of
+ {value, {type, T}} ->
+ T;
+ _ ->
+ {value, {packet, T}} = lists:keysearch(packet, 1, SockOpts),
+ T
+ end,
+
+ %% Connect to the echo server.
+ ?line EchoPort = ?config(echo_port, Opts),
+ ?line {ok, Echo} = gen_tcp:connect(localhost, EchoPort, SockOpts),
+
+ ?line SlowEcho =
+ case os:type() of
+ vxworks -> true;
+ _ -> lists:member(slow_echo, Opts)
+ end,
+
+ case Type of
+ http ->
+ echo_packet_http(Echo, Type, EchoFun);
+ http_bin ->
+ echo_packet_http(Echo, Type, EchoFun);
+ _ ->
+ echo_packet0(Echo, Type, EchoFun, SlowEcho, Opts)
+ end.
+
+echo_packet_http(Echo, Type, EchoFun) ->
+ lists:foreach(fun(Uri)-> P1 = http_request(Uri),
+ EchoFun(Echo, Type, P1, http_reply(P1, Type))
+ end,
+ http_uri_variants()),
+ P2 = http_response(),
+ EchoFun(Echo, Type, P2, http_reply(P2, Type)).
+
+echo_packet0(Echo, Type, EchoFun, SlowEcho, Opts) ->
+ ?line PacketSize =
+ case lists:keysearch(packet_size, 1, Opts) of
+ {value,{packet_size,Sz}} when Sz < 10 -> Sz;
+ {value,{packet_size,_}} -> 10;
+ false -> 0
+ end,
+ %% Echo small packets first.
+ ?line echo_packet1(Echo, Type, EchoFun, 0),
+ ?line echo_packet1(Echo, Type, EchoFun, 1),
+ ?line echo_packet1(Echo, Type, EchoFun, 2),
+ ?line echo_packet1(Echo, Type, EchoFun, 3),
+ ?line echo_packet1(Echo, Type, EchoFun, 4),
+ ?line echo_packet1(Echo, Type, EchoFun, 7),
+ if PacketSize =/= 0 ->
+ ?line echo_packet1(Echo, Type, EchoFun,
+ {PacketSize-1, PacketSize}),
+ ?line echo_packet1(Echo, Type, EchoFun,
+ {PacketSize, PacketSize}),
+ ?line echo_packet1(Echo, Type, EchoFun,
+ {PacketSize+1, PacketSize});
+ not SlowEcho -> % Go on with bigger packets if not slow echo server.
+ ?line echo_packet1(Echo, Type, EchoFun, 10),
+ ?line echo_packet1(Echo, Type, EchoFun, 13),
+ ?line echo_packet1(Echo, Type, EchoFun, 126),
+ ?line echo_packet1(Echo, Type, EchoFun, 127),
+ ?line echo_packet1(Echo, Type, EchoFun, 128),
+ ?line echo_packet1(Echo, Type, EchoFun, 255),
+ ?line echo_packet1(Echo, Type, EchoFun, 256),
+ ?line echo_packet1(Echo, Type, EchoFun, 1023),
+ ?line echo_packet1(Echo, Type, EchoFun, 3747),
+ ?line echo_packet1(Echo, Type, EchoFun, 32767),
+ ?line echo_packet1(Echo, Type, EchoFun, 32768),
+ ?line echo_packet1(Echo, Type, EchoFun, 65531),
+ ?line echo_packet1(Echo, Type, EchoFun, 65535),
+ ?line echo_packet1(Echo, Type, EchoFun, 65536),
+ ?line echo_packet1(Echo, Type, EchoFun, 70000),
+ ?line echo_packet1(Echo, Type, EchoFun, infinite);
+ true -> ok
+ end,
+ ?line gen_tcp:close(Echo),
+ ok.
+
+echo_packet1(EchoSock, Type, EchoFun, Size) ->
+ ?line case packet(Size, Type) of
+ false ->
+ ok;
+ Packet ->
+ ?line io:format("Type ~p, size ~p, time ~p",
+ [Type, Size, time()]),
+ ?line
+ case EchoFun(EchoSock, Type, Packet, [Packet]) of
+ ok ->
+ ?line
+ case Size of
+ {N, Max} when N > Max ->
+ ?line
+ test_server:fail(
+ {packet_through, {N, Max}});
+ _ -> ok
+ end;
+ {error, emsgsize} ->
+ ?line
+ case Size of
+ {N, Max} when N > Max ->
+ io:format(" Blocked!");
+ _ ->
+ ?line
+ test_server:fail(
+ {packet_blocked, Size})
+ end;
+ Error ->
+ ?line test_server:fail(Error)
+ end
+ end.
+
+active_echo(Sock, Type, Packet, PacketEchos) ->
+ ?line ok = gen_tcp:send(Sock, Packet),
+ active_recv(Sock, Type, PacketEchos).
+
+active_recv(_, _, []) ->
+ ok;
+active_recv(Sock, Type, [PacketEcho|Tail]) ->
+ Tag = case Type of
+ http -> http;
+ http_bin -> http;
+ _ -> tcp
+ end,
+ ?line receive Recv->Recv end,
+ %%io:format("Active received: ~p\n",[Recv]),
+ ?line case Recv of
+ {Tag, Sock, PacketEcho} ->
+ active_recv(Sock, Type, Tail);
+ {Tag, Sock, Bad} ->
+ ?line test_server:fail({wrong_data, Bad, expected, PacketEcho});
+ {tcp_error, Sock, Reason} ->
+ {error, Reason};
+ Other ->
+ ?line test_server:fail({unexpected_message, Other, Tag})
+ end.
+
+passive_echo(Sock, _Type, Packet, PacketEchos) ->
+ ?line ok = gen_tcp:send(Sock, Packet),
+ passive_recv(Sock, PacketEchos).
+
+passive_recv(_, []) ->
+ ok;
+passive_recv(Sock, [PacketEcho | Tail]) ->
+ Recv = gen_tcp:recv(Sock, 0),
+ %%io:format("Passive received: ~p\n",[Recv]),
+ ?line case Recv of
+ {ok, PacketEcho} ->
+ passive_recv(Sock, Tail);
+ {ok, Bad} ->
+ io:format("Expected: ~p\nGot: ~p\n",[PacketEcho,Bad]),
+ ?line test_server:fail({wrong_data, Bad});
+ {error,PacketEcho} ->
+ passive_recv(Sock, Tail); % expected error
+ {error, _}=Error ->
+ Error;
+ Other ->
+ ?line test_server:fail({unexpected_message, Other})
+ end.
+
+active_once_echo(Sock, Type, Packet, PacketEchos) ->
+ ?line ok = gen_tcp:send(Sock, Packet),
+ active_once_recv(Sock, Type, PacketEchos).
+
+active_once_recv(_, _, []) ->
+ ok;
+active_once_recv(Sock, Type, [PacketEcho | Tail]) ->
+ Tag = case Type of
+ http -> http;
+ http_bin -> http;
+ _ -> tcp
+ end,
+ ?line receive
+ {Tag, Sock, PacketEcho} ->
+ inet:setopts(Sock, [{active, once}]),
+ active_once_recv(Sock, Type, Tail);
+ {Tag, Sock, Bad} ->
+ ?line test_server:fail({wrong_data, Bad});
+ {tcp_error, Sock, Reason} ->
+ {error, Reason};
+ Other ->
+ ?line test_server:fail({unexpected_message, Other, expected, {Tag, Sock, PacketEcho}})
+ end.
+
+%%% Building of random packets.
+
+packet(infinite, {asn1, _, Tag}) ->
+ Tag++[16#80];
+packet(infinite, _) ->
+ false;
+packet({Size, _RecvLimit}, Type) ->
+ packet(Size, Type);
+packet(Size, 1) when Size > 255 ->
+ false;
+packet(Size, 2) when Size > 65535 ->
+ false;
+packet(Size, {asn1, _, Tag}) when Size < 128 ->
+ Tag++[Size|random_packet(Size)];
+packet(Size, {asn1, short, Tag}) when Size < 256 ->
+ Tag++[16#81, Size|random_packet(Size)];
+packet(Size, {asn1, short, Tag}) when Size < 65536 ->
+ Tag++[16#82|put_int16(Size, big, random_packet(Size))];
+packet(Size, {asn1, _, Tag}) ->
+ Tag++[16#84|put_int32(Size, big, random_packet(Size))];
+packet(Size, {cdr, Endian}) ->
+ [$G, $I, $O, $P, % magic
+ 1, 0, % major minor
+ if Endian == big -> 0; true -> 1 end, % flags: byte order
+ 0 | % message type
+ put_int32(Size, Endian, random_packet(Size))];
+packet(Size, sunrm) ->
+ put_int32(Size, big, random_packet(Size));
+packet(Size, line) when Size > ?LINE_LENGTH ->
+ false;
+packet(Size, line) ->
+ random_packet(Size, "\n");
+packet(Size, tpkt) ->
+ HeaderSize = 4,
+ PacketSize = HeaderSize + Size,
+ if PacketSize < 65536 ->
+ Header = [?TPKT_VRSN, 0 | put_int16(PacketSize, big)],
+ HeaderSize = length(Header), % Just to assert cirkular dependency
+ Header ++ random_packet(Size);
+ true ->
+ false
+ end;
+packet(Size, _Type) ->
+ random_packet(Size).
+
+
+
+random_packet(Size) ->
+ random_packet(Size, "", random_char()).
+
+random_packet(Size, Tail) ->
+ random_packet(Size, Tail, random_char()).
+
+random_packet(0, Result, _NextChar) ->
+ Result;
+random_packet(Left, Result, NextChar0) ->
+ NextChar =
+ if
+ NextChar0 >= 126 ->
+ 33;
+ true ->
+ NextChar0+1
+ end,
+ random_packet(Left-1, [NextChar0|Result], NextChar).
+
+random_char() ->
+ random_char("abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789").
+
+random_char(Chars) ->
+ lists:nth(uniform(length(Chars)), Chars).
+
+uniform(N) ->
+ case get(random_seed) of
+ undefined ->
+ {X, Y, Z} = time(),
+ random:seed(X, Y, Z);
+ _ ->
+ ok
+ end,
+ random:uniform(N).
+
+put_int32(X, big, List) ->
+ [ (X bsr 24) band 16#ff,
+ (X bsr 16) band 16#ff,
+ (X bsr 8) band 16#ff,
+ (X) band 16#ff | List ];
+put_int32(X, little, List) ->
+ [ (X) band 16#ff,
+ (X bsr 8) band 16#ff,
+ (X bsr 16) band 16#ff,
+ (X bsr 24) band 16#ff | List].
+
+put_int16(X, ByteOrder) ->
+ put_int16(X, ByteOrder, []).
+
+put_int16(X, big, List) ->
+ [ (X bsr 8) band 16#ff,
+ (X) band 16#ff | List ];
+put_int16(X, little, List) ->
+ [ (X) band 16#ff,
+ (X bsr 8) band 16#ff | List ].
+
+%%% A normal echo server, for systems that don't have one.
+
+echo_server() ->
+ Self = self(),
+ ?line spawn_link(fun() -> echo_server(Self) end),
+ ?line receive
+ {echo_port, Port} ->
+ {ok, Port}
+ end.
+
+echo_server(ReplyTo) ->
+ {ok, S} = gen_tcp:listen(0, [{active, false}, binary]),
+ {ok, {_, Port}} = inet:sockname(S),
+ ReplyTo ! {echo_port, Port},
+ echo_server_loop(S).
+
+echo_server_loop(Sock) ->
+ {ok, E} = gen_tcp:accept(Sock),
+ Self = self(),
+ spawn_link(fun() -> echoer(E, Self) end),
+ echo_server_loop(Sock).
+
+echoer(Sock, Parent) ->
+ unlink(Parent),
+ echoer_loop(Sock).
+
+echoer_loop(Sock) ->
+ case gen_tcp:recv(Sock, 0) of
+ {ok, Data} ->
+ ok = gen_tcp:send(Sock, Data),
+ echoer_loop(Sock);
+ {error, closed} ->
+ ok
+ end.
+
+%%% A "slow" echo server, which will echo data with a short delay
+%%% between each character.
+
+slow_echo_server() ->
+ Self = self(),
+ ?line spawn_link(fun() -> slow_echo_server(Self) end),
+ ?line receive
+ {echo_port, Port} ->
+ {ok, Port}
+ end.
+
+slow_echo_server(ReplyTo) ->
+ {ok, S} = gen_tcp:listen(0, [{active, false}, {nodelay, true}]),
+ {ok, {_, Port}} = inet:sockname(S),
+ ReplyTo ! {echo_port, Port},
+ slow_echo_server_loop(S).
+
+slow_echo_server_loop(Sock) ->
+ {ok, E} = gen_tcp:accept(Sock),
+ spawn_link(fun() -> slow_echoer(E, self()) end),
+ slow_echo_server_loop(Sock).
+
+slow_echoer(Sock, Parent) ->
+ unlink(Parent),
+ slow_echoer_loop(Sock).
+
+slow_echoer_loop(Sock) ->
+ case gen_tcp:recv(Sock, 0) of
+ {ok, Data} ->
+ slow_send(Sock, Data),
+ slow_echoer_loop(Sock);
+ {error, closed} ->
+ ok
+ end.
+
+slow_send(Sock, [C|Rest]) ->
+ ok = gen_tcp:send(Sock, [C]),
+ receive after 1 ->
+ slow_send(Sock, Rest)
+ end;
+slow_send(_, []) ->
+ ok.
+
+http_request(Uri) ->
+ list_to_binary(["POST ", Uri, <<" HTTP/1.1\r\n"
+ "Connection: close\r\n"
+ "Host: localhost:8000\r\n"
+ "User-Agent: perl post\r\n"
+ "Content-Length: 4\r\n"
+ "Content-Type: text/xml; charset=utf-8\r\n"
+ "Other-Field: with some text\r\n"
+ "Multi-Line: Once upon a time in a land far far away,\r\n"
+ " there lived a princess imprisoned in the highest tower\r\n"
+ " of the most haunted castle.\r\n"
+ "Invalid line without a colon\r\n"
+ "\r\n">>]).
+
+http_uri_variants() ->
+ ["*",
+ "http://tools.ietf.org/html/rfcX3986",
+ "http://otp.ericsson.se:8000/product/internal/",
+ "https://example.com:8042/over/there?name=ferret#nose",
+ "ftp://cnn.example.com&[email protected]/top_story.htm",
+ "/some/absolute/path",
+ "something_else", "something_else"].
+
+http_response() ->
+ <<"HTTP/1.0 404 Object Not Found\r\n"
+ "Server: inets/4.7.16\r\n"
+ "Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n"
+ "Content-Type: text/html\r\n"
+ "Content-Length: 207\r\n"
+ "\r\n">>.
+
+http_reply(Bin, Type) ->
+ {ok, Line, Rest} = erlang:decode_packet(Type,Bin,[]),
+ HType = case Type of
+ http -> httph;
+ http_bin -> httph_bin
+ end,
+ Ret = lists:reverse(http_reply(Rest,[Line],HType)),
+ io:format("HTTP: ~p\n",[Ret]),
+ Ret.
+
+http_reply(<<>>, Acc, _) ->
+ Acc;
+http_reply(Bin, Acc, HType) ->
+ {ok, Line, Rest} = erlang:decode_packet(HType,Bin,[]),
+ http_reply(Rest, [Line | Acc], HType).
+
+
+
+
diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl
new file mode 100644
index 0000000000..5d726a3b1b
--- /dev/null
+++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl
@@ -0,0 +1,2362 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(gen_tcp_misc_SUITE).
+
+-include("test_server.hrl").
+
+%-compile(export_all).
+
+-export([all/1, controlling_process/1, no_accept/1, close_with_pending_output/1,
+ data_before_close/1, iter_max_socks/1, get_status/1,
+ passive_sockets/1, accept_closed_by_other_process/1,
+ init_per_testcase/2, fin_per_testcase/2,
+ otp_3924/1, otp_3924_sender/4, closed_socket/1,
+ shutdown_active/1, shutdown_passive/1, shutdown_pending/1,
+ default_options/1, http_bad_packet/1,
+ busy_send/1, busy_disconnect_passive/1, busy_disconnect_active/1,
+ fill_sendq/1, partial_recv_and_close/1,
+ partial_recv_and_close_2/1,partial_recv_and_close_3/1,so_priority/1,
+ % Accept tests
+ primitive_accept/1,multi_accept_close_listen/1,accept_timeout/1,
+ accept_timeouts_in_order/1,accept_timeouts_in_order2/1,accept_timeouts_in_order3/1,
+ accept_timeouts_mixed/1,
+ killing_acceptor/1,killing_multi_acceptors/1,killing_multi_acceptors2/1,
+ several_accepts_in_one_go/1,active_once_closed/1, send_timeout/1, otp_7731/1,
+ zombie_sockets/1, otp_7816/1, otp_8102/1]).
+
+%% Internal exports.
+-export([sender/3, not_owner/1, passive_sockets_server/2, priority_server/1, otp_7731_server/1, zombie_server/2]).
+
+init_per_testcase(_Func, Config) when is_list(Config) ->
+ Dog = test_server:timetrap(test_server:seconds(240)),
+ [{watchdog, Dog}|Config].
+fin_per_testcase(_Func, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+all(suite) ->
+ [controlling_process, no_accept,
+ close_with_pending_output,
+ data_before_close, iter_max_socks, passive_sockets,
+ accept_closed_by_other_process, otp_3924, closed_socket,
+ shutdown_active, shutdown_passive, shutdown_pending,
+ default_options, http_bad_packet,
+ busy_send, busy_disconnect_passive, busy_disconnect_active,
+ fill_sendq, partial_recv_and_close,
+ partial_recv_and_close_2, partial_recv_and_close_3, so_priority,
+ primitive_accept,multi_accept_close_listen,accept_timeout,
+ accept_timeouts_in_order,accept_timeouts_in_order2,accept_timeouts_in_order3,
+ accept_timeouts_mixed,
+ killing_acceptor,killing_multi_acceptors,killing_multi_acceptors2,
+ several_accepts_in_one_go, active_once_closed, send_timeout, otp_7731,
+ zombie_sockets, otp_7816, otp_8102].
+
+
+default_options(doc) ->
+ ["Tests kernel application variables inet_default_listen_options and "
+ "inet_default_connect_options"];
+default_options(suite) ->
+ [];
+default_options(Config) when is_list(Config) ->
+ %% First check the delay_send option
+ ?line {true,true,true}=do_delay_send_1(),
+ ?line {false,false,false}=do_delay_send_2(),
+ ?line {true,false,false}=do_delay_send_3(),
+ ?line {false,false,false}=do_delay_send_4(),
+ ?line {false,false,false}=do_delay_send_5(),
+ ?line {false,true,true}=do_delay_send_6(),
+ %% Now lets start some nodes with different combinations of options:
+ ?line {true,true,true} = do_delay_on_other_node("",
+ fun do_delay_send_1/0),
+ ?line {true,false,false} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"[{delay_send,true}]\"",
+ fun do_delay_send_2/0),
+
+ ?line {false,true,true} =
+ do_delay_on_other_node("-kernel inet_default_listen_options "
+ "\"[{delay_send,true}]\"",
+ fun do_delay_send_2/0),
+
+ ?line {true,true,true} =
+ do_delay_on_other_node("-kernel inet_default_listen_options "
+ "\"[{delay_send,true}]\"",
+ fun do_delay_send_3/0),
+ ?line {true,true,true} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"[{delay_send,true}]\"",
+ fun do_delay_send_6/0),
+ ?line {false,false,false} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"[{delay_send,true}]\"",
+ fun do_delay_send_5/0),
+ ?line {false,true,true} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"[{delay_send,true}]\" "
+ "-kernel inet_default_listen_options "
+ "\"[{delay_send,true}]\"",
+ fun do_delay_send_5/0),
+ ?line {true,false,false} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"[{delay_send,true}]\" "
+ "-kernel inet_default_listen_options "
+ "\"[{delay_send,true}]\"",
+ fun do_delay_send_4/0),
+ ?line {true,true,true} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"{delay_send,true}\" "
+ "-kernel inet_default_listen_options "
+ "\"{delay_send,true}\"",
+ fun do_delay_send_2/0),
+ %% Active is to dangerous and is supressed
+ ?line {true,true,true} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"{active,false}\" "
+ "-kernel inet_default_listen_options "
+ "\"{active,false}\"",
+ fun do_delay_send_7/0),
+ ?line {true,true,true} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"[{active,false},{delay_send,true}]\" "
+ "-kernel inet_default_listen_options "
+ "\"[{active,false},{delay_send,true}]\"",
+ fun do_delay_send_7/0),
+ ?line {true,true,true} =
+ do_delay_on_other_node("-kernel inet_default_connect_options "
+ "\"[{active,false},{delay_send,true}]\" "
+ "-kernel inet_default_listen_options "
+ "\"[{active,false},{delay_send,true}]\"",
+ fun do_delay_send_2/0),
+ ok.
+
+
+do_delay_on_other_node(XArgs, Function) ->
+ Dir = filename:dirname(code:which(?MODULE)),
+ {ok,Node} = test_server:start_node(test_default_options_slave,slave,
+ [{args,"-pa " ++ Dir ++ " " ++
+ XArgs}]),
+ Res = rpc:call(Node,erlang,apply,[Function,[]]),
+ test_server:stop_node(Node),
+ Res.
+
+
+do_delay_send_1() ->
+ {ok,LS}=gen_tcp:listen(0,[{delay_send,true}]),
+ {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS),
+ {ok,S}=gen_tcp:connect("localhost",PortNum,[{delay_send,true}]),
+ {ok,S2}= gen_tcp:accept(LS),
+ {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]),
+ {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]),
+ {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]),
+ gen_tcp:close(S2),
+ gen_tcp:close(S),
+ gen_tcp:close(LS),
+ {B1,B2,B3}.
+
+do_delay_send_2() ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS),
+ {ok,S}=gen_tcp:connect("localhost",PortNum,[]),
+ {ok,S2}= gen_tcp:accept(LS),
+ {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]),
+ {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]),
+ {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]),
+ gen_tcp:close(S2),
+ gen_tcp:close(S),
+ gen_tcp:close(LS),
+ {B1,B2,B3}.
+
+do_delay_send_3() ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS),
+ {ok,S}=gen_tcp:connect("localhost",PortNum,[{delay_send,true}]),
+ {ok,S2}= gen_tcp:accept(LS),
+ {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]),
+ {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]),
+ {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]),
+ gen_tcp:close(S2),
+ gen_tcp:close(S),
+ gen_tcp:close(LS),
+ {B1,B2,B3}.
+
+do_delay_send_4() ->
+ {ok,LS}=gen_tcp:listen(0,[{delay_send,false}]),
+ {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS),
+ {ok,S}=gen_tcp:connect("localhost",PortNum,[]),
+ {ok,S2}= gen_tcp:accept(LS),
+ {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]),
+ {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]),
+ {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]),
+ gen_tcp:close(S2),
+ gen_tcp:close(S),
+ gen_tcp:close(LS),
+ {B1,B2,B3}.
+
+do_delay_send_5() ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS),
+ {ok,S}=gen_tcp:connect("localhost",PortNum,[{delay_send,false}]),
+ {ok,S2}= gen_tcp:accept(LS),
+ {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]),
+ {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]),
+ {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]),
+ gen_tcp:close(S2),
+ gen_tcp:close(S),
+ gen_tcp:close(LS),
+ {B1,B2,B3}.
+
+do_delay_send_6() ->
+ {ok,LS}=gen_tcp:listen(0,[{delay_send,true}]),
+ {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS),
+ {ok,S}=gen_tcp:connect("localhost",PortNum,[]),
+ {ok,S2}= gen_tcp:accept(LS),
+ {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]),
+ {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]),
+ {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]),
+ gen_tcp:close(S2),
+ gen_tcp:close(S),
+ gen_tcp:close(LS),
+ {B1,B2,B3}.
+
+do_delay_send_7() ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS),
+ {ok,S}=gen_tcp:connect("localhost",PortNum,[]),
+ {ok,S2}= gen_tcp:accept(LS),
+ {ok,[{active,B1}]}=inet:getopts(S,[active]),
+ {ok,[{active,B2}]}=inet:getopts(LS,[active]),
+ {ok,[{active,B3}]}=inet:getopts(S2,[active]),
+ gen_tcp:close(S2),
+ gen_tcp:close(S),
+ gen_tcp:close(LS),
+ {B1,B2,B3}.
+
+
+
+controlling_process(doc) ->
+ ["Open a listen port and change controlling_process for it",
+ "The result should be ok of done by the owner process,"
+ "Otherwise is should return {error,not_owner} or similar"];
+controlling_process(suite) -> [];
+controlling_process(Config) when is_list(Config) ->
+ {ok,S} = gen_tcp:listen(0,[]),
+ Pid2 = spawn(?MODULE,not_owner,[S]),
+ Pid2 ! {self(),2,control},
+ ?line {error, E} = receive {2,_E} ->
+ _E
+ after 10000 -> timeout
+ end,
+ io:format("received ~p~n",[E]),
+ Pid = spawn(?MODULE,not_owner,[S]),
+ ?line ok = gen_tcp:controlling_process(S,Pid),
+ Pid ! {self(),1,control},
+ ?line ok = receive {1,ok} ->
+ ok
+ after 1000 -> timeout
+ end,
+ Pid ! close.
+
+not_owner(S) ->
+ receive
+ {From,Tag,control} ->
+ From ! {Tag,gen_tcp:controlling_process(S,self())};
+ close ->
+ gen_tcp:close(S)
+ after 1000 ->
+ ok
+ end.
+
+no_accept(doc) ->
+ ["Open a listen port and connect to it, then close the listen port ",
+ "without doing any accept. The connected socket should receive ",
+ "a tcp_closed message."];
+no_accept(suite) -> [];
+no_accept(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skip,"Too tough for vxworks"};
+ _ ->
+ no_accept2()
+ end.
+
+no_accept2() ->
+ ?line {ok, L} = gen_tcp:listen(0, []),
+ ?line {ok, {_, Port}} = inet:sockname(L),
+ ?line {ok, Client} = gen_tcp:connect(localhost, Port, []),
+ ?line ok = gen_tcp:close(L),
+ ?line receive
+ {tcp_closed, Client} ->
+ ok
+ after 5000 ->
+ ?line test_server:fail(never_closed)
+
+ end.
+
+close_with_pending_output(doc) ->
+ ["Send several packets to a socket and close it. All packets should arrive ",
+ "to the other end."];
+close_with_pending_output(suite) -> [];
+close_with_pending_output(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skipped,"Too tough for vxworks"};
+ _ ->
+ close_with_pending_output2()
+ end.
+
+close_with_pending_output2() ->
+ ?line {ok, L} = gen_tcp:listen(0, [binary, {active, false}]),
+ ?line {ok, {_, Port}} = inet:sockname(L),
+ ?line Packets = 16,
+ ?line Total = 2048*Packets,
+ case start_remote(close_pending) of
+ {ok, Node} ->
+ ?line {ok, Host} = inet:gethostname(),
+ ?line spawn_link(Node, ?MODULE, sender, [Port, Packets, Host]),
+ ?line {ok, A} = gen_tcp:accept(L),
+ ?line case gen_tcp:recv(A, Total) of
+ {ok, Bin} when byte_size(Bin) == Total ->
+ gen_tcp:close(A),
+ gen_tcp:close(L);
+ {ok, Bin} ->
+ ?line test_server:fail({small_packet,
+ byte_size(Bin)});
+ Error ->
+ ?line test_server:fail({unexpected, Error})
+ end,
+ ok;
+ {error, no_remote_hosts} ->
+ {skipped,"No remote hosts"};
+ {error, Other} ->
+ ?line ?t:fail({failed_to_start_slave_node, Other})
+ end.
+
+sender(Port, Packets, Host) ->
+ X256 = lists:seq(0, 255),
+ X512 = [X256|X256],
+ X1K = [X512|X512],
+ Bin = list_to_binary([X1K|X1K]),
+ {ok, Sock} = gen_tcp:connect(Host, Port, []),
+ send_loop(Sock, Bin, Packets),
+ ok = gen_tcp:close(Sock).
+
+send_loop(_Sock, _Data, 0) -> ok;
+send_loop(Sock, Data, Left) ->
+ ok = gen_tcp:send(Sock, Data),
+ send_loop(Sock, Data, Left-1).
+
+-define(OTP_3924_MAX_DELAY, 100).
+%% Taken out of the blue, but on intra host connections
+%% I expect propagation of a close to be quite fast
+%% so 100 ms seems reasonable.
+
+otp_3924(doc) ->
+ ["Tests that a socket can be closed fast enough."];
+otp_3924(suite) -> [];
+otp_3924(Config) when is_list(Config) ->
+ MaxDelay = (case has_superfluous_schedulers() of
+ true -> 4;
+ false -> 1
+ end
+ * case {erlang:system_info(debug_compiled),
+ erlang:system_info(lock_checking)} of
+ {true, _} -> 6;
+ {_, true} -> 2;
+ _ -> 1
+ end * ?OTP_3924_MAX_DELAY),
+ case os:type() of
+ vxworks ->
+%% {skip,"Too tough for vxworks"};
+ otp_3924_1(MaxDelay);
+ _ ->
+ otp_3924_1(MaxDelay)
+ end.
+
+otp_3924_1(MaxDelay) ->
+ Dog = test_server:timetrap(test_server:seconds(240)),
+ ?line {ok, Node} = start_node(otp_3924),
+ ?line DataLen = 100*1024,
+ ?line Data = otp_3924_data(DataLen),
+ % Repeat the test a couple of times to prevent the test from passing
+ % by chance.
+ repeat(10,
+ fun (N) ->
+ ?line ok = otp_3924(MaxDelay, Node, Data, DataLen, N)
+ end),
+ ?line test_server:stop_node(Node),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+otp_3924(MaxDelay, Node, Data, DataLen, N) ->
+ ?line {ok, L} = gen_tcp:listen(0, [list, {active, false}]),
+ ?line {ok, {_, Port}} = inet:sockname(L),
+ ?line {ok, Host} = inet:gethostname(),
+ ?line Sender = spawn_link(Node,
+ ?MODULE,
+ otp_3924_sender,
+ [self(), Host, Port, Data]),
+ ?line Data = otp_3924_receive_data(L, Sender, MaxDelay, DataLen, N),
+ ?line ok = gen_tcp:close(L).
+
+otp_3924_receive_data(LSock, Sender, MaxDelay, Len, N) ->
+ ?line OP = process_flag(priority, max),
+ ?line OTE = process_flag(trap_exit, true),
+ ?line TimeoutRef = make_ref(),
+ ?line Data = (catch begin
+ ?line Sender ! start,
+ ?line {ok, Sock} = gen_tcp:accept(LSock),
+ ?line D = otp_3924_receive_data(Sock,
+ TimeoutRef,
+ MaxDelay,
+ Len,
+ [],
+ 0),
+ ?line ok = gen_tcp:close(Sock),
+ D
+ end),
+ ?line unlink(Sender),
+ ?line process_flag(trap_exit, OTE),
+ ?line process_flag(priority, OP),
+ receive
+ {'EXIT', _, TimeoutRef} ->
+ ?line test_server:fail({close_not_fast_enough,MaxDelay,N});
+ {'EXIT', Sender, Reason} ->
+ ?line test_server:fail({sender_exited, Reason});
+ {'EXIT', _Other, Reason} ->
+ ?line test_server:fail({linked_process_exited, Reason})
+ after 0 ->
+ case Data of
+ {'EXIT', {A,B}} ->
+ ?line test_server:fail({A,B,N});
+ {'EXIT', Failure} ->
+ ?line test_server:fail(Failure);
+ _ ->
+ ?line Data
+ end
+ end.
+
+
+otp_3924_receive_data(Sock, TimeoutRef, MaxDelay, Len, Acc, AccLen) ->
+ case gen_tcp:recv(Sock, 0) of
+ {ok, Data} ->
+ NewAccLen = AccLen + length(Data),
+ if
+ NewAccLen == Len ->
+ ?line {ok, TRef} = timer:exit_after(MaxDelay,
+ self(),
+ TimeoutRef),
+ ?line {error, closed} = gen_tcp:recv(Sock, 0),
+ ?line timer:cancel(TRef),
+ ?line lists:flatten([Acc, Data]);
+ NewAccLen > Len ->
+ exit({received_too_much, NewAccLen});
+ true ->
+ otp_3924_receive_data(Sock,
+ TimeoutRef,
+ MaxDelay,
+ Len,
+ [Acc, Data],
+ NewAccLen)
+ end;
+ {error, closed} ->
+ exit({premature_close, AccLen});
+ Error ->
+ exit({unexpected_error, Error})
+ end.
+
+otp_3924_data(Size) ->
+ Block =
+ "This is a sequence of characters that will be repeated "
+ "again and again and again and again and again and ... ",
+ L = length(Block),
+ otp_3924_data(Block, [], Size div L, Size rem L).
+
+otp_3924_data(_, Acc, 0, 0) ->
+ lists:flatten(Acc);
+otp_3924_data(_, Acc, 0, SingleLeft) ->
+ otp_3924_data(false, ["."|Acc], 0, SingleLeft-1);
+otp_3924_data(Block, Acc, BlockLeft, SingleLeft) ->
+ otp_3924_data(Block, [Block|Acc], BlockLeft-1, SingleLeft).
+
+otp_3924_sender(Receiver, Host, Port, Data) ->
+ receive
+ start ->
+ {ok, Sock} = gen_tcp:connect(Host, Port, [list]),
+ gen_tcp:send(Sock, Data),
+ ok = gen_tcp:close(Sock),
+ unlink(Receiver)
+ end.
+
+
+data_before_close(doc) ->
+ ["Tests that a huge amount of data can be received before a close."];
+data_before_close(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skip,"Too tough for vxworks"};
+ _ ->
+ data_before_close2()
+ end.
+
+data_before_close2() ->
+ ?line {ok, L} = gen_tcp:listen(0, [binary]),
+ ?line {ok, {_, TcpPort}} = inet:sockname(L),
+ ?line Bytes = 256*1024,
+ ?line spawn_link(fun() -> huge_sender(TcpPort, Bytes) end),
+ ?line {ok, A} = gen_tcp:accept(L),
+ ?line case count_bytes_recv(A, 0) of
+ {Bytes, Result} ->
+ io:format("Result: ~p", [Result]);
+ {Wrong, Result} ->
+ io:format("Result: ~p", [Result]),
+ test_server:fail({wrong_count, Wrong})
+ end,
+ ok.
+
+count_bytes_recv(Sock, Total) ->
+ receive
+ {tcp, Sock, Bin} ->
+ count_bytes_recv(Sock, Total+byte_size(Bin));
+ Other ->
+ {Total, Other}
+ end.
+
+huge_sender(TcpPort, Bytes) ->
+ {ok, Client} = gen_tcp:connect(localhost, TcpPort, []),
+ receive after 500 -> ok end,
+ gen_tcp:send(Client, make_zero_packet(Bytes)),
+ gen_tcp:close(Client).
+
+make_zero_packet(0) -> [];
+make_zero_packet(N) when N rem 2 == 0 ->
+ P = make_zero_packet(N div 2),
+ [P|P];
+make_zero_packet(N) ->
+ P = make_zero_packet(N div 2),
+ [0, P|P].
+get_status(doc) ->
+ ["OTP-2924",
+ "test that the socket process does not crash when sys:get_status(Pid)",
+ "is called."];
+get_status(suite) -> [];
+get_status(Config) when is_list(Config) ->
+ ?line {ok,{socket,Pid,_,_}} = gen_tcp:listen(5678,[]),
+ ?line {status,Pid,_,_} = sys:get_status(Pid).
+
+iter_max_socks(doc) ->
+ ["Open as many sockets as possible. Do this several times and check ",
+ "that we get the same number of sockets every time."];
+iter_max_socks(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {skip,"Too tough for vxworks"};
+ _ ->
+ iter_max_socks2()
+ end.
+
+-define(RECOVER_SLEEP, 60000).
+-define(RETRY_SLEEP, 15000).
+
+iter_max_socks2() ->
+ ?line N =
+ case os:type() of
+ vxworks ->
+ 10;
+ _ ->
+ 20
+ end,
+ L = do_iter_max_socks(N, initalize),
+ ?line io:format("Result: ~p",[L]),
+ ?line all_equal(L),
+ ?line {comment, "Max sockets: " ++ integer_to_list(hd(L))}.
+
+do_iter_max_socks(0, _) ->
+ [];
+do_iter_max_socks(N, initalize) ->
+ MS = max_socks(),
+ [MS|do_iter_max_socks(N-1, MS)];
+do_iter_max_socks(N, failed) ->
+ MS = max_socks(),
+ [MS|do_iter_max_socks(N-1, failed)];
+do_iter_max_socks(N, First) when is_integer(First) ->
+ ?line MS = max_socks(),
+ if MS == First ->
+ ?line [MS|do_iter_max_socks(N-1, First)];
+ true ->
+ ?line io:format("Sleeping for ~p seconds...~n",
+ [?RETRY_SLEEP/1000]),
+ ?line ?t:sleep(?RETRY_SLEEP),
+ ?line io:format("Trying again...~n", []),
+ ?line RetryMS = max_socks(),
+ ?line if RetryMS == First ->
+ ?line [RetryMS|do_iter_max_socks(N-1, First)];
+ true ->
+ ?line [RetryMS|do_iter_max_socks(N-1, failed)]
+ end
+ end.
+
+all_equal([]) ->
+ ok;
+all_equal([Rule | T]) ->
+ all_equal(Rule, T).
+
+all_equal(Rule, [Rule | T]) ->
+ all_equal(Rule, T);
+all_equal(_, [_ | _]) ->
+ ?line ?t:sleep(?RECOVER_SLEEP), % Wait a while and *hope* that we'll
+ % recover so other tests won't be
+ % affected.
+ ?t:fail(max_socket_mismatch);
+all_equal(_Rule, []) ->
+ ok.
+
+max_socks() ->
+ ?line Socks = open_socks(),
+ ?line N = length(Socks),
+ ?line lists:foreach(fun(S) -> ok = gen_tcp:close(S) end, Socks),
+ io:format("Got ~p sockets", [N]),
+ N.
+
+open_socks() ->
+ case gen_tcp:listen(0, []) of
+ {ok, L} ->
+ {ok, {_, Port}} = inet:sockname(L),
+ [L| connect_accept(L, Port)];
+ _ ->
+ []
+ end.
+
+connect_accept(L, Port) ->
+ case gen_tcp:connect(localhost, Port, []) of
+ {ok, C} ->
+ [C| do_accept(L, Port)];
+ _ ->
+ []
+ end.
+
+do_accept(L, Port) ->
+ case gen_tcp:accept(L) of
+ {ok, A} -> [A| connect_accept(L, Port)];
+ _ -> []
+ end.
+
+start_node(Name) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]).
+
+start_remote(Name) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ test_server:start_node(Name, slave, [{remote, true}, {args, "-pa " ++ Pa}]).
+
+passive_sockets(doc) ->
+ ["Tests that when 'the other side' on a passive socket closes, the connecting",
+ "side still can read until the end of data."];
+passive_sockets(Config) when is_list(Config) ->
+ ?line spawn_link(?MODULE, passive_sockets_server,
+ [[{active,false}],self()]),
+ ?line receive
+ {socket,Port} -> ok
+ end,
+ ?t:sleep(500),
+ ?line case gen_tcp:connect("localhost", Port, [{active, false}]) of
+ {ok, Sock} ->
+ passive_sockets_read(Sock);
+ Error ->
+ ?t:fail({"Could not connect to server", Error})
+ end.
+
+%%
+%% Read until we get an {error, closed}. If we get another error, this test case
+%% should fail.
+%%
+passive_sockets_read(Sock) ->
+ case gen_tcp:recv(Sock, 0, 2000) of
+ {ok, Data} ->
+ io:format("Received ~p bytes~n", [length(Data)]),
+ passive_sockets_read(Sock);
+ {error, closed} ->
+ gen_tcp:close(Sock);
+ Error ->
+ gen_tcp:close(Sock),
+ ?t:fail({"Did not get {error, closed} before other error", Error})
+ end.
+
+passive_sockets_server(Opts, Parent) ->
+ ?line case gen_tcp:listen(0, Opts) of
+ {ok, LSock} ->
+ {ok,{_,Port}} = inet:sockname(LSock),
+ Parent ! {socket,Port},
+ passive_sockets_server_accept(LSock);
+ Error ->
+ ?t:fail({"Could not create listen socket", Error})
+ end.
+
+passive_sockets_server_accept(Sock) ->
+ ?line case gen_tcp:accept(Sock) of
+ {ok, Socket} ->
+ ?t:sleep(500), % Simulate latency
+ passive_sockets_server_send(Socket, 5),
+ passive_sockets_server_accept(Sock);
+ Error ->
+ ?t:fail({"Could not accept connection", Error})
+ end.
+
+passive_sockets_server_send(Socket, 0) ->
+ io:format("Closing other end..~n", []),
+ gen_tcp:close(Socket);
+passive_sockets_server_send(Socket, X) ->
+ ?line Data = lists:duplicate(1024*X, $a),
+ ?line case gen_tcp:send(Socket, Data) of
+ ok ->
+ ?t:sleep(50), % Simulate some processing.
+ passive_sockets_server_send(Socket, X-1);
+ {error, _Reason} ->
+ ?t:fail("Failed to send data")
+ end.
+
+
+accept_closed_by_other_process(doc) ->
+ ["Tests the return value from gen_tcp:accept when ",
+ "the socket is closed from an other process. (OTP-3817)"];
+accept_closed_by_other_process(Config) when is_list(Config) ->
+ ?line Parent = self(),
+ ?line {ok, ListenSocket} = gen_tcp:listen(0, []),
+ ?line Child =
+ spawn_link(
+ fun() ->
+ Parent ! {self(), gen_tcp:accept(ListenSocket)}
+ end),
+ ?line receive after 1000 -> ok end,
+ ?line ok = gen_tcp:close(ListenSocket),
+ ?line receive
+ {Child, {error, closed}} ->
+ ok;
+ {Child, Other} ->
+ ?t:fail({"Wrong result of gen_tcp:accept", Other})
+ end.
+
+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.
+
+
+closed_socket(suite) ->
+ [];
+closed_socket(doc) ->
+ ["Tests the response when using a closed socket as argument"];
+closed_socket(Config) when is_list(Config) ->
+ ?line {ok, LS1} = gen_tcp:listen(0, []),
+ ?line erlang:yield(),
+ ?line ok = gen_tcp:close(LS1),
+ %% If the following delay is uncommented, the result error values
+ %% below will change from {error, einval} to {error, closed} since
+ %% inet_db then will have noticed that the socket is closed.
+ %% This is a scheduling issue, i.e when the gen_server in
+ %% in inet_db processes the 'EXIT' message from the port,
+ %% the socket is unregistered.
+ %%
+ %% ?line test_server:sleep(test_server:seconds(2)),
+ %%
+ ?line {error, R_send} = gen_tcp:send(LS1, "data"),
+ ?line {error, R_recv} = gen_tcp:recv(LS1, 17),
+ ?line {error, R_accept} = gen_tcp:accept(LS1),
+ ?line {error, R_controlling_process} =
+ gen_tcp:controlling_process(LS1, self()),
+ %%
+ ?line ok = io:format("R_send = ~p~n", [R_send]),
+ ?line ok = io:format("R_recv = ~p~n", [R_recv]),
+ ?line ok = io:format("R_accept = ~p~n", [R_accept]),
+ ?line ok = io:format("R_controlling_process = ~p~n",
+ [R_controlling_process]),
+ ok.
+
+%%%
+%%% Test using the gen_tcp:shutdown/2 function using a sort server.
+%%%
+
+shutdown_active(Config) when is_list(Config) ->
+ ?line shutdown_common(true).
+
+shutdown_passive(Config) when is_list(Config) ->
+ ?line shutdown_common(false).
+
+shutdown_common(Active) ->
+ ?line P = sort_server(Active),
+ io:format("Sort server port: ~p\n", [P]),
+
+ ?line do_sort(P, []),
+ ?line do_sort(P, ["glurf"]),
+ ?line do_sort(P, ["abc","nisse","dum"]),
+
+ ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 255)]),
+ ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(77, 999)]),
+ ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 55)]),
+ ?line do_sort(P, []),
+ ?line do_sort(P, ["apa"]),
+ ?line do_sort(P, ["kluns","gorilla"]),
+ ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 1233)]),
+ ?line do_sort(P, []),
+
+ receive
+ Any ->
+ ?t:fail({unexpected_message,Any})
+ after 0 -> ok
+ end.
+
+do_sort(P, List0) ->
+ List = [El++"\n" || El <- List0],
+ {ok,S} = gen_tcp:connect(localhost, P, [{packet,line}]),
+ send_lines(S, List),
+ gen_tcp:shutdown(S, write),
+ Lines = collect_lines(S, true),
+ io:format("~p\n", [Lines]),
+ Lines = lists:sort(List),
+ ok = gen_tcp:close(S).
+
+sort_server(Active) ->
+ Opts = [{exit_on_close,false},{packet,line},{active,Active}],
+ ?line {ok,L} = gen_tcp:listen(0, Opts),
+ Go = make_ref(),
+ ?line Pid = spawn_link(fun() ->
+ receive Go -> sort_server_1(L, Active) end
+ end),
+ ?line ok = gen_tcp:controlling_process(L, Pid),
+ ?line Pid ! Go,
+ ?line {ok,Port} = inet:port(L),
+ Port.
+
+sort_server_1(L, Active) ->
+ {ok,S} = gen_tcp:accept(L),
+ Go = make_ref(),
+ Sorter = spawn(fun() -> receive Go -> sorter(S, Active) end end),
+ ok = gen_tcp:controlling_process(S, Sorter),
+ Sorter ! Go,
+ sort_server_1(L, Active).
+
+sorter(S, Active) ->
+ Lines = collect_lines(S, Active),
+ send_lines(S, lists:sort(Lines)),
+ gen_tcp:shutdown(S, write),
+ gen_tcp:close(S).
+
+collect_lines(S, true) ->
+ collect_lines_1(S, []);
+collect_lines(S, false) ->
+ passive_collect_lines_1(S, []).
+
+collect_lines_1(S, Acc) ->
+ receive
+ {tcp,S,Line} -> collect_lines_1(S, [Line|Acc]);
+ {tcp_closed,S} -> lists:reverse(Acc)
+ end.
+
+passive_collect_lines_1(S, Acc) ->
+ case gen_tcp:recv(S, 0) of
+ {ok,Line} -> passive_collect_lines_1(S, [Line|Acc]);
+ {error,closed} -> lists:reverse(Acc)
+ end.
+
+
+send_lines(S, Lines) ->
+ lists:foreach(fun(Line) ->
+ gen_tcp:send(S, Line)
+ end, Lines).
+
+%%%
+%%% Shutdown pending.
+%%%
+
+shutdown_pending(Config) when is_list(Config) ->
+ N = 512*1024+17,
+ io:format("~p\n", [N]),
+ Data = [<<N:32>>,ones(N),42],
+ P = a_server(),
+ io:format("Server port: ~p\n", [P]),
+ ?line {ok,S} = gen_tcp:connect(localhost, P, []),
+ ?line gen_tcp:send(S, Data),
+ ?line gen_tcp:shutdown(S, write),
+ ?line receive
+ {tcp,S,Msg} ->
+ io:format("~p\n", [Msg]),
+ ?line N = list_to_integer(Msg) - 5;
+ Other ->
+ ?t:fail({unexpected,Other})
+ end,
+ ok.
+
+ ones(0) -> [];
+ ones(1) -> [1];
+ ones(N) ->
+ Half = N div 2,
+ Ones = ones(Half),
+ case 2*Half of
+ N -> [Ones|Ones];
+ _ -> [1,Ones|Ones]
+ end.
+
+ a_server() ->
+ ?line {ok,L} = gen_tcp:listen(0, [{exit_on_close,false},{active,false}]),
+ ?line Pid = spawn_link(fun() -> a_server(L) end),
+ ?line ok = gen_tcp:controlling_process(L, Pid),
+ ?line {ok,Port} = inet:port(L),
+ Port.
+
+ a_server(L) ->
+ {ok,S} = gen_tcp:accept(L),
+ do_recv(S, []).
+
+ do_recv(S, Bs0) ->
+ case gen_tcp:recv(S, 0) of
+ {ok,B} ->
+ do_recv(S, [Bs0,B]);
+ {error,closed} ->
+ Bs = list_to_binary(Bs0),
+ gen_tcp:send(S, integer_to_list(byte_size(Bs))),
+ gen_tcp:close(S)
+ end.
+
+
+%% Thanks to Luke Gorrie. Tests for a very specific problem with
+%% corrupt data. The testcase will be killed by the timetrap timeout
+%% if the bug is present.
+http_bad_packet(Config) when is_list(Config) ->
+ ?line {ok,L} = gen_tcp:listen(0,
+ [{active, false},
+ binary,
+ {reuseaddr, true},
+ {packet, http}]),
+ ?line {ok,Port} = inet:port(L),
+ ?line spawn_link(fun() -> erlang:yield(), http_bad_client(Port) end),
+ ?line case gen_tcp:accept(L) of
+ {ok,S} ->
+ http_worker(S);
+ Err ->
+ exit({accept,Err})
+ end.
+
+http_worker(S) ->
+ case gen_tcp:recv(S, 0, 30000) of
+ {ok,Data} ->
+ io:format("Data: ~p\n", [Data]),
+ http_worker(S);
+ {error,Rsn} ->
+ io:format("Error: ~p\n", [Rsn]),
+ ok
+ end.
+
+http_bad_client(Port) ->
+ {ok,S} = gen_tcp:connect("localhost", Port, [{active,false}, binary]),
+ ok = gen_tcp:send(S, "\r\n"),
+ ok = gen_tcp:close(S).
+
+
+%% Fill send queue and then start receiving.
+%%
+busy_send(Config) when is_list(Config) ->
+ ?line Master = self(),
+ ?line Msg = <<"the quick brown fox jumps over a lazy dog~n">>,
+ ?line Server =
+ spawn_link(fun () ->
+ {ok,L} = gen_tcp:listen
+ (0, [{active,false},binary,
+ {reuseaddr,true},{packet,0}]),
+ {ok,Port} = inet:port(L),
+ Master ! {self(),client,
+ busy_send_client(Port, Master, Msg)},
+ busy_send_srv(L, Master, Msg)
+ end),
+ ?line io:format("~p Server~n", [Server]),
+ ?line receive
+ {Server,client,Client} ->
+ ?line io:format("~p Client~n", [Client]),
+ ?line busy_send_loop(Server, Client, 0)
+ end.
+
+busy_send_loop(Server, Client, N) ->
+ %% Master
+ %%
+ ?line receive {Server,send} ->
+ busy_send_loop(Server, Client, N+1)
+ after 2000 ->
+ %% Send queue full, sender blocked
+ %% -> stop sender and release client
+ ?line io:format("Send timeout, time to receive...~n", []),
+ ?line Server ! {self(),close},
+ ?line Client ! {self(),recv,N+1},
+ ?line receive
+ {Server,send} ->
+ ?line busy_send_2(Server, Client, N+1)
+ after 10000 ->
+ ?t:fail({timeout,{server,not_send,flush([])}})
+ end
+ end.
+
+busy_send_2(Server, Client, _N) ->
+ %% Master
+ %%
+ ?line receive
+ {Server,[closed]} ->
+ ?line receive
+ {Client,[0,{error,closed}]} ->
+ ok
+ end
+ after 10000 ->
+ ?t:fail({timeout,{server,not_closed,flush([])}})
+ end.
+
+busy_send_srv(L, Master, Msg) ->
+ %% Server
+ %%
+ {ok,Socket} = gen_tcp:accept(L),
+ busy_send_srv_loop(Socket, Master, Msg).
+
+busy_send_srv_loop(Socket, Master, Msg) ->
+ %% Server
+ %%
+ receive
+ {Master,close} ->
+ ok = gen_tcp:close(Socket),
+ Master ! {self(),flush([closed])}
+ after 0 ->
+ ok = gen_tcp:send(Socket, Msg),
+ Master ! {self(),send},
+ busy_send_srv_loop(Socket, Master, Msg)
+ end.
+
+busy_send_client(Port, Master, Msg) ->
+ %% Client
+ %%
+ spawn_link(
+ fun () ->
+ {ok,Socket} = gen_tcp:connect(
+ "localhost", Port,
+ [{active,false},binary,{packet,0}]),
+ receive
+ {Master,recv, N} ->
+ busy_send_client_loop(Socket, Master, Msg, N)
+ end
+ end).
+
+busy_send_client_loop(Socket, Master, Msg, N) ->
+ %% Client
+ %%
+ Size = byte_size(Msg),
+ case gen_tcp:recv(Socket, Size) of
+ {ok,Msg} ->
+ busy_send_client_loop(Socket, Master, Msg, N-1);
+ Other ->
+ Master ! {self(),flush([Other,N])}
+ end.
+
+%%%
+%%% Send to a socket whose other end does not read until the port gets busy.
+%%% Then close the other end. The writer should get an {error,closed} error.
+%%% (Passive mode.)
+%%%
+
+busy_disconnect_passive(Config) when is_list(Config) ->
+ MuchoData = list_to_binary(ones(64*1024)),
+ ?line [do_busy_disconnect_passive(MuchoData) || _ <- lists:seq(1, 10)],
+ ok.
+
+do_busy_disconnect_passive(MuchoData) ->
+ S = busy_disconnect_prepare_server([{active,false}]),
+ busy_disconnect_passive_send(S, MuchoData).
+
+busy_disconnect_passive_send(S, Data) ->
+ ?line case gen_tcp:send(S, Data) of
+ ok -> ?line busy_disconnect_passive_send(S, Data);
+ {error,closed} -> ok
+ end.
+
+%%%
+%%% Send to a socket whose other end does not read until the port gets busy.
+%%% Then close the other end. The writer should get an {error,closed} error and
+%%% a {tcp_closed,Socket} message. (Active mode.)
+%%%
+busy_disconnect_active(Config) when is_list(Config) ->
+ MuchoData = list_to_binary(ones(64*1024)),
+ ?line [do_busy_disconnect_active(MuchoData) || _ <- lists:seq(1, 10)],
+ ok.
+
+do_busy_disconnect_active(MuchoData) ->
+ S = busy_disconnect_prepare_server([{active,true}]),
+ busy_disconnect_active_send(S, MuchoData).
+
+busy_disconnect_active_send(S, Data) ->
+ ?line case gen_tcp:send(S, Data) of
+ ok -> ?line busy_disconnect_active_send(S, Data);
+ {error,closed} ->
+ receive
+ {tcp_closed,S} -> ok;
+ _Other -> ?line ?t:fail()
+ end
+ end.
+
+
+busy_disconnect_prepare_server(ConnectOpts) ->
+ ?line Sender = self(),
+ ?line Server = spawn_link(fun() -> busy_disconnect_server(Sender) end),
+ receive {port,Server,Port} -> ok end,
+ ?line {ok,S} = gen_tcp:connect(localhost, Port, ConnectOpts),
+ Server ! {Sender,sending},
+ S.
+
+busy_disconnect_server(Sender) ->
+ {ok,L} = gen_tcp:listen(0, [{active,false},binary,{reuseaddr,true},{packet,0}]),
+ {ok,Port} = inet:port(L),
+ Sender ! {port,self(),Port},
+ {ok,S} = gen_tcp:accept(L),
+ receive
+ {Sender,sending} ->
+ busy_disconnect_server_wait_for_busy(Sender, S)
+ end.
+
+%% Close the socket as soon as the Sender process can't send because of
+%% a busy port.
+busy_disconnect_server_wait_for_busy(Sender, S) ->
+ case process_info(Sender, status) of
+ {status,waiting} ->
+ %% We KNOW that the sender will be in state 'waiting' only
+ %% if the port has become busy. (Fallback solution if the
+ %% implementation changes: Watch Sender's reduction count;
+ %% when it stops changing, wait 2 seconds and then close.)
+ gen_tcp:close(S);
+ _Other ->
+ io:format("~p\n", [_Other]),
+ timer:sleep(100),
+ busy_disconnect_server_wait_for_busy(Sender, S)
+ end.
+
+%%%
+%%% Fill send queue
+%%%
+fill_sendq(Config) when is_list(Config) ->
+ ?line Master = self(),
+ ?line Server =
+ spawn_link(fun () ->
+ {ok,L} = gen_tcp:listen
+ (0, [{active,false},binary,
+ {reuseaddr,true},{packet,0}]),
+ {ok,Port} = inet:port(L),
+ Master ! {self(),client,
+ fill_sendq_client(Port, Master)},
+ fill_sendq_srv(L, Master)
+ end),
+ ?line io:format("~p Server~n", [Server]),
+ ?line receive {Server,client,Client} ->
+ ?line io:format("~p Client~n", [Client]),
+ ?line receive {Server,reader,Reader} ->
+ ?line io:format("~p Reader~n", [Reader]),
+ ?line fill_sendq_loop(Server, Client, Reader)
+ end
+ end.
+
+fill_sendq_loop(Server, Client, Reader) ->
+ %% Master
+ %%
+ receive {Server,send} ->
+ fill_sendq_loop(Server, Client, Reader)
+ after 2000 ->
+ %% Send queue full, sender blocked -> close client.
+ ?line io:format("Send timeout, closing Client...~n", []),
+ ?line Client ! {self(),close},
+ ?line receive {Server,[{error,closed}]} ->
+ ?line io:format("Got server closed.~n"),
+ ?line receive {Reader,[{error,closed}]} ->
+ ?line io:format
+ ("Got reader closed.~n"),
+ ok
+ after 3000 ->
+ ?t:fail({timeout,{closed,reader}})
+ end;
+ {Reader,[{error,closed}]} ->
+ ?line io:format("Got reader closed.~n"),
+ ?line receive {Server,[{error,closed}]} ->
+ ?line io:format("Got server closed~n"),
+ ok
+ after 3000 ->
+ ?t:fail({timeout,{closed,server}})
+ end
+ after 3000 ->
+ ?t:fail({timeout,{closed,[server,reader]}})
+ end
+ end.
+
+fill_sendq_srv(L, Master) ->
+ %% Server
+ %%
+ case gen_tcp:accept(L) of
+ {ok,S} ->
+ Master ! {self(),reader,
+ spawn_link(fun () -> fill_sendq_read(S, Master) end)},
+ Msg = "the quick brown fox jumps over a lazy dog~n",
+ fill_sendq_write(S, Master, [Msg,Msg,Msg,Msg,Msg,Msg,Msg,Msg]);
+ Error ->
+ io:format("~p error: ~p.~n", [self(),Error]),
+ Master ! {self(),flush([Error])}
+ end.
+
+fill_sendq_write(S, Master, Msg) ->
+ %% Server
+ %%
+ %%io:format("~p sending...~n", [self()]),
+ Master ! {self(),send},
+ case gen_tcp:send(S, Msg) of
+ ok ->
+ %%io:format("~p ok.~n", [self()]),
+ fill_sendq_write(S, Master, Msg);
+ E ->
+ Error = flush([E]),
+ io:format("~p error: ~p.~n", [self(),Error]),
+ Master ! {self(),Error}
+ end.
+
+fill_sendq_read(S, Master) ->
+ %% Reader
+ %%
+ io:format("~p read infinity...~n", [self()]),
+ case gen_tcp:recv(S, 0, infinity) of
+ {ok,Data} ->
+ io:format("~p got: ~p.~n", [self(),Data]),
+ fill_sendq_read(S, Master);
+ E ->
+ Error = flush([E]),
+ io:format("~p error: ~p.~n", [self(),Error]),
+ Master ! {self(),Error}
+ end.
+
+fill_sendq_client(Port, Master) ->
+ %% Client
+ %%
+ spawn_link(fun () ->
+ %% Just close on order
+ {ok,S} = gen_tcp:connect(
+ "localhost", Port,
+ [{active,false},binary,{packet,0}]),
+ receive
+ {Master,close} ->
+ ok = gen_tcp:close(S)
+ end
+ end).
+
+%%% Try to receive more than available number of bytes from
+%%% a closed socket.
+%%%
+partial_recv_and_close(Config) when is_list(Config) ->
+ ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n",
+ ?line Len = length(Msg),
+ ?line {ok,L} = gen_tcp:listen(0, [{active,false}]),
+ ?line {ok,P} = inet:port(L),
+ ?line {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]),
+ ?line {ok,A} = gen_tcp:accept(L),
+ ?line ok = gen_tcp:send(S, Msg),
+ ?line ok = gen_tcp:close(S),
+ ?line {error,closed} = gen_tcp:recv(A, Len+1),
+ ok.
+
+%%% Try to receive more than available number of bytes from
+%%% a closed socket, this time waiting in the recv before closing.
+%%%
+partial_recv_and_close_2(Config) when is_list(Config) ->
+ ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n",
+ ?line Len = length(Msg),
+ ?line {ok,L} = gen_tcp:listen(0, [{active,false}]),
+ ?line {ok,P} = inet:port(L),
+ ?line Server = self(),
+ ?line Client =
+ spawn_link(
+ fun () ->
+ receive after 2000 -> ok end,
+ {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]),
+ ?line ok = gen_tcp:send(S, Msg),
+ receive {Server,close} -> ok end,
+ receive after 2000 -> ok end,
+ ?line ok = gen_tcp:close(S)
+ end),
+ ?line {ok,A} = gen_tcp:accept(L),
+ ?line Client ! {Server,close},
+ ?line {error,closed} = gen_tcp:recv(A, Len+1),
+ ok.
+
+%%% Here we tests that gen_tcp:recv/2 will return {error,closed} following
+%%% a send operation of a huge amount data when the other end closed the socket.
+%%%
+partial_recv_and_close_3(Config) when is_list(Config) ->
+ [do_partial_recv_and_close_3() || _ <- lists:seq(0, 20)],
+ ok.
+
+do_partial_recv_and_close_3() ->
+ Parent = self(),
+ spawn_link(fun() ->
+ {ok,L} = gen_tcp:listen(0, [{active,false}]),
+ {ok,{_,Port}} = inet:sockname(L),
+ Parent ! {port,Port},
+ {ok,S} = gen_tcp:accept(L),
+ gen_tcp:recv(S, 1),
+ gen_tcp:close(S)
+ end),
+ receive
+ {port,Port} -> ok
+ end,
+ ?line Much = ones(8*64*1024),
+ ?line {ok,S} = gen_tcp:connect(localhost, Port, [{active,false}]),
+
+ %% Send a lot of data (most of it will be queued). The receiver will read one byte
+ %% and close the connection. The write operation will fail.
+ ?line gen_tcp:send(S, Much),
+
+ %% We should always get {error,closed} here.
+ ?line {error,closed} = gen_tcp:recv(S, 0).
+
+
+test_prio_put_get() ->
+ Tos = 3 bsl 5,
+ ?line {ok,L1} = gen_tcp:listen(0, [{active,false}]),
+ ?line ok = inet:setopts(L1,[{priority,3}]),
+ ?line ok = inet:setopts(L1,[{tos,Tos}]),
+ ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]),
+ ?line ok = inet:setopts(L1,[{priority,3}]), % Dont destroy each other
+ ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]),
+ ?line ok = inet:setopts(L1,[{reuseaddr,true}]), % Dont let others destroy
+ ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]),
+ ?line gen_tcp:close(L1),
+ ok.
+test_prio_accept() ->
+ ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false},
+ {reuseaddr,true},{priority,4}]),
+ ?line {ok,Port} = inet:port(Sock),
+ ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0},
+ {active,false},
+ {reuseaddr,true},
+ {priority,4}]),
+ ?line {ok,Sock3}=gen_tcp:accept(Sock),
+ ?line {ok,[{priority,4}]} = inet:getopts(Sock,[priority]),
+ ?line {ok,[{priority,4}]} = inet:getopts(Sock2,[priority]),
+ ?line {ok,[{priority,4}]} = inet:getopts(Sock3,[priority]),
+ ?line gen_tcp:close(Sock),
+ ?line gen_tcp:close(Sock2),
+ ?line gen_tcp:close(Sock3),
+ ok.
+
+test_prio_accept2() ->
+ Tos1 = 4 bsl 5,
+ Tos2 = 3 bsl 5,
+ ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false},
+ {reuseaddr,true},{priority,4},
+ {tos,Tos1}]),
+ ?line {ok,Port} = inet:port(Sock),
+ ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0},
+ {active,false},
+ {reuseaddr,true},
+ {priority,4},
+ {tos,Tos2}]),
+ ?line {ok,Sock3}=gen_tcp:accept(Sock),
+ ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]),
+ ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]),
+ ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]),
+ ?line gen_tcp:close(Sock),
+ ?line gen_tcp:close(Sock2),
+ ?line gen_tcp:close(Sock3),
+ ok.
+
+test_prio_accept3() ->
+ Tos1 = 4 bsl 5,
+ Tos2 = 3 bsl 5,
+ ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false},
+ {reuseaddr,true},
+ {tos,Tos1}]),
+ ?line {ok,Port} = inet:port(Sock),
+ ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0},
+ {active,false},
+ {reuseaddr,true},
+ {tos,Tos2}]),
+ ?line {ok,Sock3}=gen_tcp:accept(Sock),
+ ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]),
+ ?line {ok,[{priority,0},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]),
+ ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]),
+ ?line gen_tcp:close(Sock),
+ ?line gen_tcp:close(Sock2),
+ ?line gen_tcp:close(Sock3),
+ ok.
+
+test_prio_accept_async() ->
+ Tos1 = 4 bsl 5,
+ Tos2 = 3 bsl 5,
+ Ref = make_ref(),
+ ?line spawn(?MODULE,priority_server,[{self(),Ref}]),
+ ?line Port = receive
+ {Ref,P} -> P
+ after 5000 -> ?t:fail({error,"helper process timeout"})
+ end,
+ ?line receive
+ after 3000 -> ok
+ end,
+ ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0},
+ {active,false},
+ {reuseaddr,true},
+ {priority,4},
+ {tos,Tos2}]),
+ ?line receive
+ {Ref,{ok,[{priority,4},{tos,Tos1}]}} ->
+ ok ;
+ {Ref,Error} ->
+ ?t:fail({missmatch,Error})
+ after 5000 -> ?t:fail({error,"helper process timeout"})
+ end,
+ ?line receive
+ {Ref,{ok,[{priority,4},{tos,Tos1}]}} ->
+ ok ;
+ {Ref,Error2} ->
+ ?t:fail({missmatch,Error2})
+ after 5000 -> ?t:fail({error,"helper process timeout"})
+ end,
+
+ ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]),
+ ?line catch gen_tcp:close(Sock2),
+ ok.
+
+priority_server({Parent,Ref}) ->
+ Tos1 = 4 bsl 5,
+ ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false},
+ {reuseaddr,true},{priority,4},
+ {tos,Tos1}]),
+ ?line {ok,Port} = inet:port(Sock),
+ Parent ! {Ref,Port},
+ ?line {ok,Sock3}=gen_tcp:accept(Sock),
+ Parent ! {Ref, inet:getopts(Sock,[priority,tos])},
+ Parent ! {Ref, inet:getopts(Sock3,[priority,tos])},
+ ok.
+
+test_prio_fail() ->
+ ?line {ok,L} = gen_tcp:listen(0, [{active,false}]),
+ ?line {error,_} = inet:setopts(L,[{priority,1000}]),
+% This error could only happen in linux kernels earlier than 2.6.24.4
+% Privilege check is now disabled and IP_TOS can never fail (only silently
+% be masked).
+% ?line {error,_} = inet:setopts(L,[{tos,6 bsl 5}]),
+ ?line gen_tcp:close(L),
+ ok.
+
+test_prio_udp() ->
+ Tos = 3 bsl 5,
+ ?line {ok,S} = gen_udp:open(0,[{active,false},binary,{tos, Tos},
+ {priority,3}]),
+ ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(S,[priority,tos]),
+ ?line gen_udp:close(S),
+ ok.
+
+so_priority(doc) ->
+ ["Tests the so_priority and ip_tos options on sockets when applicable."];
+so_priority(suite) ->
+ [];
+so_priority(Config) when is_list(Config) ->
+ ?line {ok,L} = gen_tcp:listen(0, [{active,false}]),
+ ?line ok = inet:setopts(L,[{priority,1}]),
+ ?line case inet:getopts(L,[priority]) of
+ {ok,[{priority,1}]} ->
+ gen_tcp:close(L),
+ test_prio_put_get(),
+ test_prio_accept(),
+ test_prio_accept2(),
+ test_prio_accept3(),
+ test_prio_accept_async(),
+ test_prio_fail(),
+ test_prio_udp(),
+ ok;
+ _ ->
+ case os:type() of
+ {unix,linux} ->
+ case os:version() of
+ {X,Y,_} when (X > 2) or ((X =:= 2) and (Y >= 4)) ->
+ ?line ?t:fail({error,
+ "so_priority should work on this "
+ "OS, but does not"});
+ _ ->
+ {skip, "SO_PRIORITY not suppoorted"}
+ end;
+ _ ->
+ {skip, "SO_PRIORITY not suppoorted"}
+ end
+ end.
+
+%% Accept test utilities (suites are below)
+
+millis() ->
+ {A,B,C}=erlang:now(),
+ (A*1000000*1000)+(B*1000)+(C div 1000).
+
+collect_accepts(Tmo) ->
+ A = millis(),
+ receive
+ {accepted,P,Msg} ->
+ [{P,Msg}] ++ collect_accepts(Tmo-(millis() - A))
+ after Tmo ->
+ []
+ end.
+
+-define(EXPECT_ACCEPTS(Pattern,Timeout),
+ (fun() ->
+ case collect_accepts(Timeout) of
+ Pattern ->
+ ok;
+ Other ->
+ {error,{unexpected,{Other,process_info(self(),messages)}}}
+ end
+ end)()).
+
+collect_connects(Tmo) ->
+ A = millis(),
+ receive
+ {connected,P,Msg} ->
+ [{P,Msg}] ++ collect_connects(Tmo-(millis() - A))
+ after Tmo ->
+ []
+ end.
+
+-define(EXPECT_CONNECTS(Pattern,Timeout),
+ (fun() ->
+ case collect_connects(Timeout) of
+ Pattern ->
+ ok;
+ Other ->
+ {error,{unexpected,Other}}
+ end
+ end)()).
+
+mktmofun(Tmo,Parent,LS) ->
+ fun() -> Parent ! {accepted,self(), catch gen_tcp:accept(LS,Tmo)} end.
+
+%% Accept tests
+primitive_accept(suite) ->
+ [];
+primitive_accept(doc) ->
+ ["Test singular accept"];
+primitive_accept(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line {ok,PortNo}=inet:port(LS),
+ ?line Parent = self(),
+ ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end,
+ ?line P = spawn(F),
+ ?line gen_tcp:connect("localhost",PortNo,[]),
+ ?line receive
+ {accepted,P,{ok,P0}} when is_port(P0) ->
+ ok;
+ {accepted,P,Other0} ->
+ {error,Other0}
+ after 500 ->
+ {error,timeout}
+ end.
+
+
+multi_accept_close_listen(suite) ->
+ [];
+multi_accept_close_listen(doc) ->
+ ["Closing listen socket when multi-accepting"];
+multi_accept_close_listen(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end,
+ ?line spawn(F),
+ ?line spawn(F),
+ ?line spawn(F),
+ ?line spawn(F),
+ ?line gen_tcp:close(LS),
+ ?line ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}},
+ {_,{error,closed}},{_,{error,closed}}], 500).
+
+accept_timeout(suite) ->
+ [];
+accept_timeout(doc) ->
+ ["Single accept with timeout"];
+accept_timeout(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end,
+ ?line P = spawn(F),
+ ?line ?EXPECT_ACCEPTS([{P,{error,timeout}}],2000).
+
+accept_timeouts_in_order(suite) ->
+ [];
+accept_timeouts_in_order(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order"];
+accept_timeouts_in_order(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line P1 = spawn(mktmofun(1000,Parent,LS)),
+ ?line P2 = spawn(mktmofun(1200,Parent,LS)),
+ ?line P3 = spawn(mktmofun(1300,Parent,LS)),
+ ?line P4 = spawn(mktmofun(1400,Parent,LS)),
+ ?line ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}},
+ {P3,{error,timeout}},{P4,{error,timeout}}], 2000).
+
+accept_timeouts_in_order2(suite) ->
+ [];
+accept_timeouts_in_order2(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order (more)"];
+accept_timeouts_in_order2(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line P1 = spawn(mktmofun(1400,Parent,LS)),
+ ?line P2 = spawn(mktmofun(1300,Parent,LS)),
+ ?line P3 = spawn(mktmofun(1200,Parent,LS)),
+ ?line P4 = spawn(mktmofun(1000,Parent,LS)),
+ ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}},
+ {P2,{error,timeout}},{P1,{error,timeout}}], 2000).
+
+accept_timeouts_in_order3(suite) ->
+ [];
+accept_timeouts_in_order3(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order (even more)"];
+accept_timeouts_in_order3(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line P1 = spawn(mktmofun(1200,Parent,LS)),
+ ?line P2 = spawn(mktmofun(1400,Parent,LS)),
+ ?line P3 = spawn(mktmofun(1300,Parent,LS)),
+ ?line P4 = spawn(mktmofun(1000,Parent,LS)),
+ ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}},
+ {P3,{error,timeout}},{P2,{error,timeout}}], 2000).
+
+accept_timeouts_mixed(suite) ->
+ [];
+accept_timeouts_mixed(doc) ->
+ ["Check that multi-accept timeouts behave correctly when mixed with successful timeouts"];
+accept_timeouts_mixed(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line {ok,PortNo}=inet:port(LS),
+ ?line P1 = spawn(mktmofun(1000,Parent,LS)),
+ ?line wait_until_accepting(P1,500),
+ ?line P2 = spawn(mktmofun(2000,Parent,LS)),
+ ?line wait_until_accepting(P2,500),
+ ?line P3 = spawn(mktmofun(3000,Parent,LS)),
+ ?line wait_until_accepting(P3,500),
+ ?line P4 = spawn(mktmofun(4000,Parent,LS)),
+ ?line wait_until_accepting(P4,500),
+ ?line ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}}],1500),
+ ?line {ok,_}=gen_tcp:connect("localhost",PortNo,[]),
+ ?line ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),100),
+ ?line ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],2000),
+ ?line gen_tcp:connect("localhost",PortNo,[]),
+ ?line ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),100).
+
+killing_acceptor(suite) ->
+ [];
+killing_acceptor(doc) ->
+ ["Check that single acceptor behaves as expected when killed"];
+killing_acceptor(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Pid = spawn(fun() -> erlang:display({accepted,self(),gen_tcp:accept(LS)}) end),
+ ?line receive after 100 ->
+ ok
+ end,
+ ?line {ok,L1} = prim_inet:getstatus(LS),
+ ?line true = lists:member(accepting, L1),
+ ?line exit(Pid,kill),
+ ?line receive after 100 ->
+ ok
+ end,
+ ?line {ok,L2} = prim_inet:getstatus(LS),
+ ?line false = lists:member(accepting, L2),
+ ok.
+
+killing_multi_acceptors(suite) ->
+ [];
+killing_multi_acceptors(doc) ->
+ ["Check that multi acceptors behaves as expected when killed"];
+killing_multi_acceptors(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end,
+ ?line F2 = mktmofun(1000,Parent,LS),
+ ?line Pid = spawn(F),
+ ?line Pid2 = spawn(F2),
+ ?line receive after 100 ->
+ ok
+ end,
+ ?line {ok,L1} = prim_inet:getstatus(LS),
+ ?line true = lists:member(accepting, L1),
+ ?line exit(Pid,kill),
+ ?line receive after 100 ->
+ ok
+ end,
+ ?line {ok,L2} = prim_inet:getstatus(LS),
+ ?line true = lists:member(accepting, L2),
+ ?line ok = ?EXPECT_ACCEPTS([{Pid2,{error,timeout}}],1000),
+ ?line {ok,L3} = prim_inet:getstatus(LS),
+ ?line false = lists:member(accepting, L3),
+ ok.
+
+killing_multi_acceptors2(suite) ->
+ [];
+killing_multi_acceptors2(doc) ->
+ ["Check that multi acceptors behaves as expected when killed (more)"];
+killing_multi_acceptors2(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line {ok,PortNo}=inet:port(LS),
+ ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end,
+ ?line F2 = mktmofun(1000,Parent,LS),
+ ?line Pid = spawn(F),
+ ?line Pid2 = spawn(F),
+ ?line receive after 100 ->
+ ok
+ end,
+ ?line {ok,L1} = prim_inet:getstatus(LS),
+ ?line true = lists:member(accepting, L1),
+ ?line exit(Pid,kill),
+ ?line receive after 100 ->
+ ok
+ end,
+ ?line {ok,L2} = prim_inet:getstatus(LS),
+ ?line true = lists:member(accepting, L2),
+ ?line exit(Pid2,kill),
+ ?line receive after 100 ->
+ ok
+ end,
+ ?line {ok,L3} = prim_inet:getstatus(LS),
+ ?line false = lists:member(accepting, L3),
+ ?line Pid3 = spawn(F2),
+ ?line receive after 100 ->
+ ok
+ end,
+ ?line {ok,L4} = prim_inet:getstatus(LS),
+ ?line true = lists:member(accepting, L4),
+ ?line gen_tcp:connect("localhost",PortNo,[]),
+ ?line ok = ?EXPECT_ACCEPTS([{Pid3,{ok,Port}}] when is_port(Port),100),
+ ?line {ok,L5} = prim_inet:getstatus(LS),
+ ?line false = lists:member(accepting, L5),
+ ok.
+
+several_accepts_in_one_go(suite) ->
+ [];
+several_accepts_in_one_go(doc) ->
+ ["checks that multi-accept works when more than one accept can be "
+ "done at once (wb test of inet_driver)"];
+several_accepts_in_one_go(Config) when is_list(Config) ->
+ ?line {ok,LS}=gen_tcp:listen(0,[]),
+ ?line Parent = self(),
+ ?line {ok,PortNo}=inet:port(LS),
+ ?line F1 = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end,
+ ?line F2 = fun() -> Parent ! {connected,self(),gen_tcp:connect("localhost",PortNo,[])} end,
+ ?line spawn(F1),
+ ?line spawn(F1),
+ ?line spawn(F1),
+ ?line spawn(F1),
+ ?line spawn(F1),
+ ?line spawn(F1),
+ ?line spawn(F1),
+ ?line spawn(F1),
+ ?line ok = ?EXPECT_ACCEPTS([],500),
+ ?line spawn(F2),
+ ?line spawn(F2),
+ ?line spawn(F2),
+ ?line spawn(F2),
+ ?line spawn(F2),
+ ?line spawn(F2),
+ ?line spawn(F2),
+ ?line spawn(F2),
+ ?line ok = ?EXPECT_ACCEPTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],15000),
+ ?line ok = ?EXPECT_CONNECTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],1000),
+ ok.
+
+
+flush(Msgs) ->
+ erlang:yield(),
+ receive Msg -> flush([Msg|Msgs])
+ after 0 -> lists:reverse(Msgs)
+ end.
+
+wait_until_accepting(Proc,0) ->
+ exit({timeout_waiting_for_accepting,Proc});
+wait_until_accepting(Proc,N) ->
+ case process_info(Proc,current_function) of
+ {current_function,{prim_inet,accept0,2}} ->
+ case process_info(Proc,status) of
+ {status,waiting} ->
+ ok;
+ _O1 ->
+ receive
+ after 5 ->
+ wait_until_accepting(Proc,N-1)
+ end
+ end;
+ _O2 ->
+ receive
+ after 5 ->
+ wait_until_accepting(Proc,N-1)
+ end
+ end.
+
+
+
+active_once_closed(suite) ->
+ [];
+active_once_closed(doc) ->
+ ["Check that active once and tcp_close messages behave as expected"];
+active_once_closed(Config) when is_list(Config) ->
+ (fun() ->
+ ?line {Loop,A} = setup_closed_ao(),
+ ?line Loop({{error,closed},{error,econnaborted}},
+ fun() -> gen_tcp:send(A,"Hello") end),
+ ?line ok = inet:setopts(A,[{active,once}]),
+ ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end,
+ ?line {error,einval} = inet:setopts(A,[{active,once}]),
+ ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end
+ end)(),
+ (fun() ->
+ ?line {Loop,A} = setup_closed_ao(),
+ ?line Loop({{error,closed},{error,econnaborted}},
+ fun() -> gen_tcp:send(A,"Hello") end),
+ ?line ok = inet:setopts(A,[{active,true}]),
+ ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end,
+ ?line {error,einval} = inet:setopts(A,[{active,true}]),
+ ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end
+ end)(),
+ (fun() ->
+ ?line {Loop,A} = setup_closed_ao(),
+ ?line Loop({{error,closed},{error,econnaborted}},
+ fun() -> gen_tcp:send(A,"Hello") end),
+ ?line ok = inet:setopts(A,[{active,true}]),
+ ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end,
+ ?line {error,einval} = inet:setopts(A,[{active,once}]),
+ ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end
+ end)(),
+ (fun() ->
+ ?line {Loop,A} = setup_closed_ao(),
+ ?line Loop({{error,closed},{error,econnaborted}},
+ fun() -> gen_tcp:send(A,"Hello") end),
+ ?line ok = inet:setopts(A,[{active,once}]),
+ ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end,
+ ?line {error,einval} = inet:setopts(A,[{active,true}]),
+ ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end
+ end)(),
+ (fun() ->
+ ?line {Loop,A} = setup_closed_ao(),
+ ?line Loop({{error,closed},{error,econnaborted}},
+ fun() -> gen_tcp:send(A,"Hello") end),
+ ?line ok = inet:setopts(A,[{active,false}]),
+ ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end,
+ ?line ok = inet:setopts(A,[{active,once}]),
+ ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end
+ end)().
+
+send_timeout(suite) ->
+ [];
+send_timeout(doc) ->
+ ["Test the send_timeout socket option"];
+send_timeout(Config) when is_list(Config) ->
+ %% Basic
+ BasicFun =
+ fun(AutoClose) ->
+ ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose),
+ ?line {error,timeout} =
+ Loop(fun() ->
+ Res = gen_tcp:send(A,<<1:10000>>),
+ %%erlang:display(Res),
+ Res
+ end),
+ %% Check that the socket is not busy/closed...
+ Error = after_send_timeout(AutoClose),
+ ?line {error,Error} = gen_tcp:send(A,<<"Hej">>),
+ ?line test_server:stop_node(RNode)
+ end,
+ BasicFun(false),
+ BasicFun(true),
+ %% Check timeout length
+ ?line Self = self(),
+ ?line Pid =
+ spawn(fun() ->
+ {Loop,A,RNode} = setup_timeout_sink(1000, true),
+ {error,timeout} =
+ Loop(fun() ->
+ Res = gen_tcp:send(A,<<1:10000>>),
+ %%erlang:display(Res),
+ Self ! Res,
+ Res
+ end),
+ test_server:stop_node(RNode)
+ end),
+ ?line Diff = get_max_diff(),
+ ?line io:format("Max time for send: ~p~n",[Diff]),
+ ?line true = (Diff > 500) and (Diff < 1500),
+ %% Let test_server slave die...
+ ?line Mon = erlang:monitor(process, Pid),
+ ?line receive {'DOWN',Mon,process,Pid,_} -> ok end,
+ %% Check that parallell writers do not hang forever
+ ParaFun =
+ fun(AutoClose) ->
+ ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose),
+ SenderFun = fun() ->
+ {error,Error} =
+ Loop(fun() ->
+ gen_tcp:send(A, <<1:10000>>)
+ end),
+ Self ! {error,Error}
+ end,
+ ?line spawn_link(SenderFun),
+ ?line spawn_link(SenderFun),
+ ?line receive
+ {error,timeout} -> ok
+ after 10000 ->
+ ?line exit(timeout)
+ end,
+ NextErr = after_send_timeout(AutoClose),
+ ?line receive
+ {error,NextErr} -> ok
+ after 10000 ->
+ ?line exit(timeout)
+ end,
+ ?line {error,NextErr} = gen_tcp:send(A,<<"Hej">>),
+ ?line test_server:stop_node(RNode)
+ end,
+ ParaFun(false),
+ ParaFun(true),
+ ok.
+
+after_send_timeout(AutoClose) ->
+ case AutoClose of
+ true -> enotconn;
+ false -> timeout
+ end.
+
+get_max_diff() ->
+ receive
+ ok ->
+ get_max_diff(0)
+ after 10000 ->
+ exit(timeout)
+ end.
+
+get_max_diff(Max) ->
+ T1 = millistamp(),
+ receive
+ ok ->
+ Diff = millistamp() - T1,
+ if
+ Diff > Max ->
+ get_max_diff(Diff);
+ true ->
+ get_max_diff(Max)
+ end;
+ {error,timeout} ->
+ Diff = millistamp() - T1,
+ if
+ Diff > Max ->
+ Diff;
+ true ->
+ Max
+ end
+ after 10000 ->
+ exit(timeout)
+ end.
+
+setup_closed_ao() ->
+ Dir = filename:dirname(code:which(?MODULE)),
+ {ok,R} = test_server:start_node(test_default_options_slave,slave,
+ [{args,"-pa " ++ Dir}]),
+ Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))),
+ {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}]),
+ Fun = fun(F) ->
+ receive
+ {From,X} when is_function(X) ->
+ From ! {self(),X()}, F(F);
+ die -> ok
+ end
+ end,
+ Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]),
+ {ok, Port} = inet:port(L),
+ Remote = fun(Fu) ->
+ Pid ! {self(), Fu},
+ receive {Pid,X} -> X
+ end
+ end,
+ {ok, C} = Remote(fun() ->
+ gen_tcp:connect(Host,Port,
+ [{active,false},{packet,2}])
+ end),
+ {ok,A} = gen_tcp:accept(L),
+ gen_tcp:send(A,"Hello"),
+ {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end),
+ ok = Remote(fun() -> gen_tcp:close(C) end),
+ Loop2 = fun(_,_,_,0) ->
+ {failure, timeout};
+ (L2,{MA,MB},F2,N) ->
+ case F2() of
+ MA -> MA;
+ MB -> MB;
+ Other -> io:format("~p~n",[Other]),
+ receive after 1000 -> ok end,
+ L2(L2,{MA,MB},F2,N-1)
+ end
+ end,
+ Loop = fun(Match2,F3) -> Loop2(Loop2,Match2,F3,10) end,
+ test_server:stop_node(R),
+ {Loop,A}.
+
+setup_timeout_sink(Timeout, AutoClose) ->
+ Dir = filename:dirname(code:which(?MODULE)),
+ {ok,R} = test_server:start_node(test_default_options_slave,slave,
+ [{args,"-pa " ++ Dir}]),
+ Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))),
+ {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2},
+ {send_timeout,Timeout},
+ {send_timeout_close,AutoClose}]),
+ Fun = fun(F) ->
+ receive
+ {From,X} when is_function(X) ->
+ From ! {self(),X()}, F(F);
+ die -> ok
+ end
+ end,
+ Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]),
+ {ok, Port} = inet:port(L),
+ Remote = fun(Fu) ->
+ Pid ! {self(), Fu},
+ receive {Pid,X} -> X
+ end
+ end,
+ {ok, C} = Remote(fun() ->
+ gen_tcp:connect(Host,Port,
+ [{active,false},{packet,2}])
+ end),
+ {ok,A} = gen_tcp:accept(L),
+ gen_tcp:send(A,"Hello"),
+ {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end),
+ Loop2 = fun(_,_,0) ->
+ {failure, timeout};
+ (L2,F2,N) ->
+ Ret = F2(),
+ io:format("~p~n",[Ret]),
+ case Ret of
+ ok -> receive after 1 -> ok end,
+ L2(L2,F2,N-1);
+ Other -> Other
+ end
+ end,
+ Loop = fun(F3) -> Loop2(Loop2,F3,1000) end,
+ {Loop,A,R}.
+
+millistamp() ->
+ {Mega, Secs, Micros} = erlang:now(),
+ (Micros div 1000) + Secs * 1000 + Mega * 1000000000.
+
+has_superfluous_schedulers() ->
+ case {erlang:system_info(schedulers),
+ erlang:system_info(logical_processors)} of
+ {S, unknown} when S > 1 -> true;
+ {S, P} when S > P -> true;
+ _ -> false
+ end.
+
+
+otp_7731(suite) -> [];
+otp_7731(doc) ->
+ "Leaking message from inet_drv {inet_reply,P,ok} "
+ "when a socket sending resumes working after a send_timeout";
+otp_7731(Config) when is_list(Config) ->
+ ?line ServerPid = spawn_link(?MODULE, otp_7731_server, [self()]),
+ ?line receive {ServerPid, ready, PortNum} -> ok end,
+
+ ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum,
+ [binary, {active, false}, {packet, raw},
+ {send_timeout, 1000}]),
+ otp_7731_send(Socket),
+ io:format("Sending complete...\n",[]),
+ ServerPid ! {self(), recv},
+ receive {ServerPid, ok} -> ok end,
+
+ io:format("Client waiting for leaking messages...\n",[]),
+
+ %% Now make sure inet_drv does not leak any internal messages.
+ receive Msg ->
+ ?line test_server:fail({unexpected, Msg})
+ after 1000 ->
+ ok
+ end,
+ io:format("No leaking messages. Done.\n",[]),
+ gen_tcp:close(Socket).
+
+otp_7731_send(Socket) ->
+ Bin = <<1:10000>>,
+ io:format("Client sending ~p bytes...\n",[size(Bin)]),
+ ?line case gen_tcp:send(Socket, Bin) of
+ ok -> otp_7731_send(Socket);
+ {error,timeout} -> ok
+ end.
+
+otp_7731_server(ClientPid) ->
+ ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw},
+ {active, false}]),
+ ?line {ok, {_, PortNum}} = inet:sockname(LSocket),
+ io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]),
+ ClientPid ! {self(), ready, PortNum},
+
+ {ok, CSocket} = gen_tcp:accept(LSocket),
+ gen_tcp:close(LSocket),
+
+ io:format("Server got connection, wait for recv order...\n",[]),
+
+ receive {ClientPid, recv} -> ok end,
+
+ io:format("Server start receiving...\n",[]),
+
+ otp_7731_recv(CSocket),
+
+ ClientPid ! {self(), ok},
+
+ io:format("Server finished, closing...\n",[]),
+ gen_tcp:close(CSocket).
+
+
+otp_7731_recv(Socket) ->
+ ?line case gen_tcp:recv(Socket, 0, 1000) of
+ {ok, Bin} ->
+ io:format("Server received ~p bytes\n",[size(Bin)]),
+ otp_7731_recv(Socket);
+ {error,timeout} ->
+ io:format("Server got receive timeout\n",[]),
+ ok
+ end.
+
+
+%% OTP-7615: TCP-ports hanging in CLOSING state when sending large
+%% buffer followed by a recv() that returns error due to closed
+%% connection.
+zombie_sockets(suite) -> [];
+zombie_sockets(doc) -> ["OTP-7615 Leaking closed ports."];
+zombie_sockets(Config) when is_list(Config) ->
+ register(zombie_collector,self()),
+ Calls = 10,
+ Server = spawn_link(?MODULE, zombie_server,[self(), Calls]),
+ ?line {Server, ready, PortNum} = receive Msg -> Msg end,
+ io:format("Ports before = ~p\n",[lists:sort(erlang:ports())]),
+ zombie_client_loop(Calls, PortNum),
+ Ports = lists:sort(zombie_collector(Calls,[])),
+ Server ! terminate,
+ io:format("Collected ports = ~p\n",[Ports]),
+ ?line [] = zombies_alive(Ports, 10),
+ timer:sleep(1000),
+ ok.
+
+zombie_client_loop(0, _) -> ok;
+zombie_client_loop(N, PortNum) when is_integer(PortNum) ->
+ ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum,
+ [binary, {active, false}, {packet, raw}]),
+ ?line gen_tcp:close(Socket), % to make server recv fail
+ zombie_client_loop(N-1, PortNum).
+
+
+zombie_collector(0,Acc) ->
+ Acc;
+zombie_collector(N,Acc) ->
+ receive
+ {closed, Socket} ->
+ zombie_collector(N-1,[Socket|Acc]);
+ E ->
+ {unexpected, E, Acc}
+ end.
+
+zombies_alive(Ports, WaitSec) ->
+ Alive = lists:sort(erlang:ports()),
+ io:format("Alive = ~p\n",[Alive]),
+ Zombies = lists:filter(fun(P) -> lists:member(P, Alive) end, Ports),
+ case Zombies of
+ [] -> [];
+ _ ->
+ case WaitSec of
+ 0 -> Zombies;
+ _ -> timer:sleep(1000), % Wait some more for zombies to die
+ zombies_alive(Zombies, WaitSec-1)
+ end
+ end.
+
+zombie_server(Pid, Calls) ->
+ ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw},
+ {active, false}, {backlog, Calls}]),
+ ?line {ok, {_, PortNum}} = inet:sockname(LSocket),
+ io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]),
+ BigBin = list_to_binary(lists:duplicate(100*1024, 77)),
+ Pid ! {self(), ready, PortNum},
+ zombie_accept_loop(LSocket, BigBin, Calls),
+ ?line terminate = receive Msg -> Msg end.
+
+zombie_accept_loop(_, _, 0) ->
+ ok;
+zombie_accept_loop(Socket, BigBin, Calls) ->
+ ?line case gen_tcp:accept(Socket) of
+ {ok, NewSocket} ->
+ spawn_link(fun() -> zombie_serve_client(NewSocket, BigBin) end),
+ zombie_accept_loop(Socket, BigBin, Calls-1);
+ E ->
+ E
+ end.
+
+zombie_serve_client(Socket, Bin) ->
+ %%io:format("Got connection on ~p\n",[Socket]),
+ ?line gen_tcp:send(Socket, Bin),
+ %%io:format("Sent data, waiting for reply on ~p\n",[Socket]),
+ ?line case gen_tcp:recv(Socket, 4) of
+ {error,closed} -> ok;
+ {error,econnaborted} -> ok % may be returned on Windows
+ end,
+ %%io:format("Closing ~p\n",[Socket]),
+ ?line gen_tcp:close(Socket),
+ zombie_collector ! {closed, Socket}.
+
+
+
+otp_7816(suite) -> [];
+otp_7816(doc) ->
+ "Hanging send on windows when sending iolist with more than 16 binaries.";
+otp_7816(Config) when is_list(Config) ->
+ Client = self(),
+ ?line Server = spawn_link(fun()-> otp_7816_server(Client) end),
+ ?line receive {Server, ready, PortNum} -> ok end,
+
+ ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum,
+ [binary, {active, false}, {packet, 4},
+ {send_timeout, 10}]),
+ %% We use the undocumented feature that sending can be resumed after
+ %% a send_timeout without any data loss if the peer starts to receive data.
+ %% Unless of course the 7816-bug is in affect, in which case the write event
+ %% for the socket is lost on windows and not all data is sent.
+
+ [otp_7816_send(Socket,18,BinSize,Server) || BinSize <- lists:seq(1000, 2000, 123)],
+
+ io:format("Sending complete...\n",[]),
+
+ ?line ok = gen_tcp:close(Socket),
+ Server ! {self(), closed},
+ ?line {Server, closed} = receive M -> M end.
+
+
+otp_7816_send(Socket, BinNr, BinSize, Server) ->
+ Data = lists:duplicate(BinNr, <<1:(BinSize*8)>>),
+ SentBytes = otp_7816_send_data(Socket, Data, 0) * BinNr * BinSize,
+ io:format("Client sent ~p bytes...\n",[SentBytes]),
+ Server ! {self(),recv,SentBytes},
+ ?line {Server, ok} = receive M -> M end.
+
+
+
+otp_7816_send_data(Socket, Data, Loops) ->
+ io:format("Client sending data...\n",[]),
+ case gen_tcp:send(Socket, Data) of
+ ok ->
+ otp_7816_send_data(Socket,Data, Loops+1);
+ {error,timeout} ->
+ Loops+1
+ end.
+
+
+otp_7816_server(Client) ->
+ ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, 4},
+ {active, false}]),
+ ?line {ok, {_, PortNum}} = inet:sockname(LSocket),
+ io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]),
+ Client ! {self(), ready, PortNum},
+
+ ?line {ok, CSocket} = gen_tcp:accept(LSocket),
+ io:format("Server got connection...\n",[]),
+ ?line gen_tcp:close(LSocket),
+
+ otp_7816_server_loop(CSocket),
+
+ io:format("Server terminating.\n",[]).
+
+
+otp_7816_server_loop(CSocket) ->
+ io:format("Server waiting for order...\n",[]),
+
+ receive
+ {Client, recv, RecvBytes} ->
+ io:format("Server start receiving...\n",[]),
+
+ ?line ok = otp_7816_recv(CSocket, RecvBytes),
+
+ Client ! {self(), ok},
+ otp_7816_server_loop(CSocket);
+
+ {Client, closed} ->
+ ?line {error, closed} = gen_tcp:recv(CSocket, 0, 1000),
+ Client ! {self(), closed}
+ end.
+
+
+otp_7816_recv(_, 0) ->
+ io:format("Server got all.\n",[]),
+ ok;
+otp_7816_recv(CSocket, BytesLeft) ->
+ ?line case gen_tcp:recv(CSocket, 0, 1000) of
+ {ok, Bin} when byte_size(Bin) =< BytesLeft ->
+ io:format("Server received ~p of ~p bytes.\n",[size(Bin), BytesLeft]),
+ otp_7816_recv(CSocket, BytesLeft - byte_size(Bin));
+ {error,timeout} ->
+ io:format("Server got receive timeout when expecting more data\n",[]),
+ error
+ end.
+
+otp_8102(doc) -> ["Receive a packet with a faulty packet header"];
+otp_8102(suite) -> [];
+otp_8102(Config) when is_list(Config) ->
+ ?line {ok, LSocket} = gen_tcp:listen(0, []),
+ ?line {ok, {_, PortNum}} = inet:sockname(LSocket),
+ io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]),
+
+ [otp_8102_do(LSocket, PortNum, otp_8102_packet(Type,Size))
+ || Size <- lists:seq(-10,-1),
+ Type <- [4, {cdr,big}, {cdr,little}]],
+
+ gen_tcp:close(LSocket),
+ ok.
+
+otp_8102_packet(4, Size) ->
+ {<<Size:32/big>>, 4};
+otp_8102_packet({cdr,big}, Size) ->
+ {<<"GIOP",0,0,0,0,Size:32/big>>, cdr};
+otp_8102_packet({cdr,little}, Size) ->
+ {<<"GIOP",0,0,1,0,Size:32/little>>, cdr}.
+
+otp_8102_do(LSocket, PortNum, {Bin,PType}) ->
+
+ io:format("Connect with packet option ~p ...\n",[PType]),
+ ?line {ok, RSocket} = gen_tcp:connect("localhost", PortNum, [binary,
+ {packet,PType},
+ {active,true}]),
+ ?line {ok, SSocket} = gen_tcp:accept(LSocket),
+
+ io:format("Got connection, sending ~p...\n",[Bin]),
+
+ ?line ok = gen_tcp:send(SSocket, Bin),
+
+ io:format("Sending complete...\n",[]),
+
+ ?line {tcp_error,RSocket,emsgsize} = receive M -> M end,
+
+ io:format("Got error msg, ok.\n",[]),
+ gen_tcp:close(SSocket),
+ gen_tcp:close(RSocket).
+
diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl
new file mode 100644
index 0000000000..bd5685952e
--- /dev/null
+++ b/lib/kernel/test/gen_udp_SUITE.erl
@@ -0,0 +1,410 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%
+% test the behavior of gen_udp. Testing udp is really a very unfunny task,
+% because udp is not deterministic.
+%
+-module(gen_udp_SUITE).
+-include("test_server.hrl").
+
+
+-define(default_timeout, ?t:minutes(1)).
+
+% XXX - we should pick a port that we _know_ is closed. That's pretty hard.
+-define(CLOSED_PORT, 6666).
+
+-export([all/1]).
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+-export([send_to_closed/1,
+ buffer_size/1, binary_passive_recv/1, bad_address/1,
+ read_packets/1, open_fd/1]).
+
+all(suite) ->
+ [send_to_closed,
+ buffer_size, binary_passive_recv, bad_address, read_packets,
+ open_fd].
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog=test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+%%-------------------------------------------------------------
+%% Send two packets to a closed port (on some systems this causes the socket
+%% to be closed).
+
+send_to_closed(doc) ->
+ ["Tests core functionality."];
+send_to_closed(suite) ->
+ [];
+send_to_closed(Config) when is_list(Config) ->
+ ?line {ok, Sock} = gen_udp:open(0),
+ ?line ok = gen_udp:send(Sock, {127,0,0,1}, ?CLOSED_PORT, "foo"),
+ timer:sleep(2),
+ ?line ok = gen_udp:send(Sock, {127,0,0,1}, ?CLOSED_PORT, "foo"),
+ ?line ok = gen_udp:close(Sock),
+ ok.
+
+
+
+%%-------------------------------------------------------------
+%% Test that the UDP socket buffer sizes are settable
+
+buffer_size(suite) ->
+ [];
+buffer_size(doc) ->
+ ["Test UDP buffer size setting."];
+buffer_size(Config) when is_list(Config) ->
+ ?line Len = 256,
+ ?line Bin = list_to_binary(lists:seq(0, Len-1)),
+ ?line M = 8192 div Len,
+ ?line Spec0 =
+ [{opt,M},{safe,M-1},{long,M+1},
+ {opt,2*M},{safe,2*M-1},{long,2*M+1},
+ {opt,4*M},{safe,4*M-1},{long,4*M+1}],
+ ?line Spec =
+ [case Tag of
+ opt ->
+ [{recbuf,Val*Len},{sndbuf,(Val + 2)*Len}];
+ safe ->
+ {list_to_binary(lists:duplicate(Val, Bin)),
+ [correct]};
+ long ->
+ {list_to_binary(lists:duplicate(Val, Bin)),
+ [truncated,emsgsize,timeout]}
+ end || {Tag,Val} <- Spec0],
+ %%
+ ?line {ok, ClientSocket} = gen_udp:open(0, [binary]),
+ ?line {ok, ClientPort} = inet:port(ClientSocket),
+ ?line Client = self(),
+ ?line ClientIP = {127,0,0,1},
+ ?line ServerIP = {127,0,0,1},
+ ?line Server =
+ spawn_link(
+ fun () ->
+ {ok, ServerSocket} = gen_udp:open(0, [binary]),
+ {ok, ServerPort} = inet:port(ServerSocket),
+ Client ! {self(),port,ServerPort},
+ buffer_size_server(Client, ClientIP, ClientPort,
+ ServerSocket, 1, Spec),
+ ok = gen_udp:close(ServerSocket)
+ end),
+ ?line Mref = erlang:monitor(process, Server),
+ ?line receive
+ {Server,port,ServerPort} ->
+ ?line buffer_size_client(Server, ServerIP, ServerPort,
+ ClientSocket, 1, Spec)
+ end,
+ ?line ok = gen_udp:close(ClientSocket),
+ ?line receive
+ {'DOWN',Mref,_,_,normal} ->
+ ?line ok
+ end.
+
+buffer_size_client(_, _, _, _, _, []) ->
+ ?line ok;
+buffer_size_client(Server, IP, Port,
+ Socket, Cnt, [Opts|T]) when is_list(Opts) ->
+ ?line ok = inet:setopts(Socket, Opts),
+ ?line Server ! {self(),setopts,Cnt},
+ ?line receive {Server,setopts,Cnt} -> ok end,
+ ?line buffer_size_client(Server, IP, Port, Socket, Cnt+1, T);
+buffer_size_client(Server, IP, Port,
+ Socket, Cnt, [{B,Replies}|T]) when is_binary(B) ->
+ ?line ok = gen_udp:send(Socket, IP, Port, B),
+ ?line receive
+ {Server,Cnt,Reply} ->
+ ?line case lists:member(Reply, Replies) of
+ true -> ok;
+ false ->
+ ?line
+ ?t:fail({reply_mismatch,Cnt,Reply,Replies,
+ byte_size(B),
+ inet:getopts(Socket,
+ [sndbuf,recbuf])})
+ end
+ end,
+ ?line buffer_size_client(Server, IP, Port, Socket, Cnt+1, T).
+
+buffer_size_server(_, _, _, _, _, []) ->
+ ok;
+buffer_size_server(Client, IP, Port,
+ Socket, Cnt, [Opts|T]) when is_list(Opts) ->
+ receive {Client,setopts,Cnt} -> ok end,
+ ok = inet:setopts(Socket, Opts),
+ Client ! {self(),setopts,Cnt},
+ buffer_size_server(Client, IP, Port, Socket, Cnt+1, T);
+buffer_size_server(Client, IP, Port,
+ Socket, Cnt, [{B,_}|T]) when is_binary(B) ->
+ Client !
+ {self(),Cnt,
+ receive
+ {udp,Socket,IP,Port,D} when is_binary(D) ->
+ SizeD = byte_size(D),
+ case B of
+ D -> correct;
+ <<D:SizeD/binary,_/binary>> -> truncated
+ end;
+ {udp_error,Socket,Error} -> Error
+ after 5000 -> timeout
+ end},
+ buffer_size_server(Client, IP, Port, Socket, Cnt+1, T).
+
+
+
+%%-------------------------------------------------------------
+%% OTP-3823 gen_udp:recv does not return address in binary mode
+%%
+
+binary_passive_recv(suite) ->
+ [];
+binary_passive_recv(doc) ->
+ ["OTP-3823 gen_udp:recv does not return address in binary mode"];
+binary_passive_recv(Config) when is_list(Config) ->
+ ?line D = "The quick brown fox jumps over a lazy dog",
+ ?line B = list_to_binary(D),
+ ?line {ok, R} = gen_udp:open(0, [binary, {active, false}]),
+ ?line {ok, RP} = inet:port(R),
+ ?line {ok, S} = gen_udp:open(0),
+ ?line {ok, SP} = inet:port(S),
+ ?line ok = gen_udp:send(S, localhost, RP, D),
+ ?line {ok, {{127, 0, 0, 1}, SP, B}} = gen_udp:recv(R, byte_size(B)+1),
+ ?line ok = gen_udp:close(S),
+ ?line ok = gen_udp:close(R),
+ ok.
+
+
+%%-------------------------------------------------------------
+%% OTP-3836 inet_udp crashes when IP-address is larger than 255.
+
+bad_address(suite) ->
+ [];
+bad_address(doc) ->
+ ["OTP-3836 inet_udp crashes when IP-address is larger than 255."];
+bad_address(Config) when is_list(Config) ->
+ ?line {ok, R} = gen_udp:open(0),
+ ?line {ok, RP} = inet:port(R),
+ ?line {ok, S} = gen_udp:open(0),
+ ?line {ok, _SP} = inet:port(S),
+ ?line {'EXIT', badarg} =
+ (catch gen_udp:send(S, {127,0,0,1,0}, RP, "void")),
+ ?line {'EXIT', badarg} =
+ (catch gen_udp:send(S, {127,0,0,256}, RP, "void")),
+ ?line ok = gen_udp:close(S),
+ ?line ok = gen_udp:close(R),
+ ok.
+
+
+%%-------------------------------------------------------------
+%% OTP-6249 UDP option for number of packet reads
+%%
+%% Starts a slave node that on command sends a bunch of messages
+%% to our UDP port. The receiving process just receives and
+%% ignores the incoming messages, but counts them.
+%% A tracing process traces the receiving process for
+%% 'receive' and scheduling events. From the trace,
+%% message contents is verified; and, how many messages
+%% are received per in/out scheduling, which should be
+%% the same as the read_packets parameter.
+%%
+%% What happens on the SMP emulator remains to be seen...
+%%
+
+read_packets(doc) ->
+ ["OTP-6249 UDP option for number of packet reads."];
+read_packets(Config) when is_list(Config) ->
+ case erlang:system_info(smp_support) of
+ false ->
+ read_packets_1();
+ true ->
+ %% We would need some new sort of tracing to test this
+ %% option reliably in an SMP emulator.
+ {skip,"SMP emulator"}
+ end.
+
+read_packets_1() ->
+ ?line N1 = 5,
+ ?line N2 = 7,
+ ?line {ok,R} = gen_udp:open(0, [{read_packets,N1}]),
+ ?line {ok,RP} = inet:port(R),
+ ?line {ok,Node} = start_node(gen_udp_SUITE_read_packets),
+ ?line Die = make_ref(),
+ ?line Loop = erlang:spawn_link(fun () -> infinite_loop(Die) end),
+ %%
+ ?line Msgs1 = [erlang:integer_to_list(M) || M <- lists:seq(1, N1*3)],
+ ?line [V1|_] = read_packets_test(R, RP, Msgs1, Node),
+ ?line {ok,[{read_packets,N1}]} = inet:getopts(R, [read_packets]),
+ %%
+ ?line ok = inet:setopts(R, [{read_packets,N2}]),
+ ?line Msgs2 = [erlang:integer_to_list(M) || M <- lists:seq(1, N2*3)],
+ ?line [V2|_] = read_packets_test(R, RP, Msgs2, Node),
+ ?line {ok,[{read_packets,N2}]} = inet:getopts(R, [read_packets]),
+ %%
+ ?line stop_node(Node),
+ ?line Mref = erlang:monitor(process, Loop),
+ ?line Loop ! Die,
+ ?line receive
+ {'DOWN',Mref,_,_, normal} ->
+ case {V1,V2} of
+ {N1,N2} ->
+ ok;
+ _ when V1 =/= N1, V2 =/= N2 ->
+ ok
+ end
+ end.
+
+infinite_loop(Die) ->
+ receive
+ Die ->
+ ok
+ after
+ 0 ->
+ infinite_loop(Die)
+ end.
+
+read_packets_test(R, RP, Msgs, Node) ->
+ Len = length(Msgs),
+ Receiver = self(),
+ Tracer =
+ spawn_link(
+ fun () ->
+ receive
+ {Receiver,get_trace} ->
+ Receiver ! {self(),{trace,flush()}}
+ end
+ end),
+ Sender =
+ spawn_opt(
+ Node,
+ fun () ->
+ {ok,S} = gen_udp:open(0),
+ {ok,SP} = inet:port(S),
+ Receiver ! {self(),{port,SP}},
+ receive
+ {Receiver,go} ->
+ read_packets_send(S, RP, Msgs)
+ end
+ end,
+ [link,{priority,high}]),
+ receive
+ {Sender,{port,SP}} ->
+ erlang:trace(self(), true,
+ [running,'receive',{tracer,Tracer}]),
+ erlang:yield(),
+ Sender ! {Receiver,go},
+ read_packets_recv(Len),
+ erlang:trace(self(), false, [all]),
+ Tracer ! {Receiver,get_trace},
+ receive
+ {Tracer,{trace,Trace}} ->
+ read_packets_verify(R, SP, Msgs, Trace)
+ end
+ end.
+
+read_packets_send(S, RP, [Msg|Msgs]) ->
+ ok = gen_udp:send(S, localhost, RP, Msg),
+ read_packets_send(S, RP, Msgs);
+read_packets_send(_S, _RP, []) ->
+ ok.
+
+read_packets_recv(0) ->
+ ok;
+read_packets_recv(N) ->
+ receive
+ _ ->
+ read_packets_recv(N - 1)
+ after 5000 ->
+ timeout
+ end.
+
+read_packets_verify(R, SP, Msg, Trace) ->
+ lists:reverse(
+ lists:sort(read_packets_verify(R, SP, Msg, Trace, 0))).
+
+read_packets_verify(R, SP, Msgs, [{trace,Self,OutIn,_}|Trace], M)
+ when Self =:= self(), OutIn =:= out;
+ Self =:= self(), OutIn =:= in ->
+ push(M, read_packets_verify(R, SP, Msgs, Trace, 0));
+read_packets_verify(R, SP, [Msg|Msgs],
+ [{trace,Self,'receive',{udp,R,{127,0,0,1},SP,Msg}}
+ |Trace], M)
+ when Self =:= self() ->
+ read_packets_verify(R, SP, Msgs, Trace, M+1);
+read_packets_verify(_R, _SP, [], [], M) ->
+ push(M, []);
+read_packets_verify(_R, _SP, Msgs, Trace, M) ->
+ ?t:fail({read_packets_verify,mismatch,Msgs,Trace,M}).
+
+push(0, Vs) ->
+ Vs;
+push(V, Vs) ->
+ [V|Vs].
+
+flush() ->
+ receive
+ X ->
+ [X|flush()]
+ after 200 ->
+ []
+ end.
+
+
+
+open_fd(suite) ->
+ [];
+open_fd(doc) ->
+ ["Test that the 'fd' option works"];
+open_fd(Config) when is_list(Config) ->
+ Msg = "Det g�r ont n�r knoppar brista. Varf�r skulle annars v�ren tveka?",
+ Addr = {127,0,0,1},
+ {ok,S1} = gen_udp:open(0),
+ {ok,P2} = inet:port(S1),
+ {ok,FD} = prim_inet:getfd(S1),
+ {ok,S2} = gen_udp:open(P2, [{fd,FD}]),
+ {ok,S3} = gen_udp:open(0),
+ {ok,P3} = inet:port(S3),
+ ok = gen_udp:send(S3, Addr, P2, Msg),
+ receive
+ {udp,S2,Addr,P3,Msg} ->
+ ok = gen_udp:send(S2,Addr,P3,Msg),
+ receive
+ {udp,S3,Addr,P2,Msg} ->
+ ok
+ after 1000 ->
+ ?t:fail(io_lib:format("~w", [flush()]))
+ end
+ after 1000 ->
+ ?t:fail(io_lib:format("~w", [flush()]))
+ end.
+
+
+%
+% Utils
+%
+start_node(Name) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl
new file mode 100644
index 0000000000..a8c68985e2
--- /dev/null
+++ b/lib/kernel/test/global_SUITE.erl
@@ -0,0 +1,4395 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(global_SUITE).
+
+-compile(r11). % some code is run from r11-nodes
+
+%-define(line_trace, 1).
+
+-export([all/1,
+ names/1, names_hidden/1, locks/1, locks_hidden/1,
+ bad_input/1, names_and_locks/1, lock_die/1, name_die/1,
+ basic_partition/1, basic_name_partition/1,
+ advanced_partition/1, stress_partition/1,
+ ring/1, simple_ring/1, line/1, simple_line/1,
+ global_lost_nodes/1, otp_1849/1,
+ otp_3162/1, otp_5640/1, otp_5737/1,
+ otp_6931/1,
+ simple_disconnect/1,
+ simple_resolve/1, simple_resolve2/1, simple_resolve3/1,
+ leftover_name/1, re_register_name/1, name_exit/1, external_nodes/1,
+ many_nodes/1, sync_0/1,
+ global_groups_change/1,
+ register_1/1,
+ both_known_1/1,
+ lost_unregister/1,
+ mass_death/1,
+ garbage_messages/1]).
+
+-export([global_load/3, lock_global/2, lock_global2/2]).
+
+-export([ttt/1]).
+-export([mass_spawn/1]).
+
+-export([start_tracer/0, stop_tracer/0, get_trace/0]).
+
+-compile(export_all).
+
+-include("test_server.hrl").
+
+-define(NODES, [node()|nodes()]).
+
+-define(UNTIL(Seq), loop_until_true(fun() -> Seq end, Config)).
+
+%% The resource used by the global module.
+-define(GLOBAL_LOCK, global).
+
+ttt(suite) ->
+ [
+%% 5&6: succeeds
+%% 4&5&6: succeeds
+%% 3&4&5&6: succeeds
+%% 1&2&3&6: fails
+%% 1&2&6: succeeds
+%% 3&6: succeeds
+ names, names_hidden, locks, locks_hidden,
+ bad_input,
+ names_and_locks, lock_die, name_die, basic_partition,
+% advanced_partition, basic_name_partition,
+% stress_partition, simple_ring, simple_line,
+ ring].
+
+all(suite) ->
+ case init:get_argument(ring_line) of
+ {ok, _} ->
+ [ring_line];
+ _ ->
+ [names, names_hidden, locks, locks_hidden,
+ bad_input,
+ names_and_locks, lock_die, name_die, basic_partition,
+ advanced_partition, basic_name_partition,
+ stress_partition, simple_ring, simple_line,
+ ring, line, global_lost_nodes, otp_1849,
+ otp_3162, otp_5640, otp_5737, otp_6931,
+ simple_disconnect, simple_resolve, simple_resolve2,
+ simple_resolve3,
+ leftover_name, re_register_name, name_exit,
+ external_nodes, many_nodes, sync_0, global_groups_change,
+ register_1, both_known_1, lost_unregister,
+ mass_death, garbage_messages]
+ end.
+
+-define(TESTCASE, testcase_name).
+-define(testcase, ?config(?TESTCASE, Config)).
+-define(nodes_tag, '$global_nodes').
+-define(registered, ?config(registered, Config)).
+
+init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+ ok = gen_server:call(global_name_server, high_level_trace_start,infinity),
+ [{?TESTCASE, Case}, {registered, registered()} | Config].
+
+fin_per_testcase(_Case, Config) ->
+ ?line write_high_level_trace(Config),
+ ?line _ =
+ gen_server:call(global_name_server, high_level_trace_stop, infinity),
+ ?line[global:unregister_name(N) || N <- global:registered_names(),
+ N =/= test_server],
+ ?line InitRegistered = ?registered,
+ ?line Registered = registered(),
+ ?line [io:format("~s local names: ~p~n", [What, N]) ||
+ {What, N} <- [{"Added", Registered -- InitRegistered},
+ {"Removed", InitRegistered -- Registered}],
+ N =/= []],
+ ok.
+
+%%% General comments:
+%%% One source of problems with failing tests can be that the nodes from the
+%%% previous test haven't died yet.
+%%% So, when stressing a particular test by running it in a loop, it may
+%%% fail already when starting the help nodes, even if the nodes have been
+%%% monitored and the nodedowns picked up at the previous round. Waiting
+%%% a few seconds between rounds seems to solve the problem. Possibly the
+%%% timeout of 7 seconds for connections can also be a problem. This problem
+%%% is the same with old (vsn 3) and new global (vsn 4).
+
+
+%%% Test that register_name/2 registers the name on all nodes, even if
+%%% a new node appears in the middle of the operation (OTP-3552).
+%%%
+%%% Test scenario: process p2 is spawned, locks global, starts a slave node,
+%%% and tells the parent to do register_name. Then p2 sleeps for five seconds
+%%% and releases the lock. Now the name should exist on both our own node
+%%% and on the slave node (we wait until that is true; it seems that we
+%%% can do rpc calls to another node before the connection is really up).
+register_1(suite) -> [];
+register_1(Config) when is_list(Config) ->
+ Timeout = 15,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ P = spawn_link(?MODULE, lock_global, [self(), Config]),
+ receive
+ {P, ok} ->
+ io:format("p1: received ok~n"),
+ ok
+ end,
+ P ! step2,
+ io:format("p1: sent step2~n"),
+ ?line yes = global:register_name(foo, self()),
+ io:format("p1: registered~n"),
+ P ! step3,
+ receive
+ {P, I, I2} ->
+ ok
+ end,
+ if
+ I =:= I2 ->
+ ok;
+ true ->
+ test_server:fail({notsync, I, I2})
+ end,
+ ?line _ = global:unregister_name(foo),
+ write_high_level_trace(Config),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+lock_global(Parent, Config) ->
+ Id = {global, self()},
+ io:format("p2: setting lock~n"),
+ global:set_lock(Id, [node()]),
+ Parent ! {self(), ok},
+ io:format("p2: sent ok~n"),
+ receive
+ step2 ->
+ io:format("p2: received step2"),
+ ok
+ end,
+ io:format("p2: starting slave~n"),
+ {ok, Host} = inet:gethostname(),
+ {ok, N1} = slave:start(Host, node1),
+ io:format("p2: deleting lock~n"),
+ global:del_lock(Id, [node()]),
+ io:format("p2: deleted lock~n"),
+ receive
+ step3 ->
+ ok
+ end,
+ io:format("p2: received step3~n"),
+ I = global:whereis_name(foo),
+ io:format("p2: name ~p~n", [I]),
+ ?line ?UNTIL(I =:= rpc:call(N1, global, whereis_name, [foo])),
+ I2 = I,
+ slave:stop(N1),
+ io:format("p2: name2 ~p~n", [I2]),
+ Parent ! {self(), I, I2},
+ ok.
+
+%%% Test for the OTP-3576 problem: if nodes 1 and 2 are separated and
+%%% brought together again, while keeping connection with 3, it could
+%%% happen that if someone temporarily held the 'global' lock,
+%%% 'try_again_locker' would be called, and this time cause both 1 and 2
+%%% to obtain a lock for 'global' on node 3, which would keep the
+%%% name registry from ever becoming consistent again.
+both_known_1(suite) -> [];
+both_known_1(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+
+ ?line OrigNames = global:registered_names(),
+
+ ?line [Cp1, Cp2, Cp3] = start_nodes([cp1, cp2, cp3], slave, Config),
+
+ ?line wait_for_ready_net(Config),
+
+ ?line rpc_disconnect_node(Cp1, Cp2, Config),
+
+ ?line {_Pid1, yes} = rpc:call(Cp1, ?MODULE, start_proc, [p1]),
+ ?line {_Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [p2]),
+
+ ?line Names10 = rpc:call(Cp1, global, registered_names, []),
+ ?line Names20 = rpc:call(Cp2, global, registered_names, []),
+ ?line Names30 = rpc:call(Cp3, global, registered_names, []),
+
+ Names1 = Names10 -- OrigNames,
+ Names2 = Names20 -- OrigNames,
+ Names3 = Names30 -- OrigNames,
+
+ ?line [p1] = lists:sort(Names1),
+ ?line [p2] = lists:sort(Names2),
+ ?line [p1, p2] = lists:sort(Names3),
+
+ ?line Locker = spawn(Cp3, ?MODULE, lock_global2, [{global, l3},
+ self()]),
+
+ ?line receive
+ {locked, S} ->
+ true = S
+ end,
+
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2]),
+
+ %% Bring cp1 and cp2 together, while someone has locked global.
+ %% They will now loop in 'loop_locker'.
+
+ ?line Names10_2 = rpc:call(Cp1, global, registered_names, []),
+ ?line Names20_2 = rpc:call(Cp2, global, registered_names, []),
+ ?line Names30_2 = rpc:call(Cp3, global, registered_names, []),
+
+ Names1_2 = Names10_2 -- OrigNames,
+ Names2_2 = Names20_2 -- OrigNames,
+ Names3_2 = Names30_2 -- OrigNames,
+
+ ?line [p1] = lists:sort(Names1_2),
+ ?line [p2] = lists:sort(Names2_2),
+ ?line [p1, p2] = lists:sort(Names3_2),
+
+ %% Let go of the lock, and expect the lockers to resolve the name
+ %% registry.
+ Locker ! {ok, self()},
+
+ ?line
+ ?UNTIL(begin
+ ?line Names10_3 = rpc:call(Cp1, global, registered_names, []),
+ ?line Names20_3 = rpc:call(Cp2, global, registered_names, []),
+ ?line Names30_3 = rpc:call(Cp3, global, registered_names, []),
+
+ Names1_3 = Names10_3 -- OrigNames,
+ Names2_3 = Names20_3 -- OrigNames,
+ Names3_3 = Names30_3 -- OrigNames,
+
+ N1 = lists:sort(Names1_3),
+ N2 = lists:sort(Names2_3),
+ N3 = lists:sort(Names3_3),
+ (N1 =:= [p1, p2]) and (N2 =:= [p1, p2]) and (N3 =:= [p1, p2])
+ end),
+
+ write_high_level_trace(Config),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+lost_unregister(suite) -> [];
+lost_unregister(doc) ->
+ ["OTP-6428. An unregistered name reappears."];
+lost_unregister(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+
+ ?line {ok, B} = start_node(b, Config),
+ ?line {ok, C} = start_node(c, Config),
+ Nodes = [node(), B, C],
+
+ ?line wait_for_ready_net(Config),
+
+ % start a proc and register it
+ ?line {Pid, yes} = start_proc(test),
+
+ ?line ?UNTIL(Pid =:= global:whereis_name(test)),
+ ?line check_everywhere(Nodes, test, Config),
+
+ ?line rpc_disconnect_node(B, C, Config),
+ ?line check_everywhere(Nodes, test, Config),
+ ?line _ = rpc:call(B, global, unregister_name, [test]),
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+ ?line Pid = rpc:call(C, global, whereis_name, [test]),
+ ?line check_everywhere(Nodes--[C], test, Config),
+ ?line pong = rpc:call(B, net_adm, ping, [C]),
+
+ %% Now the name has reappeared on node B.
+ ?line ?UNTIL(Pid =:= global:whereis_name(test)),
+ ?line check_everywhere(Nodes, test, Config),
+
+ exit_p(Pid),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+ ?line check_everywhere(Nodes, test, Config),
+
+ write_high_level_trace(Config),
+ stop_node(B),
+ stop_node(C),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+-define(UNTIL_LOOP, 300).
+
+-define(end_tag, 'end at').
+
+init_high_level_trace(Time) ->
+ Mul = try
+ test_server:timetrap_scale_factor()
+ catch _:_ -> 1
+ end,
+ put(?end_tag, msec() + Time * Mul * 1000),
+ %% Assures that started nodes start the high level trace automatically.
+ ok = gen_server:call(global_name_server, high_level_trace_start,infinity),
+ os:putenv("GLOBAL_HIGH_LEVEL_TRACE", "TRUE"),
+ put(?nodes_tag, []).
+
+loop_until_true(Fun, Config) ->
+ case Fun() of
+ true ->
+ true;
+ _ ->
+ case get(?end_tag) of
+ undefined ->
+ timer:sleep(?UNTIL_LOOP),
+ loop_until_true(Fun, Config);
+ EndAt ->
+ Left = EndAt - msec(),
+ case Left < 6000 of
+ true ->
+ write_high_level_trace(Config),
+ Ref = make_ref(),
+ receive Ref -> ok end;
+ false ->
+ timer:sleep(?UNTIL_LOOP),
+ loop_until_true(Fun, Config)
+ end
+ end
+ end.
+
+write_high_level_trace(Config) ->
+ case erase(?nodes_tag) of
+ undefined ->
+ ok;
+ Nodes0 ->
+ Nodes = lists:usort([node() | Nodes0]),
+ write_high_level_trace(Nodes, Config)
+ end.
+
+write_high_level_trace(Nodes, Config) ->
+ When = now(),
+ %% 'info' returns more than the trace, which is nice.
+ Data = [{Node, {info, rpc:call(Node, global, info, [])}} ||
+ Node <- Nodes],
+ Dir = ?config(priv_dir, Config),
+ DataFile = filename:join([Dir, lists:concat(["global_", ?testcase])]),
+ file:write_file(DataFile, term_to_binary({high_level_trace, When, Data})).
+
+lock_global2(Id, Parent) ->
+ S = global:set_lock(Id),
+ Parent ! {locked, S},
+ receive
+ {ok, Parent} ->
+ ok
+ end.
+
+%%-----------------------------------------------------------------
+%% Test suite for global names and locks.
+%% Should be started in a CC view with:
+%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3]
+%%-----------------------------------------------------------------
+
+%cp1 - cp3 are started, and the name 'test' registered for a process on
+%test_server. Then it is checked that the name is registered on all
+%nodes, using whereis_name and safe_whereis_name. Check that the same
+%name can't be registered with another value. Exit the registered
+%process and check that the name disappears. Register a new process
+%(Pid2) under the name 'test'. Let another new process (Pid3)
+%reregister itself under the same name. Test global:send/2. Test
+%unregister. Kill Pid3. Start a process (Pid6) on cp3,
+%register it as 'test', stop cp1 - cp3 and check that 'test' disappeared.
+%Kill Pid2 and check that 'test' isn't registered.
+
+names(suite) -> [];
+names(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line {ok, Cp1} = start_node(cp1, Config),
+ ?line {ok, Cp2} = start_node(cp2, Config),
+ ?line {ok, Cp3} = start_node(cp3, Config),
+
+ ?line wait_for_ready_net(Config),
+
+ % start a proc and register it
+ ?line {Pid, yes} = start_proc(test),
+
+ % test that it is registered at all nodes
+ ?line
+ ?UNTIL(begin
+ (Pid =:= global:safe_whereis_name(test)) and
+ (Pid =:= rpc:call(Cp1, global, safe_whereis_name, [test])) and
+ (Pid =:= rpc:call(Cp2, global, safe_whereis_name, [test])) and
+ (Pid =:= rpc:call(Cp3, global, safe_whereis_name, [test])) and
+ (Pid =:= global:whereis_name(test)) and
+ (Pid =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (Pid =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (Pid =:= rpc:call(Cp3, global, whereis_name, [test])) and
+ ([test] =:= global:registered_names() -- OrigNames)
+ end),
+
+ % try to register the same name
+ ?line no = global:register_name(test, self()),
+ ?line no = rpc:call(Cp1, global, register_name, [test, self()]),
+
+ % let process exit, check that it is unregistered automatically
+ exit_p(Pid),
+
+ ?line
+ ?UNTIL((undefined =:= global:whereis_name(test)) and
+ (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))),
+
+ % test re_register
+ ?line {Pid2, yes} = start_proc(test),
+ ?line ?UNTIL(Pid2 =:= rpc:call(Cp3, global, whereis_name, [test])),
+ Pid3 = rpc:call(Cp3, ?MODULE, start_proc2, [test]),
+ ?line ?UNTIL(Pid3 =:= rpc:call(Cp3, global, whereis_name, [test])),
+ Pid3 = global:whereis_name(test),
+
+ % test sending
+ global:send(test, {ping, self()}),
+ receive
+ {pong, Cp3} -> ok
+ after
+ 2000 -> test_server:fail(timeout1)
+ end,
+
+ rpc:call(Cp1, global, send, [test, {ping, self()}]),
+ receive
+ {pong, Cp3} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+
+ ?line _ = global:unregister_name(test),
+ ?line
+ ?UNTIL((undefined =:= global:whereis_name(test)) and
+ (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))),
+
+ exit_p(Pid3),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+
+ % register a proc
+ ?line {_Pid6, yes} = rpc:call(Cp3, ?MODULE, start_proc, [test]),
+
+ write_high_level_trace(Config),
+ % stop the nodes, and make sure names are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+ exit_p(Pid2),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+names_hidden(suite) -> [];
+names_hidden(doc) ->
+ ["Tests that names on a hidden node doesn't interfere with names on "
+ "visible nodes."];
+names_hidden(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+ ?line OrigNodes = nodes(),
+
+ ?line {ok, Cp1} = start_node(cp1, Config),
+ ?line {ok, Cp2} = start_node(cp2, Config),
+ ?line {ok, Cp3} = start_hidden_node(cp3, Config),
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cp3]),
+ ?line pong = rpc:call(Cp3, net_adm, ping, [Cp2]),
+ ?line pong = rpc:call(Cp3, net_adm, ping, [node()]),
+
+ ?line [] = [Cp1, Cp2 | OrigNodes] -- nodes(),
+
+ % start a proc on hidden node and register it
+ ?line {HPid, yes} = rpc:call(Cp3, ?MODULE, start_proc, [test]),
+ ?line Cp3 = node(HPid),
+
+ % Check that it didn't get registered on visible nodes
+ ?line
+ ?UNTIL((undefined =:= global:safe_whereis_name(test)) and
+ (undefined =:= rpc:call(Cp1, global, safe_whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp2, global, safe_whereis_name, [test])) and
+ (undefined =:= global:whereis_name(test)) and
+ (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp2, global, whereis_name, [test]))),
+
+ % start a proc on visible node and register it
+ ?line {Pid, yes} = start_proc(test),
+ ?line true = (Pid =/= HPid),
+
+ % test that it is registered at all nodes
+ ?line
+ ?UNTIL((Pid =:= global:safe_whereis_name(test)) and
+ (Pid =:= rpc:call(Cp1, global, safe_whereis_name, [test])) and
+ (Pid =:= rpc:call(Cp2, global, safe_whereis_name, [test])) and
+ (HPid =:= rpc:call(Cp3, global, safe_whereis_name, [test])) and
+ (Pid =:= global:whereis_name(test)) and
+ (Pid =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (Pid =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (HPid =:= rpc:call(Cp3, global, whereis_name, [test])) and
+ ([test] =:= global:registered_names() -- OrigNames)),
+
+ % try to register the same name
+ ?line no = global:register_name(test, self()),
+ ?line no = rpc:call(Cp1, global, register_name, [test, self()]),
+
+ % let process exit, check that it is unregistered automatically
+ exit_p(Pid),
+
+ ?line
+ ?UNTIL((undefined =:= global:whereis_name(test)) and
+ (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (HPid =:= rpc:call(Cp3, global, whereis_name, [test]))),
+
+ % test re_register
+ ?line {Pid2, yes} = start_proc(test),
+ ?line ?UNTIL(Pid2 =:= rpc:call(Cp2, global, whereis_name, [test])),
+ Pid3 = rpc:call(Cp2, ?MODULE, start_proc2, [test]),
+ ?line ?UNTIL(Pid3 =:= rpc:call(Cp2, global, whereis_name, [test])),
+ ?line Pid3 = global:whereis_name(test),
+
+ % test sending
+ ?line Pid3 = global:send(test, {ping, self()}),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout1)
+ end,
+
+ rpc:call(Cp1, global, send, [test, {ping, self()}]),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+
+ ?line _ = rpc:call(Cp3, global, unregister_name, [test]),
+ ?line
+ ?UNTIL((Pid3 =:= global:whereis_name(test)) and
+ (Pid3 =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (Pid3 =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))),
+
+ ?line _ = global:unregister_name(test),
+ ?line
+ ?UNTIL((undefined =:= global:whereis_name(test)) and
+ (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))),
+
+ exit_p(Pid3),
+ exit_p(HPid),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+
+ write_high_level_trace(Config),
+ % stop the nodes, and make sure names are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+locks(suite) -> [];
+locks(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line {ok, Cp1} = start_node(cp1, Config),
+ ?line {ok, Cp2} = start_node(cp2, Config),
+ ?line {ok, Cp3} = start_node(cp3, Config),
+
+ ?line wait_for_ready_net(Config),
+
+ % start two procs
+ ?line Pid = start_proc(),
+ ?line Pid2 = rpc:call(Cp1, ?MODULE, start_proc, []),
+ % set a lock, and make sure noone else can set the same lock
+ ?line true = global:set_lock({test_lock, self()}, ?NODES, 1),
+ ?line false = req(Pid, {set_lock, test_lock, self()}),
+ ?line false = req(Pid2, {set_lock, test_lock, self()}),
+ % delete, and let another proc set the lock
+ global:del_lock({test_lock, self()}),
+ ?line true = req(Pid, {set_lock, test_lock, self()}),
+ ?line false = req(Pid2, {set_lock, test_lock, self()}),
+ ?line false = global:set_lock({test_lock, self()}, ?NODES,1),
+ % kill lock-holding proc, make sure the lock is released
+ exit_p(Pid),
+ ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES,1)),
+ Pid2 ! {set_lock_loop, test_lock, self()},
+ % make sure we don't have the msg
+ receive
+ {got_lock, Pid2} -> test_server:fail(got_lock)
+ after
+ 1000 -> ok
+ end,
+ global:del_lock({test_lock, self()}),
+ % make sure pid2 got the lock
+ receive
+ {got_lock, Pid2} -> ok
+ after
+ % 12000 >> 5000, which is the max time before a new retry for
+ % set_lock
+ 12000 -> test_server:fail(got_lock2)
+ end,
+
+ % let proc set the same lock
+ ?line true = req(Pid2, {set_lock, test_lock, self()}),
+ % let proc set new lock
+ ?line true = req(Pid2, {set_lock, test_lock2, self()}),
+ ?line false = global:set_lock({test_lock, self()},?NODES,1),
+ ?line false = global:set_lock({test_lock2, self()}, ?NODES,1),
+ exit_p(Pid2),
+% erlang:display({locks1, ets:tab2list(global_locks)}),
+ ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES, 1)),
+ ?UNTIL(true =:= global:set_lock({test_lock2, self()}, ?NODES, 1)),
+ ?line global:del_lock({test_lock, self()}),
+ ?line global:del_lock({test_lock2, self()}),
+
+ % let proc set two locks
+ ?line Pid3 = rpc:call(Cp1, ?MODULE, start_proc, []),
+ ?line true = req(Pid3, {set_lock, test_lock, self()}),
+ ?line true = req(Pid3, {set_lock, test_lock2, self()}),
+ % del one lock
+ ?line Pid3 ! {del_lock, test_lock2},
+ ?line test_server:sleep(100),
+ % check that one lock is still set, but not the other
+ ?line false = global:set_lock({test_lock, self()}, ?NODES, 1),
+ ?line true = global:set_lock({test_lock2, self()}, ?NODES, 1),
+ ?line global:del_lock({test_lock2, self()}),
+ % kill lock-holder
+ exit_p(Pid3),
+% erlang:display({locks2, ets:tab2list(global_locks)}),
+ ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES, 1)),
+ ?line global:del_lock({test_lock, self()}),
+ ?UNTIL(true =:= global:set_lock({test_lock2, self()}, ?NODES, 1)),
+ ?line global:del_lock({test_lock2, self()}),
+
+ % start one proc on each node
+ ?line Pid4 = start_proc(),
+ ?line Pid5 = rpc:call(Cp1, ?MODULE, start_proc, []),
+ ?line Pid6 = rpc:call(Cp2, ?MODULE, start_proc, []),
+ ?line Pid7 = rpc:call(Cp3, ?MODULE, start_proc, []),
+ % set lock on two nodes
+ ?line true = req(Pid4, {set_lock, test_lock, self(), [node(), Cp1]}),
+ ?line false = req(Pid5, {set_lock, test_lock, self(), [node(), Cp1]}),
+ % set same lock on other two nodes
+ ?line true = req(Pid6, {set_lock, test_lock, self(), [Cp2, Cp3]}),
+ ?line false = req(Pid7, {set_lock, test_lock, self(), [Cp2, Cp3]}),
+ % release lock
+ Pid6 ! {del_lock, test_lock, [Cp2, Cp3]},
+ % try to set lock on a node that already has the lock
+ ?line false = req(Pid6, {set_lock, test_lock, self(), [Cp1, Cp2, Cp3]}),
+
+ % set lock on a node
+ exit_p(Pid4),
+ ?UNTIL(true =:= req(Pid5, {set_lock, test_lock, self(), [node(), Cp1]})),
+ ?line Pid8 = start_proc(),
+ ?line false = req(Pid8, {set_lock, test_lock, self()}),
+ write_high_level_trace(Config),
+ % stop the nodes, and make sure locks are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ ?line test_server:sleep(100),
+ ?line true = req(Pid8, {set_lock, test_lock, self()}),
+ exit_p(Pid8),
+ ?line test_server:sleep(10),
+
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+locks_hidden(suite) -> [];
+locks_hidden(doc) ->
+ ["Tests that locks on a hidden node doesn't interere with locks on "
+ "visible nodes."];
+locks_hidden(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNodes = nodes(),
+ ?line {ok, Cp1} = start_node(cp1, Config),
+ ?line {ok, Cp2} = start_node(cp2, Config),
+ ?line {ok, Cp3} = start_hidden_node(cp3, Config),
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cp3]),
+ ?line pong = rpc:call(Cp3, net_adm, ping, [Cp2]),
+ ?line pong = rpc:call(Cp3, net_adm, ping, [node()]),
+
+ ?line [] = [Cp1, Cp2 | OrigNodes] -- nodes(),
+
+ % start two procs
+ ?line Pid = start_proc(),
+ ?line Pid2 = rpc:call(Cp1, ?MODULE, start_proc, []),
+ ?line HPid = rpc:call(Cp3, ?MODULE, start_proc, []),
+ % Make sure hidden node doesn't interfere with visible nodes lock
+ ?line true = req(HPid, {set_lock, test_lock, self()}),
+ ?line true = global:set_lock({test_lock, self()}, ?NODES, 1),
+ ?line false = req(Pid, {set_lock, test_lock, self()}),
+ ?line true = req(HPid, {del_lock_sync, test_lock, self()}),
+ ?line false = req(Pid2, {set_lock, test_lock, self()}),
+ % delete, and let another proc set the lock
+ global:del_lock({test_lock, self()}),
+ ?line true = req(Pid, {set_lock, test_lock, self()}),
+ ?line false = req(Pid2, {set_lock, test_lock, self()}),
+ ?line false = global:set_lock({test_lock, self()}, ?NODES,1),
+ % kill lock-holding proc, make sure the lock is released
+ exit_p(Pid),
+ ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES, 1)),
+ ?UNTIL(true =:= req(HPid, {set_lock, test_lock, self()})),
+ Pid2 ! {set_lock_loop, test_lock, self()},
+ % make sure we don't have the msg
+ receive
+ {got_lock, Pid2} -> test_server:fail(got_lock)
+ after
+ 1000 -> ok
+ end,
+ global:del_lock({test_lock, self()}),
+ % make sure pid2 got the lock
+ receive
+ {got_lock, Pid2} -> ok
+ after
+ % 12000 >> 5000, which is the max time before a new retry for
+ % set_lock
+ 12000 -> test_server:fail(got_lock2)
+ end,
+ ?line true = req(HPid, {del_lock_sync, test_lock, self()}),
+
+ % let proc set the same lock
+ ?line true = req(Pid2, {set_lock, test_lock, self()}),
+ % let proc set new lock
+ ?line true = req(Pid2, {set_lock, test_lock2, self()}),
+ ?line true = req(HPid, {set_lock, test_lock, self()}),
+ ?line true = req(HPid, {set_lock, test_lock2, self()}),
+ exit_p(HPid),
+ ?line false = global:set_lock({test_lock, self()},?NODES,1),
+ ?line false = global:set_lock({test_lock2, self()}, ?NODES,1),
+ exit_p(Pid2),
+% erlang:display({locks1, ets:tab2list(global_locks)}),
+ ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES, 1)),
+ ?UNTIL(true =:= global:set_lock({test_lock2, self()}, ?NODES, 1)),
+ ?line global:del_lock({test_lock, self()}),
+ ?line global:del_lock({test_lock2, self()}),
+
+ write_high_level_trace(Config),
+ % stop the nodes, and make sure locks are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+bad_input(suite) -> [];
+bad_input(Config) when is_list(Config) ->
+ Timeout = 15,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ Pid = whereis(global_name_server),
+ ?line {'EXIT', _} = (catch global:set_lock(bad_id)),
+ ?line {'EXIT', _} = (catch global:set_lock({id, self()}, bad_nodes)),
+ ?line {'EXIT', _} = (catch global:del_lock(bad_id)),
+ ?line {'EXIT', _} = (catch global:del_lock({id, self()}, bad_nodes)),
+ ?line {'EXIT', _} = (catch global:register_name(name, bad_pid)),
+ ?line {'EXIT', _} = (catch global:reregister_name(name, bad_pid)),
+ ?line {'EXIT', _} = (catch global:trans(bad_id, {m,f})),
+ ?line {'EXIT', _} = (catch global:trans({id, self()}, {m,f}, [node()], -1)),
+ ?line Pid = whereis(global_name_server),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+names_and_locks(suite) -> [];
+names_and_locks(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line {ok, Cp1} = start_node(cp1, Config),
+ ?line {ok, Cp2} = start_node(cp2, Config),
+ ?line {ok, Cp3} = start_node(cp3, Config),
+
+ % start one proc on each node
+ ?line PidTS = start_proc(),
+ ?line Pid1 = rpc:call(Cp1, ?MODULE, start_proc, []),
+ ?line Pid2 = rpc:call(Cp2, ?MODULE, start_proc, []),
+ ?line Pid3 = rpc:call(Cp3, ?MODULE, start_proc, []),
+ % register some of them
+ ?line yes = global:register_name(test1, Pid1),
+ ?line yes = global:register_name(test2, Pid2),
+ ?line yes = global:register_name(test3, Pid3),
+ ?line no = global:register_name(test3, PidTS),
+ ?line yes = global:register_name(test4, PidTS),
+
+ % set lock on two nodes
+ ?line true = req(PidTS, {set_lock, test_lock, self(), [node(), Cp1]}),
+ ?line false = req(Pid1, {set_lock, test_lock, self(), [node(), Cp1]}),
+ % set same lock on other two nodes
+ ?line true = req(Pid2, {set_lock, test_lock, self(), [Cp2, Cp3]}),
+ ?line false = req(Pid3, {set_lock, test_lock, self(), [Cp2, Cp3]}),
+ % release lock
+ Pid2 ! {del_lock, test_lock, [Cp2, Cp3]},
+ ?line test_server:sleep(100),
+ % try to set lock on a node that already has the lock
+ ?line false = req(Pid2, {set_lock, test_lock, self(), [Cp1, Cp2, Cp3]}),
+ % set two locks
+ ?line true = req(Pid2, {set_lock, test_lock, self(), [Cp2, Cp3]}),
+ ?line true = req(Pid2, {set_lock, test_lock2, self(), [Cp2, Cp3]}),
+
+ % kill some processes, make sure all locks/names are released
+ exit_p(PidTS),
+ ?line ?UNTIL(undefined =:= global:whereis_name(test4)),
+ ?line true = global:set_lock({test_lock, self()}, [node(), Cp1], 1),
+ global:del_lock({test_lock, self()}, [node(), Cp1]),
+
+ exit_p(Pid2),
+ ?line
+ ?UNTIL((undefined =:= global:whereis_name(test2)) and
+ (true =:= global:set_lock({test_lock, self()}, [Cp2, Cp3], 1)) and
+ (true =:= global:set_lock({test_lock2, self()}, [Cp2, Cp3], 1))),
+
+ global:del_lock({test_lock, self()}, [Cp2, Cp3]),
+ global:del_lock({test_lock2, self()}, [Cp2, Cp3]),
+
+ exit_p(Pid1),
+ exit_p(Pid3),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+lock_die(suite) -> [];
+lock_die(doc) ->
+ ["OTP-6341. Remove locks using monitors."];
+lock_die(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line {ok, Cp1} = start_node(cp1, Config),
+ ?line {ok, Cp2} = start_node(cp2, Config),
+
+ %% First test.
+ LockId = {id, self()},
+ ?line Pid2 = start_proc(),
+ ?line true = req(Pid2, {set_lock2, LockId, self()}),
+
+ ?line true = global:set_lock(LockId, [Cp1]),
+ %% Id is locked on Cp1 and Cp2 (by Pid2) but not by self():
+ %% (there is no mon. ref)
+ ?line _ = global:del_lock(LockId, [node(), Cp1, Cp2]),
+
+ ?line exit_p(Pid2),
+
+ %% Second test.
+ ?line Pid3 = start_proc(),
+ ?line true = req(Pid3, {set_lock, id, self(), [Cp1]}),
+ %% The lock is removed from Cp1 thanks to monitors.
+ ?line exit_p(Pid3),
+
+ ?line true = global:set_lock(LockId, [node(), Cp1]),
+ ?line _ = global:del_lock(LockId, [node(), Cp1]),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+ write_high_level_trace(Config),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+name_die(suite) -> [];
+name_die(doc) ->
+ ["OTP-6341. Remove names using monitors."];
+name_die(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+ ?line [Cp1] = Cps = start_nodes([z], peer, Config), % z > test_server
+ Nodes = lists:sort([node() | Cps]),
+ ?line wait_for_ready_net(Config),
+
+ Name = name_die,
+ ?line Pid = rpc:call(Cp1, ?MODULE, start_proc, []),
+
+ %% Test 1. No resolver is called if the same pid is registered on
+ %% both partitions.
+ T1 = node(),
+ Part1 = [T1],
+ Part2 = [Cp1],
+ ?line rpc_cast(Cp1,
+ ?MODULE, part_2_2, [Config,
+ Part1,
+ Part2,
+ []]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+ ?line ?UNTIL(undefined =:= global:whereis_name(Name)),
+ ?line yes = global:register_name(Name, Pid),
+
+ ?line pong = net_adm:ping(Cp1),
+ ?line wait_for_ready_net(Nodes, Config),
+ ?line assert_pid(global:whereis_name(Name)),
+ exit_p(Pid),
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ %% Test 2. Register a name running outside the current partition.
+ %% Killing the pid will not remove the name from the current
+ %% partition, unless monitors are used.
+ ?line Pid2 = rpc:call(Cp1, ?MODULE, start_proc, []),
+ Dir = ?config(priv_dir, Config),
+ KillFile = filename:join([Dir, "kill.txt"]),
+ file:delete(KillFile),
+ ?line erlang:spawn(Cp1, fun() -> kill_pid(Pid2, KillFile, Config) end),
+ ?line rpc_cast(Cp1,
+ ?MODULE, part_2_2, [Config,
+ Part1,
+ Part2,
+ []]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+ ?line ?UNTIL(undefined =:= global:whereis_name(Name)),
+ ?line yes = global:register_name(Name, Pid2),
+ ?line touch(KillFile, "kill"),
+ ?line file_contents(KillFile, "done", Config),
+ file:delete(KillFile),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+ write_high_level_trace(Config),
+ stop_nodes(Cps),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+kill_pid(Pid, File, Config) ->
+ file_contents(File, "kill", Config),
+ exit_p(Pid),
+ touch(File, "done").
+
+basic_partition(suite) -> [];
+basic_partition(doc) ->
+ ["Tests that two partitioned networks exchange correct info."];
+basic_partition(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [Cp1, Cp2, Cp3] = start_nodes([cp1, cp2, cp3], peer, Config),
+ ?line [Cp1, Cp2, Cp3] = lists:sort(nodes()),
+
+ ?line wait_for_ready_net(Config),
+
+ % make cp2 and cp3 connected, partitioned from us and cp1
+ ?line rpc_cast(Cp2, ?MODULE, part1, [Config, node(), Cp1, Cp3]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+
+ % start different processes in both partitions
+ ?line {Pid, yes} = start_proc(test),
+
+ % connect to other partition
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line [Cp1, Cp2, Cp3] = lists:sort(nodes()),
+
+ % check names
+ ?line ?UNTIL(Pid =:= rpc:call(Cp2, global, whereis_name, [test])),
+ ?line ?UNTIL(undefined =/= global:whereis_name(test2)),
+ ?line Pid2 = global:whereis_name(test2),
+ ?line Pid2 = rpc:call(Cp2, global, whereis_name, [test2]),
+ ?line assert_pid(Pid2),
+ ?line Pid3 = global:whereis_name(test4),
+ ?line ?UNTIL(Pid3 =:= rpc:call(Cp1, global, whereis_name, [test4])),
+ ?line assert_pid(Pid3),
+
+ % kill all procs
+ ?line Pid3 = global:send(test4, die),
+ % sleep to let the proc die
+ wait_for_exit(Pid3),
+ ?line ?UNTIL(undefined =:= global:whereis_name(test4)),
+
+ exit_p(Pid),
+ exit_p(Pid2),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+basic_name_partition(suite) ->
+ [];
+basic_name_partition(doc) ->
+ ["Creates two partitions with two nodes in each partition.",
+ "Tests that names are exchanged correctly, and that EXITs",
+ "during connect phase are handled correctly."];
+basic_name_partition(Config) when is_list(Config) ->
+ Timeout = 60,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [Cp1, Cp2, Cp3] = start_nodes([cp1, cp2, cp3], peer, Config),
+ ?line [Cp1, Cp2, Cp3] = lists:sort(nodes()),
+ Nodes = ?NODES,
+
+ ?line wait_for_ready_net(Config),
+
+ % There used to be more than one name registered for some
+ % processes. That was a mistake; there is no support for more than
+ % one name per process, and the manual is quite clear about that
+ % ("equivalent to the register/2 and whereis/1 BIFs"). The
+ % resolver procedure did not take care of such "duplicated" names,
+ % which caused this testcase to fail every now and then.
+
+ % make cp2 and cp3 connected, partitioned from us and cp1
+ % us: register name03
+ % cp1: register name12
+ % cp2: register name12
+ % cp3: register name03
+
+ ?line rpc_cast(Cp2, ?MODULE, part1_5, [Config, node(), Cp1, Cp3]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+
+ % start different processes in both partitions
+ ?line {_, yes} = start_proc_basic(name03),
+ ?line {_, yes} = rpc:call(Cp1, ?MODULE, start_proc_basic, [name12]),
+ test_server:sleep(1000),
+
+ % connect to other partition
+ ?line pong = net_adm:ping(Cp3),
+
+ ?line ?UNTIL([Cp1, Cp2, Cp3] =:= lists:sort(nodes())),
+ ?line wait_for_ready_net(Config),
+ % check names
+ ?line Pid03 = global:whereis_name(name03),
+ ?line assert_pid(Pid03),
+ ?line true = lists:member(node(Pid03), [node(), Cp3]),
+ ?line check_everywhere(Nodes, name03, Config),
+
+ ?line Pid12 = global:whereis_name(name12),
+ ?line assert_pid(Pid12),
+ ?line true = lists:member(node(Pid12), [Cp1, Cp2]),
+ ?line check_everywhere(Nodes, name12, Config),
+
+ % kill all procs
+ ?line Pid12 = global:send(name12, die),
+ ?line Pid03 = global:send(name03, die),
+ % sleep to let the procs die
+ wait_for_exit(Pid12),
+ wait_for_exit(Pid03),
+ ?line
+ ?UNTIL(begin
+ Names = [name03, name12],
+ lists:duplicate(length(Names), undefined)
+ =:= [global:whereis_name(Name) || Name <- Names]
+ end),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%Peer nodes cp0 - cp6 are started. Break apart the connections from
+%cp3-cp6 to cp0-cp2 and test_server so we get two partitions.
+%In the cp3-cp6 partition, start one process on each node and register
+%using both erlang:register, and global:register (test1 on cp3, test2 on
+%cp4, test3 on cp5, test4 on cp6), using different resolution functions:
+%default for test1, notify_all_name for test2, random_notify_name for test3
+%and one for test4 that sends a message to test_server and keeps the
+%process which is greater in the standard ordering. In the other partition,
+%do the same (test1 on test_server, test2 on cp0, test3 on cp1, test4 on cp2).
+%Sleep a little, then from test_server, connect to cp3-cp6 in order.
+%Check that the values for the registered names are the expected ones, and
+%that the messages from test4 arrive.
+
+advanced_partition(suite) ->
+ [];
+advanced_partition(doc) ->
+ ["Test that names are resolved correctly when two",
+ "partitioned networks connect."];
+advanced_partition(Config) when is_list(Config) ->
+ Timeout = 60,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6]
+ = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5, cp6], peer, Config),
+ Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6]),
+ ?line wait_for_ready_net(Config),
+
+ % make cp3-cp6 connected, partitioned from us and cp0-cp2
+ ?line rpc_cast(Cp3, ?MODULE, part2,
+ [Config, self(), node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5,Cp6]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+
+ % start different processes in this partition
+ ?line start_procs(self(), Cp0, Cp1, Cp2, Config),
+
+ % connect to other partition
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+ ?line pong = net_adm:ping(Cp6),
+
+ ?line wait_for_ready_net(Config),
+
+ ?line
+ ?UNTIL(lists:member(undefined,
+ [rpc:call(Cp3, erlang, whereis, [test1]),
+ rpc:call(node(), erlang, whereis, [test1])])),
+
+ Nt1 = rpc:call(Cp3, erlang, whereis, [test1]),
+ Nt2 = rpc:call(Cp4, erlang, whereis, [test2]),
+ Nt3 = rpc:call(Cp5, erlang, whereis, [test3]),
+ Nt4 = rpc:call(Cp6, erlang, whereis, [test4]),
+
+ Mt1 = rpc:call(node(), erlang, whereis, [test1]),
+ Mt2 = rpc:call(Cp0, erlang, whereis, [test2]),
+ Mt3 = rpc:call(Cp1, erlang, whereis, [test3]),
+ _Mt4 = rpc:call(Cp2, erlang, whereis, [test4]),
+
+ % check names
+ ?line Pid1 = global:whereis_name(test1),
+ ?line Pid1 = rpc:call(Cp3, global, whereis_name, [test1]),
+ ?line assert_pid(Pid1),
+ ?line true = lists:member(Pid1, [Nt1, Mt1]),
+ ?line true = lists:member(undefined, [Nt1, Mt1]),
+ ?line check_everywhere(Nodes, test1, Config),
+
+ ?line undefined = global:whereis_name(test2),
+ ?line undefined = rpc:call(Cp3, global, whereis_name, [test2]),
+ ?line yes = sreq(Nt2, {got_notify, self()}),
+ ?line yes = sreq(Mt2, {got_notify, self()}),
+ ?line check_everywhere(Nodes, test2, Config),
+
+ ?line Pid3 = global:whereis_name(test3),
+ ?line Pid3 = rpc:call(Cp3, global, whereis_name, [test3]),
+ ?line assert_pid(Pid3),
+ ?line true = lists:member(Pid3, [Nt3, Mt3]),
+ ?line no = sreq(Pid3, {got_notify, self()}),
+ ?line yes = sreq(other(Pid3, [Nt2, Nt3]), {got_notify, self()}),
+ ?line check_everywhere(Nodes, test3, Config),
+
+ ?line Pid4 = global:whereis_name(test4),
+ ?line Pid4 = rpc:call(Cp3, global, whereis_name, [test4]),
+ ?line assert_pid(Pid4),
+% ?line true = lists:member(Pid4, [Nt4, Mt4]),
+ ?line Pid4 = Nt4,
+ ?line check_everywhere(Nodes, test4, Config),
+
+ ?line 1 = collect_resolves(),
+
+ ?line Pid1 = global:send(test1, die),
+ exit_p(Pid3),
+ exit_p(Pid4),
+ wait_for_exit(Pid1),
+ wait_for_exit(Pid3),
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp0),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cp4),
+ stop_node(Cp5),
+ stop_node(Cp6),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%Peer nodes cp0 - cp6 are started, and partitioned just like in
+%advanced_partition. Start cp8, only connected to test_server. Let cp6
+%break apart from the rest, and 12 s later, ping cp0 and cp3, and
+%register the name test5. After the same 12 s, let cp5 halt.
+%Wait for the death of cp5. Ping cp3 (at the same time as cp6 does).
+%Take down cp2. Start cp7, restart cp2. Ping cp4, cp6 and cp8.
+%Now, expect all nodes to be connected and have the same picture of all
+%registered names.
+
+stress_partition(suite) ->
+ [];
+stress_partition(doc) ->
+ ["Stress global, make a partitioned net, make some nodes",
+ "go up/down a bit."];
+stress_partition(Config) when is_list(Config) ->
+ Timeout = 90,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6]
+ = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5, cp6], peer, Config),
+
+ ?line wait_for_ready_net(Config),
+
+ % make cp3-cp5 connected, partitioned from us and cp0-cp2
+ % cp6 is alone (single node). cp6 pings cp0 and cp3 in 12 secs...
+ ?line rpc_cast(Cp3, ?MODULE, part3,
+ [Config, self(), node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5,Cp6]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+
+ % start different processes in this partition
+ ?line start_procs(self(), Cp0, Cp1, Cp2, Config),
+
+ ?line {ok, Cp8} = start_peer_node(cp8, Config),
+
+ monitor_node(Cp5, true),
+ receive
+ {nodedown, Cp5} -> ok
+ after
+ 20000 -> test_server:fail({no_nodedown, Cp5})
+ end,
+ monitor_node(Cp5, false),
+
+ % Ok, now cp6 pings us, and cp5 will go down.
+
+ % connect to other partition
+ ?line pong = net_adm:ping(Cp3),
+ ?line rpc_cast(Cp2, ?MODULE, crash, [0]),
+
+ % Start new nodes
+ ?line {ok, Cp7} = start_peer_node(cp7, Config),
+ ?line {ok, Cp2_2} = start_peer_node(cp2, Config),
+ Nodes = lists:sort([node(), Cp0, Cp1, Cp2_2, Cp3, Cp4, Cp6, Cp7, Cp8]),
+ put(?nodes_tag, Nodes),
+
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp6),
+ ?line pong = net_adm:ping(Cp8),
+
+ ?line wait_for_ready_net(Nodes, Config),
+
+ % Make sure that all nodes have the same picture of all names
+ ?line check_everywhere(Nodes, test1, Config),
+ ?line assert_pid(global:whereis_name(test1)),
+
+ ?line check_everywhere(Nodes, test2, Config),
+ ?line undefined = global:whereis_name(test2),
+
+ ?line check_everywhere(Nodes, test3, Config),
+ ?line assert_pid(global:whereis_name(test3)),
+
+ ?line check_everywhere(Nodes, test4, Config),
+ ?line assert_pid(global:whereis_name(test4)),
+
+ ?line check_everywhere(Nodes, test5, Config),
+ ?line ?UNTIL(undefined =:= global:whereis_name(test5)),
+
+ ?line assert_pid(global:send(test1, die)),
+ ?line assert_pid(global:send(test3, die)),
+ ?line assert_pid(global:send(test4, die)),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp0),
+ stop_node(Cp1),
+ stop_node(Cp2_2),
+ stop_node(Cp3),
+ stop_node(Cp4),
+ stop_node(Cp5),
+ stop_node(Cp6),
+ stop_node(Cp7),
+ stop_node(Cp8),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+%% Use this one to test alot of connection tests
+%% erl -sname ts -rsh ctrsh -pa /clearcase/otp/internal_tools/test_server/ebin/ -ring_line 10000 -s test_server run_test global_SUITE
+
+ring_line(suite) -> [];
+ring_line(doc) -> [""];
+ring_line(Config) when is_list(Config) ->
+ {ok, [[N]]} = init:get_argument(ring_line),
+ loop_it(list_to_integer(N), Config).
+
+loop_it(N, Config) -> loop_it(N,N, Config).
+
+loop_it(0,_, _Config) -> ok;
+loop_it(N,M, Config) ->
+ test_server:format(1, "Round: ~w", [M-N]),
+ ring(Config),
+ line(Config),
+ loop_it(N-1,M, Config).
+
+
+ring(suite) ->
+ [];
+ring(doc) ->
+ ["Make 10 single nodes, all having the same name.",
+ "Make all ping its predecessor, pinging in a ring.",
+ "Make sure that there's just one winner."];
+ring(Config) when is_list(Config) ->
+ Timeout = 60,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6, Cp7, Cp8]
+ = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5, cp6, cp7, cp8],
+ peer, Config),
+ Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6, Cp7, Cp8]),
+
+ ?line wait_for_ready_net(Config),
+
+ Time = msec() + 7000,
+
+ ?line rpc_cast(Cp0, ?MODULE, single_node, [Time, Cp8, Config]),
+ ?line rpc_cast(Cp1, ?MODULE, single_node, [Time, Cp0, Config]),
+ ?line rpc_cast(Cp2, ?MODULE, single_node, [Time, Cp1, Config]),
+ ?line rpc_cast(Cp3, ?MODULE, single_node, [Time, Cp2, Config]),
+ ?line rpc_cast(Cp4, ?MODULE, single_node, [Time, Cp3, Config]),
+ ?line rpc_cast(Cp5, ?MODULE, single_node, [Time, Cp4, Config]),
+ ?line rpc_cast(Cp6, ?MODULE, single_node, [Time, Cp5, Config]),
+ ?line rpc_cast(Cp7, ?MODULE, single_node, [Time, Cp6, Config]),
+ ?line rpc_cast(Cp8, ?MODULE, single_node, [Time, Cp7, Config]),
+
+ % sleep to make the partitioned net ready
+ test_server:sleep(Time - msec()),
+
+ ?line pong = net_adm:ping(Cp0),
+ ?line pong = net_adm:ping(Cp1),
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+ ?line pong = net_adm:ping(Cp6),
+ ?line pong = net_adm:ping(Cp7),
+ ?line pong = net_adm:ping(Cp8),
+
+ ?line pong = net_adm:ping(Cp0),
+ ?line pong = net_adm:ping(Cp1),
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+ ?line pong = net_adm:ping(Cp6),
+ ?line pong = net_adm:ping(Cp7),
+ ?line pong = net_adm:ping(Cp8),
+
+ ?line wait_for_ready_net(Nodes, Config),
+
+ % Just make sure that all nodes have the same picture of all names
+ ?line check_everywhere(Nodes, single_name, Config),
+ ?line assert_pid(global:whereis_name(single_name)),
+
+ ?line
+ ?UNTIL(begin
+ {Ns2, []} = rpc:multicall(Nodes, erlang, whereis,
+ [single_name]),
+ 9 =:= lists:foldl(fun(undefined, N) -> N + 1;
+ (_, N) -> N
+ end,
+ 0, Ns2)
+ end),
+
+ ?line assert_pid(global:send(single_name, die)),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp0),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cp4),
+ stop_node(Cp5),
+ stop_node(Cp6),
+ stop_node(Cp7),
+ stop_node(Cp8),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+simple_ring(suite) ->
+ [];
+simple_ring(doc) ->
+ ["Simpler version of the ring case. Used because there are some",
+ "distribution problems with many nodes.",
+ "Make 6 single nodes, all having the same name.",
+ "Make all ping its predecessor, pinging in a ring.",
+ "Make sure that there's just one winner."];
+simple_ring(Config) when is_list(Config) ->
+ Timeout = 60,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ Names = [cp0, cp1, cp2, cp3, cp4, cp5],
+ ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5]
+ = start_nodes(Names, peer, Config),
+ Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5]),
+
+ ?line wait_for_ready_net(Config),
+
+ Time = msec() + 5000,
+
+ ?line rpc_cast(Cp0, ?MODULE, single_node, [Time, Cp5, Config]),
+ ?line rpc_cast(Cp1, ?MODULE, single_node, [Time, Cp0, Config]),
+ ?line rpc_cast(Cp2, ?MODULE, single_node, [Time, Cp1, Config]),
+ ?line rpc_cast(Cp3, ?MODULE, single_node, [Time, Cp2, Config]),
+ ?line rpc_cast(Cp4, ?MODULE, single_node, [Time, Cp3, Config]),
+ ?line rpc_cast(Cp5, ?MODULE, single_node, [Time, Cp4, Config]),
+
+ % sleep to make the partitioned net ready
+ test_server:sleep(Time - msec()),
+
+ ?line pong = net_adm:ping(Cp0),
+ ?line pong = net_adm:ping(Cp1),
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+
+ ?line pong = net_adm:ping(Cp0),
+ ?line pong = net_adm:ping(Cp1),
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+
+ ?line wait_for_ready_net(Nodes, Config),
+
+ % Just make sure that all nodes have the same picture of all names
+ ?line check_everywhere(Nodes, single_name, Config),
+ ?line assert_pid(global:whereis_name(single_name)),
+
+ ?line
+ ?UNTIL(begin
+ {Ns2, []} = rpc:multicall(Nodes, erlang, whereis,
+ [single_name]),
+ 6 =:= lists:foldl(fun(undefined, N) -> N + 1;
+ (_, N) -> N
+ end,
+ 0, Ns2)
+ end),
+
+ ?line assert_pid(global:send(single_name, die)),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp0),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cp4),
+ stop_node(Cp5),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+line(suite) ->
+ [];
+line(doc) ->
+ ["Make 6 single nodes, all having the same name.",
+ "Make all ping its predecessor, pinging in a line.",
+ "Make sure that there's just one winner."];
+line(Config) when is_list(Config) ->
+ Timeout = 60,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6, Cp7, Cp8]
+ = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5, cp6, cp7, cp8],
+ peer, Config),
+ Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6, Cp7, Cp8]),
+
+ ?line wait_for_ready_net(Config),
+
+ Time = msec() + 7000,
+
+ ?line rpc_cast(Cp0, ?MODULE, single_node,
+ [Time, Cp0, Config]), % ping ourself!
+ ?line rpc_cast(Cp1, ?MODULE, single_node, [Time, Cp0, Config]),
+ ?line rpc_cast(Cp2, ?MODULE, single_node, [Time, Cp1, Config]),
+ ?line rpc_cast(Cp3, ?MODULE, single_node, [Time, Cp2, Config]),
+ ?line rpc_cast(Cp4, ?MODULE, single_node, [Time, Cp3, Config]),
+ ?line rpc_cast(Cp5, ?MODULE, single_node, [Time, Cp4, Config]),
+ ?line rpc_cast(Cp6, ?MODULE, single_node, [Time, Cp5, Config]),
+ ?line rpc_cast(Cp7, ?MODULE, single_node, [Time, Cp6, Config]),
+ ?line rpc_cast(Cp8, ?MODULE, single_node, [Time, Cp7, Config]),
+
+ % sleep to make the partitioned net ready
+ test_server:sleep(Time - msec()),
+
+ ?line pong = net_adm:ping(Cp0),
+ ?line pong = net_adm:ping(Cp1),
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+ ?line pong = net_adm:ping(Cp6),
+ ?line pong = net_adm:ping(Cp7),
+ ?line pong = net_adm:ping(Cp8),
+
+ ?line pong = net_adm:ping(Cp0),
+ ?line pong = net_adm:ping(Cp1),
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+ ?line pong = net_adm:ping(Cp6),
+ ?line pong = net_adm:ping(Cp7),
+ ?line pong = net_adm:ping(Cp8),
+
+ ?line wait_for_ready_net(Nodes, Config),
+
+ % Just make sure that all nodes have the same picture of all names
+ ?line check_everywhere(Nodes, single_name, Config),
+ ?line assert_pid(global:whereis_name(single_name)),
+
+ ?line
+ ?UNTIL(begin
+ {Ns2, []} = rpc:multicall(Nodes, erlang, whereis,
+ [single_name]),
+ 9 =:= lists:foldl(fun(undefined, N) -> N + 1;
+ (_, N) -> N
+ end,
+ 0, Ns2)
+ end),
+
+ ?line assert_pid(global:send(single_name, die)),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp0),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cp4),
+ stop_node(Cp5),
+ stop_node(Cp6),
+ stop_node(Cp7),
+ stop_node(Cp8),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+simple_line(suite) ->
+ [];
+simple_line(doc) ->
+ ["Simpler version of the line case. Used because there are some",
+ "distribution problems with many nodes.",
+ "Make 6 single nodes, all having the same name.",
+ "Make all ping its predecessor, pinging in a line.",
+ "Make sure that there's just one winner."];
+simple_line(Config) when is_list(Config) ->
+ Timeout = 60,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5]
+ = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5], peer, Config),
+ Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5]),
+
+ ?line wait_for_ready_net(Config),
+
+ Time = msec() + 5000,
+
+ ?line rpc_cast(Cp0, ?MODULE, single_node,
+ [Time, Cp0, Config]), % ping ourself!
+ ?line rpc_cast(Cp1, ?MODULE, single_node, [Time, Cp0, Config]),
+ ?line rpc_cast(Cp2, ?MODULE, single_node, [Time, Cp1, Config]),
+ ?line rpc_cast(Cp3, ?MODULE, single_node, [Time, Cp2, Config]),
+ ?line rpc_cast(Cp4, ?MODULE, single_node, [Time, Cp3, Config]),
+ ?line rpc_cast(Cp5, ?MODULE, single_node, [Time, Cp4, Config]),
+
+ % sleep to make the partitioned net ready
+ test_server:sleep(Time - msec()),
+
+ ?line pong = net_adm:ping(Cp0),
+ ?line pong = net_adm:ping(Cp1),
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+
+ ?line pong = net_adm:ping(Cp0),
+ ?line pong = net_adm:ping(Cp1),
+ ?line pong = net_adm:ping(Cp2),
+ ?line pong = net_adm:ping(Cp3),
+ ?line pong = net_adm:ping(Cp4),
+ ?line pong = net_adm:ping(Cp5),
+
+ ?line wait_for_ready_net(Nodes, Config),
+
+ % Just make sure that all nodes have the same picture of all names
+ ?line check_everywhere(Nodes, single_name, Config),
+ ?line assert_pid(global:whereis_name(single_name)),
+
+ ?line
+ ?UNTIL(begin
+ {Ns2, []} = rpc:multicall(Nodes, erlang, whereis,
+ [single_name]),
+ 6 =:= lists:foldl(fun(undefined, N) -> N + 1;
+ (_, N) -> N
+ end,
+ 0, Ns2)
+ end),
+
+ ?line assert_pid(global:send(single_name, die)),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+
+ write_high_level_trace(Config),
+ stop_node(Cp0),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cp4),
+ stop_node(Cp5),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+otp_1849(suite) -> [];
+otp_1849(doc) ->
+ ["Test ticket: Global should keep track of all pids that set the same lock."];
+otp_1849(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line {ok, Cp1} = start_node(cp1, Config),
+ ?line {ok, Cp2} = start_node(cp2, Config),
+ ?line {ok, Cp3} = start_node(cp3, Config),
+
+ ?line wait_for_ready_net(Config),
+
+ % start procs on each node
+ ?line Pid1 = rpc:call(Cp1, ?MODULE, start_proc, []),
+ ?line assert_pid(Pid1),
+ ?line Pid2 = rpc:call(Cp2, ?MODULE, start_proc, []),
+ ?line assert_pid(Pid2),
+ ?line Pid3 = rpc:call(Cp3, ?MODULE, start_proc, []),
+ ?line assert_pid(Pid3),
+
+ % set a lock on every node
+ ?line true = req(Pid1, {set_lock2, {test_lock, ?MODULE}, self()}),
+ ?line true = req(Pid2, {set_lock2, {test_lock, ?MODULE}, self()}),
+ ?line true = req(Pid3, {set_lock2, {test_lock, ?MODULE}, self()}),
+
+ ?line
+ ?UNTIL(begin
+ [{test_lock, ?MODULE, Lock1}] =
+ rpc:call(Cp1, ets, tab2list, [global_locks]),
+ 3 =:= length(Lock1)
+ end),
+
+ ?line true = req(Pid3, {del_lock2, {test_lock, ?MODULE}, self()}),
+ ?line
+ ?UNTIL(begin
+ [{test_lock, ?MODULE, Lock2}] =
+ rpc:call(Cp1, ets, tab2list, [global_locks]),
+ 2 =:= length(Lock2)
+ end),
+
+ ?line true = req(Pid2, {del_lock2, {test_lock, ?MODULE}, self()}),
+ ?line
+ ?UNTIL(begin
+ [{test_lock, ?MODULE, Lock3}] =
+ rpc:call(Cp1, ets, tab2list, [global_locks]),
+ 1 =:= length(Lock3)
+ end),
+
+ ?line true = req(Pid1, {del_lock2, {test_lock, ?MODULE}, self()}),
+ ?line ?UNTIL([] =:= rpc:call(Cp1, ets, tab2list, [global_locks])),
+
+
+ ?line true = req(Pid1, {set_lock2, {test_lock, ?MODULE}, self()}),
+ ?line true = req(Pid2, {set_lock2, {test_lock, ?MODULE}, self()}),
+ ?line true = req(Pid3, {set_lock2, {test_lock, ?MODULE}, self()}),
+ ?line false = req(Pid2, {set_lock2, {test_lock, not_valid}, self()}),
+
+ exit_p(Pid1),
+ ?line
+ ?UNTIL(begin
+ [{test_lock, ?MODULE, Lock10}] =
+ rpc:call(Cp1, ets, tab2list, [global_locks]),
+ 2 =:= length(Lock10)
+ end),
+ ?line
+ ?UNTIL(begin
+ [{test_lock, ?MODULE, Lock11}] =
+ rpc:call(Cp2, ets, tab2list, [global_locks]),
+ 2 =:= length(Lock11)
+ end),
+ ?line
+ ?UNTIL(begin
+ [{test_lock, ?MODULE, Lock12}] =
+ rpc:call(Cp3, ets, tab2list, [global_locks]),
+ 2 =:= length(Lock12)
+ end),
+
+ write_high_level_trace(Config),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+otp_3162(suite) -> [];
+otp_3162(doc) ->
+ ["Test ticket: Deadlock in global"];
+otp_3162(Config) when is_list(Config) ->
+ StartFun = fun() ->
+ {ok, Cp1} = start_node(cp1, Config),
+ {ok, Cp2} = start_node(cp2, Config),
+ {ok, Cp3} = start_node(cp3, Config),
+ [Cp1, Cp2, Cp3]
+ end,
+ do_otp_3162(StartFun, Config).
+
+do_otp_3162(StartFun, Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line [Cp1, Cp2, Cp3] = StartFun(),
+
+ ?line wait_for_ready_net(Config),
+
+ % start procs on each node
+ ?line Pid1 = rpc:call(Cp1, ?MODULE, start_proc4, [kalle]),
+ ?line assert_pid(Pid1),
+ ?line Pid2 = rpc:call(Cp2, ?MODULE, start_proc4, [stina]),
+ ?line assert_pid(Pid2),
+ ?line Pid3 = rpc:call(Cp3, ?MODULE, start_proc4, [vera]),
+ ?line assert_pid(Pid3),
+
+ ?line rpc_disconnect_node(Cp1, Cp2, Config),
+
+ ?line ?UNTIL
+ ([Cp3] =:= lists:sort(rpc:call(Cp1, erlang, nodes, [])) -- [node()]),
+
+ ?line ?UNTIL([kalle, test_server, vera] =:=
+ lists:sort(rpc:call(Cp1, global, registered_names, []))),
+ ?line ?UNTIL
+ ([Cp3] =:= lists:sort(rpc:call(Cp2, erlang, nodes, [])) -- [node()]),
+ ?line ?UNTIL([stina, test_server, vera] =:=
+ lists:sort(rpc:call(Cp2, global, registered_names, []))),
+ ?line ?UNTIL
+ ([Cp1, Cp2] =:=
+ lists:sort(rpc:call(Cp3, erlang, nodes, [])) -- [node()]),
+ ?line ?UNTIL([kalle, stina, test_server, vera] =:=
+ lists:sort(rpc:call(Cp3, global, registered_names, []))),
+
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cp1]),
+
+ ?line ?UNTIL
+ ([Cp2, Cp3] =:=
+ lists:sort(rpc:call(Cp1, erlang, nodes, [])) -- [node()]),
+ ?line
+ ?UNTIL(begin
+ NN = lists:sort(rpc:call(Cp1, global, registered_names, [])),
+ [kalle, stina, test_server, vera] =:= NN
+ end),
+ ?line ?UNTIL
+ ([Cp1, Cp3] =:=
+ lists:sort(rpc:call(Cp2, erlang, nodes, [])) -- [node()]),
+ ?line ?UNTIL([kalle, stina, test_server, vera] =:=
+ lists:sort(rpc:call(Cp2, global, registered_names, []))),
+ ?line ?UNTIL
+ ([Cp1, Cp2] =:=
+ lists:sort(rpc:call(Cp3, erlang, nodes, [])) -- [node()]),
+ ?line ?UNTIL([kalle, stina, test_server, vera] =:=
+ lists:sort(rpc:call(Cp3, global, registered_names, []))),
+
+ write_high_level_trace(Config),
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+otp_5640(suite) -> [];
+otp_5640(doc) ->
+ ["OTP-5640. 'allow' multiple names for registered processes."];
+otp_5640(Config) when is_list(Config) ->
+ Timeout = 25,
+ ?line Dog = test_server:timetrap(test_server:seconds(Timeout)),
+ init_high_level_trace(Timeout),
+ init_condition(Config),
+ ?line {ok, B} = start_node(b, Config),
+
+ ?line Nodes = lists:sort([node(), B]),
+ ?line wait_for_ready_net(Nodes, Config),
+
+ Server = whereis(global_name_server),
+ ServerB = rpc:call(B, erlang, whereis, [global_name_server]),
+
+ Me = self(),
+ Proc = spawn(fun() -> otp_5640_proc(Me) end),
+
+ ?line yes = global:register_name(name1, Proc),
+ ?line no = global:register_name(name2, Proc),
+
+ ?line ok = application:set_env(kernel, global_multi_name_action, allow),
+ ?line yes = global:register_name(name2, Proc),
+
+ test_server:sleep(100),
+ ?line Proc = global:whereis_name(name1),
+ ?line Proc = global:whereis_name(name2),
+ ?line check_everywhere(Nodes, name1, Config),
+ ?line check_everywhere(Nodes, name2, Config),
+
+ ?line {monitors_2levels, MonBy1} = mon_by_servers(Proc),
+ ?line [] = ([Server,Server,ServerB,ServerB] -- MonBy1),
+ ?line {links,[]} = process_info(Proc, links),
+ ?line _ = global:unregister_name(name1),
+
+ test_server:sleep(100),
+ ?line undefined = global:whereis_name(name1),
+ ?line Proc = global:whereis_name(name2),
+ ?line check_everywhere(Nodes, name1, Config),
+ ?line check_everywhere(Nodes, name2, Config),
+
+ ?line {monitors_2levels, MonBy2} = mon_by_servers(Proc),
+ ?line [] = ([Server,ServerB] -- MonBy2),
+ TmpMonBy2 = MonBy2 -- [Server,ServerB],
+ ?line TmpMonBy2 = TmpMonBy2 -- [Server,ServerB],
+ ?line {links,[]} = process_info(Proc, links),
+
+ ?line yes = global:register_name(name1, Proc),
+
+ Proc ! die,
+
+ test_server:sleep(100),
+ ?line undefined = global:whereis_name(name1),
+ ?line undefined = global:whereis_name(name2),
+ ?line check_everywhere(Nodes, name1, Config),
+ ?line check_everywhere(Nodes, name2, Config),
+ ?line {monitors, GMonitors} = process_info(Server, monitors),
+ ?line false = lists:member({process, Proc}, GMonitors),
+
+ write_high_level_trace(Config),
+ stop_node(B),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+otp_5640_proc(_Parent) ->
+ receive
+ die ->
+ exit(normal)
+ end.
+
+otp_5737(suite) -> [];
+otp_5737(doc) ->
+ ["OTP-5737. set_lock/3 and trans/4 accept Retries = 0."];
+otp_5737(Config) when is_list(Config) ->
+ Timeout = 25,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+
+ LockId = {?MODULE,self()},
+ Nodes = [node()],
+ ?line {'EXIT', _} = (catch global:set_lock(LockId, Nodes, -1)),
+ ?line {'EXIT', _} = (catch global:set_lock(LockId, Nodes, a)),
+ ?line true = global:set_lock(LockId, Nodes, 0),
+ Time1 = now(),
+ ?line false = global:set_lock({?MODULE,not_me}, Nodes, 0),
+ ?line true = timer:now_diff(now(), Time1) < 5000,
+ ?line _ = global:del_lock(LockId, Nodes),
+
+ Fun = fun() -> ok end,
+ ?line {'EXIT', _} = (catch global:trans(LockId, Fun, Nodes, -1)),
+ ?line {'EXIT', _} = (catch global:trans(LockId, Fun, Nodes, a)),
+ ?line ok = global:trans(LockId, Fun, Nodes, 0),
+
+ write_high_level_trace(Config),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+otp_6931(suite) -> [];
+otp_6931(doc) -> ["OTP-6931. Ignore nodeup when connect_all=false."];
+otp_6931(Config) when is_list(Config) ->
+ Me = self(),
+ ?line {ok, CAf} = start_non_connecting_node(ca_false, Config),
+ ?line ok = rpc:call(CAf, error_logger, add_report_handler, [?MODULE, Me]),
+ ?line info = rpc:call(CAf, error_logger, warning_map, []),
+ ?line {global_name_server,CAf} ! {nodeup, fake_node},
+ timer:sleep(100),
+ stop_node(CAf),
+ receive {nodeup,fake_node} -> test_server:fail({info_report, was, sent})
+ after 1000 -> ok
+ end,
+ ok.
+
+%%%-----------------------------------------------------------------
+%%% Testing a disconnected node. Not two partitions.
+%%%-----------------------------------------------------------------
+simple_disconnect(suite) -> [];
+simple_disconnect(doc) -> ["OTP-5563. Disconnected nodes (not partitions)"];
+simple_disconnect(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ %% Three nodes (test_server, n_1, n_2).
+ ?line [Cp1, Cp2] = Cps = start_nodes([n_1, n_2], peer, Config),
+ ?line wait_for_ready_net(Config),
+
+ Nodes = lists:sort([node() | Cps]),
+
+ lists:foreach(fun(N) -> rpc:call(N, ?MODULE, start_tracer, []) end,Nodes),
+
+ Name = name,
+ Resolver = {no_module, resolve_none}, % will never be called
+ PingNode = Cp2,
+
+ ?line {_Pid1, yes} =
+ rpc:call(Cp1, ?MODULE, start_resolver, [Name, Resolver]),
+ test_server:sleep(100),
+
+ %% Disconnect test_server and Cp2.
+ ?line true = erlang:disconnect_node(Cp2),
+ test_server:sleep(500),
+
+ %% _Pid is registered on Cp1. The exchange of names between Cp2 and
+ %% test_server sees two identical pids.
+ ?line pong = net_adm:ping(PingNode),
+ ?line ?UNTIL(Cps =:= lists:sort(nodes())),
+
+ ?line {_, Trace0} = collect_tracers(Nodes),
+ ?line Resolvers = [P || {_Node,new_resolver,{pid,P}} <- Trace0],
+ ?line lists:foreach(fun(P) -> P ! die end, Resolvers),
+ ?line lists:foreach(fun(P) -> wait_for_exit(P) end, Resolvers),
+ ?line check_everywhere(Nodes, Name, Config),
+ ?line undefined = global:whereis_name(Name),
+
+ ?line {_, Trace1} = collect_tracers(Nodes),
+ Trace = Trace0 ++ Trace1,
+ ?line [] = [foo || {_, resolve_none, _, _} <- Trace],
+
+ ?line Gs = name_servers(Nodes),
+ ?line [_, _, _] = monitored_by_node(Trace, Gs),
+
+ lists:foreach(fun(N) -> rpc:call(N, ?MODULE, stop_tracer, []) end, Nodes),
+
+ ?line OrigNames = global:registered_names(),
+ write_high_level_trace(Config),
+ stop_nodes(Cps),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Not used right now.
+simple_dis(Nodes0, Name, Resolver, Config) ->
+ Nodes = [node() | Nodes0],
+ NN = lists:zip(Nodes, lists:seq(1, length(Nodes))),
+ [{_Node,Other} | Dis] =
+ [{N,[N1 || {N1,I1} <- NN, I1 > I + 1]} || {N,I} <- NN],
+ lists:foreach(
+ fun({Node, DisNodes}) ->
+ Args = [Node, DisNodes, Name, Resolver],
+ ok = rpc:call(Node, ?MODULE, simple_dis_node, Args)
+ end, Dis),
+ ok = simple_dis_node(node(), Other, Name, Resolver, Config).
+
+simple_dis_node(_Node, DisNodes, _Name, _Resolver, Config) ->
+ lists:foreach(
+ fun(OtherNode) -> _ = erlang:disconnect_node(OtherNode) end, DisNodes),
+ ?line ?UNTIL(DisNodes -- nodes() =:= DisNodes),
+ ok.
+
+
+
+%%%-----------------------------------------------------------------
+%%% Testing resolve of name. Many combinations with four nodes.
+%%%-----------------------------------------------------------------
+-record(cf, {
+ link, % node expected to have registered process running
+ ping, % node in partition 2 to be pinged
+ n1, % node starting registered process in partition 1
+ n2, % node starting registered process in partition 2
+ nodes, % nodes expected to exist after ping
+ n_res, % expected number of resolvers after ping
+ config
+ }).
+
+-define(RES(F), {F, fun ?MODULE:F/3}).
+
+simple_resolve(suite) -> [];
+simple_resolve(doc) -> ["OTP-5563. Partitions and names."];
+simple_resolve(Config) when is_list(Config) ->
+ Timeout = 360,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [N1, A2, Z2] = Cps = start_nodes([n_1, a_2, z_2], peer, Config),
+ Nodes = lists:sort([node() | Cps]),
+ ?line wait_for_ready_net(Config),
+
+ lists:foreach(fun(N) ->
+ rpc:call(N, ?MODULE, start_tracer, [])
+ end, Nodes),
+
+ %% There used to be a link between global_name_server and the
+ %% registered name. Now there are only monitors, but the field
+ %% name 'link' remains...
+
+ Cf = #cf{link = none, ping = A2, n1 = node(), n2 = A2,
+ nodes = [node(), N1, A2, Z2], n_res = 2, config = Config},
+
+ %% There is no test with a resolver that deletes a pid (like
+ %% global_exit_name does). The resulting DOWN signal just clears
+ %% out the pid from the tables, which should be harmless. So all
+ %% tests are done with resolvers that keep both processes. This
+ %% should catch all cases which used to result in bogus process
+ %% links (now: only monitors are used).
+
+ %% Two partitions are created in each case below: [node(), n_1]
+ %% and [a_2, z_2]. A name ('name') is registered in both
+ %% partitions whereafter node() or n_1 pings a_2 or z_2. Note that
+ %% node() = test_server, which means that node() < z_2 and node()
+ %% > a_2. The lesser node calls the resolver.
+
+ %% [The following comment does not apply now that monitors are used.]
+ %% The resolver is run on a_2 with the process on node()
+ %% as first argument. The process registered as 'name' on a_2 is
+ %% removed from the tables. It is unlinked from a_2, and the new
+ %% process (on node()) is inserted without trying to link to it
+ %% (it it known to run on some other node, in the other
+ %% partition). The new process is not sent to the other partition
+ %% for update since it already exists there.
+ res(?RES(resolve_first), Cps, Cf#cf{link = node(), n2 = A2}),
+ %% The same, but the z_2 takes the place of a_2.
+ res(?RES(resolve_first), Cps, Cf#cf{link = node(), n2 = Z2}),
+ %% The resolver is run on test_server.
+ res(?RES(resolve_first), Cps, Cf#cf{link = A2, n2 = A2, ping = Z2}),
+ res(?RES(resolve_first), Cps, Cf#cf{link = Z2, n2 = Z2, ping = Z2}),
+ %% Now the same tests but with n_1 taking the place of test_server.
+ res(?RES(resolve_first), Cps, Cf#cf{link = N1, n1 = N1, n2 = A2}),
+ res(?RES(resolve_first), Cps, Cf#cf{link = N1, n1 = N1, n2 = Z2}),
+ res(?RES(resolve_first), Cps, Cf#cf{link = A2, n1 = N1, n2 = A2, ping = Z2}),
+ res(?RES(resolve_first), Cps, Cf#cf{link = Z2, n1 = N1, n2 = Z2, ping = Z2}),
+
+ %% [Maybe this set of tests is the same as (ismorphic to?) the last one.]
+ %% The resolver is run on a_2 with the process on node()
+ %% as first argument. The process registered as 'name' on a_2 is
+ %% the one kept. The old process is unlinked on node(), and the
+ %% new process (on a_2) is inserted without trying to link to it
+ %% (it it known to run on some other node).
+ res(?RES(resolve_second), Cps, Cf#cf{link = A2, n2 = A2}),
+ %% The same, but the z_2 takes the place of a_2.
+ res(?RES(resolve_second), Cps, Cf#cf{link = Z2, n2 = Z2}),
+ %% The resolver is run on test_server.
+ res(?RES(resolve_second), Cps, Cf#cf{link = node(), n2 = A2, ping = Z2}),
+ res(?RES(resolve_second), Cps, Cf#cf{link = node(), n2 = Z2, ping = Z2}),
+ %% Now the same tests but with n_1 taking the place of test_server.
+ res(?RES(resolve_second), Cps, Cf#cf{link = A2, n1 = N1, n2 = A2}),
+ res(?RES(resolve_second), Cps, Cf#cf{link = Z2, n1 = N1, n2 = Z2}),
+ res(?RES(resolve_second), Cps, Cf#cf{link = N1, n1 = N1, n2 = A2, ping = Z2}),
+ res(?RES(resolve_second), Cps, Cf#cf{link = N1, n1 = N1, n2 = Z2, ping = Z2}),
+
+ %% A resolver that does not return one of the pids.
+ res(?RES(bad_resolver), Cps, Cf#cf{n2 = A2}),
+ res(?RES(bad_resolver), Cps, Cf#cf{n2 = Z2}),
+ %% The resolver is run on test_server.
+ res(?RES(bad_resolver), Cps, Cf#cf{n2 = A2, ping = Z2}),
+ res(?RES(bad_resolver), Cps, Cf#cf{n2 = Z2, ping = Z2}),
+ %% Now the same tests but with n_1 taking the place of test_server.
+ res(?RES(bad_resolver), Cps, Cf#cf{n1 = N1, n2 = A2}),
+ res(?RES(bad_resolver), Cps, Cf#cf{n1 = N1, n2 = Z2}),
+ res(?RES(bad_resolver), Cps, Cf#cf{n1 = N1, n2 = A2, ping = Z2}),
+ res(?RES(bad_resolver), Cps, Cf#cf{n1 = N1, n2 = Z2, ping = Z2}),
+
+ %% Both processes are unlinked (demonitored).
+ res(?RES(resolve_none), Cps, Cf#cf{n2 = A2}),
+ res(?RES(resolve_none), Cps, Cf#cf{n2 = Z2}),
+ res(?RES(resolve_none), Cps, Cf#cf{n2 = A2, ping = Z2}),
+ res(?RES(resolve_none), Cps, Cf#cf{n2 = Z2, ping = Z2}),
+ res(?RES(resolve_none), Cps, Cf#cf{n1 = N1, n2 = A2}),
+ res(?RES(resolve_none), Cps, Cf#cf{n1 = N1, n2 = Z2}),
+ res(?RES(resolve_none), Cps, Cf#cf{n1 = N1, n2 = A2, ping = Z2}),
+ res(?RES(resolve_none), Cps, Cf#cf{n1 = N1, n2 = Z2, ping = Z2}),
+
+ %% A resolver faking badrpc. The resolver is run on a_2, and the
+ %% process on node() is kept.
+ res(?RES(badrpc_resolver), Cps, Cf#cf{link = node(), n2 = A2}),
+
+ %% An exiting resolver. A kind of badrpc.
+ res(?RES(exit_resolver), Cps, Cf#cf{link = node(), n2 = A2}),
+ res(?RES(exit_resolver), Cps, Cf#cf{link = node(), n2 = Z2}),
+ res(?RES(exit_resolver), Cps, Cf#cf{link = A2, n2 = A2, ping = Z2}),
+ res(?RES(exit_resolver), Cps, Cf#cf{link = Z2, n2 = Z2, ping = Z2}),
+ res(?RES(exit_resolver), Cps, Cf#cf{link = N1, n1 = N1, n2 = A2}),
+ res(?RES(exit_resolver), Cps, Cf#cf{link = N1, n1 = N1, n2 = Z2}),
+ res(?RES(exit_resolver), Cps, Cf#cf{link = A2, n1 = N1, n2 = A2, ping = Z2}),
+ res(?RES(exit_resolver), Cps, Cf#cf{link = Z2, n1 = N1, n2 = Z2, ping = Z2}),
+
+ %% A locker that takes a lock. It used to be that the
+ %% global_name_server was busy exchanging names, which caused a
+ %% deadlock.
+ res(?RES(lock_resolver), Cps, Cf#cf{link = node()}),
+
+ %% A resolver that disconnects from the node of the first pid
+ %% once. The nodedown message is processed (the resolver killed),
+ %% then a new attempt (nodeup etc.) is made. This time the
+ %% resolver does not disconnect any node.
+ res(?RES(disconnect_first), Cps, Cf#cf{link = Z2, n2 = Z2,
+ nodes = [node(), N1, A2, Z2]}),
+
+ ?line lists:foreach(fun(N) ->
+ rpc:call(N, ?MODULE, stop_tracer, [])
+ end, Nodes),
+
+ ?line OrigNames = global:registered_names(),
+ write_high_level_trace(Config),
+ stop_nodes(Cps),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+simple_resolve2(suite) -> [];
+simple_resolve2(doc) -> ["OTP-5563. Partitions and names."];
+simple_resolve2(Config) when is_list(Config) ->
+ %% Continuation of simple_resolve. Of some reason it did not
+ %% always work to re-start z_2. "Cannot be a global bug."
+
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [N1, A2, Z2] = Cps = start_nodes([n_1, a_2, z_2], peer, Config),
+ ?line wait_for_ready_net(Config),
+ Nodes = lists:sort([node() | Cps]),
+
+ lists:foreach(fun(N) ->
+ rpc:call(N, ?MODULE, start_tracer, [])
+ end, Nodes),
+
+ Cf = #cf{link = none, ping = A2, n1 = node(), n2 = A2,
+ nodes = [node(), N1, A2, Z2], n_res = 2, config = Config},
+
+ %% Halt z_2.
+ res(?RES(halt_second), Cps, Cf#cf{link = N1, n1 = N1, n2 = Z2, ping = A2,
+ nodes = [node(), N1, A2], n_res = 1}),
+
+ ?line lists:foreach(fun(N) ->
+ rpc:call(N, ?MODULE, stop_tracer, [])
+ end, Nodes),
+
+ ?line OrigNames = global:registered_names(),
+ write_high_level_trace(Config),
+ stop_nodes(Cps), % Not all nodes may be present, but it works anyway.
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+simple_resolve3(suite) -> [];
+simple_resolve3(doc) -> ["OTP-5563. Partitions and names."];
+simple_resolve3(Config) when is_list(Config) ->
+ %% Continuation of simple_resolve.
+
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [N1, A2, Z2] = Cps = start_nodes([n_1, a_2, z_2], peer, Config),
+ ?line wait_for_ready_net(Config),
+ Nodes = lists:sort([node() | Cps]),
+
+ lists:foreach(fun(N) ->
+ rpc:call(N, ?MODULE, start_tracer, [])
+ end, Nodes),
+
+ Cf = #cf{link = none, ping = A2, n1 = node(), n2 = A2,
+ nodes = [node(), N1, A2, Z2], n_res = 2, config = Config},
+
+ %% Halt a_2.
+ res(?RES(halt_second), Cps, Cf#cf{link = node(), n2 = A2,
+ nodes = [node(), N1], n_res = 1}),
+
+ ?line lists:foreach(fun(N) ->
+ rpc:call(N, ?MODULE, stop_tracer, [])
+ end, Nodes),
+
+ ?line OrigNames = global:registered_names(),
+ write_high_level_trace(Config),
+ stop_nodes(Cps), % Not all nodes may be present, but it works anyway.
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+res({Res,Resolver}, [N1, A2, Z2], Cf) ->
+ %% Note: there are no links anymore, but monitors.
+ #cf{link = LinkedNode, ping = PingNode, n1 = Res1, n2 = OtherNode,
+ nodes = Nodes0, n_res = NRes, config = Config} = Cf,
+ ?t:format("~n~nResolver: ~p", [Res]),
+ ?t:format(" Registered on partition 1: ~p", [Res1]),
+ ?t:format(" Registered on partition 2: ~p", [OtherNode]),
+ ?t:format(" Pinged node: ~p", [PingNode]),
+ ?t:format(" Linked node: ~p", [LinkedNode]),
+ ?t:format(" Expected # resolvers: ~p", [NRes]),
+ Nodes = lists:sort(Nodes0),
+ T1 = node(),
+ Part1 = [T1, N1],
+ Part2 = [A2, Z2],
+ Name = name,
+
+ %% A registered name is resolved in different scenarios with just
+ %% four nodes. In each scenario it is checked that exactly the
+ %% expected monitors remain between registered processes and the
+ %% global_name_server.
+
+ ?line rpc_cast(OtherNode,
+ ?MODULE,
+ part_2_2,
+ [Config, Part1, Part2, [{Name, Resolver}]]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+ ?line {_Pid1, yes} =
+ rpc:call(Res1, ?MODULE, start_resolver, [Name, Resolver]),
+
+ ?line pong = net_adm:ping(PingNode),
+ ?line wait_for_ready_net(Nodes, Config),
+
+ ?line check_everywhere(Nodes, Name, Config),
+ ?line case global:whereis_name(Name) of
+ undefined when LinkedNode =:= none -> ok;
+ Pid -> assert_pid(Pid)
+ end,
+
+ ?line {_, Trace0} = collect_tracers(Nodes),
+ ?line Resolvers = [P || {_Node,new_resolver,{pid,P}} <- Trace0],
+
+ ?line NRes = length(Resolvers),
+
+ %% Wait for extra monitor processes to be created.
+ %% This applies as long as global:do_monitor/1 spawns processes.
+ %% (Some day monitor() will be truly synchronous.)
+ test_server:sleep(100),
+
+ ?line lists:foreach(fun(P) -> P ! die end, Resolvers),
+ ?line lists:foreach(fun(P) -> wait_for_exit(P) end, Resolvers),
+
+ ?line check_everywhere(Nodes, Name, Config),
+ ?line undefined = global:whereis_name(Name),
+
+ %% Wait for monitors to remove names.
+ test_server:sleep(100),
+
+ ?line {_, Trace1} = collect_tracers(Nodes),
+ Trace = Trace0 ++ Trace1,
+
+ ?line Gs = name_servers([T1, N1, A2, Z2]),
+ ?line MonitoredByNode = monitored_by_node(Trace, Gs),
+ ?line MonitoredBy = [M || {_N,M} <- MonitoredByNode],
+
+ X = MonitoredBy -- Gs,
+ LengthGs = length(Gs),
+ ?line case MonitoredBy of
+ [] when LinkedNode =:= none -> ok;
+ Gs -> ok;
+ _ when LengthGs < 4, X =:= [] -> ok;
+ _ -> ?t:format("ERROR:~nMonitoredBy ~p~n"
+ "global_name_servers ~p~n",
+ [MonitoredByNode, Gs]),
+ ?t:fail(monitor_mismatch)
+ end,
+ ok.
+
+name_servers(Nodes) ->
+ lists:sort([rpc:call(N, erlang, whereis, [global_name_server]) ||
+ N <- Nodes,
+ pong =:= net_adm:ping(N)]).
+
+monitored_by_node(Trace, Servers) ->
+ lists:sort([{node(M),M} ||
+ {_Node,_P,died,{monitors_2levels,ML}} <- Trace,
+ M <- ML,
+ lists:member(M, Servers)]).
+
+%% Runs on a node in Part2
+part_2_2(Config, Part1, Part2, NameResolvers) ->
+ make_partition(Config, Part1, Part2),
+ lists:foreach
+ (fun({Name, Resolver}) ->
+ ?line {Pid2, yes} = start_resolver(Name, Resolver),
+ trace_message({node(), part_2_2, nodes(), {pid2,Pid2}})
+ end, NameResolvers).
+
+resolve_first(name, Pid1, _Pid2) ->
+ Pid1.
+
+resolve_second(name, _Pid1, Pid2) ->
+ Pid2.
+
+resolve_none(name, _Pid1, _Pid2) ->
+ none.
+
+bad_resolver(name, _Pid1, _Pid2) ->
+ bad_answer.
+
+badrpc_resolver(name, _Pid1, _Pid2) ->
+ {badrpc, badrpc}.
+
+exit_resolver(name, _Pid1, _Pid2) ->
+ erlang:error(bad_resolver).
+
+lock_resolver(name, Pid1, _Pid2) ->
+ Id = {?MODULE, self()},
+ Nodes = [node()],
+ ?line true = global:set_lock(Id, Nodes),
+ _ = global:del_lock(Id, Nodes),
+ Pid1.
+
+disconnect_first(name, Pid1, Pid2) ->
+ Name = disconnect_first_name,
+ case whereis(Name) of
+ undefined ->
+ spawn(fun() -> disconnect_first_name(Name) end),
+ true = erlang:disconnect_node(node(Pid1));
+ Pid when is_pid(Pid) ->
+ Pid ! die
+ end,
+ Pid2.
+
+disconnect_first_name(Name) ->
+ register(Name, self()),
+ receive die -> ok end.
+
+halt_second(name, _Pid1, Pid2) ->
+ rpc:call(node(Pid2), erlang, halt, []),
+ Pid2.
+
+start_resolver(Name, Resolver) ->
+ Self = self(),
+ Pid = spawn(fun() -> init_resolver(Self, Name, Resolver) end),
+ trace_message({node(), new_resolver, {pid, Pid}}),
+ receive
+ {Pid, Res} -> {Pid, Res}
+ end.
+
+init_resolver(Parent, Name, Resolver) ->
+ X = global:register_name(Name, self(), Resolver),
+ Parent ! {self(), X},
+ loop_resolver().
+
+loop_resolver() ->
+ receive
+ die ->
+ trace_message({node(), self(), died, mon_by_servers(self())}),
+ exit(normal)
+ end.
+
+%% The server sometimes uses an extra process for monitoring.
+%% The server monitors that extra process.
+mon_by_servers(Proc) ->
+ {monitored_by, ML} = process_info(Proc, monitored_by),
+ {monitors_2levels,
+ lists:append([ML |
+ [begin
+ {monitored_by, MML} = rpc:call(node(M),
+ erlang,
+ process_info,
+ [M, monitored_by]),
+ MML
+ end || M <- ML]])}.
+
+-define(REGNAME, contact_a_2).
+
+leftover_name(suite) -> [];
+leftover_name(doc) -> ["OTP-5563. Bug: nodedown while synching."];
+leftover_name(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+ ?line [N1, A2, Z2] = Cps = start_nodes([n_1, a_2, z_2], peer, Config),
+ Nodes = lists:sort([node() | Cps]),
+ ?line wait_for_ready_net(Config),
+
+ lists:foreach(fun(N) ->
+ rpc:call(N, ?MODULE, start_tracer, [])
+ end, Nodes),
+
+ Name = name, % registered on a_2
+ ResName = resolved_name, % registered on n_1 and a_2
+ %%
+ ?line _Pid = ping_a_2_fun(?REGNAME, N1, A2),
+
+ T1 = node(),
+ Part1 = [T1, N1],
+ Part2 = [A2, Z2],
+ NoResolver = {no_module, resolve_none},
+ Resolver = fun contact_a_2/3,
+ ?line rpc_cast(A2,
+ ?MODULE, part_2_2, [Config,
+ Part1,
+ Part2,
+ [{Name, NoResolver},
+ {ResName, Resolver}]]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+
+ %% resolved_name is resolved to run on a_2, an insert operation is
+ %% sent to n_1. The resolver function halts a_2, but the nodedown
+ %% message is handled by n_1 _before_ the insert operation is run
+ %% (at least every now and then; sometimes it seems to be
+ %% delayed). Unless "artificial" nodedown messages are sent the
+ %% name would linger on indefinitely. [There is no test case for
+ %% the situation that no nodedown message at all is sent.]
+ ?line {_Pid1, yes} =
+ rpc:call(N1, ?MODULE, start_resolver,
+ [ResName, fun contact_a_2/3]),
+ test_server:sleep(1000),
+
+ ?line trace_message({node(), pinging, z_2}),
+ ?line pong = net_adm:ping(Z2),
+ ?line ?UNTIL((Nodes -- [A2]) =:= lists:sort(?NODES)),
+ ?t:sleep(1000),
+
+ ?line {_,Trace0} = collect_tracers(Nodes),
+
+ ?line Resolvers = [P || {_Node,new_resolver,{pid,P}} <- Trace0],
+ ?line lists:foreach(fun(P) -> P ! die end, Resolvers),
+ ?line lists:foreach(fun(P) -> wait_for_exit(P) end, Resolvers),
+
+ ?line lists:foreach(fun(N) ->
+ rpc:call(N, ?MODULE, stop_tracer, [])
+ end, Nodes),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+ write_high_level_trace(Config),
+ stop_nodes(Cps),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Runs on n_1
+contact_a_2(resolved_name, Pid1, Pid2) ->
+ trace_message({node(), ?REGNAME, {pid1,Pid1}, {pid2,Pid2},
+ {node1,node(Pid1)}, {node2,node(Pid2)}}),
+ ?REGNAME ! doit,
+ Pid2.
+
+ping_a_2_fun(RegName, N1, A2) ->
+ spawn(N1, fun() -> ping_a_2(RegName, N1, A2) end).
+
+ping_a_2(RegName, N1, A2) ->
+ register(RegName, self()),
+ receive doit ->
+ trace_message({node(), ping_a_2, {a2, A2}}),
+ monitor_node(A2, true),
+ %% Establish contact with a_2, then take it down.
+ rpc:call(N1, ?MODULE, halt_node, [A2]),
+ receive
+ {nodedown, A2} -> ok
+ end
+ end.
+
+halt_node(Node) ->
+ rpc:call(Node, erlang, halt, []).
+
+%%%-----------------------------------------------------------------
+%%% Testing re-registration of a name.
+%%%-----------------------------------------------------------------
+re_register_name(suite) -> [];
+re_register_name(doc) -> ["OTP-5563. Name is re-registered."];
+re_register_name(Config) when is_list(Config) ->
+ %% When re-registering a name the link to the old pid used to
+ %% linger on. Don't think is was a serious bug though--some memory
+ %% occupied by links, that's all.
+ %% Later: now monitors are checked.
+ Timeout = 15,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ Me = self(),
+ Pid1 = spawn(fun() -> proc(Me) end),
+ ?line yes = global:register_name(name, Pid1),
+ Pid2 = spawn(fun() -> proc(Me) end),
+ ?line _ = global:re_register_name(name, Pid2),
+ Pid2 ! die,
+ Pid1 ! die,
+ receive {Pid1, MonitoredBy1} -> [] = MonitoredBy1 end,
+ receive {Pid2, MonitoredBy2} -> [_] = MonitoredBy2 end,
+ ?line _ = global:unregister_name(name),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+proc(Parent) ->
+ receive die -> ok end,
+ {monitored_by, MonitoredBy} = process_info(self(), monitored_by),
+ Parent ! {self(), MonitoredBy}.
+
+
+%%%-----------------------------------------------------------------
+%%%
+%%%-----------------------------------------------------------------
+name_exit(suite) -> [];
+name_exit(doc) -> ["OTP-5563. Registered process dies."];
+name_exit(Config) when is_list(Config) ->
+ case ?t:is_release_available("r11b") of
+ true ->
+ StartOldFun =
+ fun() ->
+ {ok, N1} = start_node_rel(n_1, r11b, Config),
+ {ok, N2} = start_node_rel(n_2, this, Config),
+ [N1, N2]
+ end,
+ ?t:format("Test of r11~n"),
+ do_name_exit(StartOldFun, old, Config);
+ false ->
+ ok
+ end,
+ StartFun = fun() ->
+ {ok, N1} = start_node_rel(n_1, this, Config),
+ {ok, N2} = start_node_rel(n_2, this, Config),
+ [N1, N2]
+ end,
+ ?t:format("Test of current release~n"),
+ do_name_exit(StartFun, current, Config).
+
+do_name_exit(StartFun, Version, Config) ->
+ %% When a registered process dies, the node where it is registered
+ %% removes the name from the table immediately, and then removes
+ %% it from other nodes using a lock.
+ %% This is perhaps not how it should work, but it is not easy to
+ %% change.
+ %% See also OTP-3737.
+ %%
+ %% The current release uses monitors so this test is not so relevant.
+
+ Timeout = 60,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ %% Three nodes (test_server, n_1, n_2).
+ ?line Cps = StartFun(),
+ Nodes = lists:sort([node() | Cps]),
+ ?line wait_for_ready_net(Config),
+ lists:foreach(fun(N) -> rpc:call(N, ?MODULE, start_tracer, []) end,Nodes),
+
+ Name = name,
+ ?line {Pid, yes} = start_proc(Name),
+
+ Me = self(),
+ LL = spawn(fun() -> long_lock(Me) end),
+ receive
+ long_lock_taken -> ok
+ end,
+
+ Pid ! die,
+ wait_for_exit_fast(Pid),
+
+ ?t:sleep(100),
+ %% Name has been removed from node()'s table, but nowhere else
+ %% since there is a lock on 'global'.
+ {R1,[]} = rpc:multicall(Nodes, global, whereis_name, [Name]),
+ ?line case Version of
+ old -> [_,_] = lists:usort(R1);
+ current -> [undefined, undefined, undefined] = R1
+ end,
+ ?t:sleep(3000),
+ ?line check_everywhere(Nodes, Name, Config),
+
+ lists:foreach(fun(N) -> rpc:call(N, ?MODULE, stop_tracer, []) end, Nodes),
+ ?line OrigNames = global:registered_names(),
+ exit(LL, kill),
+ write_high_level_trace(Config),
+ stop_nodes(Cps),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+long_lock(Parent) ->
+ global:trans({?GLOBAL_LOCK,self()},
+ fun() ->
+ Parent ! long_lock_taken,
+ timer:sleep(3000)
+ end).
+
+%%%-----------------------------------------------------------------
+%%% Testing the support for external nodes (cnodes)
+%%%-----------------------------------------------------------------
+external_nodes(suite) -> [];
+external_nodes(doc) -> ["OTP-5563. External nodes (cnodes)."];
+external_nodes(Config) when is_list(Config) ->
+ Timeout = 30,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ ?line [NodeB, NodeC] = start_nodes([b, c], peer, Config),
+ ?line wait_for_ready_net(Config),
+
+ %% Nodes = ?NODES,
+ %% lists:foreach(fun(N) -> rpc:call(N, ?MODULE, start_tracer, []) end,
+ %% Nodes),
+ Name = name,
+
+ %% Two partitions: [test_server] and [b, c].
+ %% c registers an external name on b
+ ?line rpc_cast(NodeB, ?MODULE, part_ext,
+ [Config, node(), NodeC, Name]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+
+ ?line pong = net_adm:ping(NodeB),
+ ?line ?UNTIL([NodeB, NodeC] =:= lists:sort(nodes())),
+ ?line wait_for_ready_net(Config),
+
+ ?line Cpid = rpc:call(NodeC, erlang, whereis, [Name]),
+ ExternalName = [{name,Cpid,NodeB}],
+ ?line ExternalName = get_ext_names(),
+ ?line ExternalName = rpc:call(NodeB, gen_server, call,
+ [global_name_server, get_names_ext]),
+ ?line ExternalName = rpc:call(NodeC, gen_server, call,
+ [global_name_server, get_names_ext]),
+
+ ?line [_] = cnode_links(Cpid),
+ ?line [_,_,_] = cnode_monitored_by(Cpid),
+ ?line no = global:register_name(Name, self()),
+ ?line yes = global:re_register_name(Name, self()),
+ ?line ?UNTIL([] =:= cnode_monitored_by(Cpid)),
+ ?line ?UNTIL([] =:= cnode_links(Cpid)),
+ ?line [] = gen_server:call(global_name_server, get_names_ext, infinity),
+
+ ?line Cpid ! {register, self(), Name},
+ ?line receive {Cpid, Reply1} -> no = Reply1 end,
+ ?line _ = global:unregister_name(Name),
+ test_server:sleep(1000),
+ ?line Cpid ! {register, self(), Name},
+ ?line ?UNTIL(length(get_ext_names()) =:= 1),
+ ?line receive {Cpid, Reply2} -> yes = Reply2 end,
+
+ ?line Cpid ! {unregister, self(), Name},
+ ?line ?UNTIL(length(get_ext_names()) =:= 0),
+ ?line receive {Cpid, Reply3} -> ok = Reply3 end,
+
+ Cpid ! die,
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+ ?line [] = get_ext_names(),
+ ?line [] = rpc:call(NodeB, gen_server, call,
+ [global_name_server, get_names_ext]),
+ ?line [] = rpc:call(NodeC, gen_server, call,
+ [global_name_server, get_names_ext]),
+
+ ?line Cpid2 = erlang:spawn(NodeC, fun() -> cnode_proc(NodeB) end),
+ ?line Cpid2 ! {register, self(), Name},
+ ?line receive {Cpid2, Reply4} -> yes = Reply4 end,
+
+ %% It could be a bug that Cpid2 is linked to 'global_name_server'
+ %% at node 'b'. The effect: Cpid2 dies when node 'b' crashes.
+ stop_node(NodeB),
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+ ?line [] = get_ext_names(),
+ ?line [] = rpc:call(NodeC, gen_server, call,
+ [global_name_server, get_names_ext]),
+
+ %% ?line {_, Trace} = collect_tracers(Nodes),
+ %% lists:foreach(fun(M) -> erlang:display(M) end, Trace),
+
+ ThisNode = node(),
+ ?line Cpid3 = erlang:spawn(NodeC, fun() -> cnode_proc(ThisNode) end),
+ ?line Cpid3 ! {register, self(), Name},
+ ?line receive {Cpid3, Reply5} -> yes = Reply5 end,
+
+ ?line ?UNTIL(length(get_ext_names()) =:= 1),
+ stop_node(NodeC),
+ ?line ?UNTIL(length(get_ext_names()) =:= 0),
+
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+get_ext_names() ->
+ gen_server:call(global_name_server, get_names_ext, infinity).
+
+%% Runs at B
+part_ext(Config, Main, C, Name) ->
+ make_partition(Config, [Main], [node(), C]),
+ ThisNode = node(),
+ Pid = erlang:spawn(C, fun() -> cnode_proc(ThisNode) end),
+ Pid ! {register, self(), Name},
+ receive {Pid, Reply} -> yes = Reply end,
+ rpc:call(C, erlang, register, [Name, Pid]).
+
+cnode_links(Pid) ->
+ Pid ! {links, self()},
+ receive
+ {links, Links} ->
+ Links
+ end.
+
+cnode_monitored_by(Pid) ->
+ Pid ! {monitored_by, self()},
+ receive
+ {monitored_by, MonitoredBy} ->
+ MonitoredBy
+ end.
+
+cnode_proc(E) ->
+ receive
+ {register, From, Name} ->
+ Rep = rpc:call(E, global, register_name_external, [Name, self()]),
+ From ! {self(), Rep};
+ {unregister, From, Name} ->
+ _ = rpc:call(E, global, unregister_name_external, [Name]),
+ From ! {self(), ok};
+ {links, From} ->
+ From ! process_info(self(), links);
+ {monitored_by, From} ->
+ From ! process_info(self(), monitored_by);
+ die ->
+ exit(normal)
+ end,
+ cnode_proc(E).
+
+
+many_nodes(suite) ->
+ [];
+many_nodes(doc) ->
+ ["OTP-5770. Start many nodes. Make them connect at the same time."];
+many_nodes(Config) when is_list(Config) ->
+ Timeout = 180,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+
+ {Rels, N_cps} =
+ case ?t:os_type() of
+ {unix, Osname} when Osname =:= linux;
+ Osname =:= openbsd;
+ Osname =:= darwin ->
+ N_nodes = quite_a_few_nodes(32),
+ {node_rel(1, N_nodes, this), N_nodes};
+ {unix, _} ->
+ case ?t:is_release_available("r11b") of
+ true ->
+ This = node_rel(1, 16, this),
+ R11B = node_rel(17, 32, r11b),
+ {This ++ R11B, 32};
+ false ->
+ {node_rel(1, 32, this), 32}
+ end;
+ _ ->
+ {node_rel(1, 32, this), 32}
+ end,
+ ?line Cps = [begin {ok, Cp} = start_node_rel(Name, Rel, Config), Cp end ||
+ {Name,Rel} <- Rels],
+ Nodes = lists:sort(?NODES),
+ ?line wait_for_ready_net(Nodes, Config),
+
+ ?line Dir = ?config(priv_dir, Config),
+ GoFile = filename:join([Dir, "go.txt"]),
+ file:delete(GoFile),
+
+ CpsFiles = [{N, filename:join([Dir, atom_to_list(N)++".node"])} ||
+ N <- Cps],
+ IsoFun =
+ fun({N, File}) ->
+ file:delete(File),
+ rpc_cast(N, ?MODULE, isolated_node, [File, GoFile, Cps, Config])
+ end,
+ ?line lists:foreach(IsoFun, CpsFiles),
+
+ ?line all_nodes_files(CpsFiles, "isolated", Config),
+ ?line Time = msec(),
+ ?line sync_until(),
+ erlang:display(ready_to_go),
+ ?line touch(GoFile, "go"),
+ ?line all_nodes_files(CpsFiles, "done", Config),
+ ?line Time2 = msec(),
+
+ ?line lists:foreach(fun(N) -> pong = net_adm:ping(N) end, Cps),
+
+ ?line wait_for_ready_net(Config),
+
+ write_high_level_trace(Config), % The test succeeded, but was it slow?
+
+ ?line lists:foreach(fun({_N, File}) -> file:delete(File) end, CpsFiles),
+ ?line file:delete(GoFile),
+
+ ?line ?UNTIL(OrigNames =:= global:registered_names()),
+ write_high_level_trace(Config),
+ ?line stop_nodes(Cps),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ Diff = Time2 - Time,
+ Return = lists:flatten(io_lib:format("~w nodes took ~w ms",
+ [N_cps, Diff])),
+ erlang:display({{nodes,N_cps},{time,Diff}}),
+ ?t:format("~s~n", [Return]),
+ {comment, Return}.
+
+node_rel(From, To, Rel) ->
+ [{lists:concat([cp, N]), Rel} || N <- lists:seq(From, To)].
+
+isolated_node(File, GoFile, Nodes, Config) ->
+ Ns = lists:sort(Nodes),
+ exit(erlang:whereis(user), kill),
+ touch(File, "start_isolated"),
+ NodesList = nodes(),
+ append_to_file(File, [{nodes,Nodes},{nodes_list,NodesList}]),
+ Replies =
+ lists:map(fun(N) -> _ = erlang:disconnect_node(N) end, NodesList),
+ append_to_file(File, {replies,Replies}),
+ ?UNTIL(begin
+ Known = get_known(node()),
+ append_to_file(File, {known,Known}),
+ Known =:= [node()]
+ end),
+ touch(File, "isolated"),
+ sync_until(File),
+ file_contents(GoFile, "go", Config, File),
+ touch(File, "got_go"),
+ lists:foreach(fun(N) -> _ = net_adm:ping(N) end, shuffle(Nodes)),
+ touch(File, "pinged"),
+ ?line ?UNTIL((Ns -- get_known(node())) =:= []),
+ touch(File, "done").
+
+touch(File, List) ->
+ ok = file:write_file(File, list_to_binary(List)).
+
+append_to_file(File, Term) ->
+ {ok, Fd} = file:open(File, [raw,binary,append]),
+ ok = file:write(Fd, io_lib:format("~p.~n", [Term])),
+ ok = file:close(Fd).
+
+all_nodes_files(CpsFiles, ContentsList, Config) ->
+ lists:all(fun({_N,File}) ->
+ file_contents(File, ContentsList, Config)
+ end, CpsFiles).
+
+file_contents(File, ContentsList, Config) ->
+ file_contents(File, ContentsList, Config, no_log_file).
+
+file_contents(File, ContentsList, Config, LogFile) ->
+ Contents = list_to_binary(ContentsList),
+ Sz = size(Contents),
+ ?UNTIL(begin
+ case file:read_file(File) of
+ {ok, FileContents}=Reply ->
+ case catch split_binary(FileContents, Sz) of
+ {Contents,_} ->
+ true;
+ _ ->
+ catch append_to_file(LogFile,
+ {File,Contents,Reply}),
+ false
+ end;
+ Reply ->
+ catch append_to_file(LogFile, {File, Contents, Reply}),
+ false
+ end
+ end).
+
+sync_until() ->
+ sync_until(no_log_file).
+
+sync_until(LogFile) ->
+ Time = ?UNTIL_LOOP - (msec(now()) rem ?UNTIL_LOOP),
+ catch append_to_file(LogFile, {sync_until, Time}),
+ timer:sleep(Time).
+
+shuffle(L) ->
+ [E || {_, E} <- lists:keysort(1, [{random:uniform(), E} || E <- L])].
+
+sync_0(suite) -> [];
+sync_0(doc) ->
+ ["OTP-5770. sync/0."];
+sync_0(Config) when is_list(Config) ->
+ Timeout = 180,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+
+ N_cps =
+ case ?t:os_type() of
+ {unix, Osname} when Osname =:= linux;
+ Osname =:= openbsd;
+ Osname =:= darwin ->
+ quite_a_few_nodes(30);
+ {unix, sunos} ->
+ 30;
+ {unix, _} ->
+ 16;
+ _ ->
+ 30
+ end,
+
+ Names = [lists:concat([cp,N]) || N <- lists:seq(1, N_cps)],
+ Cps = start_and_sync(Names),
+ ?line wait_for_ready_net(Config),
+ write_high_level_trace(Config),
+ stop_nodes(Cps),
+
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+start_and_sync([]) ->
+ [];
+start_and_sync([Name | Names]) ->
+ ?line {ok, N} = start_node(Name, slave, []),
+ ?line {Time, _Void} = rpc:call(N, timer, tc, [global, sync, []]),
+ ?t:format("~p: ~p~n", [Name, Time]),
+ [N | start_and_sync(Names)].
+
+%%%-----------------------------------------------------------------
+%%% Testing of change of global_groups parameter.
+%%%-----------------------------------------------------------------
+global_groups_change(suite) -> [];
+global_groups_change(doc) -> ["Test change of global_groups parameter."];
+global_groups_change(Config) ->
+ Timeout = 90,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line M = from($@, atom_to_list(node())),
+
+ % Create the .app files and the boot script
+ ?line {KernelVer, StdlibVer} = create_script_dc("dc"),
+ ?line case is_real_system(KernelVer, StdlibVer) of
+ true ->
+ Options = [];
+ false ->
+ Options = [local]
+ end,
+
+ ?line ok = systools:make_script("dc", Options),
+
+ [Ncp1,Ncp2,Ncp3,Ncp4,Ncp5,NcpA,NcpB,NcpC,NcpD,NcpE] =
+ node_names([cp1,cp2,cp3,cp4,cp5,cpA,cpB,cpC,cpD,cpE], Config),
+
+ % Write config files
+ ?line Dir = ?config(priv_dir,Config),
+ ?line {ok, Fd_dc} = file:open(filename:join(Dir, "sys.config"), [write]),
+ ?line config_dc1(Fd_dc, Ncp1, Ncp2, Ncp3, NcpA, NcpB, NcpC, NcpD, NcpE),
+ ?line file:close(Fd_dc),
+ ?line Config1 = filename:join(Dir, "sys"),
+
+ % Test [cp1, cp2, cp3]
+ ?line {ok, Cp1} = start_node_boot(Ncp1, Config1, dc),
+ ?line {ok, Cp2} = start_node_boot(Ncp2, Config1, dc),
+ ?line {ok, Cp3} = start_node_boot(Ncp3, Config1, dc),
+ ?line {ok, CpA} = start_node_boot(NcpA, Config1, dc),
+ ?line {ok, CpB} = start_node_boot(NcpB, Config1, dc),
+ ?line {ok, CpC} = start_node_boot(NcpC, Config1, dc),
+ ?line {ok, CpD} = start_node_boot(NcpD, Config1, dc),
+ ?line {ok, CpE} = start_node_boot(NcpE, Config1, dc),
+
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2]),
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cp3]),
+ ?line pang = rpc:call(Cp1, net_adm, ping,
+ [list_to_atom(lists:concat(["cp5@", M]))]),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cp3]),
+ ?line pang = rpc:call(Cp2, net_adm, ping,
+ [list_to_atom(lists:concat(["cp5@", M]))]),
+
+ ?line {TestGG4, yes} = rpc:call(CpB, ?MODULE, start_proc, [test]),
+ ?line {TestGG5, yes} = rpc:call(CpE, ?MODULE, start_proc, [test]),
+
+
+ ?line pong = rpc:call(CpA, net_adm, ping, [CpC]),
+ ?line pong = rpc:call(CpC, net_adm, ping, [CpB]),
+ ?line pong = rpc:call(CpD, net_adm, ping, [CpC]),
+ ?line pong = rpc:call(CpE, net_adm, ping, [CpD]),
+
+ ?line
+ ?UNTIL(begin
+ TestGG4_1 = rpc:call(CpA, global, whereis_name, [test]),
+ TestGG4_2 = rpc:call(CpB, global, whereis_name, [test]),
+ TestGG4_3 = rpc:call(CpC, global, whereis_name, [test]),
+
+ TestGG5_1 = rpc:call(CpD, global, whereis_name, [test]),
+ TestGG5_2 = rpc:call(CpE, global, whereis_name, [test]),
+ io:format("~p~n", [[TestGG4, TestGG4_1, TestGG4_2,TestGG4_3]]),
+ io:format("~p~n", [[TestGG5, TestGG5_1, TestGG5_2]]),
+ (TestGG4_1 =:= TestGG4) and
+ (TestGG4_2 =:= TestGG4) and
+ (TestGG4_3 =:= TestGG4) and
+ (TestGG5_1 =:= TestGG5) and
+ (TestGG5_2 =:= TestGG5)
+ end),
+
+ ?line ?t:format( "#### nodes() ~p~n",[nodes()]),
+
+ ?line XDcWa1 = rpc:call(Cp1, global_group, info, []),
+ ?line XDcWa2 = rpc:call(Cp2, global_group, info, []),
+ ?line XDcWa3 = rpc:call(Cp3, global_group, info, []),
+ ?line ?t:format( "#### XDcWa1 ~p~n",[XDcWa1]),
+ ?line ?t:format( "#### XDcWa2 ~p~n",[XDcWa2]),
+ ?line ?t:format( "#### XDcWa3 ~p~n",[XDcWa3]),
+
+ ?line stop_node(CpC),
+
+ %% Read the current configuration parameters, and change them
+ ?line OldEnv =
+ rpc:call(Cp1, application_controller, prep_config_change, []),
+ ?line {value, {kernel, OldKernel}} = lists:keysearch(kernel, 1, OldEnv),
+
+ ?line GG1 =
+ lists:sort([mk_node(Ncp1, M), mk_node(Ncp2, M), mk_node(Ncp5, M)]),
+ ?line GG2 = lists:sort([mk_node(Ncp3, M)]),
+ ?line GG3 = lists:sort([mk_node(Ncp4, M)]),
+ ?line GG4 = lists:sort([mk_node(NcpA, M), mk_node(NcpB, M)]),
+ ?line GG5 =
+ lists:sort([mk_node(NcpC, M), mk_node(NcpD, M), mk_node(NcpE, M)]),
+
+ ?line NewNG = {global_groups,[{gg1, normal, GG1},
+ {gg2, normal, GG2},
+ {gg3, normal, GG3},
+ {gg4, normal, GG4},
+ {gg5, hidden, GG5}]},
+
+ ?line NewKernel =
+ [{kernel, lists:keyreplace(global_groups, 1, OldKernel, NewNG)}],
+ ?line ok = rpc:call(Cp1, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(Cp2, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(Cp3, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(CpA, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(CpB, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(CpD, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+ ?line ok = rpc:call(CpE, application_controller, test_change_apps,
+ [[kernel], [NewKernel]]),
+
+ ?line ?t:format("#### ~p~n",[multicall]),
+ ?line ?t:format( "#### ~p~n",[multicall]),
+ %% no idea to check the result from the rpc because the other
+ %% nodes will disconnect test server, and thus the result will
+ %% always be {badrpc, nodedown}
+ ?line rpc:multicall([Cp1, Cp2, Cp3, CpA, CpB, CpD, CpE],
+ application_controller, config_change, [OldEnv]),
+
+ ?line {ok, Fd_dc2} = file:open(filename:join(Dir, "sys2.config"), [write]),
+ ?line config_dc2(Fd_dc2, NewNG, Ncp1, Ncp2, Ncp3),
+ ?line file:close(Fd_dc2),
+ ?line Config2 = filename:join(Dir, "sys2"),
+ ?line {ok, CpC} = start_node_boot(NcpC, Config2, dc),
+
+ ?line sync_and_wait(CpA),
+ ?line sync_and_wait(CpD),
+
+ ?line pong = rpc:call(CpA, net_adm, ping, [CpC]),
+ ?line pong = rpc:call(CpC, net_adm, ping, [CpB]),
+ ?line pong = rpc:call(CpD, net_adm, ping, [CpC]),
+ ?line pong = rpc:call(CpE, net_adm, ping, [CpD]),
+
+ ?line GG5 =
+ lists:sort([mk_node(NcpC, M)|rpc:call(CpC, erlang, nodes, [])]),
+ ?line GG5 =
+ lists:sort([mk_node(NcpD, M)|rpc:call(CpD, erlang, nodes, [])]),
+ ?line GG5 =
+ lists:sort([mk_node(NcpE, M)|rpc:call(CpE, erlang, nodes, [])]),
+
+ ?line false =
+ lists:member(mk_node(NcpC, M), rpc:call(CpA, erlang, nodes, [])),
+ ?line false =
+ lists:member(mk_node(NcpC, M), rpc:call(CpB, erlang, nodes, [])),
+
+ ?line
+ ?UNTIL(begin
+ TestGG4a = rpc:call(CpA, global, whereis_name, [test]),
+ TestGG4b = rpc:call(CpB, global, whereis_name, [test]),
+
+ TestGG5c = rpc:call(CpC, global, whereis_name, [test]),
+ TestGG5d = rpc:call(CpD, global, whereis_name, [test]),
+ TestGG5e = rpc:call(CpE, global, whereis_name, [test]),
+ io:format("~p~n", [[TestGG4, TestGG4a, TestGG4b]]),
+ io:format("~p~n", [[TestGG5, TestGG5c, TestGG5d, TestGG5e]]),
+ (TestGG4 =:= TestGG4a) and
+ (TestGG4 =:= TestGG4b) and
+ (TestGG5 =:= TestGG5c) and
+ (TestGG5 =:= TestGG5d) and
+ (TestGG5 =:= TestGG5e)
+ end),
+
+ ?line Info1 = rpc:call(Cp1, global_group, info, []),
+ ?line Info2 = rpc:call(Cp2, global_group, info, []),
+ ?line Info3 = rpc:call(Cp3, global_group, info, []),
+ ?line InfoA = rpc:call(CpA, global_group, info, []),
+ ?line InfoB = rpc:call(CpB, global_group, info, []),
+ ?line InfoC = rpc:call(CpC, global_group, info, []),
+ ?line InfoD = rpc:call(CpD, global_group, info, []),
+ ?line InfoE = rpc:call(CpE, global_group, info, []),
+ ?line ?t:format( "#### Info1 ~p~n",[Info1]),
+ ?line ?t:format( "#### Info2 ~p~n",[Info2]),
+ ?line ?t:format( "#### Info3 ~p~n",[Info3]),
+ ?line ?t:format( "#### InfoA ~p~n",[InfoA]),
+ ?line ?t:format( "#### InfoB ~p~n",[InfoB]),
+ ?line ?t:format( "#### InfoC ~p~n",[InfoC]),
+ ?line ?t:format( "#### InfoD ~p~n",[InfoD]),
+ ?line ?t:format( "#### InfoE ~p~n",[InfoE]),
+
+ ?line {global_groups, GGNodes} = NewNG,
+
+ ?line Info1ok = [{state, synced},
+ {own_group_name, gg1},
+ {own_group_nodes, GG1},
+ {synced_nodes, [mk_node(Ncp2, M)]},
+ {sync_error, []},
+ {no_contact, [mk_node(Ncp5, M)]},
+ {other_groups, remove_gg_pub_type(lists:keydelete
+ (gg1, 1, GGNodes))},
+ {monitoring, []}],
+
+
+ ?line Info2ok = [{state, synced},
+ {own_group_name, gg1},
+ {own_group_nodes, GG1},
+ {synced_nodes, [mk_node(Ncp1, M)]},
+ {sync_error, []},
+ {no_contact, [mk_node(Ncp5, M)]},
+ {other_groups, remove_gg_pub_type(lists:keydelete
+ (gg1, 1, GGNodes))},
+ {monitoring, []}],
+
+ ?line Info3ok = [{state, synced},
+ {own_group_name, gg2},
+ {own_group_nodes, GG2},
+ {synced_nodes, []},
+ {sync_error, []},
+ {no_contact, []},
+ {other_groups, remove_gg_pub_type(lists:keydelete
+ (gg2, 1, GGNodes))},
+ {monitoring, []}],
+
+ ?line InfoAok = [{state, synced},
+ {own_group_name, gg4},
+ {own_group_nodes, GG4},
+ {synced_nodes, lists:delete(mk_node(NcpA, M), GG4)},
+ {sync_error, []},
+ {no_contact, []},
+ {other_groups, remove_gg_pub_type(lists:keydelete
+ (gg4, 1, GGNodes))},
+ {monitoring, []}],
+
+ ?line InfoBok = [{state, synced},
+ {own_group_name, gg4},
+ {own_group_nodes, GG4},
+ {synced_nodes, lists:delete(mk_node(NcpB, M), GG4)},
+ {sync_error, []},
+ {no_contact, []},
+ {other_groups, remove_gg_pub_type(lists:keydelete
+ (gg4, 1, GGNodes))},
+ {monitoring, []}],
+
+ ?line InfoCok = [{state, synced},
+ {own_group_name, gg5},
+ {own_group_nodes, GG5},
+ {synced_nodes, lists:delete(mk_node(NcpC, M), GG5)},
+ {sync_error, []},
+ {no_contact, []},
+ {other_groups, remove_gg_pub_type(lists:keydelete
+ (gg5, 1, GGNodes))},
+ {monitoring, []}],
+
+ ?line InfoDok = [{state, synced},
+ {own_group_name, gg5},
+ {own_group_nodes, GG5},
+ {synced_nodes, lists:delete(mk_node(NcpD, M), GG5)},
+ {sync_error, []},
+ {no_contact, []},
+ {other_groups, remove_gg_pub_type(lists:keydelete
+ (gg5, 1, GGNodes))},
+ {monitoring, []}],
+
+ ?line InfoEok = [{state, synced},
+ {own_group_name, gg5},
+ {own_group_nodes, GG5},
+ {synced_nodes, lists:delete(mk_node(NcpE, M), GG5)},
+ {sync_error, []},
+ {no_contact, []},
+ {other_groups, remove_gg_pub_type(lists:keydelete
+ (gg5, 1, GGNodes))},
+ {monitoring, []}],
+
+
+ ?line case Info1 of
+ Info1ok ->
+ ok;
+ _ ->
+ test_server:fail({{"could not change the global groups"
+ " in node", Cp1}, {Info1, Info1ok}})
+ end,
+
+ ?line case Info2 of
+ Info2ok ->
+ ok;
+ _ ->
+ test_server:fail({{"could not change the global groups"
+ " in node", Cp2}, {Info2, Info2ok}})
+ end,
+
+ ?line case Info3 of
+ Info3ok ->
+ ok;
+ _ ->
+ test_server:fail({{"could not change the global groups"
+ " in node", Cp3}, {Info3, Info3ok}})
+ end,
+
+ ?line case InfoA of
+ InfoAok ->
+ ok;
+ _ ->
+ test_server:fail({{"could not change the global groups"
+ " in node", CpA}, {InfoA, InfoAok}})
+ end,
+
+ ?line case InfoB of
+ InfoBok ->
+ ok;
+ _ ->
+ test_server:fail({{"could not change the global groups"
+ " in node", CpB}, {InfoB, InfoBok}})
+ end,
+
+
+ ?line case InfoC of
+ InfoCok ->
+ ok;
+ _ ->
+ test_server:fail({{"could not change the global groups"
+ " in node", CpC}, {InfoC, InfoCok}})
+ end,
+
+ ?line case InfoD of
+ InfoDok ->
+ ok;
+ _ ->
+ test_server:fail({{"could not change the global groups"
+ " in node", CpD}, {InfoD, InfoDok}})
+ end,
+
+ ?line case InfoE of
+ InfoEok ->
+ ok;
+ _ ->
+ test_server:fail({{"could not change the global groups"
+ " in node", CpE}, {InfoE, InfoEok}})
+ end,
+
+ write_high_level_trace(Config), % no good since CpC was restarted
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(CpA),
+ stop_node(CpB),
+ stop_node(CpC),
+ stop_node(CpD),
+ stop_node(CpE),
+
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+sync_and_wait(Node) ->
+ Ref = make_ref(),
+ Self = self(),
+ spawn(Node, fun () ->
+ global_group:sync(),
+ case whereis(global_group_check) of
+ P when is_pid(P) ->
+ Self ! {Ref, P};
+ _ ->
+ Self ! {Ref, done}
+ end
+ end),
+ receive
+ {Ref, P} when is_pid(P) ->
+ MonRef = erlang:monitor(process, P),
+ receive
+ {'DOWN',MonRef,process,P,_} ->
+ ok
+ end;
+ {Ref, _} ->
+ ok
+ end.
+
+%%% Copied from init_SUITE.erl.
+is_real_system(KernelVsn, StdlibVsn) ->
+ LibDir = code:lib_dir(),
+ filelib:is_dir(filename:join(LibDir, "kernel-" ++ KernelVsn))
+ andalso
+ filelib:is_dir(filename:join(LibDir, "stdlib-" ++ StdlibVsn)).
+
+create_script_dc(ScriptName) ->
+ ?line Name = filename:join(".", ScriptName),
+ ?line Apps = application_controller:which_applications(),
+ ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps),
+ ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps),
+ ?line {ok,Fd} = file:open(Name ++ ".rel", [write]),
+ ?line {_, Version} = init:script_id(),
+ ?line io:format(Fd,
+ "{release, {\"Test release 3\", \"~s\"}, \n"
+ " {erts, \"4.4\"}, \n"
+ " [{kernel, \"~s\"}, {stdlib, \"~s\"}]}.\n",
+ [Version, KernelVer, StdlibVer]),
+ ?line file:close(Fd),
+ {KernelVer, StdlibVer}.
+
+%% Not used?
+config_dc(Fd, Ncp1, Ncp2, Ncp3) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, 1000},"
+ "{global_groups, [{gg1, ['~s@~s', '~s@~s']},"
+ " {gg2, ['~s@~s']}]}"
+ " ]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M, Ncp1, M, Ncp2, M, Ncp3, M]).
+
+
+config_dc1(Fd, Ncp1, Ncp2, Ncp3, NcpA, NcpB, NcpC, NcpD, NcpE) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s','~s@~s','~s@~s','~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, 1000},"
+ "{global_groups, [{gg1, ['~s@~s', '~s@~s']},"
+ " {gg2, ['~s@~s']},"
+ " {gg4, normal, ['~s@~s','~s@~s','~s@~s']},"
+ " {gg5, hidden, ['~s@~s','~s@~s']}]}]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ NcpA, M, NcpB, M, NcpC, M, NcpD, M, NcpE, M,
+ Ncp1, M, Ncp2, M,
+ Ncp3, M,
+ NcpA, M, NcpB, M, NcpC, M,
+ NcpD, M, NcpE, M]).
+
+config_dc2(Fd, NewGG, Ncp1, Ncp2, Ncp3) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, 1000},"
+ "~p]}].~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M, NewGG]).
+
+
+from(H, [H | T]) -> T;
+from(H, [_ | T]) -> from(H, T);
+from(_H, []) -> [].
+
+
+
+other(A, [A, _B]) -> A;
+other(_, [_A, B]) -> B.
+
+
+%% this one runs at cp2
+part1(Config, Main, Cp1, Cp3) ->
+ case catch begin
+ make_partition(Config, [Main, Cp1], [node(), Cp3]),
+ ?line {_Pid, yes} = start_proc(test2),
+ ?line {_Pid2, yes} = start_proc(test4)
+ end of
+ {_, yes} -> ok; % w("ok", []);
+ {'EXIT', _R} ->
+ ok
+ % w("global_SUITE line:~w: ~p", [?LINE, _R])
+ end.
+
+%% Runs at Cp2
+part1_5(Config, Main, Cp1, Cp3) ->
+ case catch begin
+ make_partition(Config, [Main, Cp1], [node(), Cp3]),
+ ?line {_Pid1, yes} = start_proc_basic(name12),
+ ?line {_Pid2, yes} =
+ rpc:call(Cp3, ?MODULE, start_proc_basic, [name03])
+ end of
+ {_, yes} -> ok; % w("ok", []);
+ {'EXIT', _R} ->
+ ok
+ % w("global_SUITE line:~w: ~p", [?LINE, _R])
+ end.
+
+w(X,Y) ->
+ {ok, F} = file:open("cp2.log", [write]),
+ io:format(F, X, Y),
+ file:close(F).
+
+%% this one runs on one node in Part2
+%% The partition is ready when is_ready_partition(Config) returns (true).
+make_partition(Config, Part1, Part2) ->
+ Dir = ?config(priv_dir, Config),
+ Ns = [begin
+ Name = lists:concat([atom_to_list(N),"_",msec(),".part"]),
+ File = filename:join([Dir, Name]),
+ file:delete(File),
+ rpc_cast(N, ?MODULE, mk_part_node, [File, Part, Config], File),
+ {N, File}
+ end || Part <- [Part1, Part2], N <- Part],
+ all_nodes_files(Ns, "done", Config),
+ lists:foreach(fun({_N,File}) -> file:delete(File) end, Ns),
+ PartFile = make_partition_file(Config),
+ touch(PartFile, "done").
+
+%% The node signals its success by touching a file.
+mk_part_node(File, MyPart0, Config) ->
+ touch(File, "start"), % debug
+ MyPart = lists:sort(MyPart0),
+ ?UNTIL(is_node_in_part(File, MyPart)),
+ touch(File, "done").
+
+%% The calls to append_to_file are for debugging.
+is_node_in_part(File, MyPart) ->
+ lists:foreach(fun(N) ->
+ _ = erlang:disconnect_node(N)
+ end, nodes() -- MyPart),
+ case {(Known = get_known(node())) =:= MyPart,
+ (Nodes = lists:sort([node() | nodes()])) =:= MyPart} of
+ {true, true} ->
+ %% Make sure the resolvers have been terminated,
+ %% otherwise they may pop up and send some message.
+ %% (This check is probably unnecessary.)
+ case element(5, global:info()) of
+ [] ->
+ true;
+ Rs ->
+ erlang:display({is_node_in_part, resolvers, Rs}),
+ trace_message({node(), is_node_in_part, Rs}),
+ append_to_file(File, {now(), Known, Nodes, Rs}),
+ false
+ end;
+ _ ->
+ append_to_file(File, {now(), Known, Nodes}),
+ false
+ end.
+
+is_ready_partition(Config) ->
+ File = make_partition_file(Config),
+ file_contents(File, "done", Config),
+ file:delete(File),
+ true.
+
+make_partition_file(Config) ->
+ Dir = ?config(priv_dir, Config),
+ filename:join([Dir, atom_to_list(make_partition_done)]).
+
+%% this one runs at cp3
+part2(Config, Parent, Main, Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6) ->
+ make_partition(Config, [Main, Cp0, Cp1, Cp2], [Cp3, Cp4, Cp5, Cp6]),
+ start_procs(Parent, Cp4, Cp5, Cp6, Config).
+
+part3(Config, Parent, Main, Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6) ->
+ make_partition(Config, [Main, Cp0, Cp1, Cp2], [Cp3, Cp4, Cp5, Cp6]),
+ start_procs(Parent, Cp4, Cp5, Cp6, Config),
+ % Make Cp6 alone
+ ?line rpc_cast(Cp5, ?MODULE, crash, [12000]),
+ ?line rpc_cast(Cp6, ?MODULE, alone, [Cp0, Cp3]).
+
+start_procs(Parent, N1, N2, N3, Config) ->
+ S1 = lists:sort([N1, N2, N3]),
+ ?line
+ ?UNTIL(begin
+ NN = lists:sort(nodes()),
+ S1 =:= NN
+ end),
+ ?line Pid3 = start_proc3(test1),
+ ?line Pid4 = rpc:call(N1, ?MODULE, start_proc3, [test2]),
+ ?line assert_pid(Pid4),
+ ?line Pid5 = rpc:call(N2, ?MODULE, start_proc3, [test3]),
+ ?line assert_pid(Pid5),
+ ?line Pid6 = rpc:call(N3, ?MODULE, start_proc3, [test4]),
+ ?line assert_pid(Pid6),
+ ?line yes = global:register_name(test1, Pid3),
+ ?line yes = global:register_name(test2, Pid4, {global, notify_all_name}),
+ ?line yes = global:register_name(test3, Pid5, {global, random_notify_name}),
+ Resolve = fun(Name, Pid1, Pid2) ->
+ Parent ! {resolve_called, Name, node()},
+ {Min, Max} = minmax(Pid1, Pid2),
+ exit(Min, kill),
+ Max
+ end,
+ ?line yes = global:register_name(test4, Pid6, Resolve).
+
+
+
+collect_resolves() -> cr(0).
+cr(Res) ->
+ receive
+ {resolve_called, Name, Node} ->
+ io:format("resolve called: ~w ~w~n", [Name, Node]),
+ cr(Res+1)
+ after
+ 0 -> Res
+ end.
+
+minmax(P1,P2) ->
+ if node(P1) < node(P2) -> {P1, P2}; true -> {P2, P1} end.
+
+fix_basic_name(name03, Pid1, Pid2) ->
+ case atom_to_list(node(Pid1)) of
+ [$c, $p, $3|_] -> exit(Pid2, kill), Pid1;
+ _ -> exit(Pid1, kill), Pid2
+ end;
+fix_basic_name(name12, Pid1, Pid2) ->
+ case atom_to_list(node(Pid1)) of
+ [$c, $p, $2|_] -> exit(Pid2, kill), Pid1;
+ _ -> exit(Pid1, kill), Pid2
+ end.
+
+start_proc() ->
+ Pid = spawn(?MODULE, p_init, [self()]),
+ receive
+ Pid -> Pid
+ end.
+
+
+start_proc(Name) ->
+ Pid = spawn(?MODULE, p_init, [self(), Name]),
+ receive
+ {Pid, Res} -> {Pid, Res}
+ end.
+
+start_proc2(Name) ->
+ Pid = spawn(?MODULE, p_init2, [self(), Name]),
+ receive
+ Pid -> Pid
+ end.
+
+start_proc3(Name) ->
+ Pid = spawn(?MODULE, p_init, [self()]),
+ register(Name, Pid),
+ receive
+ Pid -> Pid
+ end.
+
+start_proc4(Name) ->
+ Pid = spawn(?MODULE, p_init, [self()]),
+ yes = global:register_name(Name, Pid),
+ receive
+ Pid -> Pid
+ end.
+
+start_proc_basic(Name) ->
+ Pid = spawn(?MODULE, init_proc_basic, [self(), Name]),
+ receive
+ {Pid, Res} -> {Pid, Res}
+ end.
+
+init_proc_basic(Parent, Name) ->
+ X = global:register_name(Name, self(), {?MODULE, fix_basic_name}),
+ Parent ! {self(),X},
+ loop().
+
+single_node(Time, Node, Config) ->
+ exit(erlang:whereis(user), kill),
+ lists:foreach(fun(N) -> _ = erlang:disconnect_node(N) end, nodes()),
+ ?UNTIL(get_known(node()) =:= [node()]),
+ spawn(?MODULE, init_2, []),
+ test_server:sleep(Time - msec()),
+ net_adm:ping(Node).
+
+init_2() ->
+ register(single_name, self()),
+ yes = global:register_name(single_name, self()),
+ loop_2().
+
+loop_2() ->
+ receive
+ die -> ok
+ end.
+
+msec() ->
+ msec(now()).
+
+msec(T) ->
+ element(1,T)*1000000000 + element(2,T)*1000 + element(3,T) div 1000.
+
+assert_pid(Pid) ->
+ if
+ is_pid(Pid) -> true;
+ true -> exit({not_a_pid, Pid})
+ end.
+
+check_same([H|T]) -> check_same(T, H).
+
+check_same([H|T], H) -> check_same(T, H);
+check_same([], _H) -> ok.
+
+check_same_p([H|T]) -> check_same_p(T, H).
+
+check_same_p([H|T], H) -> check_same_p(T, H);
+check_same_p([], _H) -> true;
+check_same_p(_, _) -> false.
+
+p_init(Parent) ->
+ Parent ! self(),
+ loop().
+
+p_init(Parent, Name) ->
+ X = global:register_name(Name, self()),
+ Parent ! {self(),X},
+ loop().
+
+p_init2(Parent, Name) ->
+ _ = global:re_register_name(Name, self()),
+ Parent ! self(),
+ loop().
+
+req(Pid, Msg) ->
+ Pid ! Msg,
+ receive X -> X end.
+
+sreq(Pid, Msg) ->
+ Ref = make_ref(),
+ Pid ! {Msg, Ref},
+ receive {Ref, X} -> X end.
+
+alone(N1, N2) ->
+ lists:foreach(fun(Node) -> true = erlang:disconnect_node(Node) end,
+ nodes()),
+ test_server:sleep(12000),
+ net_adm:ping(N1),
+ net_adm:ping(N2),
+ yes = global:register_name(test5, self()).
+
+crash(Time) ->
+ test_server:sleep(Time),
+ erlang:halt().
+
+loop() ->
+ receive
+ {ping, From} ->
+ From ! {pong, node()},
+ loop();
+ {del_lock, Id} ->
+ global:del_lock({Id, self()}),
+ loop();
+ {del_lock_sync, Id, From} ->
+ global:del_lock({Id, self()}),
+ From ! true,
+ loop();
+ {del_lock, Id, Nodes} ->
+ global:del_lock({Id, self()}, Nodes),
+ loop();
+ {del_lock2, Id, From} ->
+ global:del_lock(Id),
+ From ! true,
+ loop();
+ {del_lock2, Id, From, Nodes} ->
+ global:del_lock(Id, Nodes),
+ From ! true,
+ loop();
+ {set_lock, Id, From} ->
+ Res = global:set_lock({Id, self()}, ?NODES, 1),
+ From ! Res,
+ loop();
+ {set_lock, Id, From, Nodes} ->
+ Res = global:set_lock({Id, self()}, Nodes, 1),
+ From ! Res,
+ loop();
+ {set_lock_loop, Id, From} ->
+ true = global:set_lock({Id, self()}, ?NODES),
+ From ! {got_lock, self()},
+ loop();
+ {set_lock2, Id, From} ->
+ Res = global:set_lock(Id, ?NODES, 1),
+ From ! Res,
+ loop();
+ {{got_notify, From}, Ref} ->
+ receive
+ X when element(1, X) =:= global_name_conflict ->
+ From ! {Ref, yes}
+ after
+ 0 -> From ! {Ref, no}
+ end,
+ loop();
+ die ->
+ exit(normal);
+ drop_dead ->
+ exit(drop_dead)
+ end.
+
+-ifdef(unused).
+pr_diff(Str, T0, T1) ->
+ Diff = begin
+ {_, {H,M,S}} = calendar:time_difference(T0, T1),
+ ((H*60+M)*60)+S
+ end,
+ test_server:format(1,"~13s: ~w (diff: ~w)",[Str, T1, Diff]),
+ if
+ Diff > 100 ->
+ test_server:format(1,"~s: ** LARGE DIFF ~w~n", [Str, Diff]);
+ true ->
+ ok
+ end.
+-endif.
+
+now_diff({A1,B1,C1},{A2,B2,C2}) ->
+ C1-C2 + 1000000*((B1-B2) + 1000000*(A1-A2)).
+
+start_node_boot(Name, Config, Boot) ->
+ Pa = filename:dirname(code:which(?MODULE)),
+ Res = test_server:start_node(Name, peer, [{args, " -pa " ++ Pa ++
+ " -config " ++ Config ++
+ " -boot " ++ atom_to_list(Boot)}]),
+ record_started_node(Res).
+
+%% Increase the timeout for when an upcoming connection is teared down
+%% again (default is 7 seconds, and can be exceeded by some tests).
+%% The default remains in effect for the test_server node itself, though.
+start_node(Name, Config) ->
+ start_node(Name, slave, Config).
+
+start_hidden_node(Name, Config) ->
+ start_node(Name, slave, "-hidden", Config).
+
+start_non_connecting_node(Name, Config) ->
+ start_node(Name, slave, "-connect_all false +W i", Config).
+
+start_peer_node(Name, Config) ->
+ start_node(Name, peer, Config).
+
+start_node(Name, How, Config) ->
+ start_node(Name, How, "", Config).
+
+start_node(Name0, How, Args, Config) ->
+ Name = node_name(Name0, Config),
+ Pa = filename:dirname(code:which(?MODULE)),
+ R = test_server:start_node(Name, How, [{args,
+ Args ++ " " ++
+ "-kernel net_setuptime 100 "
+% "-noshell "
+ "-pa " ++ Pa},
+ {linked, false}
+]),
+ %% {linked,false} only seems to work for slave nodes.
+% test_server:sleep(1000),
+ record_started_node(R).
+
+start_node_rel(Name0, Rel, Config) ->
+ Name = node_name(Name0, Config),
+ {Release, Compat} = case Rel of
+ this ->
+ {[this], "+R8"};
+ Rel when is_atom(Rel) ->
+ {[{release, atom_to_list(Rel)}], ""};
+ RelList ->
+ {RelList, ""}
+ end,
+ Env = case Rel of
+ r11b ->
+ [{env, [{"ERL_R11B_FLAGS", []}]}];
+ _ ->
+ []
+ end,
+ Pa = filename:dirname(code:which(?MODULE)),
+ Res = test_server:start_node(Name, peer,
+ [{args,
+ Compat ++
+ " -kernel net_setuptime 100 "
+ " -pa " ++ Pa},
+ {erl, Release}] ++ Env),
+ record_started_node(Res).
+
+record_started_node({ok, Node}) ->
+ case erase(?nodes_tag) of
+ undefined -> ok;
+ Nodes -> put(?nodes_tag, [Node | Nodes])
+ end,
+ {ok, Node};
+record_started_node(R) ->
+ R.
+
+node_names(Names, Config) ->
+ [node_name(Name, Config) || Name <- Names].
+
+%% simple_resolve assumes that the node name comes first.
+node_name(Name, Config) ->
+ U = "_",
+ {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()),
+ Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w",
+ [Y,M,D, H,Min,S]),
+ L = lists:flatten(Date),
+ lists:concat([Name,U,?testcase,U,U,L]).
+
+stop_nodes(Nodes) ->
+ lists:foreach(fun(Node) -> stop_node(Node) end, Nodes).
+
+stop_node(Node) ->
+ ?line ?t:stop_node(Node).
+
+
+stop() ->
+ lists:foreach(fun(Node) ->
+ ?t:stop_node(Node)
+ end, nodes()).
+
+dbg_logs(Name) -> dbg_logs(Name, ?NODES).
+
+dbg_logs(Name, Nodes) ->
+ lists:foreach(fun(N) ->
+ F = lists:concat([Name, ".log.", N, ".txt"]),
+ ?line ok = sys:log_to_file({global_name_server, N}, F)
+ end, Nodes).
+
+
+global_lost_nodes(suite) ->
+ [];
+global_lost_nodes(doc) ->
+ ["Tests that locally loaded nodes do not loose contact with other nodes."];
+global_lost_nodes(Config) when is_list(Config) ->
+ Timeout = 60,
+ Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+
+ ?line {ok, Node1} = start_node(node1, Config),
+ ?line {ok, Node2} = start_node(node2, Config),
+
+ ?line wait_for_ready_net(Config),
+
+ ?line io:format("Nodes: ~p", [nodes()]),
+ ?line io:format("Nodes at node1: ~p",
+ [rpc:call(Node1, erlang, nodes, [])]),
+ ?line io:format("Nodes at node2: ~p",
+ [rpc:call(Node2, erlang, nodes, [])]),
+
+ ?line rpc_cast(Node1, ?MODULE, global_load, [node_1,Node2,node_2]),
+ ?line rpc_cast(Node2, ?MODULE, global_load, [node_2,Node1,node_1]),
+
+ lost_nodes_waiter(Node1, Node2),
+
+ write_high_level_trace(Config),
+ ?line stop_node(Node1),
+ ?line stop_node(Node2),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+global_load(MyName, OtherNode, OtherName) ->
+ ?line yes = global:register_name(MyName, self()),
+ io:format("Registered ~p",[MyName]),
+ global_load1(OtherNode, OtherName, 0).
+
+global_load1(_OtherNode, _OtherName, 2) ->
+ io:format("*** ~p giving up. No use.", [node()]),
+ init:stop();
+global_load1(OtherNode, OtherName, Fails) ->
+ test_server:sleep(1000),
+ ?line case catch global:whereis_name(OtherName) of
+ Pid when is_pid(Pid) ->
+ io:format("~p says: ~p is still there.",
+ [node(),OtherName]),
+ global_load1(OtherNode, OtherName, Fails);
+ Other ->
+ io:format("~p says: ~p is lost (~p) Pinging.",
+ [ node(), OtherName, Other]),
+ case net_adm:ping(OtherNode) of
+ pong ->
+ io:format("Re-established contact to ~p",
+ [OtherName]);
+ pang ->
+ io:format("PANIC! Other node is DEAD.", []),
+ init:stop()
+ end,
+ global_load1(OtherNode, OtherName, Fails+1)
+ end.
+
+lost_nodes_waiter(N1, N2) ->
+ ?line net_kernel:monitor_nodes(true),
+ receive
+ {nodedown, Node} when Node =:= N1 ; Node =:= N2 ->
+ io:format("~p went down!",[Node]),
+ ?line ?t:fail("Node went down.")
+ after 10000 ->
+ ok
+ end,
+ ok.
+
+
+
+mass_death(suite) ->
+ [];
+mass_death(doc) ->
+ ["Tests the simultaneous death of many processes with registered names"];
+mass_death(Config) when is_list(Config) ->
+ Timeout = 90,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line OrigNames = global:registered_names(),
+ %% Start nodes
+ ?line Cps = [cp1,cp2,cp3,cp4,cp5],
+ ?line Nodes = [begin {ok, Node} = start_node(Cp, Config), Node end ||
+ Cp <- Cps],
+ ?line io:format("Nodes: ~p~n", [Nodes]),
+ ?line Ns = lists:seq(1, 40),
+ %% Start processes with globally registered names on the nodes
+ ?line {Pids,[]} = rpc:multicall(Nodes, ?MODULE, mass_spawn, [Ns]),
+ ?line io:format("Pids: ~p~n", [Pids]),
+ %% Wait...
+ ?line test_server:sleep(10000),
+ %% Check the globally registered names
+ ?line NewNames = global:registered_names(),
+ ?line io:format("NewNames: ~p~n", [NewNames]),
+ ?line Ndiff = lists:sort(NewNames--OrigNames),
+ ?line io:format("Ndiff: ~p~n", [Ndiff]),
+ ?line Ndiff = lists:sort(mass_names(Nodes, Ns)),
+ %%
+ %% Kill the root pids
+ ?line lists:foreach(fun (Pid) -> Pid ! drop_dead end, Pids),
+ %% Start probing and wait for all registered names to disappear
+ {YYYY,MM,DD} = date(),
+ {H,M,S} = time(),
+ io:format("Started probing: ~.4.0w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w~n",
+ [YYYY,MM,DD,H,M,S]),
+ wait_mass_death(Dog, Nodes, OrigNames, erlang:now(), Config).
+
+wait_mass_death(Dog, Nodes, OrigNames, Then, Config) ->
+ ?line Names = global:registered_names(),
+ ?line
+ case Names--OrigNames of
+ [] ->
+ ?line T = now_diff(erlang:now(), Then) div 1000,
+ ?line lists:foreach(
+ fun (Node) ->
+ stop_node(Node)
+ end, Nodes),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ {comment,lists:flatten(io_lib:format("~.3f s~n", [T/1000.0]))};
+ Ndiff ->
+ ?line io:format("Ndiff: ~p~n", [Ndiff]),
+ ?line test_server:sleep(1000),
+ ?line wait_mass_death(Dog, Nodes, OrigNames, Then, Config)
+ end.
+
+mass_spawn([]) ->
+ ok;
+mass_spawn([N|T]) ->
+ Parent = self(),
+ Pid =
+ spawn_link(
+ fun () ->
+ Name = mass_name(node(), N),
+ yes = global:register_name(Name, self()),
+ mass_spawn(T),
+ Parent ! self(),
+ loop()
+ end),
+ receive Pid -> Pid end.
+
+mass_names([], _) ->
+ [];
+mass_names([Node|T],Ns) ->
+ [mass_name(Node, N) || N <- Ns] ++ mass_names(T, Ns).
+
+mass_name(Node, N) ->
+ list_to_atom(atom_to_list(Node)++"_"++integer_to_list(N)).
+
+
+
+start_nodes(L, How, Config) ->
+ start_nodes2(L, How, 0, Config),
+ Nodes = collect_nodes(0, length(L)),
+ ?line ?UNTIL([] =:= Nodes -- nodes()),
+ put(?nodes_tag, Nodes),
+ %% Pinging doesn't help, we have to wait too, for nodes() to become
+ %% correct on the other node.
+ lists:foreach(fun(E) ->
+ net_adm:ping(E)
+ end,
+ Nodes),
+ verify_nodes(Nodes, Config),
+ Nodes.
+
+%% Not used?
+start_nodes_serially([], _, _Config) ->
+ [];
+start_nodes_serially([Name | Rest], How, Config) ->
+ {ok, R} = start_node(Name, How, Config),
+ [R | start_nodes_serially(Rest, How, Config)].
+
+verify_nodes(Nodes, Config) ->
+ verify_nodes(Nodes, lists:sort([node() | Nodes]), Config).
+
+verify_nodes([], _N, _Config) ->
+ [];
+verify_nodes([Node | Rest], N, Config) ->
+ ?line ?UNTIL(
+ case rpc:call(Node, erlang, nodes, []) of
+ Nodes when is_list(Nodes) ->
+ case N =:= lists:sort([Node | Nodes]) of
+ true ->
+ true;
+ false ->
+ lists:foreach(fun(Nd) ->
+ rpc:call(Nd, net_adm, ping,
+ [Node])
+ end,
+ nodes()),
+ false
+ end;
+ _ ->
+ false
+ end
+ ),
+ verify_nodes(Rest, N, Config).
+
+
+start_nodes2([], _How, _, _Config) ->
+ [];
+start_nodes2([Name | Rest], How, N, Config) ->
+ Self = self(),
+ spawn(fun() ->
+ erlang:display({starting, Name}),
+ {ok, R} = start_node(Name, How, Config),
+ erlang:display({started, Name, R}),
+ Self ! {N, R},
+ %% sleeping is necessary, or with peer nodes, they will
+ %% go down again, despite {linked, false}.
+ test_server:sleep(100000)
+ end),
+ start_nodes2(Rest, How, N+1, Config).
+
+collect_nodes(N, N) ->
+ [];
+collect_nodes(N, Max) ->
+ receive
+ {N, Node} ->
+ [Node | collect_nodes(N+1, Max)]
+ end.
+
+only_element(_E, []) ->
+ true;
+only_element(E, [E|R]) ->
+ only_element(E, R);
+only_element(_E, _) ->
+ false.
+
+exit_p(Pid) ->
+ Ref = erlang:monitor(process, Pid),
+ Pid ! die,
+ receive
+ {'DOWN', Ref, process, Pid, _Reason} ->
+ ok
+ end.
+
+wait_for_exit(Pid) ->
+ Ref = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', Ref, process, Pid, _Reason} ->
+ ok
+ end.
+
+wait_for_exit_fast(Pid) ->
+ Ref = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', Ref, process, Pid, _Reason} ->
+ ok
+ end.
+
+check_everywhere(Nodes, Name, Config) ->
+ ?UNTIL(begin
+ case rpc:multicall(Nodes, global, whereis_name, [Name]) of
+ {Ns1, []} ->
+ check_same_p(Ns1);
+ _R ->
+ false
+ end
+ end).
+
+init_condition(Config) ->
+ io:format("globally registered names: ~p~n", [global:registered_names()]),
+ io:format("nodes: ~p~n", [nodes()]),
+ io:format("known: ~p~n", [get_known(node()) -- [node()]]),
+ io:format("Info ~p~n", [setelement(11, global:info(), trace)]),
+ _ = [io:format("~s: ~p~n", [TN, ets:tab2list(T)]) ||
+ {TN, T} <- [{"Global Names (ETS)", global_names},
+ {"Global Names Ext (ETS)", global_names_ext},
+ {"Global Locks (ETS)", global_locks},
+ {"Global Pid Names (ETS)", global_pid_names},
+ {"Global Pid Ids (ETS)", global_pid_ids}]],
+ ?UNTIL([test_server] =:= global:registered_names()),
+ ?UNTIL([] =:= nodes()),
+ ?UNTIL([node()] =:= get_known(node())),
+ ok.
+
+mk_node(N, H) when is_list(N), is_list(H) ->
+ list_to_atom(N ++ "@" ++ H).
+
+remove_gg_pub_type([]) ->
+ [];
+remove_gg_pub_type([{GG, Nodes}|Rest]) ->
+ [{GG, Nodes}|remove_gg_pub_type(Rest)];
+remove_gg_pub_type([{GG, _, Nodes}|Rest]) ->
+ [{GG, Nodes}|remove_gg_pub_type(Rest)].
+
+%% Send garbage message to all processes that are linked to global.
+%% Better do this in a slave node.
+%% (The transition from links to monitors does not affect this case.)
+
+garbage_messages(suite) ->
+ [];
+garbage_messages(Config) when is_list(Config) ->
+ Timeout = 25,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ init_high_level_trace(Timeout),
+ ?line init_condition(Config),
+ ?line [Slave] = start_nodes([garbage_messages], slave, Config),
+ Fun = fun() ->
+ {links,L} = process_info(whereis(global_name_server), links),
+ lists:foreach(fun(Pid) -> Pid ! {garbage,to,you} end, L),
+ receive
+ _Any -> ok
+ end
+ end,
+ ?line Pid = spawn_link(Slave, erlang, apply, [Fun,[]]),
+ ?t:sleep(2000),
+ ?line Global = rpc:call(Slave, erlang, whereis, [global_name_server]),
+ ?line {registered_name,global_name_server} =
+ rpc:call(Slave, erlang, process_info, [Global,registered_name]),
+ ?line true = unlink(Pid),
+ write_high_level_trace(Config),
+ ?line stop_node(Slave),
+ ?line init_condition(Config),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+wait_for_ready_net(Config) ->
+ wait_for_ready_net(?NODES, Config).
+
+wait_for_ready_net(Nodes0, Config) ->
+ Nodes = lists:sort(Nodes0),
+ ?t:format("wait_for_ready_net ~p~n", [Nodes]),
+ ?UNTIL(begin
+ lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and
+ lists:all(fun(N) ->
+ LNs = rpc:call(N, erlang, nodes, []),
+ Nodes =:= lists:sort([N | LNs])
+ end, Nodes)
+ end).
+
+get_known(Node) ->
+ case catch gen_server:call({global_name_server,Node},get_known,infinity) of
+ {'EXIT', _} ->
+ [list, without, nodenames];
+ Known when is_list(Known) ->
+ lists:sort([Node | Known])
+ end.
+
+quite_a_few_nodes(Max) ->
+ N = try
+ ulimit("ulimit -u")
+ catch _:_ ->
+ ulimit("ulimit -p") % can fail...
+ end,
+ lists:min([(N - 40) div 3, Max]).
+
+ulimit(Cmd) ->
+ N0 = os:cmd(Cmd),
+ N1 = lists:reverse(N0),
+ N2 = lists:dropwhile(fun($\r) -> true;
+ ($\n) -> true;
+ (_) -> false
+ end, N1),
+ case lists:reverse(N2) of
+ "unlimited" -> 10000;
+ N -> list_to_integer(N)
+ end.
+
+%% To make it less probable that some low-level problem causes
+%% problems, the receiving node is ping:ed.
+rpc_cast(Node, Module, Function, Args) ->
+ {_,pong,Node}= {node(),net_adm:ping(Node),Node},
+ rpc:cast(Node, Module, Function, Args).
+
+rpc_cast(Node, Module, Function, Args, File) ->
+ case net_adm:ping(Node) of
+ pong ->
+ rpc:cast(Node, Module, Function, Args);
+ Else ->
+ append_to_file(File, {now(), {rpc_cast, Node, Module, Function,
+ Args, Else}})
+ %% Maybe we should crash, but it probably doesn't matter.
+ end.
+
+%% The emulator now ensures that the node has been removed from
+%% nodes().
+rpc_disconnect_node(Node, DisconnectedNode, _Config) ->
+ True = rpc:call(Node, erlang, disconnect_node, [DisconnectedNode]),
+ False = lists:member(DisconnectedNode, rpc:call(Node, erlang, nodes, [])),
+ {true, false} = {True, False}.
+
+%%%
+%%% Utility
+%%%
+
+%% It is a bit awkward to collect data from different nodes. One way
+%% of doing is to use a named tracer process on each node. Interesting
+%% data is banged to the tracer and when the test is finished data is
+%% collected on some node by sending messages to the tracers. One
+%% cannot do this if the net has been set up to be less than fully
+%% connected. One can also prepare other modules, such as 'global', by
+%% inserting lines like
+%% trace_message({node(), {at,?LINE}, {tag, message})
+%% where appropriate.
+
+start_tracer() ->
+ Pid = spawn(fun() -> tracer([]) end),
+ case catch register(my_tracer, Pid) of
+ {'EXIT', _} ->
+ ?t:fail(re_register_my_tracer);
+ _ ->
+ ok
+ end.
+
+tracer(L) ->
+ receive
+ % {save, Term} ->
+ % tracer([{now(),Term} | L]);
+ {get, From} ->
+ From ! {trace, lists:reverse(L)},
+ tracer([]);
+ stop ->
+ exit(normal);
+ Term ->
+ tracer([{now(),Term} | L])
+ end.
+
+stop_tracer() ->
+ trace_message(stop).
+
+get_trace() ->
+ trace_message({get, self()}),
+ receive {trace, L} ->
+ L
+ end.
+
+collect_tracers(Nodes) ->
+ Traces0 = [rpc:call(N, ?MODULE, get_trace, []) || N <- Nodes],
+ Traces = [L || L <- Traces0, is_list(L)],
+ try begin
+ Stamped = lists:keysort(1, lists:append(Traces)),
+ NotStamped = [T || {_, T} <- Stamped],
+ {Stamped, NotStamped}
+ end
+ catch _:_ -> {[], []}
+ end.
+
+trace_message(M) ->
+ case catch my_tracer ! M of
+ {'EXIT', _} ->
+ ?t:fail(my_tracer_not_registered);
+ _ ->
+ ok
+ end.
+
+%%-----------------------------------------------------------------
+%% The error_logger handler used for OTP-6931.
+%%-----------------------------------------------------------------
+init(Tester) ->
+ {ok, Tester}.
+
+handle_event({_, _GL, {_Pid,_String,[{nodeup,fake_node}=Msg]}}, Tester) ->
+ Tester ! Msg,
+ {ok, Tester};
+handle_event(_Event, State) ->
+ {ok, State}.
+
+handle_info(_Info, State) ->
+ {ok, State}.
+
+handle_call(_Query, State) -> {ok, {error, bad_query}, State}.
+
+terminate(_Reason, State) ->
+ State.
+
diff --git a/lib/kernel/test/global_SUITE_data/global_trace.erl b/lib/kernel/test/global_SUITE_data/global_trace.erl
new file mode 100644
index 0000000000..4f253baac4
--- /dev/null
+++ b/lib/kernel/test/global_SUITE_data/global_trace.erl
@@ -0,0 +1,1023 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(global_trace).
+
+%%%
+%%% Inspection of High Level Trace created by global.erl.
+%%%
+
+%%% A few handy functions when running the test_server
+%%%
+
+d() ->
+ lists:foreach(fun(F) -> dd(F, []) end, last()).
+
+d(Testcase) ->
+ d(Testcase, []).
+
+%% Skip "global_" from T.
+d(Testcase, Options) ->
+ [Filename] = tmp_files(Testcase),
+ dd(Filename, Options).
+
+dd(Filename, Options) ->
+ io:format("\n======= ~s \n", [Filename]),
+ t(Filename, Options).
+
+last() ->
+ tmp_files("*").
+
+%% global_groups_change: one node is restarted
+%% global_mass_death: nodes are stopped
+%% global_lock_die: two spurious (trying to remove locks taken by other pid)
+%% global_otp_5640: 4 spurious (names registered again &c)
+tmp_files(A) when is_atom(A) ->
+ tmp_files(atom_to_list(A));
+tmp_files(T) when is_list(T) ->
+ Logs = logdir(),
+ Dir = lists:last(filelib:wildcard(filename:join(Logs, "*"))),
+ filelib:wildcard(filename:join([Dir, log_private, "global_" ++ T])).
+
+%logdir() ->
+% "/net/yoshi/ldisk/daily_build/otp_norel_linux_r11b.2007-02-18_19/"
+% "test/test_server/global_SUITE.logs";
+%logdir() ->
+% "/ldisk/daily_build/otp_norel_linux_suse_r11b.2007-02-07_19/test/"
+% "test_server/global_SUITE.logs";
+logdir() ->
+ "/tmp/tests/test_server/global_SUITE.logs".
+
+
+
+%%% The contents of this file is by no means fixed; the printouts are
+%%% updated depending on the problems at hand. Not everything has been
+%%% designed very carefully :)
+%%%
+%%% For one thing, the trace from all nodes are written onto the file
+%%% as one single term. One term per node would be better. &c.
+
+-compile(export_all).
+
+-record(state, {connect_all, known = [], synced = [],
+ resolvers = [], syncers = [], node_name = node(),
+ the_locker, the_deleter, the_registrar, trace = [],
+ global_lock_down
+ }).
+
+%% Compatible with different versions.
+state(#state{}=S) ->
+ S;
+state({state, ConnectAll, Known, Synced, LockersResolvers, Syncers,
+ NodeName, TheLocker, TheDeleter}) ->
+ %% r10b: Lockers, r10b_patched, r11b: Resolvers
+ #state{connect_all = ConnectAll, known = Known, synced = Synced,
+ resolvers = LockersResolvers, syncers = Syncers,
+ node_name = NodeName, the_locker = TheLocker,
+ the_deleter = TheDeleter, the_registrar = undefined, trace = []};
+state({state, ConnectAll, Known, Synced, Resolvers, Syncers,
+ NodeName, TheLocker, TheDeleter, Trace}) ->
+ %% r11b, some time before r11b-3
+ #state{connect_all = ConnectAll, known = Known, synced = Synced,
+ resolvers = Resolvers, syncers = Syncers,
+ node_name = NodeName, the_locker = TheLocker,
+ the_deleter = TheDeleter, the_registrar = undefined,
+ trace = Trace};
+state({state, ConnectAll, Known, Synced, Resolvers, Syncers,
+ NodeName, TheLocker, TheDeleter, TheRegistrar, Trace}) ->
+ %% r11b, some time after r11b-3
+ #state{connect_all = ConnectAll, known = Known, synced = Synced,
+ resolvers = Resolvers, syncers = Syncers,
+ node_name = NodeName, the_locker = TheLocker,
+ the_deleter = TheDeleter, the_registrar = TheRegistrar,
+ trace = Trace, global_lock_down = false};
+state(Else) ->
+ Else.
+
+%%% Trace tuples look like {Node, Now, Message, Nodes, Extra}.
+%%% Nodes is the list as returned by nodes().
+%%% Extra is [] most of the time.
+%%%
+%%% init
+%%% {nodedown,DownNode}
+%%% {extra_nodedown,DownNode}
+%%% {nodeup, UpNode}
+%%% {added,AddedNodes}, Extra = [{new_nodes, NewNodes},
+%%% {abcast, Known},
+%%% {ops,Ops}]
+%%% NewKnown = Known ++ AddedNodes
+%%% AddedNodes = NewNodes -- Known
+%%% NewNodes �r h�r den man f�rhandlat med plus de noder den k�nner till.
+%%% {added, AddedNodes}, Extra = [{ops,Ops}]
+%%% NewKnown = Known ++ AddedNodes
+%%% Den (passiva) noden f�r Nodes som �r NewNodes
+%%% hos den f�rhandlande. Sedan: AddedNodes = (Nodes -- Known) -- [node()].
+%%% Det �r som hos f�rhandlaren.
+%%% {nodes_changed, {New,Old}}
+%%% Every now and then the list [node() | nodes()] is checked for updates.
+%%% New are the nodes that global does not know of (yet).
+%%% {new_node_name, NewNode}
+%%% Ignored. Someone changes the nodename dynamically.
+%%% {ins_name, Node}, Extra = [Name, Pid]
+%%% Node = node(Pid)
+%%% {ins_name_ext, Node}, Extra = [Name, Pid]
+%%% Node = node(Pid)
+%%% {del_name, Node}, Extra = [Name, Pid]
+%%% Node = node(Pid)
+%%% {ins_lock, Node}, Extra = [Id, Pid]
+%%% Node = node(Pid)
+%%% {rem_lock, Node}, Extra = [Id, Pid]
+%%% Node = node(Pid)
+%%% {locker_succeeded, node()}, Extra = {First, Known}
+%%% {locker_failed, node()}, Extra = {Tried, SoFar}
+%%% The nodes in SoFar have been locked, could not lock Tried.
+%%%
+%%% Also trace of the creation and deletion of resolvers
+%%% (this kind of resolvers are created when nodeup arrives from
+%%% unknown nodes (there are also name resolvers...)).
+%%% {new_resolver, Node}, Extra = [Tag, ResolverPid]
+%%% {kill_resolver, Node}, Extra = [Tag, ResolverPid]
+%%% {exit_resolver, Node}, Extra = [Tag]
+
+-record(node, {
+ node,
+ known = [], % #state.known (derived)
+ nodes = [], % nodes()
+ locks = [], % [{Id, [Pid, node(Pid)]}] (derived)
+ names = [], % [{Name, Pid, node(Pid)}] (derived)
+ resolvers = [], % [{Node, Tag, ResolverPid}]
+ n_locks = {0, % OK
+ 0, % Tried to lock the boss
+ 0, % Tried to lock other boss
+ 0}, % Tried to lock known
+ rejected = 0 % Lock OK, but later rejected
+ }).
+
+-record(w, {nodes = [], % [#node{}]
+ n = []}).
+
+t(File) ->
+ t(File, []).
+
+%%% What to search for in the output of t/2?
+%%% - 'NEGOTIATIONS': this is a list of the name negotiations
+%%% (the big picture);
+%%% - '###' signals a possibly strange event;
+%%% - 'spurious' is used for "tagging" such events;
+%%% - 'resol ' could mean that some resolver process has not been removed;
+%%% ...
+
+%% Options:
+%% {show_state, From, To}
+%% From = To = integer() | {integer(), integer()}
+%% Examples: {7, 8} (show states between seconds 7.0 and 8.0);
+%% {{1,431234},{2,432}} (between 1.431234 and 2.000432)
+%% The state of a node includes locks, names, nodes, known, ...
+%% Default is {{0,0}, {0,0}}, that is, do not show state.
+%% show_state
+%% same as {show_state, 0, 1 bsl 28}, that is, show every state
+%% {show_trace, bool()
+%% Show the complete trace as one list and per node pair.
+%% Default is true.
+t(File, Options) ->
+ {StateFun, ShowTrace} =
+ case options(Options, [show_state, show_trace]) of
+ [{From,To}, ST] ->
+ {fun(T, S) ->
+ Time = element(2, T),
+ if
+ Time >= From, Time =< To ->
+ io:format("===> ~p~n", [T]),
+ display_nodes("After", Time, S#w.nodes, T);
+ true ->
+ ok
+ end
+ end, ST};
+ _ ->
+ erlang:error(badarg, [File, Options])
+ end,
+ D1 = try
+ %% All nodes' trace is put on the file as one binary.
+ %% This could (and should?) be improved upon.
+ {ok, Bin} = file:read_file(File),
+ io:format("Size of trace file is ~p bytes~n", [size(Bin)]),
+ binary_to_term(Bin)
+ catch _:_ ->
+ {ok, [D0]} = file:consult(File),
+ D0
+ end,
+ {D2, End} = case D1 of
+ {high_level_trace, ET, D3} ->
+ {D3, ET};
+ _ ->
+ {D1, now()}
+ end,
+ D = adjust_nodes(D2),
+ {NodeNodeTrace, _NodeTrace, Trace, Base} = get_trace(D, End),
+ messages(D, Base, End),
+
+ %io:format("NET~n ~p~n", [net_kernel_nodes(NodeTrace)]),
+
+ io:format("NEGOTIATIONS:~n ~p~n", [negotiations(Trace)]),
+
+ io:format("*** Complete trace ***~n"),
+ if
+ ShowTrace ->
+ show_trace(Trace),
+ io:format("--- End of complete trace ---~n"),
+ lists:map(fun({{Node,ActionNode},Ts}) ->
+ io:format("*** Trace for ~p on node ~p ***~n",
+ [ActionNode, Node]),
+ show_trace(lists:keysort(2, Ts)),
+ io:format("--- End of trace for ~p on node ~p ---~n",
+ [ActionNode, Node])
+ end, NodeNodeTrace);
+ true -> ok
+ end,
+ io:format("*** Evaluation ***~n"),
+ {Fini, Spurious} = eval(Trace, StateFun),
+ io:format("*** End of evaluation ***~n"),
+ show_spurious(NodeNodeTrace, Spurious),
+ display_nodes("FINI", '', Fini),
+ ok.
+
+% show_trace(Trace) ->
+% lists:foreach(fun({Node, {S,Mu}, Message, Nodes, Extra}) ->
+% io:format("~2w.~6..0w ~w~n", [S, Mu, Node]),
+% io:format(" ~p~n", [Message]),
+% io:format(" Nodes: ~p~n", [Nodes]),
+% case Extra of
+% [] -> ok;
+% _ -> io:format(" Extra: ~p~n", [Extra])
+% end
+% end, Trace);
+show_trace(Trace) ->
+ lists:map(fun(T) -> io:format("~p~n", [T]) end, Trace).
+
+get_trace(D, EndTime0) ->
+ NodeTrace0 = [{Node,lists:keysort(2, (state(State))#state.trace)} ||
+ {Node,{info,State}} <- D,
+ case state(State) of
+ #state{trace = no_trace} ->
+ io:format("No trace for ~p~n", [Node]),
+ false;
+ #state{} ->
+ true;
+ Else ->
+ io:format("Bad state for ~p: ~p~n",
+ [Node, Else]),
+ false
+ end],
+ Trace0 = lists:keysort(2, lists:append([T || {_Node, T} <- NodeTrace0])),
+ Trace1 = sort_nodes(Trace0),
+ {Base, Trace2} = adjust_times(Trace1),
+ EndTime = adjust_time(EndTime0, Base),
+ io:format("The trace was generated at ~p~n", [EndTime]),
+ Trace = [T || T <- Trace2, element(2, T) < EndTime],
+ NodeTrace = [{Node, adjust_times(Ts, Base)} ||
+ {Node, Ts} <- NodeTrace0],
+ NodeNodeTrace =
+ [{{Node,ActionNode}, T} || {Node, Ts} <- NodeTrace,
+ T <- Ts,
+ ActionNode <- action_nodes(T)],
+ {family(NodeNodeTrace), NodeTrace, Trace, Base}.
+
+adjust_nodes([E | Es]) ->
+ [adjust_nodes(E) | adjust_nodes(Es)];
+adjust_nodes(T) when is_tuple(T) ->
+ list_to_tuple(adjust_nodes(tuple_to_list(T)));
+adjust_nodes(A) when is_atom(A) ->
+ adjust_node(A);
+adjust_nodes(E) ->
+ E.
+
+sort_nodes(Ts) ->
+ [setelement(4, T, lists:sort(element(4, T))) || T <- Ts].
+
+adjust_times([]) ->
+ {0, []};
+adjust_times([T1 | _]=Ts) ->
+ Base = element(2, T1),
+ {Base, adjust_times(Ts, Base)}.
+
+adjust_times(Ts, Base) ->
+ [setelement(2, adj_tag(T, Base), adjust_time(element(2, T), Base)) ||
+ T <- Ts].
+
+adj_tag({Node, Time, {M, Node2}, Nodes, Extra}=T, Base) ->
+ if
+ M =:= new_resolver;
+ M =:= kill_resolver;
+ M =:= exit_resolver ->
+ {Node, Time, {M, Node2}, Nodes,
+ [adjust_time(hd(Extra), Base) | tl(Extra)]};
+ true ->
+ T
+ end.
+
+adjust_time(Time, Base) ->
+ musec2sec(timer:now_diff(Time, Base)).
+
+action_nodes({_Node, _Time, {_, Nodes}, _, _}) when is_list(Nodes) ->
+ Nodes;
+action_nodes({_Node, _Time, {_, Node}, _, _}) ->
+ [Node].
+
+%% Some of the names in global_SUITE.erl are recognized.
+adjust_node(Node) ->
+ case atom_to_list(Node) of
+ "cp" ++ L ->
+ list_to_atom([$c, $p | lists:takewhile(fun is_digit/1, L)]);
+ "test_server" ++ _ ->
+ test_server;
+ "a_2" ++ _ ->
+ a_2;
+ "n_1" ++ _ ->
+ n_1;
+ "n_2" ++ _ ->
+ n_2;
+ "z_2" ++ _ ->
+ z_2;
+ "z_" ++ _ ->
+ z;
+ "b_" ++ _ ->
+ b;
+ "c_external_nodes" ++ _ ->
+ c_external_nodes;
+ _ ->
+ Node
+ end.
+
+is_digit(C) ->
+ (C >= $0) and (C =< $9).
+
+eval(Trace, Fun) ->
+ eval(Trace, {0, 0}, #w{}, Fun).
+
+eval([T | Ts], Time0, S0, Fun) ->
+ Time1 = element(2, T),
+ case is_fresh(S0#w.nodes) of
+ true ->
+ io:format("~p ***************** FRESH *****************~n",
+ [Time1]);
+ false ->
+ ok
+ end,
+ case time_diff(Time1, Time0) > 0 of
+ true ->
+ display_nodes("PAUS", Time1, S0#w.nodes, T);
+ false ->
+ ok
+ end,
+ S = eval_trace(T, S0),
+ Fun(T, S),
+ eval(Ts, Time1, S, Fun);
+eval([], _, S, _Fun) ->
+ {S#w.nodes, lists:usort(S#w.n)}.
+
+%% Old.
+eval_trace({Node, Time, {added,Added}, _Nodes, [_NewNodes,_Abc]}, S0) ->
+ added(Node, Added, Time, S0);
+eval_trace({Node, Time, {added,Added}, _Nodes, []}, S0) ->
+ added(Node, Added, Time, S0);
+
+
+eval_trace({Node, Time, {init, Node}, Nodes, []}, S0) ->
+ init(Node, Nodes, Time, S0);
+eval_trace({Node, Time, {nodedown, DownNode}, Nodes, []}, S0) ->
+ node_down(Node, DownNode, Nodes, Time, S0);
+eval_trace({Node, Time, {extra_nodedown, DownNode}, Nodes, []}, S0) ->
+ node_down(Node, DownNode, Nodes, Time, S0);
+eval_trace({Node, Time, {nodeup, UpNode}, Nodes, []}, S0) ->
+ node_up(Node, UpNode, Nodes, Time, S0);
+eval_trace({Node, Time, {added,Added}, _Nodes, [_NewNodes,_Abc,_Ops]}, S0) ->
+ added(Node, Added, Time, S0);
+eval_trace({Node, Time, {added,Added}, _Nodes, [_Ops]}, S0) ->
+ added(Node, Added, Time, S0);
+eval_trace({Node, Time, {nodes_changed, {New,Old}}, _Nodes, []}, S0) ->
+ nodes_changed(Node, New, Old, Time, S0);
+eval_trace({Node, Time, {ins_name, PNode}, _Nodes, [Name, Pid]}, S0) ->
+ insert_name(Node, PNode, Time, Name, Pid, S0);
+eval_trace({Node, Time, {del_name, PNode}, _Nodes, [Name, Pid]}, S0) ->
+ delete_name(Node, PNode, Time, Name, Pid, S0);
+eval_trace({Node, Time, {ins_name_ext, PNode}, _Nodes, [Name, Pid]}, S0) ->
+ insert_external_name(Node, PNode, Time, Name, Pid, S0);
+eval_trace({Node, Time, {ins_lock, PNode}, _Nodes, [Id, Pid]}, S0) ->
+ insert_lock(Node, PNode, Time, Id, Pid, S0);
+eval_trace({Node, Time, {rem_lock, PNode}, _Nodes, [Id, Pid]}, S0) ->
+ remove_lock(Node, PNode, Time, Id, Pid, S0);
+eval_trace({Node, Time, {locker_succeeded, _}, _Nodes,{_First,_Known}}, S0) ->
+ locker_succeeded(Node, Time, S0);
+eval_trace({Node, Time, {lock_rejected, _}, _Nodes, Known}, S0) ->
+ lock_rejected(Node, Time, Known, S0);
+eval_trace({Node, Time, {locker_failed, _}, _Nodes, {Tried,SoFar}}, S0) ->
+ locker_failed(Node, Time, Tried, SoFar, S0);
+eval_trace({Node, Time, {new_resolver, RNode}, _Nodes, [Tag, ResPid]}, S0) ->
+ new_resolver(Node, Time, RNode, Tag, ResPid, S0);
+eval_trace({Node, Time, {kill_resolver, RNode}, _Nodes, [Tag,_ResPid]}, S0) ->
+ stop_resolver(Node, Time, RNode, Tag, kill, S0);
+eval_trace({Node, Time, {exit_resolver, RNode}, _Nodes, [Tag]}, S0) ->
+ stop_resolver(Node, Time, RNode, Tag, exit, S0);
+eval_trace(_Ignored, S) ->
+io:format("ignored ~p~n", [_Ignored]),
+ S.
+
+init(_Node, [], _Time, S) ->
+ S;
+init(Node, NodesList, Time, S) ->
+ io:format("### ~p ~p: already in nodes(): ~p~n", [Node, Time, NodesList]),
+ S.
+
+node_down(Node, DownNode, NodesList, Time, S0) ->
+ case get_node(Node, S0) of
+ {ok, #node{known = Known, nodes = Nodes}=N} ->
+ case lists:member(DownNode, Nodes) of
+ true ->
+ S1 = case lists:member(DownNode, Known) of
+ true ->
+ S0;
+ false ->
+ io:format("### ~p ~p:~n "
+ "nodedown but unknown ~p~n",
+ [Node, Time, DownNode]),
+ case lists:member(DownNode, Nodes) of
+ true ->
+ io:format("(but note that ~p"
+ " is member of nodes())~n",
+ [DownNode]);
+ false ->
+ ok
+ end,
+ add_spurious(Node, DownNode, S0, Time)
+ end,
+ NewKnown = lists:delete(DownNode, Known),
+ NewNodes = lists:delete(DownNode, Nodes),
+ put_node(N#node{known = NewKnown, nodes = NewNodes}, S1);
+ false ->
+ io:format("### ~p ~p:~n spurious nodedown from ~p~n "
+ "~p~n", [Node, Time, DownNode, NodesList]),
+ NewKnown = lists:delete(DownNode, Known),
+ S1 = put_node(N#node{known = NewKnown,nodes = Nodes}, S0),
+ add_spurious(Node, DownNode, S1, Time)
+ end;
+ not_ok ->
+ io:format("### ~p ~p:~n unknown node got nodedown from ~p~n",
+ [Node, Time, DownNode]),
+ add_spurious(Node, DownNode, S0, Time)
+ end.
+
+node_up(Node, UpNode, NodesList, Time, S) ->
+ case get_node(Node, S) of
+ {ok, #node{nodes = Nodes}=N} ->
+ case lists:member(UpNode, Nodes) of
+ true ->
+ io:format("### ~p ~p:~n spurious nodeup from ~p~n "
+ "~p~n", [Node, Time, UpNode, NodesList]),
+ add_spurious(Node, UpNode, S, Time);
+ false ->
+ put_node(N#node{nodes = lists:sort([UpNode | Nodes])}, S)
+ end;
+ not_ok ->
+ S#w{nodes = [#node{node = Node, nodes = [UpNode]} | S#w.nodes]}
+ end.
+
+added(Node, Added, Time, S0) ->
+ case get_node(Node, S0) of
+ {ok, #node{known = Known, nodes = Nodes}=N} ->
+ case Known -- (Known -- Added) of
+ [] ->
+ S1 = put_node(N#node{known = lists:sort(Added ++ Known),
+ nodes = Nodes}, S0),
+ case lists:member(Node, Added) of
+ true ->
+ io:format("### ~p ~p:~n adding node()"
+ " to known (~p)~n", [Node, Time,Added]),
+ add_spurious(Node, Added, S1, Time);
+ false ->
+ S1
+ end;
+ AK ->
+ io:format("### ~p ~p:~n added already known ~p~n",
+ [Node, Time, AK]),
+ S1 = put_node(N#node{known = lists:usort(Added ++ Known),
+ nodes = Nodes}, S0),
+ add_spurious(Node, AK, S1, Time)
+ end;
+ not_ok ->
+ io:format("### ~p ~p:~n unknown node got added ~p~n",
+ [Node, Time, Added]),
+ S1 = S0#w{nodes = [#node{node = Node, known = Added} |
+ S0#w.nodes]},
+ add_spurious(Node, Added, S1, Time)
+ end.
+
+nodes_changed(Node, New, Old, Time, S) ->
+ io:format("### ~p ~p:~n nodes changed, new are ~p, old are ~p~n",
+ [Node, Time, New, Old]),
+ S.
+
+insert_external_name(Node, PNode, Time, Name, Pid, S) ->
+ insert_name(Node, PNode, Time, Name, Pid, S).
+
+insert_name(Node, PNode, Time, Name, Pid, S0) ->
+ RegName = {Name, Pid, PNode},
+ case get_node(Node, S0) of
+ {ok, #node{names = Names}=N} ->
+ case lists:keysearch(Name, 1, Names) of
+ {value, {Name, OldPid, OldPNode}} ->
+ io:format("### ~p ~p:~n name ~p already registered "
+ "for ~p on ~p~n",
+ [Node, Time, Name, OldPid, OldPNode]),
+ add_spurious(Node, [PNode], S0, Time);
+ false ->
+ case lists:keysearch(Pid, 2, Names) of
+ {value, {OldName, Pid, OldPNode}} ->
+ io:format("### ~p ~p:~n pid ~p already "
+ "registered as ~p on ~p~n",
+ [Node, Time, Pid, OldName, OldPNode]),
+ add_spurious(Node, [PNode], S0, Time);
+ false ->
+ put_node(N#node{names = [RegName | Names]}, S0)
+ end
+ end;
+ not_ok ->
+ io:format("### ~p ~p:~n unknown node registered ~p for ~p "
+ "on ~p~n", [Node, Time, Name, Pid, PNode]),
+ Known = add_to_known(Node, PNode, []),
+ N = #node{node = Node, known = Known, names = [RegName]},
+ S1 = S0#w{nodes = [N | S0#w.nodes]},
+ add_spurious(Node, [PNode], S1, Time)
+ end.
+
+delete_name(Node, PNode, Time, Name, Pid, S0) ->
+ case get_node(Node, S0) of
+ {ok, #node{names = Names}=N} ->
+ case lists:keysearch(Name, 1, Names) of
+ {value, {Name, Pid, PNode}} ->
+ NewNames = lists:keydelete(Name, 1, Names),
+ put_node(N#node{names = NewNames}, S0);
+ {value, {Name, Pid2, PNode2}} -> % bad log
+ io:format("### ~p ~p:~n name ~p not registered "
+ "for ~p on ~p but for ~p on ~p~n",
+ [Node, Time, Name, Pid, PNode, Pid2, PNode2]),
+ add_spurious(Node, [PNode], S0, Time);
+ false ->
+ io:format("### ~p ~p:~n name ~p not registered "
+ "for ~p on ~p~n",
+ [Node, Time, Name, Pid, PNode]),
+ add_spurious(Node, [PNode], S0, Time)
+ end;
+ not_ok ->
+ io:format("### ~p ~p:~n unknown node deleted ~p for ~p on ~p~n",
+ [Node, Time, Name, Pid, PNode]),
+ Known = add_to_known(Node, PNode, []),
+ N = #node{node = Node, known = Known},
+ S1 = S0#w{nodes = [N | S0#w.nodes]},
+ add_spurious(Node, [PNode], S1, Time)
+ end.
+
+insert_lock(Node, PNode, Time, Id, Pid, S0) ->
+ Lock = {Pid, PNode},
+ case get_node(Node, S0) of
+ {ok, #node{locks = NLocks}=N} ->
+ case lists:keysearch(Id, 1, NLocks) of
+ {value, {Id, OldLocks}} ->
+ case lists:member(Lock, OldLocks) of
+ true ->
+ io:format("### ~p ~p:~n lock ~p already set "
+ "for ~p on ~p~n",
+ [Node, Time, Id, Pid, PNode]),
+ %% This is not so strange, actually.
+ add_spurious(Node, [PNode], S0, Time);
+ false ->
+ NewLocks = {Id, [Lock | OldLocks]},
+ Ls = lists:keyreplace(Id, 1, NLocks, NewLocks),
+ put_node(N#node{locks = Ls}, S0)
+ end;
+ false ->
+ put_node(N#node{locks = [{Id,[Lock]}|N#node.locks]}, S0)
+ end;
+ not_ok ->
+ Known = add_to_known(Node, PNode, []),
+ N = #node{node = Node, known = Known, locks = [{Id, [Lock]}]},
+ S1 = S0#w{nodes = [N | S0#w.nodes]},
+ if
+ Node =/= PNode ->
+ io:format("### ~p ~p:~n unknown pid ~p locked ~p on "
+ "~p~n", [Node, Time, Pid, Id, PNode]),
+ add_spurious(Node, [PNode], S1, Time);
+ true ->
+ S1
+ end
+ end.
+
+remove_lock(Node, PNode, Time, Id, Pid, S0) ->
+ Lock = {Pid, PNode},
+ case get_node(Node, S0) of
+ {ok, #node{locks = NLocks}=N} ->
+ case lists:keysearch(Id, 1, NLocks) of
+ {value, {Id, OldLocks}} ->
+ case lists:member(Lock, OldLocks) of
+ true ->
+ NewLocks = lists:delete(Lock, OldLocks),
+ Ls = case NewLocks of
+ [] ->
+ lists:keydelete(Id, 1, NLocks);
+ _ ->
+ lists:keyreplace(Id, 1, NLocks,
+ {Id, NewLocks})
+ end,
+ put_node(N#node{locks = Ls}, S0);
+ false ->
+ io:format("### ~p ~p:~n lock ~p not set "
+ "by ~p on ~p~n",
+ [Node, Time, Id, Pid, PNode]),
+ add_spurious(Node, [PNode], S0, Time)
+ end;
+ false ->
+ io:format("### ~p ~p:~n lock ~p not set "
+ "by ~p on ~p~n",
+ [Node, Time, Id, Pid, PNode]),
+ add_spurious(Node, [PNode], S0, Time)
+ end;
+ not_ok ->
+ io:format("### ~p ~p:~n ~p unlocked ~p on unknown node ~p~n",
+ [Node, Time, Pid, Id, PNode]),
+ Known = add_to_known(Node, PNode, []),
+ N = #node{node = Node, known = Known},
+ S1 = S0#w{nodes = [N | S0#w.nodes]},
+ add_spurious(Node, [PNode], S1, Time)
+ end.
+
+%% This is just statistics...
+locker_succeeded(Node, Time, S0) ->
+ case get_node(Node, S0) of
+ {ok, #node{n_locks = {Ok,Boss,NodeX,Bad}}=N} ->
+ put_node(N#node{n_locks = {Ok+1,Boss,NodeX,Bad}}, S0);
+ not_ok ->
+ io:format("### ~p ~p:~n unknown node's locker succeeded~n",
+ [Node, Time]),
+ add_spurious(Node, [Node], S0, Time)
+ end.
+
+lock_rejected(Node, Time, _Known, S0) ->
+ case get_node(Node, S0) of
+ {ok, #node{rejected = Rej}=N} ->
+ put_node(N#node{rejected = Rej+1}, S0);
+ not_ok ->
+ io:format("### ~p ~p:~n unknown node's lock rejected~n",
+ [Node, Time]),
+ add_spurious(Node, [Node], S0, Time)
+ end.
+
+locker_failed(Node, Time, Tried, SoFar, S0) ->
+ case get_node(Node, S0) of
+ {ok, #node{known = Known, n_locks = {Ok,Boss,NodeX,Bad}}=N} ->
+ TheBoss = lists:max([Node | Known]),
+ Cheap = (Tried =:= [TheBoss]),
+ RatherCheap = ((SoFar -- [Node, TheBoss]) =:= []) and
+ ((Tried -- [Node, TheBoss]) =/= []),
+ if
+ Cheap ->
+ put_node(N#node{n_locks = {Ok,Boss+1,NodeX,Bad}}, S0);
+ RatherCheap ->
+ put_node(N#node{n_locks = {Ok,Boss,NodeX+1,Bad}}, S0);
+ true ->
+ put_node(N#node{n_locks = {Ok,Boss,NodeX,Bad+1}}, S0)
+ end;
+ not_ok ->
+ io:format("### ~p ~p:~n unknown node's locker failed~n",
+ [Node, Time]),
+ add_spurious(Node, [Node], S0, Time)
+ end.
+
+new_resolver(Node, Time, ResNode, Tag, ResPid, S0) ->
+ case get_node(Node, S0) of
+ {ok, #node{resolvers = Rs}=N} ->
+ put_node(N#node{resolvers = [{ResNode, Tag, ResPid} | Rs]}, S0);
+ not_ok ->
+ io:format("### ~p ~p:~n resolver created for unknown node~n",
+ [Node, Time]),
+ add_spurious(Node, [Node], S0, Time)
+ end.
+
+stop_resolver(Node, Time, ResNode, Tag, How, S0) ->
+ case get_node(Node, S0) of
+ {ok, #node{resolvers = Rs}=N} ->
+ case lists:keysearch(Tag, 2, Rs) of
+ {value, {ResNode, Tag, _ResPid}} ->
+ NewRs = lists:keydelete(Tag, 2, Rs),
+ put_node(N#node{resolvers = NewRs}, S0);
+ false ->
+ case lists:keysearch(ResNode, 1, Rs) of
+ {value, {ResNode, _Tag2, _ResPid2}} ->
+ NewRs = lists:keydelete(ResNode, 1, Rs),
+ put_node(N#node{resolvers = NewRs}, S0);
+ false when How =:= exit ->
+ io:format("### ~p ~p:~n there is no resolver "
+ "with tag ~p on node ~p~n",
+ [Node, Time, Tag, ResNode]),
+ add_spurious(Node, [ResNode], S0, Time);
+ false when How =:= kill ->
+ S0
+ end
+ end;
+ not_ok ->
+ io:format("### ~p ~p:~n resolver stopped for unknown node~n",
+ [Node, Time]),
+ add_spurious(Node, [Node], S0, Time)
+ end.
+
+add_to_known(Node, NodeToAdd, Known) ->
+ if
+ Node =:= NodeToAdd ->
+ Known;
+ true ->
+ lists:sort([NodeToAdd | Known])
+ end.
+
+get_node(Node, S) ->
+ case lists:keysearch(Node, #node.node, S#w.nodes) of
+ {value, N} ->
+ {ok, N};
+ false ->
+ not_ok
+ end.
+
+put_node(#node{node = Node, known = [], nodes = [], locks = [], names = [],
+ n_locks = {0,0,0,0}},
+ S) ->
+ S#w{nodes = lists:keydelete(Node, #node.node, S#w.nodes)};
+put_node(N, S) ->
+ S#w{nodes = lists:keyreplace(N#node.node, #node.node, S#w.nodes, N)}.
+
+is_fresh(#node{known = [], nodes = [], locks = [], names = []}) ->
+ true;
+is_fresh(#node{}) ->
+ false;
+is_fresh([]) ->
+ true;
+is_fresh([N | Ns]) ->
+ is_fresh(N) andalso is_fresh(Ns).
+
+add_spurious(Node, ActionNodes, S, Time) when is_list(ActionNodes) ->
+ S#w{n = [{{Node,N},Time}|| N <- ActionNodes] ++ S#w.n};
+add_spurious(Node, ActionNode, S, Time) ->
+ add_spurious(Node, [ActionNode], S, Time).
+
+messages(D, Base, End) ->
+ messages1(no_info(D), no_info),
+ messages1(resolvers(D, Base, End), resolvers),
+ messages1(syncers(D), syncers).
+
+messages1(M, ST) ->
+ [foo || {Node, T} <- M,
+ ok =:= io:format(ms(ST), [Node, T])].
+
+ms(no_info) ->
+ "~p: ~p~n";
+ms(resolvers) ->
+ "~p: resolvers ~p~n";
+ms(syncers) ->
+ "~p: syncers ~p~n".
+
+no_info(D) ->
+ [{Node,no_info} || {Node, no_info} <- D].
+
+resolvers(D, Base, End) ->
+ [{Node,
+ [{N,adjust_time(T, Base),P} || {N, T, P} <- Rs, T < End]} ||
+ {Node, {info,State}} <- D,
+ is_record(State, state),
+ [] =/= (Rs = (state(State))#state.resolvers)].
+
+syncers(D) ->
+ [{Node,Ss} || {Node, {info,State}} <- D,
+ is_record(State, state),
+ [] =/= (Ss = (state(State))#state.syncers)].
+
+net_kernel_nodes(NodeTrace) ->
+ [{Node, nkn(Trace, [])} || {Node, Trace} <- NodeTrace].
+
+nkn([], _Nodes) ->
+ [];
+nkn([{Node, Time, _Message, Ns, _X} | Ts], Nodes) ->
+ {NewS, _, OldS} = sofs:symmetric_partition(sofs:set(Ns), sofs:set(Nodes)),
+ New = sofs:to_external(NewS),
+ Old = sofs:to_external(OldS),
+ [{Node, Time, {newnode, N}, []} || N <- New] ++
+ [{Node, Time, {oldnode, N}, []} || N <- Old] ++
+ nkn(Ts, (Nodes -- Old) ++ New).
+
+negotiations(Trace) ->
+ Ns = [{Node,T,Added,X} ||
+ {Node,T,{added,Added},_Nodes,X} <- Trace],
+ Pass = [{passive,Node,T,Added} ||
+ {Node,T,Added,[_Ops]} <- Ns],
+ Act = [{active,Node,T,Other,Added,NewNodes} ||
+ {Node,T,Added,[{new_nodes,[Other|_]=NewNodes},_Abcast,_Ops]} <- Ns],
+ Act ++ Pass.
+
+show_spurious(NodeTrace, Spurious) ->
+ Pairs = [{Node,ActionNode} || {{Node,ActionNode}, _Time} <- Spurious],
+ S = sofs:restriction(sofs:relation(NodeTrace), sofs:set(Pairs)),
+ [foo ||
+ {{{Node,ANode},Times},
+ {{Node,ANode},Ts}} <- lists:zip(family(Spurious),
+ sofs:to_external(S)),
+ show_spurious(Node, ANode, Times, lists:keysort(2, Ts))].
+
+show_spurious(Node, ActionNode, Times, Ts) ->
+ io:format("** Actions for ~p on node ~p **~n", [ActionNode, Node]),
+ lists:map(fun(T) -> spurious(Node, T, Times) end, Ts),
+ io:format("-- End of actions for ~p on node ~p --~n", [ActionNode, Node]),
+ true.
+
+spurious(Node, Trace, Times) ->
+ As = case Trace of
+ {Node, _T0, {init, Node}, _Nodes, _} ->
+ init; % should not happen, I guess
+ {Node, _T0, {nodedown, _ActionNode}, _Nodes, _} ->
+ nodedown;
+ {Node, _T0, {extra_nodedown, _ActionNode}, _Nodes, _} ->
+ extra_nodedown;
+ {Node, _T0, {nodeup, _ActionNode}, _Nodes, _} ->
+ nodeup;
+ {Node, _T0, {added, Added}, _Nodes, [_Ops]} ->
+ {passive, Added};
+ {Node, _T0, {added, Added}, _Nodes, [_NewNodes,_AbCast,_Ops]} ->
+ {negotiator, Added};
+ {Node, _T0, {ins_lock, PNode}, _Nodes, [Id, Pid]} ->
+ {insert_lock, [Id, Pid, PNode]};
+ {Node, _T0, {rem_lock, PNode}, _Nodes, [Id, Pid]} ->
+ {remove_lock, [Id, Pid, PNode]};
+ {Node, _T0, {ins_name, PNode}, _Nodes, [Name, Pid]} ->
+ {insert_name, [Name, Pid, PNode]};
+ {Node, _T0, {del_name, PNode}, _Nodes, [Name, Pid]} ->
+ {insert_name, [Name, Pid, PNode]};
+ {Node, _T0, {nodes_changed, CNode}, _Nodes, []} ->
+ {nodes_changed, [CNode]};
+ {Node, _T0, {Any, Some}, _Nodes, X} ->
+ {Any, [Some | X]}
+ end,
+ T = element(2, Trace),
+ _Nodes2 = element(4, Trace),
+ TS = ["(spurious)" || lists:member(T, Times)],
+ io:format("~p: ~p ~s~n", [T, As, TS]),
+% io:format(" ~w~n", [_Nodes2]),
+ ok.
+
+display_nodes(Why, Time, Nodes) ->
+ display_nodes(Why, Time, Nodes, none).
+
+display_nodes(Why, Time, Nodes, LastTrace) ->
+ io:format("~p **** ~s ****~n", [Time, Why]),
+ {OkL, BossL, NodeXL, BadL} = unzip4([L || #node{n_locks = L} <- Nodes]),
+ [NOk, NBoss, NNodeX, NBad] =
+ [lists:sum(L) || L <- [OkL, BossL, NodeXL, BadL]],
+ Rejected = lists:sum([Rej || #node{rejected = Rej} <- Nodes]),
+ io:format("Locks: (~w+~w+~w=~w)/~w, ~w of ~w rejected~n",
+ [NOk, NBoss, NNodeX, NOk+NBoss+NNodeX, NOk+NBoss+NNodeX+NBad,
+ Rejected, NOk]),
+ lists:foreach(fun(#node{node = Node, known = Known, nodes = Ns,
+ locks = Locks, names = Names,
+ n_locks = {Ok, Boss, NodeX, Bad},
+ resolvers = Resolvers0,
+ rejected = Rej}) ->
+ NodeL = io_lib:format("~p: ",[Node]),
+ io:format("~sknown ~p~n", [NodeL, Known]),
+ Sp = spaces(NodeL),
+ case Ns =:= Known of
+ true -> ok;
+ false -> display_list(Sp, nodes, Ns)
+ end,
+ display_list(Sp, locks, Locks),
+ display_list(Sp, names, lists:sort(Names)),
+ Resolvers = lists:sort(Resolvers0),
+ _ResNs = [R || {R,_,_} <- Resolvers],
+ %% Should check trace on this node (Node) only:
+ New = [N || {_,_,{nodeup,N},_,_} <- [LastTrace]],
+ _ResAllowed = (Ns -- New) -- Known,
+%% Displays too much junk.
+% case ResAllowed =:= ResNs of
+% true -> ok;
+% false -> display_list(Sp, resol, Resolvers)
+% end,
+ %% This is less bulky:
+ case Known =:= Ns of
+ true -> display_list(Sp, resol, Resolvers);
+ false -> ok
+ end,
+ case {Ok, Boss, NodeX, Bad} of
+ {0, 0, 0, 0} -> ok;
+ _ -> io:format("~slocks (~w+~w+~w=~w)/~w, "
+ "~w of ~w rejected~n",
+ [Sp, Ok, Boss, NodeX,
+ Ok+Boss+NodeX,Ok+Boss+NodeX+Bad,
+ Rej, Ok])
+ end
+ end, lists:keysort(#node.node, Nodes)),
+ io:format("\n").
+
+display_list(_S, _What, []) ->
+ ok;
+display_list(S, What, L) ->
+ io:format("~s~p ~p~n", [S, What, L]).
+
+spaces(Iolist) ->
+ lists:duplicate(iolist_size(Iolist), $\s).
+
+family(R) ->
+ sofs:to_external(sofs:relation_to_family(sofs:relation(R))).
+
+time_diff({S1,MyS1}, {S0,MyS0}) ->
+ ((S1*1000000+MyS1) - (S0*1000000+MyS0)) div 1000000.
+
+musec2sec(T) ->
+ S = T div 1000000,
+ M = (T - S * 1000000),
+ {S, M}.
+
+%%% Options
+
+options(Options, Keys) when is_list(Options) ->
+ options(Options, Keys, []);
+options(Option, Keys) ->
+ options([Option], Keys, []).
+
+options(Options0, [Key | Keys], L) when is_list(Options0) ->
+ Options = case lists:member(Key, Options0) of
+ true ->
+ [atom_option(Key) | lists:delete(Key, Options0)];
+ false ->
+ Options0
+ end,
+ V = case lists:keysearch(Key, 1, Options) of
+ {value, {show_state, From, To}} when is_integer(From), From >= 0,
+ is_integer(To), To >= From ->
+ {ok, {{From,0}, {To,0}}};
+ {value, {show_state, {From, FromMusec},
+ {To, ToMusec}}} when is_integer(From),
+ From >= 0,
+ is_integer(To),
+ To >= From,
+ FromMusec >= 0,
+ FromMusec =< 999999,
+ ToMusec >= 0,
+ ToMusec =< 999999 ->
+ {ok, {{From,FromMusec}, {To,ToMusec}}};
+ {value, {show_state, false}} ->
+ {value, default_option(show_state)};
+ {value, {show_trace, Bool}} when Bool; not Bool ->
+ {ok, Bool};
+ {value, {Key, _}} ->
+ badarg;
+ false ->
+ Default = default_option(Key),
+ {ok, Default}
+ end,
+ case V of
+ badarg ->
+ badarg;
+ {ok, Value} ->
+ NewOptions = lists:keydelete(Key, 1, Options),
+ options(NewOptions, Keys, [Value | L])
+ end;
+options([], [], L) ->
+ lists:reverse(L);
+options(_Options, _, _L) ->
+ badarg.
+
+default_option(show_state) -> {{0,0}, {0,0}};
+default_option(show_trace) -> true.
+
+atom_option(show_state) ->
+ {show_state, 0, 1 bsl 28};
+atom_option(show_trace) ->
+ {show_trace, true};
+atom_option(_) ->
+ erlang:error(program_error, []).
+
+unzip4(Ts) -> unzip4(Ts, [], [], [], []).
+
+unzip4([{X, Y, Z, W} | Ts], Xs, Ys, Zs, Ws) ->
+ unzip4(Ts, [X | Xs], [Y | Ys], [Z | Zs], [W | Ws]);
+unzip4([], Xs, Ys, Zs, Ws) ->
+ {lists:reverse(Xs), lists:reverse(Ys),
+ lists:reverse(Zs), lists:reverse(Ws)}.
+
diff --git a/lib/kernel/test/global_group_SUITE.erl b/lib/kernel/test/global_group_SUITE.erl
new file mode 100644
index 0000000000..a8b87390eb
--- /dev/null
+++ b/lib/kernel/test/global_group_SUITE.erl
@@ -0,0 +1,1415 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(global_group_SUITE).
+
+-export([all/1]).
+-export([start_gg_proc/1, no_gg_proc/1, no_gg_proc_sync/1, compatible/1,
+ one_grp/1, one_grp_x/1, two_grp/1, hidden_groups/1, test_exit/1]).
+-export([init/1, init/2, init2/2, start_proc/1, start_proc_rereg/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+%-compile(export_all).
+
+-include("test_server.hrl").
+
+-define(NODES, [node()|nodes()]).
+
+-define(UNTIL(Seq), loop_until_true(fun() -> Seq end)).
+
+all(suite) ->
+ [start_gg_proc, no_gg_proc, no_gg_proc_sync,
+ compatible, one_grp, one_grp_x, two_grp, test_exit,
+ hidden_groups].
+
+-define(TESTCASE, testcase_name).
+-define(testcase, ?config(?TESTCASE, Config)).
+
+init_per_testcase(Case, Config) when atom(Case), list(Config) ->
+ Dog=?t:timetrap(?t:minutes(5)),
+ [{?TESTCASE, Case}, {watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog).
+
+%%-----------------------------------------------------------------
+%% Test suites for global groups.
+%% Should be started in a CC view with:
+%% erl -sname XXX -rsh ctrsh where XXX not in [cp1 .. cpN]
+%%-----------------------------------------------------------------
+
+
+start_gg_proc(suite) -> [];
+start_gg_proc(doc) -> ["Check that the global_group processes are started automatically. "];
+start_gg_proc(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(120)),
+
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File = filename:join(Dir, "global_group.config"),
+ ?line {ok, Fd}=file:open(File, write),
+ [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config),
+ ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"),
+
+ ?line Cp1nn = node_at(Ncp1),
+ ?line Cp2nn = node_at(Ncp2),
+ ?line Cp3nn = node_at(Ncp3),
+
+ ?line {ok, Cp1} = start_node(Ncp1, Config),
+ ?line {ok, Cp2} = start_node(Ncp2, Config),
+ ?line {ok, Cp3} = start_node(Ncp3, Config),
+
+ ?line [] = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]),
+ ?line [] = rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}]),
+ ?line [] = rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}]),
+
+ % stop the nodes, and make sure names are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+no_gg_proc(suite) -> [];
+no_gg_proc(doc) -> ["Start a system without global groups. Nodes are not "
+ "synced at start (sync_nodes_optional is not defined)"];
+no_gg_proc(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(200)),
+
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File = filename:join(Dir, "no_global_group.config"),
+ ?line {ok, Fd} = file:open(File, write),
+ ?line config_no(Fd),
+
+ ?line NN = node_name(atom_to_list(node())),
+ ?line Cp1nn = list_to_atom("cp1@" ++ NN),
+ ?line Cp2nn = list_to_atom("cp2@" ++ NN),
+ ?line Cp3nn = list_to_atom("cp3@" ++ NN),
+ ?line Cpxnn = list_to_atom("cpx@" ++ NN),
+ ?line Cpynn = list_to_atom("cpy@" ++ NN),
+ ?line Cpznn = list_to_atom("cpz@" ++ NN),
+
+ ?line {ok, Cp1} = start_node_no(cp1, Config),
+ ?line {ok, Cp2} = start_node_no(cp2, Config),
+ ?line {ok, Cp3} = start_node_no(cp3, Config),
+ ?line {ok, Cpx} = start_node_no(cpx, Config),
+ ?line {ok, Cpy} = start_node_no(cpy, Config),
+ ?line {ok, Cpz} = start_node_no(cpz, Config),
+
+ %% let the nodes know of each other
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2nn]),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cp3nn]),
+ ?line pong = rpc:call(Cp3, net_adm, ping, [Cpxnn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cpynn]),
+ ?line pong = rpc:call(Cpy, net_adm, ping, [Cpznn]),
+
+ ?line wait_for_ready_net(),
+
+ ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]),
+ ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}]),
+ ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}]),
+ ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}]),
+ ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}]),
+ ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}]),
+
+
+ % start a proc and register it
+ ?line {Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [test2]),
+
+ ?line RegNames = lists:sort([test2,test_server]),
+
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}])),
+
+
+ ?line undefined = rpc:call(Cp3, global_group, global_groups, []),
+
+ ?line Own_nodes_should = [node(), Cp1nn, Cp2nn, Cp3nn,
+ Cpxnn, Cpynn, Cpznn],
+ ?line Own_nodes = rpc:call(Cp3, global_group, own_nodes, []),
+ ?line true = (Own_nodes -- Own_nodes_should) =:= [],
+ ?line true = (Own_nodes_should -- Own_nodes) =:= [],
+
+ ?line Pid2 = rpc:call(Cp1, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line Pid2 = rpc:call(Cp2, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout3)
+ end,
+ ?line Pid2 = rpc:call(Cpz, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout4)
+ end,
+
+
+ % start a proc and register it
+ ?line {PidX, yes} = rpc:call(Cpx, ?MODULE, start_proc, [test]),
+
+
+ %%------------------------------------
+ %% Test monitor nodes
+ %%------------------------------------
+ ?line Pid2 = rpc:call(Cp1, global_group, send, [{node, Cp2nn}, test2, monitor]),
+ ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, monitor]),
+
+
+ % Kill node Cp1
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cp1}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cp1}]),
+ ?line test_server:sleep(100),
+ ?line stop_node(Cp1),
+ ?line test_server:sleep(1000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Kill node Cpz
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cpz}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cpz}]),
+ ?line test_server:sleep(100),
+ ?line stop_node(Cpz),
+ ?line test_server:sleep(1000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Restart node Cp1
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cp1}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cp1}]),
+ ?line {ok, Cp1} = start_node_no(cp1, Config),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cp1nn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cp1nn]),
+ ?line wait_for_ready_net(),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Restart node Cpz
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cpz}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cpz}]),
+ ?line {ok, Cpz} = start_node_no(cpz, Config),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cpznn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cpznn]),
+ ?line wait_for_ready_net(),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % stop the nodes, and make sure names are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cpx),
+ stop_node(Cpy),
+ stop_node(Cpz),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+
+no_gg_proc_sync(suite) -> [];
+no_gg_proc_sync(doc) ->
+ ["Start a system without global groups, but syncing the nodes by using "
+ "sync_nodes_optional."];
+no_gg_proc_sync(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(200)),
+
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File = filename:join(Dir, "no_global_group_sync.config"),
+ ?line {ok, Fd} = file:open(File, write),
+
+ [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz] =
+ node_names([cp1,cp2,cp3,cpx,cpy,cpz], Config),
+ ?line config_sync(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz),
+
+ ?line Cp1nn = node_at(Ncp1),
+ ?line Cp2nn = node_at(Ncp2),
+ ?line Cp3nn = node_at(Ncp3),
+ ?line Cpxnn = node_at(Ncpx),
+ ?line Cpynn = node_at(Ncpy),
+ ?line Cpznn = node_at(Ncpz),
+
+ ?line {ok, Cp1} = start_node_no2(Ncp1, Config),
+ ?line {ok, Cp2} = start_node_no2(Ncp2, Config),
+ ?line {ok, Cp3} = start_node_no2(Ncp3, Config),
+ ?line {ok, Cpx} = start_node_no2(Ncpx, Config),
+ ?line {ok, Cpy} = start_node_no2(Ncpy, Config),
+ ?line {ok, Cpz} = start_node_no2(Ncpz, Config),
+
+ %% let the nodes know of each other
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2nn]),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cp3nn]),
+ ?line pong = rpc:call(Cp3, net_adm, ping, [Cpxnn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cpynn]),
+ ?line pong = rpc:call(Cpy, net_adm, ping, [Cpznn]),
+
+ ?line wait_for_ready_net(),
+
+ ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]),
+ ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}]),
+ ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}]),
+ ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}]),
+ ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}]),
+ ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}]),
+
+
+ % start a proc and register it
+ ?line {Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [test2]),
+
+ ?line RegNames = lists:sort([test2,test_server]),
+
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}])),
+
+
+ ?line undefined = rpc:call(Cp3, global_group, global_groups, []),
+
+ ?line Own_nodes_should = [node(), Cp1nn, Cp2nn, Cp3nn,
+ Cpxnn, Cpynn, Cpznn],
+ ?line Own_nodes = rpc:call(Cp3, global_group, own_nodes, []),
+ ?line true = (Own_nodes -- Own_nodes_should) =:= [],
+ ?line true = (Own_nodes_should -- Own_nodes) =:= [],
+
+ ?line Pid2 = rpc:call(Cp1, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line Pid2 = rpc:call(Cp2, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout3)
+ end,
+ ?line Pid2 = rpc:call(Cpz, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout4)
+ end,
+
+
+ % start a proc and register it
+ ?line {PidX, yes} = rpc:call(Cpx, ?MODULE, start_proc, [test]),
+
+
+ %%------------------------------------
+ %% Test monitor nodes
+ %%------------------------------------
+ ?line Pid2 = rpc:call(Cp1, global_group, send, [{node, Cp2nn}, test2, monitor]),
+ ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, monitor]),
+
+
+ % Kill node Cp1
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cp1}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cp1}]),
+ ?line test_server:sleep(100),
+ ?line stop_node(Cp1),
+ ?line test_server:sleep(1000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Kill node Cpz
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cpz}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cpz}]),
+ ?line test_server:sleep(100),
+ ?line stop_node(Cpz),
+ ?line test_server:sleep(1000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Restart node Cp1
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cp1}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cp1}]),
+ ?line {ok, Cp1} = start_node_no2(Ncp1, Config),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cp1nn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cp1nn]),
+ ?line wait_for_ready_net(),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Restart node Cpz
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cpz}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cpz}]),
+ ?line {ok, Cpz} = start_node_no2(Ncpz, Config),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cpznn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cpznn]),
+ ?line wait_for_ready_net(),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % stop the nodes, and make sure names are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cpx),
+ stop_node(Cpy),
+ stop_node(Cpz),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+
+compatible(suite) -> [];
+compatible(doc) ->
+ ["Check that a system without global groups is compatible with the old R4 system."];
+compatible(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(200)),
+
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File = filename:join(Dir, "global_group_comp.config"),
+ ?line {ok, Fd} = file:open(File, write),
+
+ [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz] =
+ node_names([cp1,cp2,cp3,cpx,cpy,cpz], Config),
+ ?line config_comp(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz),
+
+ ?line Cp1nn = node_at(Ncp1),
+ ?line Cp2nn = node_at(Ncp2),
+ ?line Cp3nn = node_at(Ncp3),
+ ?line Cpxnn = node_at(Ncpx),
+ ?line Cpynn = node_at(Ncpy),
+ ?line Cpznn = node_at(Ncpz),
+
+ ?line {ok, Cp1} = start_node_comp(Ncp1, Config),
+ ?line {ok, Cp2} = start_node_comp(Ncp2, Config),
+ ?line {ok, Cp3} = start_node_comp(Ncp3, Config),
+ ?line {ok, Cpx} = start_node_comp(Ncpx, Config),
+ ?line {ok, Cpy} = start_node_comp(Ncpy, Config),
+ ?line {ok, Cpz} = start_node_comp(Ncpz, Config),
+
+ %% let the nodes know of each other
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2nn]),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cp3nn]),
+ ?line pong = rpc:call(Cp3, net_adm, ping, [Cpxnn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cpynn]),
+ ?line pong = rpc:call(Cpy, net_adm, ping, [Cpznn]),
+
+ ?line wait_for_ready_net(),
+
+ ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]),
+ ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}]),
+ ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}]),
+ ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}]),
+ ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}]),
+ ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}]),
+
+
+ % start a proc and register it
+ ?line {Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [test2]),
+
+ ?line RegNames = lists:sort([test2,test_server]),
+
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}])),
+ ?line RegNames =
+ lists:sort(
+ rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}])),
+
+
+ ?line undefined = rpc:call(Cp3, global_group, global_groups, []),
+
+ ?line Own_nodes_should = [node(), Cp1nn, Cp2nn, Cp3nn,
+ Cpxnn, Cpynn, Cpznn],
+ ?line Own_nodes = rpc:call(Cp3, global_group, own_nodes, []),
+ ?line true = (Own_nodes -- Own_nodes_should) =:= [],
+ ?line true = (Own_nodes_should -- Own_nodes) =:= [],
+
+ ?line Pid2 = rpc:call(Cp1, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line Pid2 = rpc:call(Cp2, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout3)
+ end,
+ ?line Pid2 = rpc:call(Cpz, global_group, send, [test2, {ping, self()}]),
+ ?line receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout4)
+ end,
+
+
+ % start a proc and register it
+ ?line {PidX, yes} = rpc:call(Cpx, ?MODULE, start_proc, [test]),
+
+
+ %%------------------------------------
+ %% Test monitor nodes
+ %%------------------------------------
+ ?line Pid2 = rpc:call(Cp1, global_group, send, [{node, Cp2nn}, test2, monitor]),
+ ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, monitor]),
+
+
+ % Kill node Cp1
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cp1}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cp1}]),
+ ?line test_server:sleep(100),
+ ?line stop_node(Cp1),
+ ?line test_server:sleep(1000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Kill node Cpz
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cpz}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cpz}]),
+ ?line test_server:sleep(100),
+ ?line stop_node(Cpz),
+ ?line test_server:sleep(1000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Restart node Cp1
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cp1}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cp1}]),
+ ?line {ok, Cp1} = start_node_comp(Ncp1, Config),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cp1nn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cp1nn]),
+ ?line wait_for_ready_net(),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % Restart node Cpz
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cpz}]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cpz}]),
+ ?line {ok, Cpz} = start_node_comp(Ncpz, Config),
+ ?line pong = rpc:call(Cp2, net_adm, ping, [Cpznn]),
+ ?line pong = rpc:call(Cpx, net_adm, ping, [Cpznn]),
+ ?line wait_for_ready_net(),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+
+ % stop the nodes, and make sure names are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cpx),
+ stop_node(Cpy),
+ stop_node(Cpz),
+
+ ?line ?UNTIL(undefined =:= global:whereis_name(test)),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+
+one_grp(suite) -> [];
+one_grp(doc) -> ["Test a system with only one global group. "];
+one_grp(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(120)),
+
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File = filename:join(Dir, "global_group.config"),
+ ?line {ok, Fd} = file:open(File, write),
+ [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config),
+ ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"),
+
+ ?line {ok, Cp1} = start_node(Ncp1, Config),
+ ?line {ok, Cp2} = start_node(Ncp2, Config),
+ ?line {ok, Cp3} = start_node(Ncp3, Config),
+
+ % sleep a while to make the global_group to sync...
+ test_server:sleep(1000),
+
+ % start a proc and register it
+ ?line {Pid, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]),
+
+ % test that it is registered at all nodes
+ ?line Pid = rpc:call(Cp1, global, whereis_name, [test]),
+ ?line Pid = rpc:call(Cp2, global, whereis_name, [test]),
+ ?line Pid = rpc:call(Cp3, global, whereis_name, [test]),
+
+ % try to register the same name
+ ?line no = rpc:call(Cp1, global, register_name, [test, self()]),
+
+ % let process exit, check that it is unregistered automatically
+ Pid ! die,
+ ?line
+ ?UNTIL(begin
+ (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))
+ end),
+
+ % test re_register
+ ?line {Pid2, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]),
+ ?line Pid2 = rpc:call(Cp3, global, whereis_name, [test]),
+ Pid3 = rpc:call(Cp3, ?MODULE, start_proc_rereg, [test]),
+ ?line Pid3 = rpc:call(Cp3, global, whereis_name, [test]),
+
+ % test sending
+ rpc:call(Cp1, global, send, [test, {ping, self()}]),
+ receive
+ {pong, Cp3} -> ok
+ after
+ 2000 -> test_server:fail(timeout1)
+ end,
+
+ rpc:call(Cp3, global, send, [test, {ping, self()}]),
+ receive
+ {pong, Cp3} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+
+ ?line rpc:call(Cp3, global, unregister_name, [test]),
+ ?line undefined = rpc:call(Cp1, global, whereis_name, [test]),
+ ?line undefined = rpc:call(Cp2, global, whereis_name, [test]),
+ ?line undefined = rpc:call(Cp3, global, whereis_name, [test]),
+
+ Pid3 ! die,
+ ?line ?UNTIL(undefined =:= rpc:call(Cp3, global, whereis_name, [test])),
+
+ % register a proc
+ ?line {_, yes} = rpc:call(Cp3, ?MODULE, start_proc, [test]),
+
+ % stop the nodes, and make sure names are released.
+ stop_node(Cp3),
+
+ ?line ?UNTIL(undefined =:= rpc:call(Cp1, global, whereis_name, [test])),
+ Pid2 ! die,
+
+ stop_node(Cp1),
+ stop_node(Cp2),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+
+
+one_grp_x(suite) -> [];
+one_grp_x(doc) -> ["Check a system with only one global group. "
+ "Start the nodes with different time intervals. "];
+one_grp_x(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(120)),
+
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File = filename:join(Dir, "global_group.config"),
+ ?line {ok, Fd} = file:open(File, write),
+ [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config),
+ ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"),
+
+ ?line {ok, Cp1} = start_node(Ncp1, Config),
+ % sleep a while to make the global_group to sync...
+ test_server:sleep(1000),
+
+ % start a proc and register it
+ ?line {Pid, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]),
+
+ ?line {ok, Cp2} = start_node(Ncp2, Config),
+ % sleep a while to make the global_group to sync...
+ test_server:sleep(1000),
+
+ % test that it is registered at all nodes
+ ?line Pid = rpc:call(Cp1, global, whereis_name, [test]),
+ ?line Pid = rpc:call(Cp2, global, whereis_name, [test]),
+
+ ?line {ok, Cp3} = start_node(Ncp3, Config),
+ % sleep a while to make the global_group to sync...
+ test_server:sleep(1000),
+
+ ?line Pid = rpc:call(Cp3, global, whereis_name, [test]),
+
+ % try to register the same name
+ ?line no = rpc:call(Cp1, global, register_name, [test, self()]),
+
+ % let process exit, check that it is unregistered automatically
+ Pid ! die,
+ ?line
+ ?UNTIL(begin
+ (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and
+ (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))
+ end),
+
+ % test re_register
+ ?line {Pid2, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]),
+ ?line Pid2 = rpc:call(Cp3, global, whereis_name, [test]),
+
+ Pid2 ! die,
+
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+
+
+
+two_grp(suite) -> [];
+two_grp(doc) -> ["Test a two global group system. "];
+two_grp(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(200)),
+
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File = filename:join(Dir, "global_group.config"),
+ ?line {ok, Fd} = file:open(File, write),
+
+ [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz,Ncpq] =
+ node_names([cp1,cp2,cp3,cpx,cpy,cpz,cpq], Config),
+ ?line config(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz, Ncpq),
+
+ ?line Cp1nn = node_at(Ncp1),
+ ?line Cp2nn = node_at(Ncp2),
+ ?line Cp3nn = node_at(Ncp3),
+ ?line Cpxnn = node_at(Ncpx),
+ ?line Cpynn = node_at(Ncpy),
+ ?line Cpznn = node_at(Ncpz),
+
+ ?line {ok, Cp1} = start_node(Ncp1, Config),
+ ?line {ok, Cp2} = start_node(Ncp2, Config),
+ ?line {ok, Cp3} = start_node(Ncp3, Config),
+ ?line {ok, Cpx} = start_node(Ncpx, Config),
+ ?line {ok, Cpy} = start_node(Ncpy, Config),
+ ?line {ok, Cpz} = start_node(Ncpz, Config),
+
+ %% The groups (cpq not started):
+ %% [{nc1, [cp1,cp2,cp3]}, {nc2, [cpx,cpy,cpz]}, {nc3, [cpq]}]
+
+ % sleep a while to make the global_groups to sync...
+ test_server:sleep(1000),
+
+ % check the global group names
+ ?line {nc1, [nc2, nc3]} = rpc:call(Cp1, global_group, global_groups, []),
+ ?line {nc1, [nc2, nc3]} = rpc:call(Cp2, global_group, global_groups, []),
+ ?line {nc1, [nc2, nc3]} = rpc:call(Cp3, global_group, global_groups, []),
+ ?line {nc2, [nc1, nc3]} = rpc:call(Cpx, global_group, global_groups, []),
+ ?line {nc2, [nc1, nc3]} = rpc:call(Cpy, global_group, global_groups, []),
+ ?line {nc2, [nc1, nc3]} = rpc:call(Cpz, global_group, global_groups, []),
+
+ % check the global group nodes
+ ?line [Cp1nn, Cp2nn, Cp3nn] = rpc:call(Cp1, global_group, own_nodes, []),
+ ?line [Cp1nn, Cp2nn, Cp3nn] = rpc:call(Cp2, global_group, own_nodes, []),
+ ?line [Cp1nn, Cp2nn, Cp3nn] = rpc:call(Cp3, global_group, own_nodes, []),
+ ?line [Cpxnn, Cpynn, Cpznn] = rpc:call(Cpx, global_group, own_nodes, []),
+ ?line [Cpxnn, Cpynn, Cpznn] = rpc:call(Cpy, global_group, own_nodes, []),
+ ?line [Cpxnn, Cpynn, Cpznn] = rpc:call(Cpz, global_group, own_nodes, []),
+
+
+ % start a proc and register it
+ ?line {Pid1, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]),
+
+ ?line Pid1 = rpc:call(Cp1, global_group, send, [test, {io, from_cp1}]),
+ ?line Pid1 = rpc:call(Cpx, global_group, send, [test, {io, from_cpx}]),
+ ?line Pid1 = rpc:call(Cp1, global_group, send, [{group,nc1}, test,
+ {io, from_cp1}]),
+ ?line [test] =
+ rpc:call(Cpx, global_group, registered_names, [{node, Cp1nn}]),
+ ?line [test] =
+ rpc:call(Cpx, global_group, registered_names, [{group, nc1}]),
+ ?line [] = rpc:call(Cpx, global_group, registered_names, [{node, Cpxnn}]),
+ ?line [] = rpc:call(Cpx, global_group, registered_names, [{group, nc2}]),
+ ?line Pid1 = rpc:call(Cpx, global_group, send, [{group,nc1}, test,
+ {io, from_cp1}]),
+ ?line {badarg,{test,{io,from_cpx}}} =
+ rpc:call(Cp1, global_group, send, [{group,nc2}, test, {io, from_cpx}]),
+ ?line {badarg,{test,{io,from_cpx}}} =
+ rpc:call(Cpx, global_group, send, [{group,nc2}, test, {io, from_cpx}]),
+
+
+
+ % test that it is registered at all nodes
+ ?line Pid1 = rpc:call(Cp1, global, whereis_name, [test]),
+ ?line Pid1 = rpc:call(Cp2, global, whereis_name, [test]),
+ ?line Pid1 = rpc:call(Cp3, global, whereis_name, [test]),
+ ?line undefined = rpc:call(Cpx, global, whereis_name, [test]),
+ ?line undefined = rpc:call(Cpy, global, whereis_name, [test]),
+ ?line undefined = rpc:call(Cpz, global, whereis_name, [test]),
+
+ % start a proc and register it
+ ?line {PidX, yes} = rpc:call(Cpx, ?MODULE, start_proc, [test]),
+
+ % test that it is registered at all nodes
+ ?line Pid1 = rpc:call(Cp1, global, whereis_name, [test]),
+ ?line Pid1 = rpc:call(Cp2, global, whereis_name, [test]),
+ ?line Pid1 = rpc:call(Cp3, global, whereis_name, [test]),
+ ?line PidX = rpc:call(Cpx, global, whereis_name, [test]),
+ ?line PidX = rpc:call(Cpy, global, whereis_name, [test]),
+ ?line PidX = rpc:call(Cpz, global, whereis_name, [test]),
+
+ Pid1 ! die,
+ %% If we don't wait for global on other nodes to have updated its
+ %% tables, 'test' may still be defined at the point when it is
+ %% tested a few lines below.
+ ?line
+ ?UNTIL(begin
+ Pid = rpc:call(Cp2, global, whereis_name, [test]),
+ undefined =:= Pid
+ end),
+
+ % start a proc and register it
+ ?line {Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [test2]),
+
+ % test that it is registered at all nodes
+ ?line Pid2 = rpc:call(Cp1, global, whereis_name, [test2]),
+ ?line Pid2 = rpc:call(Cp2, global, whereis_name, [test2]),
+ ?line Pid2 = rpc:call(Cp3, global, whereis_name, [test2]),
+ ?line PidX = rpc:call(Cpx, global, whereis_name, [test]),
+ ?line PidX = rpc:call(Cpy, global, whereis_name, [test]),
+ ?line PidX = rpc:call(Cpz, global, whereis_name, [test]),
+
+ ?line undefined = rpc:call(Cp1, global, whereis_name, [test]),
+ ?line undefined = rpc:call(Cp2, global, whereis_name, [test]),
+ ?line undefined = rpc:call(Cp3, global, whereis_name, [test]),
+ ?line undefined = rpc:call(Cpx, global, whereis_name, [test2]),
+ ?line undefined = rpc:call(Cpy, global, whereis_name, [test2]),
+ ?line undefined = rpc:call(Cpz, global, whereis_name, [test2]),
+
+
+ ?line Pid2 = rpc:call(Cp1, global_group, send, [test2, {ping, self()}]),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line Pid2 = rpc:call(Cp2, global_group, send, [test2, {ping, self()}]),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line Pid2 = rpc:call(Cp3, global_group, send, [test2, {ping, self()}]),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+
+ ?line PidX = rpc:call(Cpx, global_group, send, [test, {ping, self()}]),
+ receive
+ {pong, Cpx} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line PidX = rpc:call(Cpy, global_group, send, [test, {ping, self()}]),
+ receive
+ {pong, Cpx} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line PidX = rpc:call(Cpz, global_group, send, [test, {ping, self()}]),
+ receive
+ {pong, Cpx} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+
+ ?line Pid2 = rpc:call(Cpx, global_group, send, [{node, Cp1nn}, test2,
+ {ping, self()}]),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line Pid2 = rpc:call(Cpy, global_group, send, [{node, Cp2nn}, test2,
+ {ping, self()}]),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line Pid2 = rpc:call(Cpz, global_group, send, [{node, Cp3nn}, test2,
+ {ping, self()}]),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+
+ ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpznn}, test,
+ {ping, self()}]),
+ receive
+ {pong, Cpx} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line PidX = rpc:call(Cpy, global_group, send, [{node, Cpxnn}, test,
+ {ping, self()}]),
+ receive
+ {pong, Cpx} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line PidX = rpc:call(Cpz, global_group, send, [{node, Cpynn}, test,
+ {ping, self()}]),
+ receive
+ {pong, Cpx} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+
+ ?line Pid2 = rpc:call(Cpx, global_group, send, [{group, nc1}, test2,
+ {ping, self()}]),
+ receive
+ {pong, Cp2} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+ ?line PidX = rpc:call(Cpy, global_group, send, [{group, nc2}, test,
+ {ping, self()}]),
+ receive
+ {pong, Cpx} -> ok
+ after
+ 2000 -> test_server:fail(timeout2)
+ end,
+
+ %%------------------------------------
+ %% Test monitor nodes
+ %%------------------------------------
+ ?line Pid2 =
+ rpc:call(Cp1, global_group, send, [{node, Cp2nn}, test2, monitor]),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, monitor]),
+
+
+ % Kill node Cp1
+ ?line Pid2 = rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2,
+ {wait_nodedown, Cp1}]),
+ ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test,
+ {wait_nodedown, Cp1}]),
+ ?line test_server:sleep(100),
+ ?line stop_node(Cp1),
+ ?line test_server:sleep(1000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop_nodedown),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, to_loop]),
+
+ % Kill node Cpz
+ ?line Pid2 = rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2,
+ {wait_nodedown, Cpz}]),
+ ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test,
+ {wait_nodedown, Cpz}]),
+ ?line test_server:sleep(100),
+ ?line stop_node(Cpz),
+ ?line test_server:sleep(1000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop_nodedown),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, to_loop]),
+
+ % Restart node Cp1
+ ?line [Cp1nn, Cp2nn, Cp3nn] = rpc:call(Cp2, global_group, own_nodes, []),
+ ?line Pid2 = rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2,
+ {wait_nodeup, Cp1}]),
+ ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test,
+ {wait_nodeup, Cp1}]),
+ ?line test_server:sleep(100),
+ ?line {ok, Cp1} = start_node(Ncp1, Config),
+ ?line test_server:sleep(5000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop_nodeup),
+ ?line PidX =
+ rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, to_loop]),
+
+
+ % Restart node Cpz
+ ?line Pid2 = rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2,
+ {wait_nodeup, Cpz}]),
+ ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test,
+ {wait_nodeup, Cpz}]),
+ ?line test_server:sleep(100),
+ ?line {ok, Cpz} = start_node(Ncpz, Config),
+ ?line test_server:sleep(5000),
+
+ ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop_nodeup),
+ ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop),
+ ?line Pid2 =
+ rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, to_loop]),
+
+
+ Pid2 ! die,
+ PidX ! die,
+
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cpx),
+ stop_node(Cpy),
+ stop_node(Cpz),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+
+hidden_groups(suite) -> [];
+hidden_groups(doc) -> ["Test hidden global groups."];
+hidden_groups(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(200)),
+
+ ?line Dir = ?config(priv_dir, Config),
+ ?line File = filename:join(Dir, "global_group.config"),
+ ?line {ok, Fd} = file:open(File, write),
+
+ [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz,Ncpq] =
+ node_names([cp1,cp2,cp3,cpx,cpy,cpz,cpq], Config),
+ ?line config_hidden(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz, Ncpq),
+
+ ?line {ok, Cp1} = start_node(Ncp1, Config),
+ ?line {ok, Cp2} = start_node(Ncp2, Config),
+ ?line {ok, Cp3} = start_node(Ncp3, Config),
+ ?line {ok, Cpx} = start_node(Ncpx, Config),
+ ?line {ok, Cpy} = start_node(Ncpy, Config),
+ ?line {ok, Cpz} = start_node(Ncpz, Config),
+ ?line {ok, Cpq} = start_node(Ncpq, Config),
+
+ % sleep a while to make the global_groups to sync...
+ test_server:sleep(1000),
+
+ % check the global group names
+ ?line {nc1, [nc2, nc3]} = rpc:call(Cp1, global_group, global_groups, []),
+ ?line {nc1, [nc2, nc3]} = rpc:call(Cp2, global_group, global_groups, []),
+ ?line {nc1, [nc2, nc3]} = rpc:call(Cp3, global_group, global_groups, []),
+ ?line {nc2, [nc1, nc3]} = rpc:call(Cpx, global_group, global_groups, []),
+ ?line {nc2, [nc1, nc3]} = rpc:call(Cpy, global_group, global_groups, []),
+ ?line {nc2, [nc1, nc3]} = rpc:call(Cpz, global_group, global_groups, []),
+
+ % check the global group nodes
+ ?line [Cp1, Cp2, Cp3] = rpc:call(Cp1, global_group, own_nodes, []),
+ ?line [Cp1, Cp2, Cp3] = rpc:call(Cp2, global_group, own_nodes, []),
+ ?line [Cp1, Cp2, Cp3] = rpc:call(Cp3, global_group, own_nodes, []),
+ ?line [Cpx, Cpy, Cpz] = rpc:call(Cpx, global_group, own_nodes, []),
+ ?line [Cpx, Cpy, Cpz] = rpc:call(Cpy, global_group, own_nodes, []),
+ ?line [Cpx, Cpy, Cpz] = rpc:call(Cpz, global_group, own_nodes, []),
+ ?line [Cpq] = rpc:call(Cpq, global_group, own_nodes, []),
+
+ % Make some inter group connections
+ ?line pong = rpc:call(Cp1, net_adm, ping, [Cpx]),
+ ?line pong = rpc:call(Cpy, net_adm, ping, [Cp2]),
+ ?line pong = rpc:call(Cp3, net_adm, ping, [Cpx]),
+ ?line pong = rpc:call(Cpz, net_adm, ping, [Cp3]),
+ ?line pong = rpc:call(Cpq, net_adm, ping, [Cp1]),
+ ?line pong = rpc:call(Cpz, net_adm, ping, [Cpq]),
+
+ % Check that no inter group connections are visible
+ NC1Nodes = lists:sort([Cp1, Cp2, Cp3]),
+ NC2Nodes = lists:sort([Cpx, Cpy, Cpz]),
+ ?line NC1Nodes = lists:sort([Cp1|rpc:call(Cp1, erlang, nodes, [])]),
+ ?line NC1Nodes = lists:sort([Cp2|rpc:call(Cp2, erlang, nodes, [])]),
+ ?line NC1Nodes = lists:sort([Cp3|rpc:call(Cp3, erlang, nodes, [])]),
+ ?line NC2Nodes = lists:sort([Cpx|rpc:call(Cpx, erlang, nodes, [])]),
+ ?line NC2Nodes = lists:sort([Cpy|rpc:call(Cpy, erlang, nodes, [])]),
+ ?line NC2Nodes = lists:sort([Cpz|rpc:call(Cpz, erlang, nodes, [])]),
+ NC12Nodes = lists:append(NC1Nodes, NC2Nodes),
+ ?line false = lists:any(fun(N) -> lists:member(N, NC12Nodes) end,
+ rpc:call(Cpq, erlang, nodes, [])),
+
+
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+ stop_node(Cpx),
+ stop_node(Cpy),
+ stop_node(Cpz),
+ stop_node(Cpq),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+test_exit(suite) -> [];
+test_exit(doc) -> ["Checks when the search process exits. "];
+test_exit(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(120)),
+
+ ?line NN = node_name(atom_to_list(node())),
+ ?line Cp1nn = list_to_atom("cp1@" ++ NN),
+
+ ?line {ok, Cp1} = start_node(cp1, Config),
+ ?line {ok, Cp2} = start_node(cp2, Config),
+ ?line {ok, Cp3} = start_node(cp3, Config),
+
+ test_server:sleep(1000),
+
+ ?line {error, illegal_function_call} =
+ rpc:call(Cp1, global_group, registered_names_test, [{node, Cp1nn}]),
+ ?line {badarg,_} =
+ rpc:call(Cp1, global_group, send, [king, "The message"]),
+ ?line undefined = rpc:call(Cp1, global_group, whereis_name, [king]),
+
+ % stop the nodes, and make sure names are released.
+ stop_node(Cp1),
+ stop_node(Cp2),
+ stop_node(Cp3),
+
+ % sleep to let the nodes die
+ test_server:sleep(1000),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+start_node(Name, Config) ->
+ Pa=filename:dirname(code:which(?MODULE)),
+ Dir=?config(priv_dir, Config),
+ ConfFile = " -config " ++ filename:join(Dir, "global_group"),
+ test_server:start_node(Name, slave, [{args, "-pa " ++ Pa ++ ConfFile}]).
+
+start_node_no(Name, Config) ->
+ Pa=filename:dirname(code:which(?MODULE)),
+ Dir=?config(priv_dir, Config),
+ ConfFile = " -config " ++ filename:join(Dir, "no_global_group"),
+ test_server:start_node(Name, slave, [{args, "-pa " ++ Pa ++ ConfFile}]).
+
+start_node_no2(Name, Config) ->
+ Pa=filename:dirname(code:which(?MODULE)),
+ Dir=?config(priv_dir, Config),
+ ConfFile = " -config " ++ filename:join(Dir, "no_global_group_sync"),
+ test_server:start_node(Name, slave, [{args, "-pa " ++ Pa ++ ConfFile}]).
+
+start_node_comp(Name, Config) ->
+ Pa=filename:dirname(code:which(?MODULE)),
+ Dir=?config(priv_dir, Config),
+ ConfFile = " -config " ++ filename:join(Dir, "global_group_comp"),
+ test_server:start_node(Name, slave, [{args, "-pa " ++ Pa ++ ConfFile}]).
+
+node_names(Names, Config) ->
+ [node_name(Name, Config) || Name <- Names].
+
+node_name(Name, Config) ->
+ U = "_",
+ Pid = os:getpid(),
+ {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()),
+ Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w",
+ [Y,M,D, H,Min,S]),
+ L = lists:flatten(Date),
+ lists:concat([Name,U,?testcase,U,Pid,U,U,L]).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
+
+
+wait_for_ready_net() ->
+ Nodes = lists:sort(?NODES),
+ ?UNTIL(begin
+ lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and
+ lists:all(fun(N) ->
+ LNs = rpc:call(N, erlang, nodes, []),
+ Nodes =:= lists:sort([N | LNs])
+ end, Nodes)
+ end).
+
+get_known(Node) ->
+ Known = gen_server:call({global_name_server,Node}, get_known),
+ lists:sort([Node | Known]).
+
+config_hidden(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz, Ncpq) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s', "
+ " '~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, 1000},"
+ "{global_groups, [{nc1, hidden, ['~s@~s','~s@~s','~s@~s']}, "
+ "{nc2, hidden, ['~s@~s','~s@~s','~s@~s']}, "
+ "{nc3, normal, ['~s@~s']}]} ] }]. ~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncpx, M, Ncpy, M, Ncpz, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncpx, M, Ncpy, M, Ncpz, M,
+ Ncpq, M]).
+
+config(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz, Ncpq) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s', "
+ " '~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, 1000},"
+ "{global_groups, [{nc1, ['~s@~s','~s@~s','~s@~s']}, "
+ " {nc2, ['~s@~s','~s@~s','~s@~s']}, "
+ "{nc3, ['~s@~s']}]} ] }]. ~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncpx, M, Ncpy, M, Ncpz, M,
+ Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncpx, M, Ncpy, M, Ncpz, M,
+ Ncpq, M]).
+
+config_no(Fd) ->
+ io:format(Fd, "[{kernel, [{global_groups, []}]}]. ~n",[]).
+
+config_sync(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s', "
+ " '~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, 1000},"
+ "{global_groups, []} ] }] .~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncpx, M, Ncpy, M, Ncpz, M]).
+
+
+config_comp(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s', "
+ " '~s@~s','~s@~s','~s@~s']},"
+ "{sync_nodes_timeout, 1000} ] }] .~n",
+ [Ncp1, M, Ncp2, M, Ncp3, M,
+ Ncpx, M, Ncpy, M, Ncpz, M]).
+
+node_at(N) ->
+ NN = node_name(atom_to_list(node())),
+ list_to_atom(lists:concat([N, "@", NN])).
+
+node_name(L) ->
+ from($@, L).
+
+from(H, [H | T]) -> T;
+from(H, [_ | T]) -> from(H, T);
+from(_, []) -> [].
+
+
+start_proc(Name) ->
+ Pid = spawn(?MODULE, init, [self(), Name]),
+ receive
+ {Pid, Res} -> {Pid, Res}
+ end.
+
+start_proc_rereg(Name) ->
+ Pid = spawn(?MODULE, init2, [self(), Name]),
+ receive
+ Pid -> Pid
+ end.
+
+
+
+
+
+
+
+init(Parent) ->
+ Parent ! self(),
+ loop().
+
+init(Parent, Name) ->
+ X = global:register_name(Name, self()),
+ Parent ! {self(),X},
+ loop().
+
+init2(Parent, Name) ->
+ global:re_register_name(Name, self()),
+ Parent ! self(),
+ loop().
+
+loop() ->
+ receive
+ monitor ->
+ global_group:monitor_nodes(true),
+ loop();
+ stop_monitor ->
+ global_group:monitor_nodes(false),
+ loop();
+ {wait_nodeup, Node} ->
+ loop_nodeup(Node);
+ {wait_nodedown, Node} ->
+ loop_nodedown(Node);
+ {io, _Msg} ->
+ loop();
+ {ping, From} ->
+ From ! {pong, node()},
+ loop();
+ {del_lock, Id} ->
+ global:del_lock({Id, self()}),
+ loop();
+ {del_lock, Id, Nodes} ->
+ global:del_lock({Id, self()}, Nodes),
+ loop();
+ {set_lock, Id, From} ->
+ Res = global:set_lock({Id, self()}, ?NODES, 1),
+ From ! Res,
+ loop();
+ {set_lock, Id, From, Nodes} ->
+ Res = global:set_lock({Id, self()}, Nodes, 1),
+ From ! Res,
+ loop();
+ {set_lock_loop, Id, From} ->
+ global:set_lock({Id, self()}, ?NODES),
+ From ! {got_lock, self()},
+ loop();
+ {{got_notify, From}, Ref} ->
+ receive
+ X when element(1, X) == global_name_conflict ->
+ From ! {Ref, yes}
+ after
+ 0 -> From ! {Ref, no}
+ end,
+ loop();
+ {which_loop, From} ->
+ From ! loop,
+ loop();
+ die ->
+ exit(normal)
+ end.
+
+
+loop_nodeup(Node) ->
+ receive
+ {nodeup, Node} ->
+ loop();
+ to_loop ->
+ loop();
+ {which_loop, From} ->
+ From ! loop_nodeup,
+ loop_nodeup(Node);
+ die ->
+ exit(normal)
+ end.
+
+
+loop_nodedown(Node) ->
+ receive
+ {nodedown, Node} ->
+ loop();
+ to_loop ->
+ loop();
+ {which_loop, From} ->
+ From ! loop_nodedown,
+ loop_nodedown(Node);
+ die ->
+ exit(normal)
+ end.
+
+assert_loop(Cp, CpName, Name, NamePid, Loop) ->
+ M = {which_loop, self()},
+ NamePid = rpc:call(Cp, global_group, send, [{node, CpName}, Name, M]),
+ receive
+ Loop ->
+ ok;
+ Other1 ->
+ test_server:fail(Other1)
+ after 5000 ->
+ test_server:fail(timeout)
+ end.
+
+loop_until_true(Fun) ->
+ case Fun() of
+ true ->
+ ok;
+ _ ->
+ loop_until_true(Fun)
+ end.
+
diff --git a/lib/kernel/test/global_group_SUITE_data/.gitignore b/lib/kernel/test/global_group_SUITE_data/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/test/global_group_SUITE_data/.gitignore
diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl
new file mode 100644
index 0000000000..b06244db3c
--- /dev/null
+++ b/lib/kernel/test/heart_SUITE.erl
@@ -0,0 +1,460 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(heart_SUITE).
+
+-include("test_server.hrl").
+
+-export([all/1, ostype/1, start/1, restart/1, reboot/1, set_cmd/1, clear_cmd/1,
+ dont_drop/1, kill_pid/1, fini/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+-export([start_heart_stress/1, mangle/1, suicide_by_heart/0]).
+
+-define(DEFAULT_TIMEOUT_SECS, 120).
+
+init_per_testcase(_Func, Config) ->
+ Dog=test_server:timetrap(test_server:seconds(?DEFAULT_TIMEOUT_SECS)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+ Nodes = nodes(),
+ lists:foreach(fun(X) ->
+ NNam = list_to_atom(hd(string:tokens(atom_to_list(X),"@"))),
+ case NNam of
+ heart_test ->
+ ?t:format(1, "WARNING: Killed ~p~n", [X]),
+ rpc:cast(X, erlang, halt, []);
+ _ ->
+ ok
+ end
+ end, Nodes),
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+%%-----------------------------------------------------------------
+%% Test suite for heart.
+%% Should be started in a CC view with:
+%% erl -sname master -rsh ctrsh
+%%-----------------------------------------------------------------
+all(suite) ->
+ [{conf, ostype, [start, restart, reboot,
+ set_cmd, clear_cmd, kill_pid], fini}].
+
+ostype(Config) when is_list(Config) ->
+ case os:type() of
+ {win32, windows} ->
+ {skipped, "No use to run on Windows 95/98"};
+ _ ->
+ Config
+ end.
+fini(Config) when is_list(Config) ->
+ Config.
+
+start_check(Type, Name) ->
+ Args = case ?t:os_type() of
+ {win32,_} -> "-heart -env HEART_COMMAND no_reboot";
+ _ -> "-heart"
+ end,
+ {ok, Node} = case Type of
+ loose ->
+ loose_node:start(Name, Args, ?DEFAULT_TIMEOUT_SECS);
+ _ ->
+ ?t:start_node(Name, Type, [{args, Args}])
+ end,
+ erlang:monitor_node(Node, true),
+ case rpc:call(Node, erlang, whereis, [heart]) of
+ Pid when pid(Pid) ->
+ ok;
+ _ ->
+ test_server:fail(heart_not_started)
+ end,
+ {ok, Node}.
+
+start(doc) -> [];
+start(suite) -> {req, [{time, 10}]};
+start(Config) when is_list(Config) ->
+ ?line {ok, Node} = start_check(slave, heart_test),
+ ?line rpc:call(Node, init, reboot, []),
+ receive
+ {nodedown, Node} ->
+ ok
+ after 2000 ->
+ test_server:fail(node_not_closed)
+ end,
+ test_server:sleep(5000),
+ ?line case net_adm:ping(Node) of
+ pang ->
+ ok;
+ _ ->
+ test_server:fail(node_rebooted)
+ end,
+ test_server:stop_node(Node).
+
+%% Also test fixed bug in R1B (it was not possible to
+%% do init:stop/0 on a restarted system before)
+%% Slave executes erlang:halt() on master nodedown.
+%% Therefore the slave process has to be killed
+%% before restart.
+restart(doc) -> [];
+restart(suite) ->
+ case ?t:os_type() of
+ {Fam, _} when Fam == unix; Fam == win32 ->
+ {req, [{time,10}]};
+ _ ->
+ {skip, "Only run on unix and win32"}
+ end;
+restart(Config) when is_list(Config) ->
+ ?line {ok, Node} = start_check(loose, heart_test),
+ ?line rpc:call(Node, init, restart, []),
+ receive
+ {nodedown, Node} ->
+ ok
+ after 2000 ->
+ test_server:fail(node_not_closed)
+ end,
+ test_server:sleep(5000),
+
+ ?line case net_adm:ping(Node) of
+ pong ->
+ erlang:monitor_node(Node, true),
+ ?line rpc:call(Node, init, stop, []),
+ receive
+ {nodedown, Node} ->
+ ok
+ after 2000 ->
+ test_server:fail(node_not_closed2)
+ end,
+ ok;
+ _ ->
+ test_server:fail(node_not_restarted)
+ end,
+ loose_node:stop(Node).
+
+reboot(doc) -> [];
+reboot(suite) -> {req, [{time, 10}]};
+reboot(Config) when is_list(Config) ->
+ {ok, Node} = start_check(slave, heart_test),
+
+ ?line ok = rpc:call(Node, heart, set_cmd,
+ [atom_to_list(lib:progname()) ++
+ " -noshell -heart " ++ name(Node) ++ "&"]),
+ ?line rpc:call(Node, init, reboot, []),
+ receive
+ {nodedown, Node} ->
+ ok
+ after 2000 ->
+ test_server:fail(node_not_closed)
+ end,
+ test_server:sleep(5000),
+ ?line case net_adm:ping(Node) of
+ pong ->
+ erlang:monitor_node(Node, true),
+ ?line rpc:call(Node, init, reboot, []),
+ receive
+ {nodedown, Node} ->
+ ok
+ after 2000 ->
+ test_server:fail(node_not_closed2)
+ end,
+ ok;
+ _ ->
+ test_server:fail(node_not_rebooted)
+ end,
+ ok.
+
+%% Only tests bad command, correct behaviour is tested in reboot/1.
+set_cmd(suite) -> [];
+set_cmd(Config) when is_list(Config) ->
+ ?line {ok, Node} = start_check(slave, heart_test),
+ Cmd = wrong_atom,
+ ?line {error, {bad_cmd, Cmd}} = rpc:call(Node, heart, set_cmd, [Cmd]),
+ Cmd1 = lists:duplicate(2047, $a),
+ ?line {error, {bad_cmd, Cmd1}} = rpc:call(Node, heart, set_cmd, [Cmd1]),
+ Cmd2 = lists:duplicate(28, $a),
+ ?line ok = rpc:call(Node, heart, set_cmd, [Cmd2]),
+ Cmd3 = lists:duplicate(2000, $a),
+ ?line ok = rpc:call(Node, heart, set_cmd, [Cmd3]),
+ stop_node(Node),
+ ok.
+
+clear_cmd(suite) -> {req,[{time,15}]};
+clear_cmd(Config) when is_list(Config) ->
+ ?line {ok, Node} = start_check(slave, heart_test),
+ ?line ok = rpc:call(Node, heart, set_cmd,
+ [atom_to_list(lib:progname()) ++
+ " -noshell -heart " ++ name(Node) ++ "&"]),
+ ?line rpc:call(Node, init, reboot, []),
+ receive
+ {nodedown, Node} ->
+ ok
+ after 2000 ->
+ test_server:fail(node_not_closed)
+ end,
+ test_server:sleep(5000),
+ ?line case net_adm:ping(Node) of
+ pong ->
+ erlang:monitor_node(Node, true);
+ _ ->
+ test_server:fail(node_not_rebooted)
+ end,
+ ?line ok = rpc:call(Node, heart, set_cmd,
+ ["erl -noshell -heart " ++ name(Node) ++ "&"]),
+ ?line ok = rpc:call(Node, heart, clear_cmd, []),
+ ?line rpc:call(Node, init, reboot, []),
+ receive
+ {nodedown, Node} ->
+ ok
+ after 2000 ->
+ test_server:fail(node_not_closed)
+ end,
+ test_server:sleep(5000),
+ ?line case net_adm:ping(Node) of
+ pang ->
+ ok;
+ _ ->
+ test_server:fail(node_rebooted)
+ end,
+ ok.
+
+dont_drop(suite) ->
+%%% Removed as it may crash epmd/distribution in colourful
+%%% ways. While we ARE finding out WHY, it would
+%%% be nice for others to be able to run the kernel test suite
+%%% without "exploding machines", so thats why I removed it for now.
+ [];
+dont_drop(doc) ->
+ ["Tests that the heart command does not get dropped when ",
+ "set just before halt on very high I/O load."];
+dont_drop(Config) when is_list(Config) ->
+ %%% Have to do it some times to make it happen...
+ case os:type() of
+ vxworks ->
+ {comment, "No use to run with slaves on other nodes..."};
+ _ ->
+ [ok,ok,ok,ok,ok,ok,ok,ok,ok,ok] = do_dont_drop(Config,10),
+ ok
+ end.
+
+do_dont_drop(_,0) ->
+ [];
+do_dont_drop(Config,N) ->
+ %% Name of first slave node
+ ?line NN1 = atom_to_list(?MODULE) ++ "slave_1",
+ %% Name of node started by heart on failure
+ ?line NN2 = atom_to_list(?MODULE) ++ "slave_2",
+ %% Name of node started by heart on success
+ ?line NN3 = atom_to_list(?MODULE) ++ "slave_3",
+ ?line Host = hd(tl(string:tokens(atom_to_list(node()),"@"))),
+ %% The initial heart command
+ ?line FirstCmd = erl() ++ name(NN2 ++ "@" ++ Host),
+ %% Separated the parameters to start_node_run for clarity...
+ ?line Name = list_to_atom(NN1),
+ ?line Env = [{"HEART_COMMAND", FirstCmd}],
+ ?line Func = "start_heart_stress",
+ ?line Arg = NN3 ++ "@" ++ Host ++ " " ++
+ filename:join(?config(data_dir, Config), "simple_echo"),
+ ?line start_node_run(Name,Env,Func,Arg),
+ ?line case wait_for_any_of(list_to_atom(NN2 ++ "@" ++ Host),
+ list_to_atom(NN3 ++ "@" ++ Host)) of
+ 2 ->
+ ?line [ok | do_dont_drop(Config,N-1)];
+ _ ->
+ ?line false
+ end.
+
+wait_for_any_of(N1,N2) ->
+ ?line wait_for_any_of(N1,N2,45).
+
+wait_for_any_of(_N1,_N2,0) ->
+ ?line false;
+
+wait_for_any_of(N1,N2,Times) ->
+ ?line receive
+ after 1000 ->
+ ?line ok
+ end,
+ ?line case net_adm:ping(N1) of
+ pang ->
+ ?line case net_adm:ping(N2) of
+ pang ->
+ ?line wait_for_any_of(N1,N2,Times - 1);
+ pong ->
+ ?line rpc:call(N2,init,stop,[]),
+ ?line 2
+ end;
+ pong ->
+ ?line rpc:call(N1,init,stop,[]),
+ ?line 1
+ end.
+
+
+kill_pid(suite) ->
+ [];
+kill_pid(doc) ->
+ ["Tests that heart kills the old erlang node before executing ",
+ "heart command."];
+kill_pid(Config) when is_list(Config) ->
+ %%% Have to do it some times to make it happen...
+ case os:type() of
+ vxworks ->
+ {comment, "No use to run with slaves on other nodes..."};
+ _ ->
+ ok = do_kill_pid(Config)
+ end.
+
+do_kill_pid(_Config) ->
+ Name = heart_test,
+ Env = [{"HEART_COMMAND", "nickeNyfikenFarEttJobb"}],
+ {ok,Node} = start_node_run(Name,Env,suicide_by_heart,[]),
+ ok = wait_for_node(Node,15),
+ erlang:monitor_node(Node, true),
+ receive
+ {nodedown,Node} ->
+ ok
+ after 30000 ->
+ false
+ end.
+
+wait_for_node(_,0) ->
+ false;
+wait_for_node(Node,N) ->
+ receive
+ after 1000 ->
+ ok
+ end,
+ case net_adm:ping(Node) of
+ pong ->
+ ok;
+ pang ->
+ wait_for_node(Node,N-1)
+ end.
+
+erl() ->
+ case os:type() of
+ {win32,_} ->
+ "werl ";
+ _ ->
+ "erl "
+ end.
+
+name(Node) when is_list(Node) -> name(Node,[]);
+name(Node) when atom(Node) -> name(atom_to_list(Node),[]).
+
+name([$@|Node], Name) ->
+ case lists:member($., Node) of
+ true ->
+ "-name " ++ lists:reverse(Name);
+ _ ->
+ "-sname " ++ lists:reverse(Name)
+ end;
+name([H|T], Name) ->
+ name(T, [H|Name]).
+
+
+atom_conv(A) when atom(A) ->
+ atom_to_list(A);
+atom_conv(A) when is_list(A) ->
+ A.
+
+env_conv([]) ->
+ [];
+env_conv([{X,Y}|T]) ->
+ atom_conv(X) ++ " \"" ++ atom_conv(Y) ++ "\" " ++ env_conv(T).
+
+%%%
+%%% Starts a node and runs a function in this
+%%% module.
+%%% Name is the node name as either atom or string,
+%%% Env is a list of Tuples containing name-value pairs.
+%%% Function is the function to run in this module
+%%% Argument is the argument(s) to send through erl -s
+%%%
+start_node_run(Name, Env, Function, Argument) ->
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line Params = "-heart -env " ++ env_conv(Env) ++ " -pa " ++ PA ++
+ " -s " ++
+ atom_conv(?MODULE) ++ " " ++ atom_conv(Function) ++ " " ++
+ atom_conv(Argument),
+ ?line start_node(Name, Params).
+
+start_node(Name, Param) ->
+ test_server:start_node(Name, slave, [{args, Param}]).
+
+stop_node(Node) ->
+ test_server:stop_node(Node).
+
+
+%%% This code is run in a slave node to ensure that
+%%% A heart command really gets set syncronously
+%%% and cannot get "dropped".
+
+send_to(_,_,0) ->
+ ok;
+send_to(Port,D,N) ->
+ Port ! {self(),{command,D}},
+ send_to(Port,D,N-1).
+
+receive_from(_,_,0) ->
+ ok;
+
+receive_from(Port,D,N) ->
+ receive
+ {Port, {data,{eol,_Data}}} ->
+ receive_from(Port,D,N-1);
+ X ->
+ io:format("Got garbage ~p~n",[X])
+ end.
+
+mangle(PP) when is_list(PP) ->
+ Port = open_port({spawn,PP},[{line,100}]),
+ mangle(Port);
+
+mangle(Port) ->
+ send_to(Port, "ABCDEFGHIJ" ++ io_lib:nl(),1),
+ receive_from(Port,"ABCDEFGHIJ",1),
+ mangle(Port).
+
+
+
+explode(0,_) ->
+ ok;
+explode(N,PP) ->
+ spawn(?MODULE,mangle,[PP]),
+ explode(N-1,PP).
+
+start_heart_stress([NewName,PortProgram]) ->
+ explode(10,atom_to_list(PortProgram)),
+ NewCmd = erl() ++ name(NewName),
+ %%io:format("~p~n",[NewCmd]),
+ receive
+ after 10000 ->
+ heart:set_cmd(NewCmd),
+ halt()
+ end.
+
+suicide_by_heart() ->
+ %%io:format("Suicide starting...~n"),
+ open_port({spawn,"heart -ht 11 -pid "++os:getpid()},[{packet,2}]),
+ receive X -> X end,
+ %% Just hang and wait for heart to timeout
+ receive
+ {makaronipudding} ->
+ sallad
+ end.
diff --git a/lib/kernel/test/heart_SUITE_data/Makefile.src b/lib/kernel/test/heart_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..f48506235f
--- /dev/null
+++ b/lib/kernel/test/heart_SUITE_data/Makefile.src
@@ -0,0 +1,14 @@
+CC = @CC@
+LD = @LD@
+CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@
+CROSSLDFLAGS = @CROSSLDFLAGS@
+
+PROGS = simple_echo@exe@
+
+all: $(PROGS)
+
+simple_echo@exe@: simple_echo@obj@
+ $(LD) $(CROSSLDFLAGS) -o simple_echo simple_echo@obj@ @LIBS@
+
+simple_echo@obj@: simple_echo.c
+ $(CC) -c -o simple_echo@obj@ $(CFLAGS) simple_echo.c
diff --git a/lib/kernel/test/heart_SUITE_data/simple_echo.c b/lib/kernel/test/heart_SUITE_data/simple_echo.c
new file mode 100644
index 0000000000..0093dbce9b
--- /dev/null
+++ b/lib/kernel/test/heart_SUITE_data/simple_echo.c
@@ -0,0 +1,17 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#ifdef VXWORKS
+int simple_echo(void){
+#else
+int main(void){
+#endif
+ int x;
+ while((x = getchar()) != EOF){
+ putchar(x);
+ fflush(stdout);
+ }
+ return 0;
+}
+
diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl
new file mode 100644
index 0000000000..cf33e8b27f
--- /dev/null
+++ b/lib/kernel/test/inet_SUITE.erl
@@ -0,0 +1,735 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_SUITE).
+
+-include("test_server.hrl").
+-include_lib("kernel/include/inet.hrl").
+-include_lib("kernel/src/inet_dns.hrl").
+
+-export([all/1, t_gethostbyaddr/1, t_getaddr/1, t_gethostbyname/1,
+ t_gethostbyaddr_v6/1, t_getaddr_v6/1, t_gethostbyname_v6/1,
+ ipv4_to_ipv6/1, host_and_addr/1, parse/1, t_gethostnative/1,
+ gethostnative_parallell/1, cname_loop/1,
+ gethostnative_soft_restart/1,gethostnative_debug_level/1,getif/1]).
+
+-export([get_hosts/1, get_ipv6_hosts/1, parse_hosts/1,
+ kill_gethost/0, parallell_gethost/0]).
+-export([init_per_testcase/2, end_per_testcase/2]).
+
+
+all(suite) ->
+ [t_gethostbyaddr, t_gethostbyname, t_getaddr,
+ t_gethostbyaddr_v6, t_gethostbyname_v6, t_getaddr_v6,
+ ipv4_to_ipv6, host_and_addr, parse,t_gethostnative,
+ gethostnative_parallell, cname_loop,
+ gethostnative_debug_level,gethostnative_soft_restart,
+ getif].
+
+init_per_testcase(_Func, Config) ->
+ Dog = test_server:timetrap(test_server:seconds(60)),
+ [{watchdog,Dog}|Config].
+
+end_per_testcase(_Func, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+
+t_gethostbyaddr(doc) -> "Test the inet:gethostbyaddr/1 function.";
+t_gethostbyaddr(Config) when is_list(Config) ->
+ ?line {Name,FullName,IPStr,IP,Aliases,_,_} = ?config(test_host_ipv4_only, Config),
+ ?line {ok,HEnt} = inet:gethostbyaddr(IPStr),
+ ?line {ok,HEnt} = inet:gethostbyaddr(IP),
+ ?line {error,Error} = inet:gethostbyaddr(Name),
+ ?line ok = io:format("Failure reason: ~p: ~s",
+ [error,inet:format_error(Error)]),
+ ?line HEnt_ = HEnt#hostent{h_addrtype = inet,
+ h_length = 4,
+ h_addr_list = [IP]},
+ ?line HEnt_ = HEnt,
+ case {os:type(),os:version()} of
+ {{unix,freebsd},{5,0,0}} ->
+ %% The alias list seems to be buggy in FreeBSD 5.0.0.
+ ?line check_elems([{HEnt#hostent.h_name,[Name,FullName]}]),
+ io:format("Buggy alias list: ~p", [HEnt#hostent.h_aliases]),
+ ok;
+ _ ->
+ ?line check_elems([{HEnt#hostent.h_name,[Name,FullName]},
+ {HEnt#hostent.h_aliases,[[],Aliases]}])
+ end,
+
+ ?line {_DName, _DFullName, DIPStr, DIP, _, _, _} =
+ ?config(test_dummy_host, Config),
+ ?line {error,nxdomain} = inet:gethostbyaddr(DIPStr),
+ ?line {error,nxdomain} = inet:gethostbyaddr(DIP),
+ ok.
+
+t_gethostbyaddr_v6(doc) -> "Test the inet:gethostbyaddr/1 inet6 function.";
+t_gethostbyaddr_v6(Config) when is_list(Config) ->
+ ?line {Name6, FullName6, IPStr6, IP6, Aliases6} =
+ ?config(test_host_ipv6_only, Config),
+
+ ?line case inet:gethostbyaddr(IPStr6) of
+ %% Even if IPv6 is not supported, the native resolver may succeed
+ %% looking up the host. DNS lookup will probably fail.
+ {error,nxdomain} ->
+ {skip, "IPv6 test fails! IPv6 not supported on this host!?"};
+ {ok,HEnt6} ->
+ ?line {ok,HEnt6} = inet:gethostbyaddr(IP6),
+ ?line {error,Error6} = inet:gethostbyaddr(Name6),
+ ?line ok = io:format("Failure reason: ~p: ~s",
+ [Error6, inet:format_error(Error6)]),
+ ?line HEnt6_ = HEnt6#hostent{h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [IP6]},
+ ?line HEnt6_ = HEnt6,
+ ?line check_elems([{HEnt6#hostent.h_name,[Name6,FullName6]},
+ {HEnt6#hostent.h_aliases,[[],Aliases6]}]),
+
+ ?line {_DName6, _DFullName6, DIPStr6, DIP6, _} =
+ ?config(test_dummy_ipv6_host, Config),
+ ?line {error,nxdomain} = inet:gethostbyaddr(DIPStr6),
+ ?line {error,nxdomain} = inet:gethostbyaddr(DIP6),
+ ok
+ end.
+
+t_gethostbyname(doc) -> "Test the inet:gethostbyname/1 function.";
+t_gethostbyname(suite) -> [];
+t_gethostbyname(Config) when is_list(Config) ->
+ ?line {Name,FullName,IPStr,IP,Aliases,IP_46_Str,_} =
+ ?config(test_host_ipv4_only, Config),
+ ?line {ok,_} = inet:gethostbyname(IPStr),
+ ?line {ok,HEnt} = inet:gethostbyname(Name),
+ ?line {ok,HEnt} = inet:gethostbyname(list_to_atom(Name)),
+ ?line HEnt_ = HEnt#hostent{h_addrtype = inet,
+ h_length = 4,
+ h_addr_list = [IP]},
+ ?line HEnt_ = HEnt,
+ ?line check_elems([{HEnt#hostent.h_name,[Name,FullName]},
+ {HEnt#hostent.h_aliases,[[],Aliases]}]),
+
+ ?line {ok,HEntF} = inet:gethostbyname(FullName),
+ ?line HEntF_ = HEntF#hostent{h_name = FullName,
+ h_addrtype = inet,
+ h_length = 4,
+ h_addr_list = [IP]},
+ ?line HEntF_ = HEntF,
+ ?line check_elems([{HEnt#hostent.h_aliases,[[],Aliases]}]),
+
+ ?line {DName, _DFullName, _DIPStr, _DIP, _, _, _} =
+ ?config(test_dummy_host, Config),
+ ?line {error,nxdomain} = inet:gethostbyname(DName),
+ ?line {error,nxdomain} = inet:gethostbyname(IP_46_Str).
+
+t_gethostbyname_v6(doc) -> "Test the inet:gethostbyname/1 inet6 function.";
+t_gethostbyname_v6(suite) -> [];
+t_gethostbyname_v6(Config) when is_list(Config) ->
+ ?line {Name, _, _, _,Aliases,IP_46_Str,IP_46} =
+ ?config(test_host_ipv4_only, Config),
+
+ case {inet:gethostbyname(IP_46_Str, inet6),
+ inet:gethostbyname(Name, inet6)} of
+ {{ok,HEnt46},{ok,_}} ->
+ ?line HEnt46_ = HEnt46#hostent{h_name = IP_46_Str,
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [IP_46]},
+ ?line HEnt46_ = HEnt46,
+ ?line check_elems([{HEnt46#hostent.h_aliases,[[],Aliases]}]),
+
+ ?line {Name6, FullName6, IPStr6, IP6, Aliases6} =
+ ?config(test_host_ipv6_only, Config),
+ ?line {ok,_} = inet:gethostbyname(IPStr6, inet6),
+ ?line {ok,HEnt6} = inet:gethostbyname(Name6, inet6),
+ ?line {ok,HEnt6} = inet:gethostbyname(list_to_atom(Name6), inet6),
+ ?line case HEnt6#hostent.h_addr_list of
+ [IP6] -> % ipv6 ok
+ ?line HEnt6_ = HEnt6#hostent{h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [IP6]},
+ ?line HEnt6_ = HEnt6,
+ ?line check_elems([{HEnt6#hostent.h_name,[Name6,FullName6]},
+ {HEnt6#hostent.h_aliases,[[],Aliases6]}]);
+ _ -> % ipv4 compatible addr
+ ?line {ok,HEnt4} = inet:gethostbyname(Name6, inet),
+ ?line [IP4] = HEnt4#hostent.h_addr_list,
+ ?line {ok,IP46_2} =
+ inet_parse:ipv6_address("::ffff:"++inet_parse:ntoa(IP4)),
+ ?line HEnt6_ = HEnt6#hostent{h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [IP46_2]},
+ ?line HEnt6_ = HEnt6,
+ ?line check_elems([{HEnt6#hostent.h_name,[Name6,FullName6]}])
+ end,
+
+ ?line {ok,HEntF6} = inet:gethostbyname(FullName6, inet6),
+ ?line case HEntF6#hostent.h_addr_list of
+ [IP6] -> % ipv6 ok
+ ?line HEntF6_ = HEntF6#hostent{h_name = FullName6,
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [IP6]},
+ ?line HEntF6_ = HEntF6,
+ ?line check_elems([{HEntF6#hostent.h_aliases,[[],Aliases6]}]);
+ _ -> % ipv4 compatible addr
+ ?line {ok,HEntF4} = inet:gethostbyname(FullName6, inet),
+ ?line [IPF4] = HEntF4#hostent.h_addr_list,
+ ?line {ok,IPF46_2} =
+ inet_parse:ipv6_address("::ffff:"++inet_parse:ntoa(IPF4)),
+ ?line HEntF6_ = HEntF6#hostent{h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [IPF46_2]},
+ ?line HEntF6_ = HEntF6,
+ ?line check_elems([{HEntF6#hostent.h_name,[Name6,FullName6]}])
+ end,
+
+ ?line {DName6, _DFullName6, _DIPStr6, _DIP6, _} =
+ ?config(test_dummy_ipv6_host, Config),
+ ?line {error,nxdomain} = inet:gethostbyname(DName6, inet6),
+ ok;
+ {_,_} ->
+ {skip, "IPv6 is not supported on this host"}
+ end.
+
+check_elems([{Val,Tests} | Elems]) ->
+ check_elem(Val, Tests, Tests),
+ check_elems(Elems);
+check_elems([]) -> ok.
+
+check_elem(Val, [Val|_], _) -> ok;
+check_elem(Val, [_|Tests], Tests0) ->
+ check_elem(Val, Tests, Tests0);
+check_elem(Val, [], Tests0) ->
+ ?t:fail({no_match,Val,Tests0}).
+
+
+t_getaddr(doc) -> "Test the inet:getaddr/2 function.";
+t_getaddr(suite) -> [];
+t_getaddr(Config) when is_list(Config) ->
+ ?line {Name,FullName,IPStr,IP,_,IP_46_Str,IP46} =
+ ?config(test_host_ipv4_only, Config),
+ ?line {ok,IP} = inet:getaddr(list_to_atom(Name), inet),
+ ?line {ok,IP} = inet:getaddr(Name, inet),
+ ?line {ok,IP} = inet:getaddr(FullName, inet),
+ ?line {ok,IP} = inet:getaddr(IP, inet),
+ ?line {ok,IP} = inet:getaddr(IPStr, inet),
+ ?line {error,nxdomain} = inet:getaddr(IP_46_Str, inet),
+ ?line {error,eafnosupport} = inet:getaddr(IP46, inet),
+
+ ?line {DName, DFullName, DIPStr, DIP, _, _, _} = ?config(test_dummy_host, Config),
+ ?line {error,nxdomain} = inet:getaddr(DName, inet),
+ ?line {error,nxdomain} = inet:getaddr(DFullName, inet),
+ ?line {ok,DIP} = inet:getaddr(DIPStr, inet),
+ ?line {ok,DIP} = inet:getaddr(DIP, inet).
+
+t_getaddr_v6(doc) -> "Test the inet:getaddr/2 function.";
+t_getaddr_v6(suite) -> [];
+t_getaddr_v6(Config) when is_list(Config) ->
+ ?line {Name,FullName,IPStr,_IP,_,IP_46_Str,IP46} =
+ ?config(test_host_ipv4_only, Config),
+ case {inet:getaddr(IP_46_Str, inet6),inet:getaddr(Name, inet6)} of
+ {{ok,IP46},{ok,_}} ->
+ %% Since we suceeded in parsing an IPv6 address string and
+ %% look up the name, this computer fully supports IPv6.
+ ?line {ok,IP46} = inet:getaddr(IP46, inet6),
+ ?line {ok,IP46} = inet:getaddr(Name, inet6),
+ ?line {ok,IP46} = inet:getaddr(FullName, inet6),
+ ?line IP4toIP6 = inet:getaddr(IPStr, inet6),
+ ?line case IP4toIP6 of
+ {ok,IP46} -> % only native can do this
+ ?line true = lists:member(native,
+ inet_db:res_option(lookup));
+ {error,nxdomain} ->
+ ok
+ end,
+ ?line {Name6, FullName6, IPStr6, IP6, _} =
+ ?config(test_host_ipv6_only, Config),
+ ?line {ok,_} = inet:getaddr(list_to_atom(Name6), inet6),
+ ?line {ok,_} = inet:getaddr(Name6, inet6),
+ ?line {ok,_} = inet:getaddr(FullName6, inet6),
+ ?line {ok,IP6} = inet:getaddr(IP6, inet6),
+ ?line {ok,IP6} = inet:getaddr(IPStr6, inet6),
+
+ ?line {DName6, DFullName6, DIPStr6, DIP6, _} =
+ ?config(test_dummy_ipv6_host, Config),
+ ?line {error,nxdomain} = inet:getaddr(DName6, inet6),
+ ?line {error,nxdomain} = inet:getaddr(DFullName6, inet6),
+ ?line {ok,DIP6} = inet:getaddr(DIPStr6, inet6),
+ ?line {ok,DIP6} = inet:getaddr(DIP6, inet6),
+ ok;
+ {_,_} ->
+ {skip, "IPv6 is not supported on this host"}
+ end.
+
+ipv4_to_ipv6(doc) -> "Test if IPv4 address is converted to IPv6 address.";
+ipv4_to_ipv6(suite) -> [];
+ipv4_to_ipv6(Config) when is_list(Config) ->
+ %% Test what happens if an IPv4 address is looked up in an IPv6 context.
+ %% If the native resolver succeeds to look it up, an IPv4 compatible
+ %% address should be returned. If no IPv6 support on this host, an
+ %% error should beturned.
+ ?line {_Name,_FullName,IPStr,_IP,Aliases,IP_46_Str,IP_46} =
+ ?config(test_host_ipv4_only, Config),
+ ?line IP4to6Res =
+ case inet:getaddr(IPStr, inet6) of
+ {ok,IP_46} ->
+ io:format("IPv4->IPv6: success~n"),
+ true;
+ E = {error,nxdomain} ->
+ io:format("IPv4->IPv6: nxdomain~n"),
+ E;
+ E = {error,eafnosupport} ->
+ io:format("IPv6->IPv4: eafnosupport~n"),
+ E;
+ Other ->
+ ?line ?t:fail({ipv4_to_ipv6_lookup_failed,Other})
+ end,
+ ?line case {IP4to6Res,inet:gethostbyname(IPStr, inet6)} of
+ {true,{ok,HEnt}} ->
+ ?line true = lists:member(native, inet_db:res_option(lookup)),
+ ?line HEnt_ = HEnt#hostent{h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [IP_46]},
+ ?line HEnt_ = HEnt,
+ ?line check_elems([{HEnt#hostent.h_name,[IP_46_Str,IPStr]},
+ {HEnt#hostent.h_aliases,[[],Aliases]}]);
+ {_,IP4to6Res} -> ok
+ end,
+ ok.
+
+host_and_addr(doc) -> ["Test looking up hosts and addresses. Use 'ypcat hosts' ",
+ "or the local eqivalent to find all hosts."];
+host_and_addr(suite) -> [];
+host_and_addr(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:minutes(5)),
+
+ ?line lists:foreach(fun try_host/1, get_hosts(Config)),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+try_host({Ip0, Host}) ->
+ ?line {ok,Ip} = inet:getaddr(Ip0, inet),
+ ?line {ok,{hostent, _, _, inet, _, Ips1}} = inet:gethostbyaddr(Ip),
+ ?line {ok,{hostent, _, _, inet, _, _Ips2}} = inet:gethostbyname(Host),
+ ?line true = lists:member(Ip, Ips1),
+ ok.
+
+%% Get all hosts from the system using 'ypcat hosts' or the local
+%% equvivalent.
+
+get_hosts(Config) ->
+ case os:type() of
+ {unix, _} ->
+ List = lists:map(fun(X) ->
+ atom_to_list(X)++" "
+ end, ?config(test_hosts, Config)),
+ Cmd = "ypmatch "++List++" hosts.byname",
+ HostFile = os:cmd(Cmd),
+ get_hosts(HostFile, [], [], []);
+ _ ->
+ ?config(hardcoded_hosts, Config)
+ end.
+
+get_ipv6_hosts(Config) ->
+ case os:type() of
+ {unix, _} ->
+ List = lists:map(fun(X) ->
+ atom_to_list(X)++" "
+ end, ?config(test_hosts, Config)),
+ Cmd = "ypmatch "++List++" ipnodes.byname",
+ HostFile = os:cmd(Cmd),
+ get_hosts(HostFile, [], [], []);
+ _ ->
+ ?config(hardcoded_ipv6_hosts, Config)
+ end.
+
+get_hosts([$\t|Rest], Cur, Ip, Result) when Ip /= [] ->
+ get_hosts(Rest, Cur, Ip, Result);
+get_hosts([$\t|Rest], Cur, _Ip, Result) ->
+ get_hosts(Rest, [], lists:reverse(Cur), Result);
+get_hosts([$\r|Rest], Cur, Ip, Result) ->
+ get_hosts(Rest, Cur, Ip, Result);
+get_hosts([$\n|Rest], Cur, Ip, Result) ->
+ [First|_] = string:tokens(lists:reverse(Cur), " "),
+ Ips = string:tokens(Ip, ","),
+ Hosts = [{I, First} || I <- Ips],
+ get_hosts(Rest, [], [], Hosts++Result);
+get_hosts([C|Rest], Cur, Ip, Result) ->
+ get_hosts(Rest, [C|Cur], Ip, Result);
+get_hosts([], _, _, Result) ->
+ Result.
+
+parse(suite) -> [parse_hosts];
+parse(doc) -> ["Test that parsing of the hosts file or equivalent works,",
+ "and that erroneous lines are skipped"].
+parse_hosts(Config) when is_list(Config) ->
+ ?line DataDir = ?config(data_dir,Config),
+ ?line HostFile = filename:join(DataDir, "hosts"),
+ ?line inet_parse:hosts(HostFile),
+ ?line HostFileErr1 = filename:join(DataDir, "hosts_err1"),
+ ?line inet_parse:hosts(HostFileErr1),
+ ?line Resolv = filename:join(DataDir,"resolv.conf"),
+ ?line inet_parse:resolv(Resolv),
+ ?line ResolvErr1 = filename:join(DataDir,"resolv.conf.err1"),
+ ?line inet_parse:resolv(ResolvErr1).
+
+t_gethostnative(suite) ->[];
+t_gethostnative(doc) ->[];
+t_gethostnative(Config) when is_list(Config) ->
+%% this will result in 26 bytes sent which causes problem in Windows
+%% if the port-program has not assured stdin to be read in BINARY mode
+%% OTP-2555
+ case os:type() of
+ vxworks ->
+ {skipped, "VxWorks has no native gethostbyname()"};
+ _ ->
+ ?line case inet_gethost_native:gethostbyname(
+ "a23456789012345678901234") of
+ {error,notfound} ->
+ ?line ok;
+ {error,no_data} ->
+ ?line ok
+ end
+ end.
+
+gethostnative_parallell(suite) ->
+ [];
+gethostnative_parallell(doc) ->
+ ["Check that the emulator survives crashes in gethost_native"];
+gethostnative_parallell(Config) when is_list(Config) ->
+ ?line {ok,Hostname} = inet:gethostname(),
+ ?line {ok,_} = inet:gethostbyname(Hostname),
+ case whereis(inet_gethost_native) of
+ Pid when is_pid(Pid) ->
+ ?line do_gethostnative_parallell();
+ _ ->
+ ?line {skipped, "Not running native gethostbyname"}
+ end.
+
+do_gethostnative_parallell() ->
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok,Node} = ?t:start_node(gethost_parallell, slave,
+ [{args, "-pa " ++ PA}]),
+ ?line ok = rpc:call(Node, ?MODULE, parallell_gethost, []),
+ ?line receive after 10000 -> ok end,
+ ?line pong = net_adm:ping(Node),
+ ?line ?t:stop_node(Node),
+ ok.
+
+parallell_gethost() ->
+ {ok,Hostname} = inet:gethostname(),
+ process_flag(trap_exit,true),
+ parallell_gethost_loop(10, Hostname).
+
+parallell_gethost_loop(0, _) -> ok;
+parallell_gethost_loop(N, Hostname) ->
+ case whereis(inet_gethost_native) of
+ Pid when is_pid(Pid) ->
+ true = exit(Pid,kill);
+ _ ->
+ ok
+ end,
+
+ L = spawn_gethosters(Hostname, 10),
+ release_gethosters(L),
+ collect_gethosters(10),
+ parallell_gethost_loop(N-1, Hostname).
+
+spawn_gethosters(_, 0) ->
+ [];
+spawn_gethosters(Hostname, N) ->
+ Collector = self(),
+ [spawn(fun() ->
+ receive
+ go ->
+ case (catch inet:gethostbyname(Hostname)) of
+ {ok,_} ->
+ Collector ! ok;
+ Else ->
+ Collector ! {error,Else}
+ end
+ end
+ end) |
+ spawn_gethosters(Hostname, N-1)].
+
+release_gethosters([]) ->
+ ok;
+release_gethosters([H|T]) ->
+ H ! go,
+ release_gethosters(T).
+
+collect_gethosters(0) ->
+ ok;
+collect_gethosters(N) ->
+ receive
+ ok ->
+ collect_gethosters(N-1);
+ Else ->
+ {failed, {unexpected, Else}}
+ after 2000 ->
+ {failed, {missing, N}}
+ end.
+
+kill_gethost() ->
+ kill_gethost(20).
+
+kill_gethost(0) ->
+ ok;
+kill_gethost(N) ->
+ put(kill_gethost_n,N),
+ Pid = wait_for_gethost(10),
+ true = exit(Pid,kill),
+ wait_for_dead_gethost(10),
+ kill_gethost(N-1).
+
+wait_for_dead_gethost(0) ->
+ exit({not_dead,inet_gethost_native});
+wait_for_dead_gethost(N) ->
+ case whereis(inet_gethost_native) of
+ Pid when is_pid(Pid) ->
+ receive after 1000 ->
+ ok
+ end,
+ wait_for_dead_gethost(N-1);
+ undefined ->
+ ok
+ end.
+
+wait_for_gethost(0) ->
+ exit(gethost_not_found);
+wait_for_gethost(N) ->
+ {ok,Hostname} = inet:gethostname(),
+ case (catch inet:gethostbyname(Hostname)) of
+ {ok,_} ->
+ ok;
+ Otherwise ->
+ %% This is what I call an exit tuple :)
+ exit({inet,gethostbyname, returned, Otherwise, 'when',
+ 'N','=',N,'and','hostname','=',Hostname,'and',
+ kill_gethost_n,'=',get(kill_gethost_n)})
+ end,
+ case whereis(inet_gethost_native) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ _ ->
+ receive
+ after 1000 ->
+ ok
+ end,
+ wait_for_gethost(N-1)
+ end.
+
+cname_loop(suite) ->
+ [];
+cname_loop(doc) ->
+ ["Check that the resolver handles a CNAME loop"];
+cname_loop(Config) when is_list(Config) ->
+ %% getbyname (hostent_by_domain)
+ ?line ok = inet_db:add_rr("mydomain.com", in, ?S_CNAME, ttl, "mydomain.com"),
+ ?line {error,nxdomain} = inet_db:getbyname("mydomain.com", ?S_A),
+ ?line ok = inet_db:del_rr("mydomain.com", in, ?S_CNAME, "mydomain.com"),
+ %% res_hostent_by_domain
+ RR = #dns_rr{domain = "mydomain.com",
+ class = in,
+ type = ?S_CNAME,
+ data = "mydomain.com"},
+ Rec = #dns_rec{anlist = [RR]},
+ ?line {error,nxdomain} = inet_db:res_hostent_by_domain("mydomain.com", ?S_A, Rec),
+ ok.
+
+
+
+%% These must be run in the whole suite since they need
+%% the host list and require inet_gethost_native to be started.
+%%
+-record(gethostnative_control, {control_seq,
+ control_interval=100,
+ lookup_delay=10,
+ lookup_count=300,
+ lookup_processes=20}).
+
+gethostnative_soft_restart(suite) ->
+ [];
+gethostnative_soft_restart(doc) ->
+ ["Check that no name lookups fails during soft restart "
+ "of inet_gethost_native"];
+gethostnative_soft_restart(Config) when is_list(Config) ->
+ ?line gethostnative_control(Config,
+ #gethostnative_control{
+ control_seq=[soft_restart]}).
+
+gethostnative_debug_level(suite) ->
+ [];
+gethostnative_debug_level(doc) ->
+ ["Check that no name lookups fails during debug level change "
+ "of inet_gethost_native"];
+gethostnative_debug_level(Config) when is_list(Config) ->
+ ?line gethostnative_control(Config,
+ #gethostnative_control{
+ control_seq=[{debug_level,1},
+ {debug_level,0}]}).
+
+gethostnative_control(Config, Optrec) ->
+ ?line case inet_db:res_option(lookup) of
+ [native] ->
+ case whereis(inet_gethost_native) of
+ Pid when is_pid(Pid) ->
+ ?line gethostnative_control_1(Config, Optrec);
+ _ ->
+ ?line {skipped, "Not running native gethostbyname"}
+ end;
+ _ ->
+ ?line {skipped, "Native not only lookup metod"}
+ end.
+
+gethostnative_control_1(Config,
+ #gethostnative_control{
+ control_seq=Seq,
+ control_interval=Interval,
+ lookup_delay=Delay,
+ lookup_count=Cnt,
+ lookup_processes=N}) ->
+ ?line {ok, Hostname} = inet:gethostname(),
+ ?line {ok, _} = inet:gethostbyname(Hostname),
+ ?line Hosts =
+ [Hostname|[H || {_,H} <- get_hosts(Config)]
+ ++[H++D || H <- ["www.","www1.","www2.",""],
+ D <- ["erlang.org","erlang.se"]]
+ ++[H++"cslab.ericsson.net" || H <- ["morgoth.","hades.","styx."]]],
+ %% Spawn some processes to do parallel lookups while
+ %% I repeatedly do inet_gethost_native:control/1.
+ ?line TrapExit = process_flag(trap_exit, true),
+ ?line gethostnative_control_2([undefined], Interval, Delay, Cnt, N, Hosts),
+ ?line test_server:format(
+ "First intermission: now starting control sequence ~w\n",
+ [Seq]),
+ ?line erlang:display(first_intermission),
+ ?line gethostnative_control_2(Seq, Interval, Delay, Cnt, N, Hosts),
+ ?line erlang:display(second_intermission),
+ ?line test_server:format(
+ "Second intermission: now stopping control sequence ~w\n",
+ [Seq]),
+ ?line gethostnative_control_2([undefined], Interval, Delay, Cnt, N, Hosts),
+ ?line true = process_flag(trap_exit, TrapExit),
+ ?line ok.
+
+gethostnative_control_2(Seq, Interval, Delay, Cnt, N, Hosts) ->
+ ?line Tag = make_ref(),
+ ?line Parent = self(),
+ ?line Lookupers =
+ [spawn_link(
+ fun () ->
+ random:seed(),
+ lookup_loop(Hosts, Delay, Tag, Parent, Cnt, Hosts)
+ end)
+ || _ <- lists:seq(1, N)],
+ control_loop(Seq, Interval, Tag, Lookupers, Seq),
+ gethostnative_control_3(Tag, ok).
+
+gethostnative_control_3(Tag, Reason) ->
+ receive
+ {Tag,Error} ->
+ ?line gethostnative_control_3(Tag, Error)
+ after 0 ->
+ Reason
+ end.
+
+control_loop([], _Interval, _Tag, [], _Seq) ->
+ ok;
+control_loop([], Interval, Tag, Lookupers, Seq) ->
+ control_loop(Seq, Interval, Tag, Lookupers, Seq);
+control_loop([Op|Ops], Interval, Tag, Lookupers, Seq) ->
+ control_loop(Ops, Interval, Tag,
+ control_loop_1(Op, Interval, Tag, Lookupers),
+ Seq).
+
+control_loop_1(Op, Interval, Tag, Lookupers) ->
+ ?line
+ receive
+ {'EXIT',Pid,Reason} ->
+ ?line case Reason of
+ Tag -> % Done
+ ?line control_loop_1
+ (Op, Interval, Tag,
+ lists:delete(Pid, Lookupers));
+ _ ->
+ ?line io:format("Lookuper ~p died: ~p",
+ [Pid,Reason]),
+ ?line test_server:fail("Lookuper died")
+ end
+ after Interval ->
+ ?line if Op =/= undefined ->
+ ?line ok = inet_gethost_native:control(Op);
+ true ->
+ ?line ok
+ end,
+ ?line Lookupers
+ end.
+
+lookup_loop(_, _Delay, Tag, _Parent, 0, _Hosts) ->
+ exit(Tag);
+lookup_loop([], Delay, Tag, Parent, Cnt, Hosts) ->
+ lookup_loop(Hosts, Delay, Tag, Parent, Cnt, Hosts);
+lookup_loop([H|Hs], Delay, Tag, Parent, Cnt, Hosts) ->
+ case inet:gethostbyname(H) of
+ {ok,_Hent} -> ok;
+ {error,nxdomain} -> ok;
+ Error ->
+ ?line io:format("Name lookup error for ~p for ~p: ~p",
+ [self(),H,Error]),
+ Parent ! {Tag,Error}
+ end,
+ receive
+ after random:uniform(Delay) ->
+ lookup_loop(Hs, Delay, Tag, Parent, Cnt-1, Hosts)
+ end.
+
+
+
+getif(suite) ->
+ [];
+getif(doc) ->
+ ["Tests basic functionality of getiflist, getif, and ifget"];
+getif(Config) when is_list(Config) ->
+ ?line {ok,Hostname} = inet:gethostname(),
+ ?line {ok,Address} = inet:getaddr(Hostname, inet),
+ ?line {ok,Loopback} = inet:getaddr("localhost", inet),
+ ?line {ok,Interfaces} = inet:getiflist(),
+ ?line Addresses =
+ lists:sort(
+ lists:foldl(
+ fun (I, Acc) ->
+ case inet:ifget(I, [addr]) of
+ {ok,[{addr,A}]} -> [A|Acc];
+ {ok,[]} -> Acc
+ end
+ end, [], Interfaces)),
+ ?line {ok,Getif} = inet:getif(),
+ ?line Addresses = lists:sort([A || {A,_,_} <- Getif]),
+ ?line true = ip_member(Address, Addresses),
+ ?line true = ip_member(Loopback, Addresses),
+ ?line ok.
+
+%% Works just like lists:member/2, except that any {127,_,_,_} tuple
+%% matches any other {127,_,_,_}. We do this to handle Linux systems
+%% that use (for instance) 127.0.1.1 as the IP address for the hostname.
+
+ip_member({127,_,_,_}, [{127,_,_,_}|_]) -> true;
+ip_member(K, [K|_]) -> true;
+ip_member(K, [_|T]) -> ip_member(K, T);
+ip_member(_, []) -> false.
diff --git a/lib/kernel/test/inet_SUITE_data/hosts b/lib/kernel/test/inet_SUITE_data/hosts
new file mode 100644
index 0000000000..64d1d54f9b
--- /dev/null
+++ b/lib/kernel/test/inet_SUITE_data/hosts
@@ -0,0 +1,22 @@
+150.236.20.66 fingolfin
+150.236.20.65 bingo
+150.236.20.32 lw5 lw5d
+150.236.14.81 jarzebiak
+150.236.14.71 grolsch
+150.236.14.68 napoleon
+127.0.0.1 localhost
+150.236.20.74 strider
+150.236.20.72 elrond
+150.236.20.78 aule
+150.236.14.36 lw4 lw4d
+150.236.14.16 super super-14 www-cslab ftp-cslab mail smtp pop loghost
+150.236.14.251 router-14
+150.236.20.67 sam
+150.236.20.86 mallor
+150.236.20.251 router-20
+150.236.20.192 merry
+150.236.14.247 nenya
+150.236.20.193 beamish
+150.236.20.16 gandalf-20
+150.236.14.18 news nntp
+150.236.14.77 gordons
diff --git a/lib/kernel/test/inet_SUITE_data/hosts_err1 b/lib/kernel/test/inet_SUITE_data/hosts_err1
new file mode 100644
index 0000000000..201141d252
--- /dev/null
+++ b/lib/kernel/test/inet_SUITE_data/hosts_err1
@@ -0,0 +1,170 @@
+150.236.14.243 msvw
+150.236.14.224 peps
+150.236.14.217 150.236.14.217
+150.236.14.213 euasb05
+150.236.14.206 nubbe
+rappakalja
+150.236.14.164 legolas2
+150.236.14.200 apx_ether146
+150.236.14.135 jb
+150.236.14.131 ruddles
+150.236.14.106 guinness
+150.236.20.66 fingolfin
+150.236.20.65 bingo
+150.236.20.32 lw5 lw5d
+150.236.14.90 ballantines
+150.236.14.81 jarzebiak
+150.236.14.80 calvados
+150.236.14.72 explorer
+150.236.14.71 grolsch
+150.236.14.68 napoleon
+127.0.0.1 localhost
+150.236.14.211 cp2
+150.236.14.199 booze
+150.236.14.198 macscot
+150.236.14.165 vb
+150.236.14.111 randy
+150.236.14.94 bacardi
+150.236.14.85 platins
+150.236.14.76 scotch
+150.236.14.69 martell
+150.236.21.242 lme-pc12
+150.236.21.240 lme-pc10
+150.236.21.234 lme-pc04
+150.236.14.248 vilya
+150.236.14.219 four-roses
+150.236.14.218 wasted
+150.236.14.196 mac1 su-mac
+150.236.14.195 besk
+150.236.14.163 tall
+150.236.14.157 nijmegen
+150.236.14.151 skalman
+150.236.20.79 balin
+150.236.20.75 bifur
+150.236.20.74 strider
+150.236.20.72 elrond
+150.236.14.98 katt
+150.236.14.89 fbsd-install
+150.236.14.32 pm1
+150.236.14.19 styx
+150.236.20.196 sauron
+150.236.14.246 narya
+150.236.14.245 mspc
+150.236.14.216 ester-clop
+150.236.14.212 dp1
+150.236.14.210 cp1
+150.236.14.169 natasja
+150.236.14.168 helga
+150.236.14.167 sjuan
+150.236.14.138 rioja
+150.236.14.137 pluto
+150.236.20.78 aule
+150.236.20.18 super-20
+150.236.14.64 renat
+150.236.14.36 lw4 lw4d
+150.236.14.35 lwt
+150.236.14.33 lw lwd lp-seb
+150.236.14.16 super super-14 www-cslab ftp-cslab mail smtp pop loghost
+150.236.21.241 lme-pc11
+150.236.21.235 lme-pc05
+150.236.14.251 router-14
+150.236.14.244 mslab
+150.236.14.240 msepu
+150.236.14.223 kosken
+150.236.14.197 mac2 su-mac2
+150.236.14.162 merkurius
+150.236.14.152 luthagen
+150.236.14.148 baidarka
+150.236.14.142 kurt
+150.236.14.136 russell
+150.236.14.132 elbereth
+150.236.14.130 plato
+150.236.20.71 faenor
+150.236.20.69 tom
+150.236.14.93 turkey
+150.236.14.84 absolut
+150.236.14.75 chivas
+150.236.14.21 proxy
+150.236.21.239 lme-pc09
+150.236.21.238 lme-pc08
+150.236.15.251 router-15
+150.236.14.221 rent
+150.236.14.215 ester-spwb
+150.236.14.207 mackinlays
+150.236.14.203 egri
+150.236.14.201 tinto
+150.236.14.200 raki
+150.236.14.156 force
+150.236.14.144 halvan
+150.236.14.140 spex
+150.236.14.109 anna
+150.236.14.103 catrin
+150.236.20.77 orome
+150.236.20.67 sam
+150.236.14.99 heering
+150.236.14.91 bourbon
+150.236.14.82 tequila
+150.236.14.73 strega
+150.236.14.67 aalborg
+150.236.14.34 lwc
+150.236.21.251 router-21
+150.236.21.237 lme-pc07
+150.236.21.233 lme-pc03
+150.236.21.231 lme-pc01
+150.236.20.251 router-20
+150.236.20.192 merry
+150.236.14.247 nenya
+150.236.14.241 ms40
+150.236.14.161 marisa
+150.236.14.154 al
+150.236.14.150 bill
+150.236.14.149 sundsvall
+150.236.14.139 dans
+150.236.14.133 campari
+150.236.20.76 gimli
+150.236.20.70 bilbo
+150.236.20.68 gwaihir
+150.236.14.92 vodka
+150.236.14.83 punsch # unused
+150.236.14.74 pernod
+150.236.14.22 gandalf gandalf-14
+150.236.14.20 www-sarc
+150.236.20.193 beamish
+150.236.14.209 seagram
+150.236.14.166 hine
+150.236.14.160 plutt
+150.236.14.158 granbom
+150.236.14.147 findus
+150.236.14.146 ture
+150.236.14.129 ariadne
+150.236.14.128 op-andersson helan
+150.236.14.104 steinlager
+150.236.14.102 morgan
+150.236.20.73 legolas
+150.236.20.16 gandalf-20
+150.236.14.18 news nntp
+150.236.14.17 otp
+150.236.20.195 thorin
+150.236.14.220 jackd
+150.236.14.214 ester-asm
+150.236.14.202 hutt
+150.236.14.145 fedra
+150.236.14.141 jura
+150.236.20.64 falco
+150.236.14.96 bushmill
+150.236.14.87 loranga
+150.236.14.78 cointreau
+150.236.14.70 dickel
+150.236.14.66 gin
+150.236.21.236 lme-pc06
+150.236.21.232 lme-pc02
+150.236.20.194 frodo
+150.236.14.242 mssol
+150.236.14.153 bubak
+150.236.14.134 wyborowa
+150.236.14.97 finlandia
+150.236.14.95 finkel
+150.236.14.88 macallan
+150.236.14.86 unicum
+150.236.14.79 skeppet
+150.236.14.77 gordons
diff --git a/lib/kernel/test/inet_SUITE_data/resolv.conf b/lib/kernel/test/inet_SUITE_data/resolv.conf
new file mode 100644
index 0000000000..c09d88fd92
--- /dev/null
+++ b/lib/kernel/test/inet_SUITE_data/resolv.conf
@@ -0,0 +1,7 @@
+domain du.etx.ericsson.se
+nameserver 150.236.14.16
+garbage x
+nameserver 150.236.16.2
+nameserver 130.100.128.25
+search du.etx.ericsson.se etx.ericsson.se ericsson.se
+lookup yp bind file
diff --git a/lib/kernel/test/inet_SUITE_data/resolv.conf.err1 b/lib/kernel/test/inet_SUITE_data/resolv.conf.err1
new file mode 100644
index 0000000000..c8f164be92
--- /dev/null
+++ b/lib/kernel/test/inet_SUITE_data/resolv.conf.err1
@@ -0,0 +1,7 @@
+domain du.etx.ericsson.se
+nameserver 150.236.14.16
+nameserver kalle
+nameserver 150.236.16.2
+nameserver 130.100.128.25
+search du.etx.ericsson.se etx.ericsson.se ericsson.se
+lookup yp bind file
diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl
new file mode 100644
index 0000000000..659cfc5988
--- /dev/null
+++ b/lib/kernel/test/inet_res_SUITE.erl
@@ -0,0 +1,418 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_res_SUITE).
+
+-include("test_server.hrl").
+-include("test_server_line.hrl").
+
+-include_lib("kernel/include/inet.hrl").
+-include_lib("kernel/src/inet_dns.hrl").
+
+-export([all/1, init_per_testcase/2, end_per_testcase/2]).
+-export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1]).
+-export([gethostbyaddr/1, gethostbyaddr_v6/1,
+ gethostbyname/1, gethostbyname_v6/1,
+ getaddr/1, getaddr_v6/1, ipv4_to_ipv6/1, host_and_addr/1]).
+
+-define(RUN_NAMED, "run-named").
+
+all(suite) ->
+ [basic, resolve, edns0, txt_record, files_monitor,
+ gethostbyaddr, gethostbyaddr_v6, gethostbyname, gethostbyname_v6,
+ getaddr, getaddr_v6, ipv4_to_ipv6, host_and_addr].
+
+zone_dir(basic) ->
+ otptest;
+zone_dir(resolve) ->
+ otptest;
+zone_dir(edns0) ->
+ otptest;
+zone_dir(files_monitor) ->
+ otptest;
+zone_dir(_) ->
+ undefined.
+
+init_per_testcase(Func, Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ DataDir = ?config(data_dir, Config),
+ try ns_init(zone_dir(Func), PrivDir, DataDir) of
+ NsSpec ->
+ Lookup = inet_db:res_option(lookup),
+ inet_db:set_lookup([file,dns]),
+ case NsSpec of
+ {_,{IP,Port},_} ->
+ inet_db:ins_alt_ns(IP, Port);
+ _ -> ok
+ end,
+ Dog = test_server:timetrap(test_server:seconds(10)),
+ [{nameserver,NsSpec},{res_lookup,Lookup},{watchdog,Dog}|Config]
+ catch
+ SkipReason ->
+ {skip,SkipReason}
+ end.
+
+end_per_testcase(_Func, Config) ->
+ test_server:timetrap_cancel(?config(watchdog, Config)),
+ inet_db:set_lookup(?config(res_lookup, Config)),
+ NsSpec = ?config(nameserver, Config),
+ case NsSpec of
+ {_,{IP,Port},_} ->
+ inet_db:del_alt_ns(IP, Port);
+ _ -> ok
+ end,
+ ns_end(NsSpec, ?config(priv_dir, Config)).
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Nameserver control
+
+ns(Config) ->
+ {_ZoneDir,NS,_P} = ?config(nameserver, Config),
+ NS.
+
+ns_init(ZoneDir, PrivDir, DataDir) ->
+ case os:type() of
+ {unix,_} when ZoneDir =:= undefined -> undefined;
+ {unix,_} ->
+ {ok,S} = gen_udp:open(0, [{reuseaddr,true}]),
+ {ok,PortNum} = inet:port(S),
+ gen_udp:close(S),
+ RunNamed = filename:join(DataDir, ?RUN_NAMED),
+ NS = {{127,0,0,1},PortNum},
+ P = erlang:open_port({spawn_executable,RunNamed},
+ [{cd,PrivDir},
+ {line,80},
+ {args,["127.0.0.1",
+ integer_to_list(PortNum),
+ atom_to_list(ZoneDir)]},
+ stderr_to_stdout,
+ eof]),
+ ns_start(ZoneDir, NS, P);
+ _ ->
+ throw("Only run on Unix")
+ end.
+
+ns_start(ZoneDir, NS, P) ->
+ case ns_collect(P) of
+ eof ->
+ erlang:error(eof);
+ "Running: "++_ ->
+ {ZoneDir,NS,P};
+ "Error: "++Error ->
+ throw(Error);
+ _ ->
+ ns_start(ZoneDir, NS, P)
+ end.
+
+ns_end(undefined, _PrivDir) -> undefined;
+ns_end({ZoneDir,_NS,P}, PrivDir) ->
+ port_command(P, ["quit",io_lib:nl()]),
+ ns_stop(P),
+ ns_printlog(filename:join([PrivDir,ZoneDir,"named.log"])),
+ ok.
+
+ns_stop(P) ->
+ case ns_collect(P) of
+ eof ->
+ erlang:port_close(P);
+ _ ->
+ ns_stop(P)
+ end.
+
+ns_collect(P) ->
+ ns_collect(P, []).
+ns_collect(P, Buf) ->
+ receive
+ {P,{data,{eol,L}}} ->
+ Line = lists:flatten(lists:reverse(Buf, [L])),
+ io:format("~s", [Line]),
+ Line;
+ {P,{data,{noeol,L}}} ->
+ ns_collect(P, [L|Buf]);
+ {P,eof} ->
+ eof
+ end.
+
+ns_printlog(Fname) ->
+ io:format("Name server log file contents:~n", []),
+ case file:read_file(Fname) of
+ {ok,Bin} ->
+ io:format("~s~n", [Bin]);
+ _ ->
+ ok
+ end.
+
+%%
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+basic(doc) ->
+ ["Lookup an A record with different API functions"];
+basic(Config) when is_list(Config) ->
+ NS = ns(Config),
+ Name = "ns.otptest",
+ IP = {127,0,0,254},
+ %%
+ %% nslookup
+ {ok,Msg1} = inet_res:nslookup(Name, in, a, [NS]),
+ io:format("~p~n", [Msg1]),
+ [RR1] = inet_dns:msg(Msg1, anlist),
+ IP = inet_dns:rr(RR1, data),
+ Bin1 = inet_dns:encode(Msg1),
+ %%io:format("Bin1 = ~w~n", [Bin1]),
+ {ok,Msg1} = inet_dns:decode(Bin1),
+ %%
+ %% resolve
+ {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]}]),
+ io:format("~p~n", [Msg2]),
+ [RR2] = inet_dns:msg(Msg2, anlist),
+ IP = inet_dns:rr(RR2, data),
+ Bin2 = inet_dns:encode(Msg2),
+ %%io:format("Bin2 = ~w~n", [Bin2]),
+ {ok,Msg2} = inet_dns:decode(Bin2),
+ %%
+ %% lookup
+ [IP] = inet_res:lookup(Name, in, a, [{nameservers,[NS]}]),
+ %%
+ %% gethostbyname
+ {ok,#hostent{h_addr_list=[IP]}} = inet_res:gethostbyname(Name),
+ %%
+ %% getbyname
+ {ok,#hostent{h_addr_list=[IP]}} = inet_res:getbyname(Name, a),
+ ok.
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+resolve(doc) ->
+ ["Lookup different records using resolve/2..4"];
+resolve(Config) when is_list(Config) ->
+ NS = ns(Config),
+ Domain = "otptest",
+ RDomain4 = "0.0.127.in-addr.arpa",
+ RDomain6 = "0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa",
+ Name = "resolve."++Domain,
+ L = [{in,a,Name,[{127,0,0,28}],undefined},
+ {in,aaaa,Name,[{0,0,0,0,0,0,32512,28}],undefined},
+ {in,cname,"cname."++Name,[Name],undefined},
+ {in,a,"cname."++Name,[Name,{127,0,0,28}],undefined},
+ {in,ns,"ns."++Name,[],[Name]},
+ {in,soa,Domain,[],[{"ns.otptest","lsa.otptest",1,60,10,300,30}]},
+ %% WKS: protocol TCP (6), services (bits) TELNET (23) and SMTP (25)
+ {in,wks,"wks."++Name,[{{127,0,0,28},6,<<0,0,1,64>>}],undefined},
+ {in,ptr,"28."++RDomain4,[Name],undefined},
+ {in,ptr,"c.1.0.0.0.0.f.7."++RDomain6,[Name],undefined},
+ {in,hinfo,Name,[{"BEAM","Erlang/OTP"}],undefined},
+ {in,mx,RDomain4,[{10,"mx."++Domain}],undefined},
+ {in,srv,"_srv._tcp."++Name,[{10,3,4711,Name}],undefined},
+ {in,naptr,"naptr."++Name,
+ [{10,5,"s","http","","_srv._tcp."++Name}],undefined},
+ {in,txt,"txt."++Name,
+ [["Hej ","du ","glade "],["ta ","en ","spade!"]],undefined},
+ {in,mb,"mb."++Name,["mx."++Name],undefined},
+ {in,mg,"mg."++Name,["lsa."++Domain],undefined},
+ {in,mr,"mr."++Name,["lsa."++Domain],undefined},
+ {in,minfo,"minfo."++Name,
+ [{"minfo-owner."++Name,"minfo-bounce."++Name}],undefined},
+ {in,any,"cname."++Name,[Name],undefined},
+ {in,any,Name,[{127,0,0,28},
+ {0,0,0,0,0,0,32512,28},
+ {"BEAM","Erlang/OTP"}],undefined}
+ ],
+ resolve([{edns,false},{nameservers,[NS]}], L),
+ resolve([{edns,0},{nameservers,[NS]}], L).
+
+resolve(_Opts, []) -> ok;
+resolve(Opts, [{Class,Type,Name,Answers,Authority}=Q|Qs]) ->
+ io:format("Query: ~p~nOptions: ~p~n", [Q,Opts]),
+ {ok,Msg} = inet_res:resolve(Name, Class, Type, Opts),
+ if Answers =/= undefined ->
+ AnList = lists:sort(Answers),
+ AnList = lists:sort([inet_dns:rr(RR, data) ||
+ RR <- inet_dns:msg(Msg, anlist)]);
+ true -> ok end,
+ if Authority =/= undefined ->
+ NsList = lists:sort(Authority),
+ NsList = lists:sort([inet_dns:rr(RR, data) ||
+ RR <- inet_dns:msg(Msg, nslist)]);
+ true -> ok end,
+ Buf = inet_dns:encode(Msg),
+ {ok,Msg} = inet_dns:decode(Buf),
+ resolve(Opts, Qs).
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+edns0(doc) ->
+ ["Test EDNS and truncation"];
+edns0(Config) when is_list(Config) ->
+ NS = ns(Config),
+ Domain = "otptest",
+ Filler = "-5678901234567890123456789012345678.",
+ MXs = lists:sort([{10,"mx."++Domain},
+ {20,"mx1"++Filler++Domain},
+ {20,"mx2"++Filler++Domain},
+ {20,"mx3"++Filler++Domain},
+ {20,"mx4"++Filler++Domain},
+ {20,"mx5"++Filler++Domain},
+ {20,"mx6"++Filler++Domain},
+ {20,"mx7"++Filler++Domain}]),
+ false = inet_db:res_option(edns), % ASSERT
+ true = inet_db:res_option(udp_payload_size) >= 1280, % ASSERT
+ %% These will fall back to TCP
+ MXs = lists:sort(inet_res:lookup(Domain, in, mx, [{nameservers,[NS]}])),
+ %%
+ {ok,#hostent{h_addr_list=As}} = inet_res:getbyname(Domain++".", mx),
+ MXs = lists:sort(As),
+ %%
+ {ok,Msg1} = inet_res:resolve(Domain, in, mx),
+ MXs = lists:sort(inet_res_filter(inet_dns:msg(Msg1, anlist), in, mx)),
+ %% There should be no OPT record in the answer
+ [] = [RR || RR <- inet_dns:msg(Msg1, arlist),
+ inet_dns:rr(RR, type) =:= opt],
+ Buf1 = inet_dns:encode(Msg1),
+ {ok,Msg1} = inet_dns:decode(Buf1),
+ %%
+ %% Use EDNS - should not need to fall back to TCP
+ %% there is no way to tell from the outside.
+ %%
+ {ok,Msg2} = inet_res:resolve(Domain, in, mx, [{edns,0}]),
+ MXs = lists:sort(inet_res_filter(inet_dns:msg(Msg2, anlist), in, mx)),
+ Buf2 = inet_dns:encode(Msg2),
+ {ok,Msg2} = inet_dns:decode(Buf2),
+ [OptRR] = [RR || RR <- inet_dns:msg(Msg2, arlist),
+ inet_dns:rr(RR, type) =:= opt],
+ io:format("~p~n", [inet_dns:rr(OptRR)]),
+ ok.
+
+inet_res_filter(Anlist, Class, Type) ->
+ [inet_dns:rr(RR, data) || RR <- Anlist,
+ inet_dns:rr(RR, type) =:= Type,
+ inet_dns:rr(RR, class) =:= Class].
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+txt_record(suite) ->
+ [];
+txt_record(doc) ->
+ ["Tests TXT records"];
+txt_record(Config) when is_list(Config) ->
+ D1 = "cslab.ericsson.net",
+ D2 = "mail1.cslab.ericsson.net",
+ {ok,#dns_rec{anlist=[RR1]}} =
+ inet_res:nslookup(D1, in, txt),
+ io:format("~p~n", [RR1]),
+ {ok,#dns_rec{anlist=[RR2]}} =
+ inet_res:nslookup(D2, in, txt),
+ io:format("~p~n", [RR2]),
+ #dns_rr{domain=D1, class=in, type=txt, data=A1} = RR1,
+ #dns_rr{domain=D2, class=in, type=txt, data=A2} = RR2,
+ case [lists:flatten(A2)] of
+ A1 = [[_|_]] -> ok
+ end,
+ ok.
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+files_monitor(suite) ->
+ [];
+files_monitor(doc) ->
+ ["Tests monitoring of /etc/hosts and /etc/resolv.conf, but not them"];
+files_monitor(Config) when is_list(Config) ->
+ HostsFile = inet_db:res_option(hosts_file),
+ ResolvConf = inet_db:res_option(resolv_conf),
+ Inet6 = inet_db:res_option(inet6),
+ try do_files_monitor(Config)
+ after
+ inet_db:res_option(resolv_conf, ResolvConf),
+ inet_db:res_option(hosts_file, HostsFile),
+ inet_db:res_option(inet6, Inet6)
+ end.
+
+do_files_monitor(Config) ->
+ Dir = ?config(priv_dir, Config),
+ {ok,Hostname} = inet:gethostname(),
+ FQDN = Hostname++"."++inet_db:res_option(domain),
+ HostsFile = filename:join(Dir, "files_monitor_hosts"),
+ ResolvConf = filename:join(Dir, "files_monitor_resolv.conf"),
+ ok = inet_db:res_option(resolv_conf, ResolvConf),
+ ok = inet_db:res_option(hosts_file, HostsFile),
+ [] = inet_db:res_option(search),
+ {ok,#hostent{h_name = Hostname,
+ h_addrtype = inet,
+ h_length = 4,
+ h_addr_list = [{127,0,0,1}]}} = inet:gethostbyname(Hostname),
+ {ok,#hostent{h_name = FQDN,
+ h_addrtype = inet,
+ h_length = 4,
+ h_addr_list = [{127,0,0,1}]}} = inet:gethostbyname(FQDN),
+ {error,nxdomain} = inet_res:gethostbyname(Hostname),
+ {error,nxdomain} = inet_res:gethostbyname(FQDN),
+ {ok,{127,0,0,10}} = inet:getaddr("mx.otptest", inet),
+ {ok,{0,0,0,0,0,0,32512,28}} = inet:getaddr("resolve.otptest", inet6),
+ ok = inet_db:res_option(inet6, true),
+ {ok,#hostent{h_name = Hostname,
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [{0,0,0,0,0,0,0,1}]}} =
+ inet:gethostbyname(Hostname),
+ {ok,#hostent{h_name = FQDN,
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [{0,0,0,0,0,0,0,1}]}} =
+ inet:gethostbyname(FQDN),
+ {error,nxdomain} = inet_res:gethostbyname("resolve"),
+ %% XXX inet does not honour res_option inet6, might be a problem?
+ %% therefore inet_res is called here
+ {ok,#hostent{h_name = "resolve.otptest",
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [{0,0,0,0,0,0,32512,28}]}} =
+ inet_res:gethostbyname("resolve.otptest"),
+ {error,nxdomain} = inet_hosts:gethostbyname("files_monitor"),
+ ok = file:write_file(ResolvConf, "search otptest\n"),
+ ok = file:write_file(HostsFile, "::100 files_monitor\n"),
+ receive after 7000 -> ok end, % RES_FILE_UPDATE_TM in inet_res.hrl is 5 s
+ {ok,#hostent{h_name = "resolve.otptest",
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [{0,0,0,0,0,0,32512,28}]}} =
+ inet_res:gethostbyname("resolve.otptest"),
+ ["otptest"] = inet_db:res_option(search),
+ {ok,#hostent{h_name = "files_monitor",
+ h_addrtype = inet6,
+ h_length = 16,
+ h_addr_list = [{0,0,0,0,0,0,0,256}]}} =
+ inet_hosts:gethostbyname("files_monitor"),
+ ok = inet_db:res_option(inet6, false),
+ {ok,#hostent{h_name = "resolve.otptest",
+ h_addrtype = inet,
+ h_length = 4,
+ h_addr_list = [{127,0,0,28}]}} =
+ inet:gethostbyname("resolve.otptest"),
+ ok.
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Compatibility tests. Call the inet_SUITE tests, but with
+%% lookup = [file,dns] instead of [native]
+
+gethostbyaddr(Config) -> inet_SUITE:t_gethostbyaddr(Config).
+gethostbyaddr_v6(Config) -> inet_SUITE:t_gethostbyaddr_v6(Config).
+gethostbyname(Config) -> inet_SUITE:t_gethostbyname(Config).
+gethostbyname_v6(Config) -> inet_SUITE:t_gethostbyname_v6(Config).
+getaddr(Config) -> inet_SUITE:t_getaddr(Config).
+getaddr_v6(Config) -> inet_SUITE:t_getaddr_v6(Config).
+ipv4_to_ipv6(Config) -> inet_SUITE:ipv4_to_ipv6(Config).
+host_and_addr(Config) -> inet_SUITE:host_and_addr(Config).
diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone b/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone
new file mode 100644
index 0000000000..81e14217ba
--- /dev/null
+++ b/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone
@@ -0,0 +1,12 @@
+$TTL 3600
+@ IN SOA ns.otptest. lsa.otptest. (
+ 1 ; serial
+ 60 ; refresh
+ 10 ; retry
+ 300 ; expiry
+ 30 ) ; minimum
+
+ IN NS ns.otptest.
+ IN MX 10 mx.otptest.
+
+c.1 IN PTR resolve.otptest.
diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.127.in-addr.arpa.zone b/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.127.in-addr.arpa.zone
new file mode 100644
index 0000000000..bae50a9eec
--- /dev/null
+++ b/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.127.in-addr.arpa.zone
@@ -0,0 +1,27 @@
+$TTL 3600
+@ IN SOA ns.otptest. lsa.otptest. (
+ 1 ; serial
+ 60 ; refresh
+ 10 ; retry
+ 300 ; expiry
+ 30 ) ; minimum
+
+ IN NS ns.otptest.
+ IN MX 10 mx.otptest.
+
+1 IN PTR test1-78901234567890123456789012345678.otptest.
+2 IN PTR test2-78901234567890123456789012345678.otptest.
+10 IN PTR mx.otptest.
+11 IN PTR ns1-5678901234567890123456789012345678.otptest.
+12 IN PTR ns2-5678901234567890123456789012345678.otptest.
+21 IN PTR mx1-5678901234567890123456789012345678.otptest.
+22 IN PTR mx2-5678901234567890123456789012345678.otptest.
+23 IN PTR mx3-5678901234567890123456789012345678.otptest.
+24 IN PTR mx4-5678901234567890123456789012345678.otptest.
+25 IN PTR mx5-5678901234567890123456789012345678.otptest.
+26 IN PTR mx6-5678901234567890123456789012345678.otptest.
+27 IN PTR mx7-5678901234567890123456789012345678.otptest.
+
+28 IN PTR resolve.otptest.
+
+254 IN PTR ns.otptest.
diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf b/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf
new file mode 100644
index 0000000000..0b01b25204
--- /dev/null
+++ b/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf
@@ -0,0 +1,12 @@
+zone "." in {
+ type master;
+ file "root.zone";
+};
+zone "0.0.127.in-addr.arpa" in {
+ type master;
+ file "0.0.127.in-addr.arpa.zone";
+};
+zone "0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa" in {
+ type master;
+ file "0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone";
+}; \ No newline at end of file
diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone b/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone
new file mode 100644
index 0000000000..11cba18d45
--- /dev/null
+++ b/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone
@@ -0,0 +1,50 @@
+$TTL 3600
+@ IN SOA ns.otptest lsa.otptest (
+ 1 ; serial
+ 60 ; refresh
+ 10 ; retry
+ 300 ; expiry
+ 30 ) ; minimum
+
+ IN NS ns.otptest
+ IN NS ns1-5678901234567890123456789012345678.otptest
+ IN NS ns2-5678901234567890123456789012345678.otptest
+otptest IN MX 10 mx.otptest
+otptest IN MX 20 mx1-5678901234567890123456789012345678.otptest
+otptest IN MX 20 mx2-5678901234567890123456789012345678.otptest
+otptest IN MX 20 mx3-5678901234567890123456789012345678.otptest
+otptest IN MX 20 mx4-5678901234567890123456789012345678.otptest
+otptest IN MX 20 mx5-5678901234567890123456789012345678.otptest
+otptest IN MX 20 mx6-5678901234567890123456789012345678.otptest
+otptest IN MX 20 mx7-5678901234567890123456789012345678.otptest
+
+test1-78901234567890123456789012345678.otptest IN A 127.0.0.1
+test2-78901234567890123456789012345678.otptest IN A 127.0.0.2
+ns1-5678901234567890123456789012345678.otptest IN A 127.0.0.11
+ns2-5678901234567890123456789012345678.otptest IN A 127.0.0.12
+mx.otptest IN A 127.0.0.10
+mx1-5678901234567890123456789012345678.otptest IN A 127.0.0.21
+mx2-5678901234567890123456789012345678.otptest IN A 127.0.0.22
+mx3-5678901234567890123456789012345678.otptest IN A 127.0.0.23
+mx4-5678901234567890123456789012345678.otptest IN A 127.0.0.24
+mx5-5678901234567890123456789012345678.otptest IN A 127.0.0.25
+mx6-5678901234567890123456789012345678.otptest IN A 127.0.0.26
+mx7-5678901234567890123456789012345678.otptest IN A 127.0.0.27
+
+resolve.otptest IN A 127.0.0.28
+resolve.otptest IN AAAA ::127.0.0.28
+cname.resolve.otptest IN CNAME resolve.otptest
+wks.resolve.otptest IN WKS 127.0.0.28 TCP ( telnet smtp )
+resolve.otptest IN HINFO "BEAM" "Erlang/OTP"
+ns.resolve.otptest IN NS resolve.otptest
+mx.resolve.otptest IN MX 10 resolve.otptest
+_srv._tcp.resolve.otptest IN SRV 10 3 4711 resolve.otptest
+naptr.resolve.otptest IN NAPTR 10 5 "S" "HTTP" "" _srv._tcp.resolve.otptest
+txt.resolve.otptest IN TXT "Hej " "du " "glade "
+txt.resolve.otptest IN TXT "ta " "en " "spade!"
+mb.resolve.otptest IN MB mx.resolve.otptest
+mg.resolve.otptest IN MG lsa.otptest
+mr.resolve.otptest IN MR lsa.otptest
+minfo.resolve.otptest IN MINFO minfo-owner.resolve.otptest minfo-bounce.resolve.otptest
+
+ns.otptest IN A 127.0.0.254
diff --git a/lib/kernel/test/inet_res_SUITE_data/run-named b/lib/kernel/test/inet_res_SUITE_data/run-named
new file mode 100755
index 0000000000..b418607d48
--- /dev/null
+++ b/lib/kernel/test/inet_res_SUITE_data/run-named
@@ -0,0 +1,163 @@
+#! /bin/sh
+##
+## %CopyrightBegin%
+##
+## Copyright Ericsson AB 2009. All Rights Reserved.
+##
+## The contents of this file are subject to the Erlang Public License,
+## Version 1.1, (the "License"); you may not use this file except in
+## compliance with the License. You should have received a copy of the
+## Erlang Public License along with this software. If not, it can be
+## retrieved online at http://www.erlang.org/.
+##
+## Software distributed under the License is distributed on an "AS IS"
+## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+## the License for the specific language governing rights and limitations
+## under the License.
+##
+## %CopyrightEnd%
+##
+#
+
+#
+## run-named
+##
+## $0 IPAddress PortNum SubDir
+##
+## * Create a work directory ./SubDir, create a named.conf there.
+## * Locate named and check its version.
+## * Zopy zone files from `dirname $0`/SubDir to ./SubDir.
+## * Start named in ./SubDir with logging to named.log there.
+## * Wait for "quit" on stdin.
+## * Terminate named and wait for it.
+##
+## Prints status lines starting with tag and colon (think mail header):
+## Error: have given up, no name server started
+## Running: name server is running, waiting for "quit"
+## Other tags: diagnostics info
+#
+
+unset LDPATH CDPATH ENV BASH_ENV
+IFS=' '
+PATH=/usr/sbin:/sbin:/usr/bin:/bin
+SHELL=/bin/sh
+export PATH SHELL
+
+CONF_FILE=named.conf
+INC_FILE=named_inc.conf
+PID_FILE=named.pid
+LOG_FILE=named.log
+
+error () {
+ r=$?
+ echo "Error: $*"
+ exit $r
+}
+
+# Check argument: IP address
+test :"$1" != : || \
+ error "Empty argument 1: IP address !"
+
+# Check argument: Port number
+expr "0$2" + 0 '>' 0 '&' "0$2" + 0 '<' 65536 >/dev/null 2>&1 || \
+ error "Invalid argument 2: port number !"
+
+# Check argument: Work/Zone subdir
+test :"$3" != : || \
+ error "Empty argument 3: Work/Zone subdir!"
+SRCDIR="`dirname "$0"`/$3"
+test -d "$SRCDIR" || \
+ error "Missing zone directory $SRCDIR !"
+test -f "$SRCDIR/$INC_FILE" || \
+ error "Missing file: $SRCDIR/$INC_FILE !"
+
+# Locate named and check version
+NAMED=named
+for n in /usr/sbin/named /usr/sbin/in.named; do
+ test -x "$n" && NAMED="$n"
+done
+NAMED_VER="`"$NAMED" -v 2>&1`" || \
+ error "Name server not found!"
+NAMED_VER=`echo "$NAMED_VER" | ( read V1 V2 V3 IGNORED && \
+ if test :"$V1" = :'in.named'; then
+ echo "$V2 $V3"
+ else
+ echo "$V1 $V2"
+ fi
+)`
+case :"$NAMED_VER" in
+ :'BIND '8.*) NAMED_FG='-f';;
+ :'BIND '9.*) NAMED_FG='-g';;
+ :*) error "Name server version is unknown: $NAMED_VER";;
+esac
+
+# Create working directory and cd to it
+mkdir "$3" >/dev/null 2>&1
+cd "$3" >/dev/null 2>&1 || \
+ error "Can not cd: $3 !"
+
+# Create $CONF_FILE
+cat >"$CONF_FILE" <<-CONF_FILE
+ #
+ # $CONF_FILE for $NAMED_VER
+ # Generated by $0.
+ #
+ # Copyright: see $0.
+ #
+ logging {
+ category default {
+ default_stderr;
+ };
+ };
+ CONF_FILE
+case :"$NAMED_VER" in
+ :'BIND '8.*|:'BIND '9.[012]|:'BIND '9.[012].*)
+ cat >>"$CONF_FILE" <<-CONF_FILE
+ controls {
+ inet 127.0.0.1 port 0 allow { !0/32; };
+ };
+ options {
+ pid-file "$PID_FILE";
+ listen-on port $2 { $1; };
+ recursion no;
+ allow-query { $1; };
+ };
+ CONF_FILE
+ ;;
+ :*)
+ cat >>"$CONF_FILE" <<-CONF_FILE
+ controls {
+ };
+ options {
+ pid-file none;
+ listen-on port $2 { $1; };
+ recursion no;
+ allow-query { $1; };
+ };
+ CONF_FILE
+ ;;
+esac
+cat >>"$CONF_FILE" <<-CONF_FILE
+ include "$INC_FILE";
+ CONF_FILE
+
+# Copy all subdir files
+( cd "$SRCDIR" && ls -1 ) | while read f; do
+ cp -fp "$SRCDIR/$f" .
+done
+
+# Start nameserver
+echo "Cwd: `pwd`"
+echo "Nameserver: $NAMED_VER"
+echo "Port: $2"
+echo "ZoneDir: $3"
+$NAMED $NAMED_FG -c "$CONF_FILE" >"$LOG_FILE" 2>&1 </dev/null &
+NAMED=$!
+trap "kill -TERM $NAMED >/dev/null 2>&1; wait $NAMED >/dev/null 2>&1" \
+ 0 1 2 3 15
+sleep 1 # Give name server time to load its zone files
+echo "Running: Enter \`\`quit'' to terminate nameserver[$NAMED]..."
+while read LINE; do
+ test :"$LINE" = :'quit' && break
+done
+echo "Closing: Terminating nameserver..."
diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl
new file mode 100644
index 0000000000..0fa0226ccf
--- /dev/null
+++ b/lib/kernel/test/inet_sockopt_SUITE.erl
@@ -0,0 +1,681 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(inet_sockopt_SUITE).
+
+-include("test_server.hrl").
+
+
+-define(C_GET_IPPROTO_TCP,1).
+-define(C_GET_IPPROTO_IP,2).
+-define(C_GET_SOL_SOCKET,3).
+-define(C_GET_SOL_IP,4).
+
+-define(C_GET_TCP_KEEPIDLE,11).
+-define(C_GET_TCP_LINGER2,12).
+-define(C_GET_TCP_INFO,13).
+-define(C_GET_SO_REUSEADDR,14).
+-define(C_GET_SO_KEEPALIVE,15).
+-define(C_GET_SO_LINGER,16).
+
+-define(C_GET_LINGER_SIZE,21).
+-define(C_GET_TCP_INFO_SIZE,22).
+
+-define(C_GET_OFF_LINGER_L_ONOFF,31).
+-define(C_GET_OFF_LINGER_L_LINGER,32).
+-define(C_GET_OFF_TCPI_SACKED,33).
+-define(C_GET_OFF_TCPI_OPTIONS,34).
+
+-define(C_GET_SIZ_LINGER_L_ONOFF,41).
+-define(C_GET_SIZ_LINGER_L_LINGER,42).
+-define(C_GET_SIZ_TCPI_SACKED,43).
+-define(C_GET_SIZ_TCPI_OPTIONS,44).
+
+-define(C_QUIT,99).
+
+-export([all/1, simple/1, loop_all/1, simple_raw/1, simple_raw_getbin/1,
+ doc_examples_raw/1,doc_examples_raw_getbin/1,
+ large_raw/1,large_raw_getbin/1,combined/1,combined_getbin/1,
+ type_errors/1]).
+
+-export([init_per_testcase/2, end_per_testcase/2]).
+
+
+all(suite) ->
+ [simple,loop_all,simple_raw,simple_raw_getbin,
+ doc_examples_raw, doc_examples_raw_getbin,
+ large_raw,large_raw_getbin,combined,combined_getbin,type_errors].
+
+init_per_testcase(_Func, Config) ->
+ Dog = test_server:timetrap(test_server:seconds(60)),
+ [{watchdog,Dog}|Config].
+
+end_per_testcase(_Func, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+simple(suite) -> [];
+simple(doc) -> "Test inet:setopt/getopt simple functionality.";
+simple(Config) when is_list(Config) ->
+ ?line XOpt = case os:type() of
+ {unix,_} -> [{reuseaddr,true}];
+ _ -> []
+ end,
+ ?line Opt = [{nodelay,true},
+ {keepalive,true},{packet,4},
+ {active,false}|XOpt],
+ ?line OptTags = [X || {X,_} <- Opt],
+ ?line {S1,S2} = create_socketpair(Opt, Opt),
+ ?line {ok,Opt} = inet:getopts(S1,OptTags),
+ ?line {ok,Opt} = inet:getopts(S2,OptTags),
+ ?line COpt = [{X,case X of nodelay -> false;_ -> Y end} || {X,Y} <- Opt],
+ ?line inet:setopts(S1,COpt),
+ ?line {ok,COpt} = inet:getopts(S1,OptTags),
+ ?line {ok,Opt} = inet:getopts(S2,OptTags),
+ ?line gen_tcp:close(S1),
+ ?line gen_tcp:close(S2),
+ ok.
+
+loop_all(suite) -> [];
+loop_all(doc) -> "Loop through all socket options and check that they work";
+loop_all(Config) when is_list(Config) ->
+ ?line ListenFailures =
+ lists:foldr(make_check_fun(listen,1),[],all_listen_options()),
+ ?line ConnectFailures =
+ lists:foldr(make_check_fun(connect,2),[],all_connect_options()),
+ ?line case ListenFailures++ConnectFailures of
+ [] ->
+ ?line ok;
+ Failed ->
+ ?line {comment,lists:flatten(
+ io_lib:format("Non mandatory failed:~w",
+ [Failed]))}
+ end.
+
+
+
+simple_raw(suite) -> [];
+simple_raw(doc) -> "Test simple setopt/getopt of raw options.";
+simple_raw(Config) when is_list(Config) ->
+ do_simple_raw(Config,false).
+simple_raw_getbin(suite) -> [];
+simple_raw_getbin(doc) -> "Test simple setopt/getopt of raw options, "
+ "with binaries in getopt.";
+simple_raw_getbin(Config) when is_list(Config) ->
+ do_simple_raw(Config,true).
+
+do_simple_raw(Config,Binary) when is_list(Config) ->
+ ?line Port = start_helper(Config),
+ ?line SolSocket = ask_helper(Port,?C_GET_SOL_SOCKET),
+ ?line SoKeepAlive = ask_helper(Port,?C_GET_SO_KEEPALIVE),
+ ?line OptionTrue = {raw,SolSocket,SoKeepAlive,<<1:32/native>>},
+ ?line OptionFalse = {raw,SolSocket,SoKeepAlive,<<0:32/native>>},
+ ?line {S1,S2} = create_socketpair([OptionTrue],[{keepalive,true}]),
+ ?line {ok,[{keepalive,true}]} = inet:getopts(S1,[keepalive]),
+ ?line {ok,[{keepalive,true}]} = inet:getopts(S2,[keepalive]),
+ ?line {ok,[{raw,SolSocket,SoKeepAlive,X1B}]} =
+ inet:getopts(S1,[{raw,SolSocket,SoKeepAlive,binarify(4,Binary)}]),
+ ?line X1 = nintbin2int(X1B),
+ ?line {ok,[{raw,SolSocket,SoKeepAlive,X2B}]} =
+ inet:getopts(S2,[{raw,SolSocket,SoKeepAlive,binarify(4,Binary)}]),
+ ?line X2 = nintbin2int(X2B),
+ ?line true = X1 > 0,
+ ?line true = X2 > 0,
+ ?line inet:setopts(S1,[{keepalive,false}]),
+ ?line inet:setopts(S2,[OptionFalse]),
+ ?line {ok,[{keepalive,false}]} = inet:getopts(S1,[keepalive]),
+ ?line {ok,[{keepalive,false}]} = inet:getopts(S2,[keepalive]),
+ ?line {ok,[{raw,SolSocket,SoKeepAlive,Y1B}]} =
+ inet:getopts(S1,[{raw,SolSocket,SoKeepAlive,binarify(4,Binary)}]),
+ ?line Y1 = nintbin2int(Y1B),
+ ?line {ok,[{raw,SolSocket,SoKeepAlive,Y2B}]} =
+ inet:getopts(S2,[{raw,SolSocket,SoKeepAlive,binarify(4,Binary)}]),
+ ?line Y2 = nintbin2int(Y2B),
+ ?line true = Y1 == 0,
+ ?line true = Y2 == 0,
+ ?line gen_tcp:close(S1),
+ ?line gen_tcp:close(S2),
+ ?line stop_helper(Port),
+ ok.
+
+nintbin2int(<<Int:32/native>>) -> Int;
+nintbin2int(<<Int:24/native>>) -> Int;
+nintbin2int(<<Int:16/native>>) -> Int;
+nintbin2int(<<Int:8/native>>) -> Int;
+nintbin2int(<<>>) -> 0.
+
+doc_examples_raw(suite) -> [];
+doc_examples_raw(doc) -> "Test that the example code from the documentation "
+ "works";
+doc_examples_raw(Config) when is_list(Config) ->
+ do_doc_examples_raw(Config,false).
+doc_examples_raw_getbin(suite) -> [];
+doc_examples_raw_getbin(doc) -> "Test that the example code from the "
+ "documentation works when getopt uses "
+ "binaries";
+doc_examples_raw_getbin(Config) when is_list(Config) ->
+ do_doc_examples_raw(Config,true).
+do_doc_examples_raw(Config,Binary) when is_list(Config) ->
+ ?line Port = start_helper(Config),
+ ?line Proto = ask_helper(Port,?C_GET_IPPROTO_TCP),
+ ?line TcpInfo = ask_helper(Port,?C_GET_TCP_INFO),
+ ?line TcpInfoSize = ask_helper(Port,?C_GET_TCP_INFO_SIZE),
+ ?line TcpiSackedOffset = ask_helper(Port,?C_GET_OFF_TCPI_SACKED),
+ ?line TcpiOptionsOffset = ask_helper(Port,?C_GET_OFF_TCPI_OPTIONS),
+ ?line TcpiSackedSize = ask_helper(Port,?C_GET_SIZ_TCPI_SACKED),
+ ?line TcpiOptionsSize = ask_helper(Port,?C_GET_SIZ_TCPI_OPTIONS),
+ ?line TcpLinger2 = ask_helper(Port,?C_GET_TCP_LINGER2),
+ ?line stop_helper(Port),
+ case all_ok([Proto,TcpInfo,TcpInfoSize,TcpiSackedOffset,
+ TcpiOptionsOffset,TcpiSackedSize,TcpiOptionsSize,
+ TcpLinger2]) of
+ false ->
+ {skipped,"Does not run on this OS."};
+ true ->
+ ?line {Sock,I} = create_socketpair([],[]),
+ ?line {ok,[{raw,Proto,TcpLinger2,<<OrigLinger:32/native>>}]} =
+ inet:getopts(Sock,[{raw,Proto,TcpLinger2,binarify(4,Binary)}]),
+ ?line NewLinger = OrigLinger div 2,
+ ?line ok = inet:setopts(Sock,[{raw,Proto,TcpLinger2,
+ <<NewLinger:32/native>>}]),
+ ?line {ok,[{raw,Proto,TcpLinger2,<<NewLinger:32/native>>}]} =
+ inet:getopts(Sock,[{raw,Proto,TcpLinger2,binarify(4,Binary)}]),
+ ?line ok = inet:setopts(Sock,[{raw,Proto,TcpLinger2,
+ <<OrigLinger:32/native>>}]),
+ ?line {ok,[{raw,Proto,TcpLinger2,<<OrigLinger:32/native>>}]} =
+ inet:getopts(Sock,[{raw,Proto,TcpLinger2,binarify(4,Binary)}]),
+ ?line {ok,[{raw,_,_,Info}]} =
+ inet:getopts(Sock,[{raw,Proto,TcpInfo,
+ binarify(TcpInfoSize,Binary)}]),
+ ?line Bit1 = TcpiSackedSize * 8,
+ ?line <<_:TcpiSackedOffset/binary,
+ TcpiSacked:Bit1/native,_/binary>> =
+ Info,
+ ?line 0 = TcpiSacked,
+ ?line Bit2 = TcpiOptionsSize * 8,
+ ?line <<_:TcpiOptionsOffset/binary,
+ TcpiOptions:Bit2/native,_/binary>> =
+ Info,
+ ?line true = TcpiOptions =/= 0,
+ ?line gen_tcp:close(Sock),
+ ?line gen_tcp:close(I),
+ ok
+ end.
+
+large_raw(suite) -> [];
+large_raw(doc) -> "Test structs and large/too large buffers when raw";
+large_raw(Config) when is_list(Config) ->
+ do_large_raw(Config,false).
+large_raw_getbin(suite) -> [];
+large_raw_getbin(doc) -> "Test structs and large/too large buffers when raw"
+ "using binaries to getopts";
+large_raw_getbin(Config) when is_list(Config) ->
+ do_large_raw(Config,true).
+do_large_raw(Config,Binary) when is_list(Config) ->
+ ?line Port = start_helper(Config),
+ ?line Proto = ask_helper(Port,?C_GET_SOL_SOCKET),
+ ?line Linger = ask_helper(Port,?C_GET_SO_LINGER),
+ ?line LingerSize = ask_helper(Port,?C_GET_LINGER_SIZE),
+ ?line LingerOnOffOffset = ask_helper(Port,?C_GET_OFF_LINGER_L_ONOFF),
+ ?line LingerLingerOffset = ask_helper(Port,?C_GET_OFF_LINGER_L_LINGER),
+ ?line LingerOnOffSize = ask_helper(Port,?C_GET_SIZ_LINGER_L_ONOFF),
+ ?line LingerLingerSize = ask_helper(Port,?C_GET_SIZ_LINGER_L_LINGER),
+ ?line stop_helper(Port),
+ case all_ok([Proto,Linger,LingerSize,LingerOnOffOffset,
+ LingerLingerOffset,LingerOnOffSize,LingerLingerSize]) of
+ false ->
+ {skipped,"Does not run on this OS."};
+ true ->
+ ?line {Sock1,Sock2} = create_socketpair([{linger,{true,10}}],
+ [{linger,{false,0}}]),
+ ?line LargeSize = 1024, % Solaris can take up to 1024*9,
+ % linux 1024*63...
+ ?line TooLargeSize = 1024*64,
+ ?line {ok,[{raw,Proto,Linger,Linger1}]} =
+ inet:getopts(Sock1,[{raw,Proto,Linger,
+ binarify(LargeSize,Binary)}]),
+ ?line {ok,[{raw,Proto,Linger,Linger2}]} =
+ inet:getopts(Sock2,[{raw,Proto,Linger,
+ binarify(LingerSize,Binary)}]),
+ ?line true = byte_size(Linger1) =:= LingerSize,
+ ?line LingerLingerBits = LingerLingerSize * 8,
+ ?line LingerOnOffBits = LingerOnOffSize * 8,
+ ?line <<_:LingerLingerOffset/binary,
+ Ling1:LingerLingerBits/native,_/binary>> = Linger1,
+ ?line <<_:LingerOnOffOffset/binary,
+ Off1:LingerOnOffBits/native,_/binary>> = Linger1,
+ ?line <<_:LingerOnOffOffset/binary,
+ Off2:LingerOnOffBits/native,_/binary>> = Linger2,
+ ?line true = Off1 =/= 0,
+ ?line true = Off2 == 0,
+ ?line true = Ling1 == 10,
+ ?line {error,einval} =
+ inet:getopts(Sock1,[{raw,Proto,Linger,TooLargeSize}]),
+ ?line gen_tcp:close(Sock1),
+ ?line gen_tcp:close(Sock2),
+ ok
+ end.
+
+combined(suite) -> [];
+combined(doc) -> "Test raw structs combined w/ other options ";
+combined(Config) when is_list(Config) ->
+ do_combined(Config,false).
+combined_getbin(suite) -> [];
+combined_getbin(doc) -> "Test raw structs combined w/ other options and "
+ "binarise in getopts";
+combined_getbin(Config) when is_list(Config) ->
+ do_combined(Config,true).
+do_combined(Config,Binary) when is_list(Config) ->
+ ?line Port = start_helper(Config),
+ ?line Proto = ask_helper(Port,?C_GET_SOL_SOCKET),
+ ?line Linger = ask_helper(Port,?C_GET_SO_LINGER),
+ ?line LingerSize = ask_helper(Port,?C_GET_LINGER_SIZE),
+ ?line LingerOnOffOffset = ask_helper(Port,?C_GET_OFF_LINGER_L_ONOFF),
+ ?line LingerLingerOffset = ask_helper(Port,?C_GET_OFF_LINGER_L_LINGER),
+ ?line LingerOnOffSize = ask_helper(Port,?C_GET_SIZ_LINGER_L_ONOFF),
+ ?line LingerLingerSize = ask_helper(Port,?C_GET_SIZ_LINGER_L_LINGER),
+ ?line stop_helper(Port),
+ case all_ok([Proto,Linger,LingerSize,LingerOnOffOffset,
+ LingerLingerOffset,LingerOnOffSize,LingerLingerSize]) of
+ false ->
+ {skipped,"Does not run on this OS."};
+ true ->
+ ?line LingerLingerBits = LingerLingerSize * 8,
+ ?line LingerOnOffBits = LingerOnOffSize * 8,
+ ?line {LingerOn,LingerOff} =
+ case LingerOnOffOffset < LingerLingerOffset of
+ true ->
+ Pad1 =
+ list_to_binary(
+ lists:duplicate(LingerOnOffOffset,
+ 0)),
+ Pad2Siz =
+ LingerLingerOffset - LingerOnOffSize -
+ LingerOnOffOffset,
+ Pad2 =
+ list_to_binary(
+ lists:duplicate(Pad2Siz,
+ 0)),
+ Pad3Siz = LingerSize - LingerLingerSize -
+ LingerLingerOffset,
+ Pad3 = list_to_binary(
+ lists:duplicate(Pad3Siz,
+ 0)),
+ {<<Pad1/binary,1:LingerOnOffBits/native,
+ Pad2/binary,10:LingerLingerBits/native,
+ Pad3/binary>>,
+ <<Pad1/binary,0:LingerOnOffBits/native,
+ Pad2/binary,0:LingerLingerBits/native,
+ Pad3/binary>>};
+ false ->
+ Pad1 =
+ list_to_binary(
+ lists:duplicate(LingerLingerOffset,
+ 0)),
+ Pad2Siz =
+ LingerOnOffOffset - LingerLingerSize -
+ LingerLingerOffset,
+ Pad2 =
+ list_to_binary(
+ lists:duplicate(Pad2Siz,
+ 0)),
+ Pad3Siz = LingerSize - LingerOnOffSize -
+ LingerOnOffOffset,
+ Pad3 = list_to_binary(
+ lists:duplicate(Pad3Siz,
+ 0)),
+ {<<Pad1/binary,1:LingerLingerBits/native,
+ Pad2/binary,10:LingerOnOffBits/native,
+ Pad3/binary>>,
+ <<Pad1/binary,0:LingerLingerBits/native,
+ Pad2/binary,0:LingerOnOffBits/native,
+ Pad3/binary>>}
+ end,
+ ?line RawLingerOn = {raw,Proto,Linger,LingerOn},
+ ?line RawLingerOff = {raw,Proto,Linger,LingerOff},
+ ?line {Sock1,Sock2} =
+ create_socketpair([{keepalive,true},
+ RawLingerOn],
+ [{keepalive,false},
+ RawLingerOff]),
+ ?line {ok,[{raw,Proto,Linger,Linger1},{keepalive,Keep1}]} =
+ inet:getopts(Sock1,[{raw,Proto,Linger,
+ binarify(LingerSize,Binary)},keepalive]),
+ ?line {ok,[{raw,Proto,Linger,Linger2},{keepalive,Keep2}]} =
+ inet:getopts(Sock2,[{raw,Proto,Linger,
+ binarify(LingerSize,Binary)},keepalive]),
+ ?line true = byte_size(Linger1) =:= LingerSize,
+ ?line <<_:LingerLingerOffset/binary,
+ Ling1:LingerLingerBits/native,_/binary>> = Linger1,
+ ?line <<_:LingerOnOffOffset/binary,
+ Off1:LingerOnOffBits/native,_/binary>> = Linger1,
+ ?line <<_:LingerOnOffOffset/binary,
+ Off2:LingerOnOffBits/native,_/binary>> = Linger2,
+ ?line true = Off1 =/= 0,
+ ?line true = Off2 == 0,
+ ?line true = Ling1 == 10,
+ ?line true = Keep1 =:= true,
+ ?line true = Keep2 =:= false,
+ ?line {Sock3,Sock4} =
+ create_socketpair([RawLingerOn,{keepalive,true}],
+ [RawLingerOff,{keepalive,false}]),
+ ?line {ok,[{raw,Proto,Linger,Linger3},{keepalive,Keep3}]} =
+ inet:getopts(Sock3,[{raw,Proto,Linger,
+ binarify(LingerSize,Binary)},keepalive]),
+ ?line {ok,[{raw,Proto,Linger,Linger4},{keepalive,Keep4}]} =
+ inet:getopts(Sock4,[{raw,Proto,Linger,
+ binarify(LingerSize,Binary)},keepalive]),
+ ?line true = byte_size(Linger3) =:= LingerSize,
+ ?line <<_:LingerLingerOffset/binary,
+ Ling3:LingerLingerBits/native,_/binary>> = Linger3,
+ ?line <<_:LingerOnOffOffset/binary,
+ Off3:LingerOnOffBits/native,_/binary>> = Linger3,
+ ?line <<_:LingerOnOffOffset/binary,
+ Off4:LingerOnOffBits/native,_/binary>> = Linger4,
+ ?line true = Off3 =/= 0,
+ ?line true = Off4 == 0,
+ ?line true = Ling3 == 10,
+ ?line true = Keep3 =:= true,
+ ?line true = Keep4 =:= false,
+ ?line {Sock5,Sock6} =
+ create_socketpair([{packet,4},RawLingerOn,{keepalive,true}],
+ [{packet,2},RawLingerOff,{keepalive,false}]),
+ ?line {ok,[{packet,Pack5},{raw,Proto,Linger,Linger5},
+ {keepalive,Keep5}]} =
+ inet:getopts(Sock5,[packet,{raw,Proto,Linger,
+ binarify(LingerSize,Binary)},
+ keepalive]),
+ ?line {ok,[{packet,Pack6},{raw,Proto,Linger,Linger6},
+ {keepalive,Keep6}]} =
+ inet:getopts(Sock6,[packet,{raw,Proto,Linger,
+ binarify(LingerSize,Binary)},
+ keepalive]),
+ ?line true = byte_size(Linger5) =:= LingerSize,
+ ?line <<_:LingerLingerOffset/binary,
+ Ling5:LingerLingerBits/native,_/binary>> = Linger5,
+ ?line <<_:LingerOnOffOffset/binary,
+ Off5:LingerOnOffBits/native,_/binary>> = Linger5,
+ ?line <<_:LingerOnOffOffset/binary,
+ Off6:LingerOnOffBits/native,_/binary>> = Linger6,
+ ?line true = Off5 =/= 0,
+ ?line true = Off6 == 0,
+ ?line true = Ling5 == 10,
+ ?line true = Keep5 =:= true,
+ ?line true = Keep6 =:= false,
+ ?line true = Pack5 =:= 4,
+ ?line true = Pack6 =:= 2,
+ ?line inet:setopts(Sock6,[{packet,4},RawLingerOn,
+ {keepalive,true}]),
+ ?line {ok,[{packet,Pack7},{raw,Proto,Linger,Linger7},
+ {keepalive,Keep7}]} =
+ inet:getopts(Sock6,[packet,{raw,Proto,Linger,
+ binarify(LingerSize,Binary)},
+ keepalive]),
+ ?line <<_:LingerOnOffOffset/binary,
+ Off7:LingerOnOffBits/native,_/binary>> = Linger7,
+ ?line true = Off7 =/= 0,
+ ?line true = Keep7 =:= true,
+ ?line true = Pack7 =:= 4,
+ ?line gen_tcp:close(Sock1),
+ ?line gen_tcp:close(Sock2),
+ ?line gen_tcp:close(Sock3),
+ ?line gen_tcp:close(Sock4),
+ ?line gen_tcp:close(Sock5),
+ ?line gen_tcp:close(Sock6),
+ ok
+ end.
+
+type_errors(suite) ->
+ [];
+type_errors(doc) ->
+ "Test that raw data requests are not executed for bad types";
+type_errors(Config) when is_list(Config) ->
+ ?line BadSetOptions =
+ [
+ {raw,x,3,<<1:32>>},
+ {raw,1,tre,<<1:32>>},
+ {raw,1,3,ko},
+ {raw,1,3,5},
+ {raw,1,3},
+ {raw,1},
+ {raw},
+ {raw,ett},
+ {raw,ett,tre},
+ {raw,{true,10}},
+ {raw,{ett,tre,<<1:32>>}},
+ {rav,1,3,<<1:32>>},
+ raw,
+ rav,
+ {linger,banan}
+ ],
+ ?line BadGetOptions =
+ [
+ {raw,x,3,<<1:32>>},
+ {raw,1,tre,<<1:32>>},
+ {raw,1,3,ko},
+ {raw,1,3,5.1},
+ {raw,1,3,-3},
+ {raw,1,3},
+ {raw,1},
+ {raw},
+ {raw,ett},
+ {raw,ett,tre},
+ {raw,{true,10}},
+ {raw,{ett,tre,<<1:32>>}},
+ {rav,1,3,<<1:32>>},
+ raw,
+ rav,
+ {linger,banan}
+ ],
+ ?line lists:foreach(fun(Option) ->
+ ?line case
+ catch create_socketpair([Option],[]) of
+ {'EXIT',badarg} ->
+ ?line ok;
+ Unexpected1 ->
+ ?line exit({unexpected,
+ Unexpected1})
+ end,
+ ?line case
+ catch create_socketpair([],[Option]) of
+ {'EXIT',badarg} ->
+ ?line ok;
+ Unexpected2 ->
+ ?line exit({unexpected,
+ Unexpected2})
+ end,
+ ?line {Sock1,Sock2} = create_socketpair([],[]),
+ ?line case inet:setopts(Sock1, [Option]) of
+ {error,einval} ->
+ ?line ok;
+ Unexpected3 ->
+ ?line exit({unexpected,
+ Unexpected3})
+ end,
+ ?line gen_tcp:close(Sock1),
+ ?line gen_tcp:close(Sock2)
+ end,BadSetOptions),
+ ?line {Sock1,Sock2} = create_socketpair([],[]),
+ ?line lists:foreach(fun(Option) ->
+ ?line case inet:getopts(Sock1, [Option]) of
+ {error,einval} ->
+ ?line ok;
+ Unexpected ->
+ ?line exit({unexpected,
+ Unexpected})
+ end
+ end,BadGetOptions),
+ ?line gen_tcp:close(Sock1),
+ ?line gen_tcp:close(Sock2),
+ ok.
+
+all_ok([]) ->
+ true;
+all_ok([H|T]) when H >= 0 ->
+ all_ok(T);
+all_ok(_) ->
+ false.
+
+
+make_check_fun(Type,Element) ->
+ fun({Name,V1,V2,Mand,Chang},Acc) ->
+ ?line {LO1,CO1} = setelement(Element,{[],[]}, [{Name,V1}]),
+ ?line {LO2,CO2} = setelement(Element,{[],[]}, [{Name,V2}]),
+ ?line {X1,Y1} = create_socketpair(LO1,CO1),
+ ?line {X2,Y2} = create_socketpair(LO2,CO2),
+ ?line S1 = element(Element,{X1,Y1}),
+ ?line S2 = element(Element,{X2,Y2}),
+ ?line {ok,[{Name,R1}]} = inet:getopts(S1,[Name]),
+ ?line {ok,[{Name,R2}]} = inet:getopts(S2,[Name]),
+ NewAcc =
+ case R1 =/= R2 of
+ true ->
+ case Chang of
+ true ->
+ ?line inet:setopts(S1,[{Name,V2}]),
+ ?line {ok,[{Name,R3}]} =
+ inet:getopts(S1,[Name]),
+ case {R3 =/= R1, R3 =:= R2} of
+ {true,true} ->
+ ?line Acc;
+ _ ->
+ case Mand of
+ true ->
+ ?line exit
+ ({failed_sockopt,
+ {change,
+ Name}});
+ false ->
+ ?line [{change,Name}|Acc]
+ end
+ end;
+ false ->
+ ?line Acc
+ end;
+ false ->
+ case Mand of
+ true ->
+ ?line exit({failed_sockopt,
+ {Type,Name}});
+ false ->
+ ?line [{Type,Name}|Acc]
+ end
+ end,
+ ?line gen_tcp:close(X1),
+ ?line gen_tcp:close(Y1),
+ ?line gen_tcp:close(X2),
+ ?line gen_tcp:close(Y2),
+ NewAcc
+ end.
+
+% {OptionName,Value1,Value2,Mandatory,Changeable}
+all_listen_options() ->
+ [{tos,0,1,false,true},
+ {priority,0,1,false,true},
+ {reuseaddr,false,true,false,true},
+ {keepalive,false,true,true,true},
+ {linger, {false,10}, {true,10},true,true},
+ {sndbuf,2048,4096,false,true},
+ {recbuf,2048,4096,false,true},
+ {nodelay,false,true,true,true},
+ {header,2,4,true,true},
+ {active,false,true,true,false},
+ {packet,2,4,true,true},
+ {buffer,1000,2000,true,true},
+ {mode,list,binary,true,true},
+ {deliver,term,port,true,true},
+ {exit_on_close, true, false, true, true},
+ %{high_watermark,4096,8192,true,true},
+ %{low_watermark,2048,4096,true,true},
+ {bit8,on,off,true,true},
+ {send_timeout,infinity,1000,true,true},
+ {send_timeout_close,false,true,true,true},
+ {delay_send,false,true,true,true},
+ {packet_size,0,4,true,true}
+ ].
+all_connect_options() ->
+ [{tos,0,1,false,true},
+ {priority,0,1,false,true},
+ {reuseaddr,false,true,false,true},
+ {keepalive,false,true,true,true},
+ {linger, {false,10}, {true,10},true,true},
+ {sndbuf,2048,4096,false,true},
+ {recbuf,2048,4096,false,true},
+ {nodelay,false,true,true,true},
+ {header,2,4,true,true},
+ {active,false,true,true,false},
+ {packet,2,4,true,true},
+ {buffer,1000,2000,true,true},
+ {mode,list,binary,true,true},
+ {deliver,term,port,true,true},
+ {exit_on_close, true, false, true, true},
+ {high_watermark,4096,8192,false,true},
+ {low_watermark,2048,4096,false,true},
+ {bit8,on,off,true,true},
+ {send_timeout,infinity,1000,true,true},
+ {send_timeout_close,false,true,true,true},
+ {delay_send,false,true,true,true},
+ {packet_size,0,4,true,true}
+ ].
+
+
+create_socketpair(ListenOptions,ConnectOptions) ->
+ ?line {ok,LS}=gen_tcp:listen(0,ListenOptions),
+ ?line {ok,Port}=inet:port(LS),
+ ?line {ok,CS}=gen_tcp:connect(localhost,Port,ConnectOptions),
+ ?line {ok,AS}=gen_tcp:accept(LS),
+ ?line gen_tcp:close(LS),
+ {AS,CS}.
+
+
+start_helper(Config) ->
+ Progname = filename:join(?config(data_dir, Config), "sockopt_helper"),
+ Port = open_port({spawn,Progname},[eof,line]),
+ Port.
+
+ask_helper(Port,Code) ->
+ Com = integer_to_list(Code)++"\n",
+ Port ! {self(),{command,Com}},
+ receive
+ {Port,{data,{eol,Text}}} ->
+ list_to_integer(Text);
+ Other ->
+ exit({error,{unexpected_data_from_helper,Other}})
+ after 3000 ->
+ exit({error,helper_timeout})
+ end.
+
+stop_helper(Port) ->
+ catch ask_helper(Port,?C_QUIT),
+ receive
+ {Port,eof} ->
+ Port ! {self(), close},
+ receive
+ {Port,closed} ->
+ ok
+ after 1000 ->
+ timeout
+ end
+ after 1000 ->
+ timeout
+ end.
+
+binarify(Size,Binary) when Binary =:= true ->
+ <<0:Size/unit:8>>;
+binarify(Size,Binary) when Binary =:= false ->
+ Size.
diff --git a/lib/kernel/test/inet_sockopt_SUITE_data/Makefile.src b/lib/kernel/test/inet_sockopt_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..22829e8033
--- /dev/null
+++ b/lib/kernel/test/inet_sockopt_SUITE_data/Makefile.src
@@ -0,0 +1,14 @@
+CC = @CC@
+LD = @LD@
+CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@
+CROSSLDFLAGS = @CROSSLDFLAGS@
+
+PROGS = sockopt_helper@exe@
+
+all: $(PROGS)
+
+sockopt_helper@exe@: sockopt_helper@obj@
+ $(LD) $(CROSSLDFLAGS) -o sockopt_helper sockopt_helper@obj@ @LIBS@
+
+sockopt_helper@obj@: sockopt_helper.c
+ $(CC) -c -o sockopt_helper@obj@ $(CFLAGS) sockopt_helper.c
diff --git a/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c b/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c
new file mode 100644
index 0000000000..fb3c622909
--- /dev/null
+++ b/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c
@@ -0,0 +1,219 @@
+#if defined(VXWORKS) || defined(__OSE__)
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+int sockopt_helper(void){
+ return 0;
+}
+#else
+
+#if defined(__WIN32__)
+#define WIN32_LEAN_AND_MEAN
+#include <winsock2.h>
+#include <windows.h>
+#include <process.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+#else /* Unix */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+#include <stdarg.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <sys/wait.h>
+#ifdef HAVE_LINUX_TCP_H
+#ifdef HAVE_SANE_LINUX_TCP_H
+#include <linux/tcp.h>
+#endif
+#endif
+#include <netinet/in.h>
+#include <arpa/inet.h>
+#include <netdb.h>
+#include <errno.h>
+#include <signal.h>
+
+#endif
+
+#define C_GET_IPPROTO_TCP 1
+#define C_GET_IPPROTO_IP 2
+#define C_GET_SOL_SOCKET 3
+#define C_GET_SOL_IP 4
+
+#define C_GET_TCP_KEEPIDLE 11
+#define C_GET_TCP_LINGER2 12
+#define C_GET_TCP_INFO 13
+#define C_GET_SO_REUSEADDR 14
+#define C_GET_SO_KEEPALIVE 15
+#define C_GET_SO_LINGER 16
+
+#define C_GET_LINGER_SIZE 21
+#define C_GET_TCP_INFO_SIZE 22
+
+#define C_GET_OFF_LINGER_L_ONOFF 31
+#define C_GET_OFF_LINGER_L_LINGER 32
+#define C_GET_OFF_TCPI_SACKED 33
+#define C_GET_OFF_TCPI_OPTIONS 34
+
+#define C_GET_SIZ_LINGER_L_ONOFF 41
+#define C_GET_SIZ_LINGER_L_LINGER 42
+#define C_GET_SIZ_TCPI_SACKED 43
+#define C_GET_SIZ_TCPI_OPTIONS 44
+
+#define C_QUIT 99
+
+int get_command(void)
+{
+ char buff[256];
+ int res;
+ if (fgets(buff,256,stdin) == NULL)
+ exit(1);
+ sscanf(buff,"%d",&res);
+ return res;
+}
+
+void put_answer(int x)
+{
+ printf("%d\n",x);
+}
+
+int main(void){
+ int x;
+ int res;
+ setbuf(stdin,NULL);
+ setbuf(stdout,NULL);
+ do {
+ x = get_command();
+
+ switch(x) {
+#ifdef IPPROTO_TCP
+ case C_GET_IPPROTO_TCP:
+ res = IPPROTO_TCP;
+ break;
+#endif
+#ifdef IPPROTO_IP
+ case C_GET_IPPROTO_IP:
+ res = IPPROTO_IP;
+ break;
+#endif
+#ifdef SOL_SOCKET
+ case C_GET_SOL_SOCKET:
+ res = SOL_SOCKET;
+ break;
+#endif
+#ifdef SOL_IP
+ case C_GET_SOL_IP :
+ res = SOL_IP;
+ break;
+#endif
+#ifdef TCP_KEEPIDLE
+ case C_GET_TCP_KEEPIDLE:
+ res = TCP_KEEPIDLE;
+ break;
+#endif
+#ifdef TCP_LINGER2
+ case C_GET_TCP_LINGER2:
+ res = TCP_LINGER2;
+ break;
+#endif
+#ifdef TCP_INFO
+ case C_GET_TCP_INFO:
+ res = TCP_INFO;
+ break;
+#endif
+#ifdef SO_REUSEADDR
+ case C_GET_SO_REUSEADDR:
+ res = SO_REUSEADDR;
+ break;
+#endif
+#ifdef SO_KEEPALIVE
+ case C_GET_SO_KEEPALIVE:
+ res = SO_KEEPALIVE;
+ break;
+#endif
+#ifdef SO_LINGER
+ case C_GET_SO_LINGER:
+ res = SO_LINGER;
+ break;
+#endif
+#ifdef SO_LINGER
+ case C_GET_LINGER_SIZE:
+ res = sizeof(struct linger);
+ break;
+#endif
+#if defined(TCP_INFO) && defined(HAVE_LINUX_TCP_H)
+ case C_GET_TCP_INFO_SIZE:
+ res = sizeof(struct tcp_info);
+ break;
+#endif
+#ifdef SO_LINGER
+ case C_GET_OFF_LINGER_L_ONOFF:
+ {
+ struct linger l;
+ res = ((char *) &(l.l_onoff)) - ((char *) &l);
+ }
+ break;
+ case C_GET_OFF_LINGER_L_LINGER:
+ {
+ struct linger l;
+ res = ((char *) &(l.l_linger)) - ((char *) &l);
+ }
+ break;
+#endif
+#if defined(TCP_INFO) && defined(HAVE_LINUX_TCP_H)
+ case C_GET_OFF_TCPI_SACKED:
+ {
+ struct tcp_info ti;
+ res = ((char *) &(ti.tcpi_sacked)) - ((char *) &(ti));
+ }
+ break;
+ case C_GET_OFF_TCPI_OPTIONS:
+ {
+ struct tcp_info ti;
+ res = ((char *) &(ti.tcpi_options)) - ((char *) &(ti));
+ }
+ break;
+#endif
+#ifdef SO_LINGER
+ case C_GET_SIZ_LINGER_L_ONOFF:
+ {
+ struct linger l;
+ res = sizeof(l.l_onoff);
+ }
+ break;
+ case C_GET_SIZ_LINGER_L_LINGER:
+ {
+ struct linger l;
+ res = sizeof(l.l_linger);
+ }
+ break;
+#endif
+#if defined(TCP_INFO) && defined(HAVE_LINUX_TCP_H)
+ case C_GET_SIZ_TCPI_SACKED:
+ {
+ struct tcp_info ti;
+ res = sizeof(ti.tcpi_sacked);
+ }
+ break;
+ case C_GET_SIZ_TCPI_OPTIONS:
+ {
+ struct tcp_info ti;
+ res = sizeof(ti.tcpi_options);
+ }
+ break;
+#endif
+ case C_QUIT:
+ res = 0;
+ break;
+ default:
+ res = -1;
+ }
+ put_answer(res);
+ } while (x != C_QUIT);
+ return 0;
+}
+#endif
+
diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl
new file mode 100644
index 0000000000..3d777f93a4
--- /dev/null
+++ b/lib/kernel/test/init_SUITE.erl
@@ -0,0 +1,582 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(init_SUITE).
+
+-include("test_server.hrl").
+
+-export([all/1]).
+
+-export([get_arguments/1, get_argument/1, boot_var/1, restart/1,
+ get_plain_arguments/1,
+ reboot/1, stop/1, get_status/1, script_id/1, boot/1]).
+-export([boot1/1, boot2/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+-export([init/1, fini/1]).
+
+-define(DEFAULT_TIMEOUT_SEC, 100).
+
+%%-----------------------------------------------------------------
+%% Test suite for init. (Most code is run during system start/stop.
+%% Should be started in a CC view with:
+%% erl -sname master -rsh ctrsh
+%%-----------------------------------------------------------------
+all(suite) ->
+ [get_arguments, get_argument, boot_var,
+ get_plain_arguments,
+ restart,
+ get_status, script_id, boot].
+
+init_per_testcase(Func, Config) when atom(Func), list(Config) ->
+ Dog=?t:timetrap(?t:seconds(?DEFAULT_TIMEOUT_SEC)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog).
+
+init(doc) -> [];
+init(suite) -> [];
+init(Config) when is_list(Config) ->
+ Config.
+
+fini(doc) -> [];
+fini(suite) -> [];
+fini(Config) when is_list(Config) ->
+ Host = list_to_atom(from($@, atom_to_list(node()))),
+ Node = list_to_atom(lists:concat([init_test, "@", Host])),
+ stop_node(Node),
+ Config.
+
+get_arguments(doc) ->[];
+get_arguments(suite) -> {req, [distribution, {local_slave_nodes, 1}]};
+get_arguments(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(10)),
+
+ Args = args(),
+ ?line {ok, Node} = start_node(init_test, Args),
+ ?line case rpc:call(Node, init, get_arguments, []) of
+ Arguments when is_list(Arguments) ->
+ stop_node(Node),
+ check_a(Arguments),
+ check_b(Arguments),
+ check_c(Arguments),
+ check_d(Arguments);
+ _ ->
+ stop_node(Node),
+ ?t:fail(get_arguments)
+ end,
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+check_a(Args) ->
+ case lists:keysearch(a,1,Args) of
+ {value, {a,["kalle"]}} ->
+ Args1 = lists:keydelete(a,1,Args),
+ case lists:keysearch(a,1,Args1) of
+ false ->
+ ok;
+ _ ->
+ ?t:fail(check_a1)
+ end;
+ _ ->
+ ?t:fail(check_a2)
+ end.
+
+check_b(Args) ->
+ case lists:keysearch(b,1,Args) of
+ {value, {b,["hej", "hopp"]}} ->
+ Args1 = lists:keydelete(b,1,Args),
+ case lists:keysearch(b,1,Args1) of
+ {value, {b,["san", "sa"]}} ->
+ Args2 = lists:keydelete(b,1,Args1),
+ case lists:keysearch(b,1,Args2) of
+ false ->
+ ok;
+ _ ->
+ ?t:fail(check_b1)
+ end;
+ _ ->
+ ?t:fail(check_b2)
+ end;
+ _ ->
+ ?t:fail(check_b3)
+ end.
+
+check_c(Args) ->
+ case lists:keysearch(c,1,Args) of
+ {value, {c,["4", "5", "6"]}} ->
+ Args1 = lists:keydelete(c,1,Args),
+ case lists:keysearch(c,1,Args1) of
+ {value, {c,["7", "8", "9"]}} ->
+ Args2 = lists:keydelete(c,1,Args1),
+ case lists:keysearch(c,1,Args2) of
+ false ->
+ ok;
+ _ ->
+ ?t:fail(check_c1)
+ end;
+ _ ->
+ ?t:fail(check_c2)
+ end;
+ _ ->
+ ?t:fail(check_c3)
+ end.
+
+check_d(Args) ->
+ case lists:keysearch(d,1,Args) of
+ {value, {d,[]}} ->
+ Args1 = lists:keydelete(d,1,Args),
+ case lists:keysearch(d,1,Args1) of
+ false ->
+ ok;
+ _ ->
+ ?t:fail(check_d1)
+ end;
+ _ ->
+ ?t:fail(check_d2)
+ end.
+
+get_argument(doc) ->[];
+get_argument(suite) -> {req, [distribution, {local_slave_nodes, 1}]};
+get_argument(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(10)),
+
+ Args = args(),
+ ?line {ok, Node} = start_node(init_test, Args),
+ ?line case rpc:call(Node, init, get_argument, [b]) of
+ {ok, [["hej", "hopp"],["san", "sa"]]} ->
+ ok;
+ _ ->
+ stop_node(Node),
+ ?t:fail({get_argument, b})
+ end,
+ ?line case rpc:call(Node, init, get_argument, [a]) of
+ {ok, [["kalle"]]} ->
+ ok;
+ _ ->
+ stop_node(Node),
+ ?t:fail({get_argument, a})
+ end,
+ ?line case rpc:call(Node, init, get_argument, [c]) of
+ {ok, [["4", "5", "6"], ["7", "8", "9"]]} ->
+ ok;
+ _ ->
+ stop_node(Node),
+ ?t:fail({get_argument, c})
+ end,
+ ?line case rpc:call(Node, init, get_argument, [d]) of
+ {ok, [[]]} ->
+ ok;
+ _ ->
+ stop_node(Node),
+ ?t:fail({get_argument, d})
+ end,
+ ?line case rpc:call(Node, init, get_argument, [e]) of
+ error ->
+ ok;
+ _ ->
+ stop_node(Node),
+ ?t:fail({get_argument, e})
+ end,
+ stop_node(Node),
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+get_plain_arguments(doc) ->[];
+get_plain_arguments(suite) -> {req, [distribution, {local_slave_nodes, 1}]};
+get_plain_arguments(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(10)),
+ Longstring =
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2"
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2"
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2"
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2"
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2"
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2"
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2"
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2"
+ "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2",
+ ?line true = (length(Longstring) > 255),
+ Args = long_args(Longstring),
+ ?line {ok, Node} = start_node(init_test, Args),
+ ?line case rpc:call(Node, init, get_plain_arguments, []) of
+ ["a", "b", "c", Longstring] ->
+ ok;
+ As ->
+ stop_node(Node),
+ ?t:fail({get_argument, As})
+ end,
+ stop_node(Node),
+ ?line ?t:timetrap_cancel(Dog),
+
+ ok.
+
+
+%% ------------------------------------------------
+%% Use -boot_var flag to set $TEST_VAR in boot script.
+%% ------------------------------------------------
+boot_var(doc) -> [];
+boot_var(suite) -> {req, [distribution, {local_slave_nodes, 1}]};
+boot_var(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "Not run on VxWorks"};
+ _ ->
+ ?line Dog = ?t:timetrap(?t:seconds(100)),
+
+ {BootScript, TEST_VAR, KernelVsn, StdlibVsn} = create_boot(Config),
+
+ %% Should fail as we have not given -boot_var TEST_VAR
+ ?line {error, timeout} =
+ start_node(init_test, "-boot " ++ BootScript),
+
+ case is_real_system(KernelVsn, StdlibVsn) of
+ true ->
+ %% Now it should work !!
+ ?line {ok, Node} =
+ start_node(init_test,
+ "-boot " ++ BootScript ++
+ " -boot_var TEST_VAR " ++ TEST_VAR),
+ stop_node(Node),
+ Res = ok;
+ _ ->
+%% What we need is not so much version numbers on the directories, but
+%% for the boot var TEST_VAR to appear in the boot script, and it doesn't
+%% if we give the 'local' option to systools:make_script.
+ ?t:format(
+ "Test case not complete as we are not~n"
+ "running in a real system!~n"
+ "Probably this test is performed in a "
+ "clearcase view or source tree.~n"
+ "Need version numbers on the kernel and "
+ "stdlib directories!~n",
+ []),
+ Res = {skip,
+ "Test case only partially run since it is run "
+ "in a clearcase view or in a source tree. "
+ "Need an installed system to complete this test."}
+ end,
+ ?line ?t:timetrap_cancel(Dog),
+ Res
+ end.
+
+create_boot(Config) ->
+ ?line {ok, OldDir} = file:get_cwd(),
+ ?line {LatestDir, LatestName, KernelVsn, StdlibVsn} =
+ create_script(Config),
+ LibDir = code:lib_dir(),
+ ?line ok = file:set_cwd(LatestDir),
+ ?line ok = systools:make_script(LatestName,
+ [{variables, [{"TEST_VAR", LibDir}]}]),
+ ?line ok = file:set_cwd(OldDir),
+ {LatestDir ++ "/" ++ LatestName, LibDir, KernelVsn, StdlibVsn}.
+
+is_real_system(KernelVsn, StdlibVsn) ->
+ LibDir = code:lib_dir(),
+ filelib:is_dir(filename:join(LibDir, "kernel"++KernelVsn)) andalso
+ filelib:is_dir(filename:join(LibDir, "stdlib"++StdlibVsn)).
+
+%% ------------------------------------------------
+%% Slave executes erlang:halt() on master nodedown.
+%% Therefore the slave process must be killed
+%% before restart.
+%% ------------------------------------------------
+restart(doc) -> [];
+restart(suite) ->
+ case ?t:os_type() of
+ {Fam, _} when Fam == unix; Fam == win32 ->
+ {req, [distribution, {local_slave_nodes, 1}, {time, 5}]};
+ _ ->
+ {skip, "Only run on unix and win32"}
+ end;
+restart(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(40)),
+ ?line Args = args(),
+
+ %% Currently test_server:start_node cannot be used. The restarted
+ %% node immediately halts due to the implementation of
+ %% test_server:start_node.
+ ?line {ok, Node} = loose_node:start(init_test, Args, ?DEFAULT_TIMEOUT_SEC),
+ %% Ok, the node is up, now the real test test begins.
+ ?line erlang:monitor_node(Node, true),
+ ?line InitPid = rpc:call(Node, erlang, whereis, [init]),
+ ?line Procs = rpc:call(Node, erlang, processes, []),
+ ?line MaxPid = lists:last(Procs),
+ ?line ok = rpc:call(Node, init, restart, []),
+ ?line receive
+ {nodedown, Node} ->
+ ok
+ after 10000 ->
+ loose_node:stop(Node),
+ ?t:fail(not_stopping)
+ end,
+ ?line ok = wait_restart(30, Node),
+
+ %% Still the same init process!
+ ?line InitPid1 = rpc:call(Node, erlang, whereis, [init]),
+ InitP = pid_to_list(InitPid),
+ ?line InitP = pid_to_list(InitPid1),
+
+ ?line NewProcs0 = rpc:call(Node, erlang, processes, []),
+ NewProcs = lists:delete(InitPid1, NewProcs0),
+ ?line case check_processes(NewProcs, MaxPid) of
+ true ->
+ ok;
+ _ ->
+ loose_node:stop(Node),
+ ?t:fail(processes_not_greater)
+ end,
+
+ %% Test that, for instance, the same argument still exists.
+ ?line case rpc:call(Node, init, get_argument, [c]) of
+ {ok, [["4", "5", "6"], ["7", "8", "9"]]} ->
+ ok;
+ _ ->
+ loose_node:stop(Node),
+ ?t:fail({get_argument, restart_fail})
+ end,
+ loose_node:stop(Node),
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+wait_restart(0, _Node) ->
+ ?t:fail(not_restarted);
+wait_restart(N, Node) ->
+ case net_adm:ping(Node) of
+ pong -> ok;
+ _ ->
+ ?t:sleep(1000),
+ wait_restart(N - 1, Node)
+ end.
+
+check_processes(NewProcs, MaxPid) ->
+ [N,P,I] = apid(MaxPid),
+ case lists:filter(fun(Pid) ->
+ case apid(Pid) of
+ [N,P1,_I1] when P1 > P -> false;
+ [N,_P1,I1] when I1 > I -> false;
+ _ -> true
+ end
+ end, NewProcs) of
+ [] ->
+ true;
+ _ ->
+ false
+ end.
+
+apid(Pid) ->
+ [N,P,I] = string:tokens(pid_to_list(Pid),"<>."),
+ [list_to_integer(N),list_to_integer(P),list_to_integer(I)].
+
+%% ------------------------------------------------
+%% Just test that the system is halted here.
+%% The reboot facility using heart is tested
+%% in the heart_SUITE.
+%% ------------------------------------------------
+reboot(doc) -> [];
+reboot(suite) -> {req, [distribution, {local_slave_nodes, 1}]};
+reboot(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(40)),
+
+ Args = args(),
+ ?line {ok, Node} = start_node(init_test, Args),
+ erlang:monitor_node(Node, true),
+ ?line ok = rpc:call(Node, init, reboot, []),
+ ?line receive
+ {nodedown, Node} ->
+ ok
+ after 10000 ->
+ stop_node(Node),
+ ?t:fail(not_stopping)
+ end,
+ ?t:sleep(5000),
+ ?line case net_adm:ping(Node) of
+ pang ->
+ ok;
+ _ ->
+ stop_node(Node),
+ ?t:fail(system_rebooted)
+ end,
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+%% ------------------------------------------------
+%%
+%% ------------------------------------------------
+stop(doc) -> [];
+stop(suite) -> [];
+stop(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(20)),
+ Args = args(),
+ ?line {ok, Node} = start_node(init_test, Args),
+ erlang:monitor_node(Node, true),
+ ?line ok = rpc:call(Node, init, reboot, []),
+ ?line receive
+ {nodedown, Node} ->
+ ok
+ after 10000 ->
+ stop_node(Node),
+ ?t:fail(not_stopping)
+ end,
+ ?t:sleep(5000),
+ ?line case net_adm:ping(Node) of
+ pang ->
+ ok;
+ _ ->
+ stop_node(Node),
+ ?t:fail(system_rebooted)
+ end,
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+%% ------------------------------------------------
+%%
+%% ------------------------------------------------
+get_status(doc) -> [];
+get_status(suite) -> [];
+get_status(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(10)),
+ ?line ?t:timetrap_cancel(Dog),
+
+ ?line {Start, _} = init:get_status(),
+ %% Depending on how the test_server is started Start has
+ %% different values. staring if test_server started with
+ %% -s flag.
+ ?line case lists:member(Start, [started, starting]) of
+ true ->
+ ok;
+ _ ->
+ ?t:fail(get_status)
+ end.
+
+%% ------------------------------------------------
+%%
+%% ------------------------------------------------
+script_id(doc) -> [];
+script_id(suite) -> [];
+script_id(Config) when is_list(Config) ->
+ ?line Dog = ?t:timetrap(?t:seconds(10)),
+
+ ?line {Name, Vsn} = init:script_id(),
+ ?line if
+ list(Name), list(Vsn) ->
+ ok;
+ true ->
+ ?t:fail(not_standard_script)
+ end,
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+%% ------------------------------------------------
+%% Start the slave system with -boot flag.
+%% ------------------------------------------------
+boot(suite) -> [boot1, boot2].
+
+boot1(doc) -> [];
+boot1(suite) -> {req, [distribution, {local_slave_nodes, 1}, {time, 35}]};
+boot1(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "Not run on VxWorks"};
+ _ ->
+ ?line Dog = ?t:timetrap(?t:seconds(80)),
+ Args = args() ++ " -boot start_sasl",
+ ?line {ok, Node} = start_node(init_test, Args),
+ ?line stop_node(Node),
+
+ %% Try to start with non existing boot file.
+ Args1 = args() ++ " -boot dummy_script",
+ ?line {error, timeout} = start_node(init_test, Args1),
+
+ ?line ?t:timetrap_cancel(Dog),
+ ok
+ end.
+
+boot2(doc) -> [];
+boot2(suite) -> {req, [distribution, {local_slave_nodes, 1}, {time, 35}]};
+boot2(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "Not run on VxWorks"};
+ _ ->
+ ?line Dog = ?t:timetrap(?t:seconds(80)),
+
+ %% Absolute boot file name
+ Boot = filename:join([code:root_dir(), "bin", "start_sasl"]),
+
+ Args = args() ++ " -boot " ++ Boot,
+ ?line {ok, Node} = start_node(init_test, Args),
+ ?line stop_node(Node),
+
+ case os:type() of
+ {win32, _} ->
+ %% Absolute boot file name for Windows -- all slashes are
+ %% converted to backslashes.
+ Win_boot = lists:map(fun($/) -> $\\; (C) -> C end,
+ Boot),
+ Args2 = args() ++ " -boot " ++ Win_boot,
+ ?line {ok, Node2} = start_node(init_test, Args2),
+ ?line stop_node(Node2);
+ _ ->
+ ok
+ end,
+
+ ?line ?t:timetrap_cancel(Dog),
+ ok
+ end.
+
+%% Misc. functions
+
+start_node(Name, Param) ->
+ ?t:start_node(Name, slave, [{args, Param}]).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
+
+from(H, [H | T]) -> T;
+from(H, [_ | T]) -> from(H, T);
+from(_, []) -> [].
+
+args() ->
+ "-a kalle -- a b -d -b hej hopp -- c d -b san sa -c 4 5 6 -c 7 8 9".
+
+long_args(A) ->
+ lists:flatten(
+ io_lib:format("-a kalle -- a b -d -b hej hopp -- c "
+ "~s -b san sa -c 4 5 6 -c 7 8 9",
+ [A])).
+
+create_script(Config) ->
+ ?line PrivDir = ?config(priv_dir,Config),
+ ?line Name = PrivDir ++ "boot_var_test",
+ ?line Apps = application_controller:which_applications(),
+ ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps),
+ ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps),
+ ?line {ok,Fd} = file:open(Name ++ ".rel", write),
+ ?line io:format(Fd,
+ "{release, {\"Test release 3\", \"P2A\"}, \n"
+ " {erts, \"4.4\"}, \n"
+ " [{kernel, \"~s\"}, {stdlib, \"~s\"}]}.\n",
+ [KernelVer,StdlibVer]),
+ ?line file:close(Fd),
+ {filename:dirname(Name), filename:basename(Name),
+ KernelVer, StdlibVer}.
+
diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl
new file mode 100644
index 0000000000..c0db292ba5
--- /dev/null
+++ b/lib/kernel/test/interactive_shell_SUITE.erl
@@ -0,0 +1,616 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(interactive_shell_SUITE).
+-include("test_server.hrl").
+-export([all/1, get_columns_and_rows/1, exit_initial/1, job_control_local/1,
+ job_control_remote/1,
+ job_control_remote_noshell/1]).
+
+-export([init_per_testcase/2, end_per_testcase/2]).
+%% For spawn
+-export([toerl_server/3]).
+
+init_per_testcase(_Func, Config) ->
+ Dog = test_server:timetrap(test_server:seconds(60)),
+ Term = case os:getenv("TERM") of
+ List when is_list(List) ->
+ List;
+ _ ->
+ "dumb"
+ end,
+ os:putenv("TERM","vt100"),
+ [{watchdog,Dog},{term,Term}|Config].
+
+end_per_testcase(_Func, Config) ->
+ Dog = ?config(watchdog, Config),
+ Term = ?config(term,Config),
+ os:putenv("TERM",Term),
+ test_server:timetrap_cancel(Dog).
+
+
+all(suite) ->
+ [get_columns_and_rows, exit_initial, job_control_local,
+ job_control_remote, job_control_remote_noshell].
+
+%-define(DEBUG,1).
+-ifdef(DEBUG).
+-define(dbg(Data),erlang:display(Data)).
+-else.
+-define(dbg(Data),noop).
+-endif.
+
+get_columns_and_rows(suite) -> [];
+get_columns_and_rows(doc) -> ["Test that the shell can access columns and rows"];
+get_columns_and_rows(Config) when is_list(Config) ->
+ ?line rtnode([{putline,""},
+ {putline, "2."},
+ {getline, "2"},
+ {putline,"io:columns()."},
+%% Behaviour change in R12B-5, returns 80
+%% {getline,"{error,enotsup}"},
+ {getline,"{ok,80}"},
+ {putline,"io:rows()."},
+%% Behaviour change in R12B-5, returns 24
+%% {getline,"{error,enotsup}"}
+ {getline,"{ok,24}"}
+ ],[]),
+ ?line rtnode([{putline,""},
+ {putline, "2."},
+ {getline, "2"},
+ {putline,"io:columns()."},
+ {getline,"{ok,90}"},
+ {putline,"io:rows()."},
+ {getline,"{ok,40}"}],
+ [],
+ "stty rows 40; stty columns 90; ").
+
+
+
+exit_initial(suite) -> [];
+exit_initial(doc) -> ["Tests that exit of initial shell restarts shell"];
+exit_initial(Config) when is_list(Config) ->
+ ?line rtnode([{putline,""},
+ {putline, "2."},
+ {getline, "2"},
+ {putline,"exit()."},
+ {getline,""},
+ {getline,"Eshell"},
+ {putline,""},
+ {putline,"35."},
+ {getline,"35"}],[]).
+
+job_control_local(suite) -> [];
+job_control_local(doc) -> [ "Tests that local shell can be "
+ "started by means of job control" ];
+job_control_local(Config) when is_list(Config) ->
+ ?line rtnode([{putline,""},
+ {putline, "2."},
+ {getline, "2"},
+ {putline,[7]},
+ {sleep,timeout(short)},
+ {putline,""},
+ {getline," -->"},
+ {putline,"s"},
+ {putline,"c"},
+ {putline_raw,""},
+ {getline,"Eshell"},
+ {putline_raw,""},
+ {getline,"1>"},
+ {putline,"35."},
+ {getline,"35"}],[]).
+
+job_control_remote(suite) -> [];
+job_control_remote(doc) -> [ "Tests that remote shell can be "
+ "started by means of job control" ];
+job_control_remote(Config) when is_list(Config) ->
+ case node() of
+ nonode@nohost ->
+ ?line exit(not_distributed);
+ _ ->
+ ?line RNode = create_nodename(),
+ ?line MyNode = atom_to_list(node()),
+ ?line Pid = spawn_link(fun() ->
+ receive die ->
+ ok
+ end
+ end),
+ ?line PidStr = pid_to_list(Pid),
+ ?line register(kalaskula,Pid),
+ ?line CookieString = lists:flatten(
+ io_lib:format("~w",
+ [erlang:get_cookie()])),
+ ?line Res = rtnode([{putline,""},
+ {putline, "erlang:get_cookie()."},
+ {getline, CookieString},
+ {putline,[7]},
+ {sleep,timeout(short)},
+ {putline,""},
+ {getline," -->"},
+ {putline,"r "++MyNode},
+ {putline,"c"},
+ {putline_raw,""},
+ {getline,"Eshell"},
+ {sleep,timeout(short)},
+ {putline_raw,""},
+ {getline,"("++MyNode++")1>"},
+ {putline,"whereis(kalaskula)."},
+ {getline,PidStr},
+ {sleep,timeout(short)}, % Race, known bug.
+ {putline_raw,"exit()."},
+ {getline,"***"},
+ {putline,[7]},
+ {putline,""},
+ {getline," -->"},
+ {putline,"c 1"},
+ {putline,""},
+ {sleep,timeout(short)},
+ {putline_raw,""},
+ {getline,"("++RNode++")"}],RNode),
+ ?line Pid ! die,
+ ?line Res
+ end.
+job_control_remote_noshell(suite) -> [];
+job_control_remote_noshell(doc) ->
+ [ "Tests that remote shell can be "
+ "started by means of job control to -noshell node" ];
+job_control_remote_noshell(Config) when is_list(Config) ->
+ case node() of
+ nonode@nohost ->
+ ?line exit(not_distributed);
+ _ ->
+ ?line RNode = create_nodename(),
+ ?line NSNode = start_noshell_node(interactive_shell_noshell),
+ ?line Pid = spawn_link(NSNode, fun() ->
+ receive die ->
+ ok
+ end
+ end),
+ ?line PidStr = rpc:call(NSNode,erlang,pid_to_list,[Pid]),
+ ?line true = rpc:call(NSNode,erlang,register,[kalaskula,Pid]),
+ ?line NSNodeStr = atom_to_list(NSNode),
+ ?line CookieString = lists:flatten(
+ io_lib:format("~w",
+ [erlang:get_cookie()])),
+ ?line Res = rtnode([{putline,""},
+ {putline, "erlang:get_cookie()."},
+ {getline, CookieString},
+ {putline,[7]},
+ {sleep,timeout(short)},
+ {putline,""},
+ {getline," -->"},
+ {putline,"r "++NSNodeStr},
+ {putline,"c"},
+ {putline_raw,""},
+ {getline,"Eshell"},
+ {sleep,timeout(short)},
+ {putline_raw,""},
+ {getline,"("++NSNodeStr++")1>"},
+ {putline,"whereis(kalaskula)."},
+ {getline,PidStr},
+ {sleep,timeout(short)}, % Race, known bug.
+ {putline_raw,"exit()."},
+ {getline,"***"},
+ {putline,[7]},
+ {putline,""},
+ {getline," -->"},
+ {putline,"c 1"},
+ {putline,""},
+ {sleep,timeout(short)},
+ {putline_raw,""},
+ {getline,"("++RNode++")"}],RNode),
+ ?line Pid ! die,
+ ?line stop_noshell_node(NSNode),
+ ?line Res
+ end.
+
+rtnode(C,N) ->
+ rtnode(C,N,[]).
+rtnode(Commands,Nodename,ErlPrefix) ->
+ ?line case get_progs() of
+ {error,_Reason} ->
+ ?line {skip,"No runerl present"};
+ {RunErl,ToErl,Erl} ->
+ ?line case create_tempdir() of
+ {error, Reason2} ->
+ ?line {skip, Reason2};
+ Tempdir ->
+ ?line SPid =
+ start_runerl_node(RunErl,ErlPrefix++Erl,
+ Tempdir,Nodename),
+ ?line CPid = start_toerl_server(ToErl,Tempdir),
+ ?line erase(getline_skipped),
+ ?line Res =
+ (catch get_and_put(CPid, Commands,1)),
+ ?line case stop_runerl_node(CPid) of
+ {error,_} ->
+ ?line CPid2 =
+ start_toerl_server
+ (ToErl,Tempdir),
+ ?line erase(getline_skipped),
+ ?line ok = get_and_put
+ (CPid2,
+ [{putline,[7]},
+ {sleep,
+ timeout(short)},
+ {putline,""},
+ {getline," -->"},
+ {putline,"s"},
+ {putline,"c"},
+ {putline,""}],1),
+ ?line stop_runerl_node(CPid2);
+ _ ->
+ ?line ok
+ end,
+ ?line wait_for_runerl_server(SPid),
+ ?line ok = rm_rf(Tempdir),
+ ?line ok = Res
+ end
+ end.
+
+timeout(long) ->
+ 2 * timeout(normal);
+timeout(short) ->
+ timeout(normal) div 10;
+timeout(normal) ->
+ 10000 * test_server:timetrap_scale_factor().
+
+
+start_noshell_node(Name) ->
+ PADir = filename:dirname(code:which(?MODULE)),
+ {ok, Node} = test_server:start_node(Name,slave,[{args," -noshell -pa "++
+ PADir++" "}]),
+ Node.
+stop_noshell_node(Node) ->
+ test_server:stop_node(Node).
+
+
+rm_rf(Dir) ->
+ try
+ {ok,List} = file:list_dir(Dir),
+ Files = [filename:join([Dir,X]) || X <- List],
+ [case file:list_dir(Y) of
+ {error, enotdir} ->
+ ok = file:delete(Y);
+ _ ->
+ ok = rm_rf(Y)
+ end || Y <- Files],
+ ok = file:del_dir(Dir),
+ ok
+ catch
+ _:Exception -> {error, {Exception,Dir}}
+ end.
+
+
+get_and_put(_CPid,[],_) ->
+ ok;
+get_and_put(CPid, [{sleep, X}|T],N) ->
+ ?dbg({sleep, X}),
+ receive
+ after X ->
+ get_and_put(CPid,T,N+1)
+ end;
+get_and_put(CPid, [{getline, Match}|T],N) ->
+ ?dbg({getline, Match}),
+ CPid ! {self(), {get_line, timeout(normal)}},
+ receive
+ {get_line, timeout} ->
+ error_logger:error_msg("~p: getline timeout waiting for \"~s\" "
+ "(command number ~p, skipped: ~p)~n",
+ [?MODULE, Match,N,get(getline_skipped)]),
+ {error, timeout};
+ {get_line, Data} ->
+ ?dbg({data,Data}),
+ case lists:prefix(Match, Data) of
+ true ->
+ erase(getline_skipped),
+ get_and_put(CPid, T,N+1);
+ false ->
+ case get(getline_skipped) of
+ undefined ->
+ put(getline_skipped,[Data]);
+ List ->
+ put(getline_skipped,List ++ [Data])
+ end,
+ get_and_put(CPid, [{getline, Match}|T],N)
+ end
+ end;
+
+get_and_put(CPid, [{putline_raw, Line}|T],N) ->
+ ?dbg({putline_raw, Line}),
+ CPid ! {self(), {send_line, Line}},
+ Timeout = timeout(normal),
+ receive
+ {send_line, ok} ->
+ get_and_put(CPid, T,N+1)
+ after Timeout ->
+ error_logger:error_msg("~p: putline_raw timeout (~p) sending "
+ "\"~s\" (command number ~p)~n",
+ [?MODULE, Timeout, Line, N]),
+ {error, timeout}
+ end;
+
+get_and_put(CPid, [{putline, Line}|T],N) ->
+ ?dbg({putline, Line}),
+ CPid ! {self(), {send_line, Line}},
+ Timeout = timeout(normal),
+ receive
+ {send_line, ok} ->
+ get_and_put(CPid, [{getline, []}|T],N)
+ after Timeout ->
+ error_logger:error_msg("~p: putline timeout (~p) sending "
+ "\"~s\" (command number ~p)~n[~p]~n",
+ [?MODULE, Timeout, Line, N,get()]),
+ {error, timeout}
+ end.
+
+wait_for_runerl_server(SPid) ->
+ Ref = erlang:monitor(process, SPid),
+ Timeout = timeout(long),
+ receive
+ {'DOWN', Ref, process, SPid, _} ->
+ ok
+ after Timeout ->
+ {error, timeout}
+ end.
+
+
+
+stop_runerl_node(CPid) ->
+ Ref = erlang:monitor(process, CPid),
+ CPid ! {self(), kill_emulator},
+ Timeout = timeout(long),
+ receive
+ {'DOWN', Ref, process, CPid, noproc} ->
+ ok;
+ {'DOWN', Ref, process, CPid, normal} ->
+ ok;
+ {'DOWN', Ref, process, CPid, {error, Reason}} ->
+ {error, Reason}
+ after Timeout ->
+ {error, timeout}
+ end.
+
+get_progs() ->
+ case os:type() of
+ {unix,freebsd} ->
+ {error,"cant use run_erl on freebsd"};
+ {unix,openbsd} ->
+ {error,"cant use run_erl on openbsd"};
+ {unix,_} ->
+ case os:find_executable("run_erl") of
+ RE when is_list(RE) ->
+ case os:find_executable("to_erl") of
+ TE when is_list(TE) ->
+ case os:find_executable("erl") of
+ E when is_list(E) ->
+ {RE,TE,E};
+ _ ->
+ {error, "Could not find erl command"}
+ end;
+ _ ->
+ {error, "Could not find to_erl command"}
+ end;
+ _ ->
+ {error, "Could not find run_erl command"}
+ end;
+ _ ->
+ {error, "Not a unix OS"}
+ end.
+
+create_tempdir() ->
+ create_tempdir(filename:join(["/tmp","rtnode"++os:getpid()]),$A).
+
+create_tempdir(Dir,X) when X > $Z, X < $a ->
+ create_tempdir(Dir,$a);
+create_tempdir(Dir,X) when X > $z ->
+ Estr = lists:flatten(
+ io_lib:format("Unable to create ~s, reason eexist",
+ [Dir++[$z]])),
+ {error, Estr};
+create_tempdir(Dir0, Ch) ->
+ % Expect fairly standard unix.
+ Dir = Dir0++[Ch],
+ case file:make_dir(Dir) of
+ {error, eexist} ->
+ create_tempdir(Dir0, Ch+1);
+ {error, Reason} ->
+ Estr = lists:flatten(
+ io_lib:format("Unable to create ~s, reason ~p",
+ [Dir,Reason])),
+ {error,Estr};
+ ok ->
+ Dir
+ end.
+
+create_nodename() ->
+ create_nodename($A).
+
+create_nodename(X) when X > $Z, X < $a ->
+ create_nodename($a);
+create_nodename(X) when X > $z ->
+ {error,out_of_nodenames};
+create_nodename(X) ->
+ NN = "rtnode"++os:getpid()++[X],
+ case file:read_file_info(filename:join(["/tmp",NN])) of
+ {error,enoent} ->
+ Host = lists:nth(2,string:tokens(atom_to_list(node()),"@")),
+ NN++"@"++Host;
+ _ ->
+ create_nodename(X+1)
+ end.
+
+
+start_runerl_node(RunErl,Erl,Tempdir,Nodename) ->
+ XArg = case Nodename of
+ [] ->
+ [];
+ _ ->
+ " -sname "++(if is_atom(Nodename) -> atom_to_list(Nodename);
+ true -> Nodename
+ end)++
+ " -setcookie "++atom_to_list(erlang:get_cookie())
+ end,
+ spawn(fun() ->
+ os:cmd(RunErl++" "++Tempdir++"/ "++Tempdir++" \""++
+ Erl++XArg++"\"")
+ end).
+
+start_toerl_server(ToErl,Tempdir) ->
+ Pid = spawn(?MODULE,toerl_server,[self(),ToErl,Tempdir]),
+ receive
+ {Pid,started} ->
+ Pid;
+ {Pid,error,Reason} ->
+ {error,Reason}
+ end.
+
+try_to_erl(_Command, 0) ->
+ {error, cannot_to_erl};
+try_to_erl(Command, N) ->
+ ?dbg({?LINE,N}),
+ Port = open_port({spawn, Command},[eof,{line,1000}]),
+ Timeout = timeout(normal) div 2,
+ receive
+ {Port, eof} ->
+ receive after Timeout ->
+ ok
+ end,
+ try_to_erl(Command, N-1)
+ after Timeout ->
+ ?dbg(Port),
+ Port
+ end.
+
+toerl_server(Parent,ToErl,Tempdir) ->
+ Port = try_to_erl(ToErl++" "++Tempdir++"/ 2>/dev/null",8),
+ case Port of
+ P when is_port(P) ->
+ Parent ! {self(),started};
+ {error,Other} ->
+ Parent ! {self(),error,Other},
+ exit(Other)
+ end,
+ case toerl_loop(Port,[]) of
+ normal ->
+ ok;
+ {error, Reason} ->
+ error_logger:error_msg("toerl_server exit with reason ~p~n",
+ [Reason]),
+ exit(Reason)
+ end.
+
+toerl_loop(Port,Acc) ->
+ ?dbg({toerl_loop, Port, Acc}),
+ receive
+ {Port,{data,{Tag0,Data}}} when is_port(Port) ->
+ ?dbg({?LINE,Port,{data,{Tag0,Data}}}),
+ case Acc of
+ [{noeol,Data0}|T0] ->
+ toerl_loop(Port,[{Tag0, Data0++Data}|T0]);
+ _ ->
+ toerl_loop(Port,[{Tag0,Data}|Acc])
+ end;
+ {Pid,{get_line,Timeout}} ->
+ case Acc of
+ [] ->
+ case get_data_within(Port,Timeout,[]) of
+ timeout ->
+ Pid ! {get_line, timeout},
+ toerl_loop(Port,[]);
+ {noeol,Data1} ->
+ Pid ! {get_line, timeout},
+ toerl_loop(Port,[{noeol,Data1}]);
+ {eol,Data2} ->
+ Pid ! {get_line, Data2},
+ toerl_loop(Port,[])
+ end;
+ [{noeol,Data3}] ->
+ case get_data_within(Port,Timeout,Data3) of
+ timeout ->
+ Pid ! {get_line, timeout},
+ toerl_loop(Port,Acc);
+ {noeol,Data4} ->
+ Pid ! {get_line, timeout},
+ toerl_loop(Port,[{noeol,Data4}]);
+ {eol,Data5} ->
+ Pid ! {get_line, Data5},
+ toerl_loop(Port,[])
+ end;
+ List ->
+ {NewAcc,[{eol,Data6}]} = lists:split(length(List)-1,List),
+ Pid ! {get_line,Data6},
+ toerl_loop(Port,NewAcc)
+ end;
+ {Pid, {send_line, Data7}} ->
+ Port ! {self(),{command, Data7++"\n"}},
+ Pid ! {send_line, ok},
+ toerl_loop(Port,Acc);
+ {_Pid, kill_emulator} ->
+ Port ! {self(),{command, "init:stop().\n"}},
+ Timeout1 = timeout(long),
+ receive
+ {Port,eof} ->
+ normal
+ after Timeout1 ->
+ {error, kill_timeout}
+ end;
+ {Port, eof} ->
+ {error, unexpected_eof};
+ Other ->
+ {error, {unexpected, Other}}
+ end.
+
+millistamp() ->
+ {Mega, Secs, Micros} = erlang:now(),
+ (Micros div 1000) + Secs * 1000 + Mega * 1000000000.
+
+get_data_within(Port, X, Acc) when X =< 0 ->
+ ?dbg({get_data_within, X, Acc, ?LINE}),
+ receive
+ {Port,{data,{Tag0,Data}}} ->
+ ?dbg({?LINE,Port,{data,{Tag0,Data}}}),
+ {Tag0, Acc++Data}
+ after 0 ->
+ case Acc of
+ [] ->
+ timeout;
+ Noeol ->
+ {noeol,Noeol}
+ end
+ end;
+
+
+get_data_within(Port, Timeout, Acc) ->
+ ?dbg({get_data_within, Timeout, Acc, ?LINE}),
+ T1 = millistamp(),
+ receive
+ {Port,{data,{noeol,Data}}} ->
+ ?dbg({?LINE,Port,{data,{noeol,Data}}}),
+ Elapsed = millistamp() - T1 + 1,
+ get_data_within(Port, Timeout - Elapsed, Acc ++ Data);
+ {Port,{data,{eol,Data1}}} ->
+ ?dbg({?LINE,Port,{data,{eol,Data1}}}),
+ {eol, Acc ++ Data1}
+ after Timeout ->
+ timeout
+ end.
+
+
+
+
diff --git a/lib/kernel/test/kernel.cover b/lib/kernel/test/kernel.cover
new file mode 100644
index 0000000000..228dafc565
--- /dev/null
+++ b/lib/kernel/test/kernel.cover
@@ -0,0 +1,4 @@
+%% -*- erlang -*-
+{exclude,all}.
+{include,[gen_udp,inet6_udp,inet_res,inet_dns]}.
+
diff --git a/lib/kernel/test/kernel.dynspec b/lib/kernel/test/kernel.dynspec
new file mode 100644
index 0000000000..297a7c71ea
--- /dev/null
+++ b/lib/kernel/test/kernel.dynspec
@@ -0,0 +1,57 @@
+%% -*- erlang -*-
+%% You can test this file using this command.
+%% file:script("kernel.dynspec", [{'Os',"Unix"}]).
+
+case Os of
+ "VxWorks" ->
+ FsCantHandle = "VxWorks filesystem can't handle this",
+ FsOverload = "VxWorks filesystem would overload",
+ CantHandle = "VxWorks can't handle this",
+ SlaveMisadaption = "Test not adopted to slaves on different machine",
+ [{skip,{application_SUITE,
+ "VxWorks: requires manual testing "++
+ "(requires multiple nodes (OTP-1774))"}},
+ {skip,{bif_SUITE, spawn_link_race1, "Known bug."}},
+ {skip,{erl_distribution_SUITE, "VxWorks: More vx nodes needed"}},
+ {skip,{file_SUITE,read_write_file,FsCantHandle}},
+ {skip,{file_SUITE,cur_dir_0,FsCantHandle}},
+ {skip,{file_SUITE,open1,FsCantHandle}},
+ {skip,{file_SUITE,file_info_times,FsCantHandle}},
+ {skip,{file_SUITE,file_write_file_info,FsCantHandle}},
+ {skip,{file_SUITE,truncate,FsCantHandle}},
+ {skip,{file_SUITE,rename,FsCantHandle}},
+ {skip,{file_SUITE,e_delete,FsCantHandle}},
+ {skip,{file_SUITE,e_rename,FsCantHandle}},
+ {skip,{file_SUITE,delayed_write,FsCantHandle}},
+ {skip,{file_SUITE,read_ahead,FsCantHandle}},
+ {skip,{file_SUITE,segment_write,FsOverload}},
+ {skip,{file_SUITE,segment_read,FsOverload}},
+ {skip,{file_SUITE,compress_errors,FsCantHandle}},
+ {skip,{global_SUITE,
+ "To heavy on slavenodes for VxWorks (and more)."}},
+ {skip,{global_group_SUITE, "To heavy on slavenodes for VxWorks."}},
+ {skip,{heart_SUITE, "Not for VxWorks heart, it's special"}},
+ {skip,{init_SUITE,restart,"Uses peer nodes"}},
+ {skip,{kernel_config_SUITE, "VxWorks does not support slave nodes"}},
+ {skip,{os_SUITE,space_in_cwd,CantHandle}},
+ {skip,{os_SUITE,space_in_name,CantHandle}},
+ {skip,{os_SUITE,quoting,CantHandle}},
+ {skip,{prim_file_SUITE,open1,FsCantHandle}},
+ {skip,{prim_file_SUITE,compress_errors,FsCantHandle}},
+ {skip,{seq_trace_SUITE,distributed_recv,SlaveMisadaption}},
+ {skip,{seq_trace_SUITE,distributed_exit,SlaveMisadaption}}];
+ _ ->
+ []
+end ++
+try gen_sctp:open() of
+ {ok,Socket} ->
+ gen_sctp:close(Socket),
+ [];
+ _ ->
+ []
+catch
+ error:badarg ->
+ [{skip,{gen_sctp_SUITE,"SCTP not supported on this machine"}}];
+ _:_ ->
+ []
+end.
diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl
new file mode 100644
index 0000000000..225bc38b05
--- /dev/null
+++ b/lib/kernel/test/kernel_SUITE.erl
@@ -0,0 +1,61 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%----------------------------------------------------------------
+%%% Kernel application test suite.
+%%%-----------------------------------------------------------------
+-module(kernel_SUITE).
+-include("test_server.hrl").
+
+
+% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+% Test server specific exports
+-export([all/1]).
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+% Test cases must be exported.
+-export([app_test/1]).
+
+%%
+%% all/1
+%%
+all(doc) ->
+ [];
+all(suite) ->
+ [app_test].
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog=test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+fin_per_testcase(_Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+%
+% Test cases starts here.
+%
+app_test(doc) ->
+ ["Tests the applications consistency."];
+app_test(suite) ->
+ [];
+app_test(Config) when list(Config) ->
+ ?line ok=?t:app_test(kernel),
+ ok.
diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl
new file mode 100644
index 0000000000..6b7d788e60
--- /dev/null
+++ b/lib/kernel/test/kernel_config_SUITE.erl
@@ -0,0 +1,107 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(kernel_config_SUITE).
+
+-include("test_server.hrl").
+
+-export([all/1, sync/1]).
+
+-export([init/1, fini/1]).
+
+all(suite) ->
+ [{conf, init, [sync], fini}].
+
+init(doc) -> [];
+init(suite) -> [];
+init(Config) when is_list(Config) ->
+ Config.
+
+fini(doc) -> [];
+fini(suite) -> [];
+fini(Config) when is_list(Config) ->
+ stop_node(init_test),
+ Config.
+
+config(Fd) ->
+ M = from($@, atom_to_list(node())),
+ io:format(Fd, "[{kernel, [{sync_nodes_optional, ['cp1@~s','cp2@~s']},"
+ "{sync_nodes_timeout, 15000}]}].~n",
+ [M, M]).
+
+from(H, [H | T]) -> T;
+from(H, [_ | T]) -> from(H, T);
+from(_, []) -> [].
+
+%%-----------------------------------------------------------------
+%% Test suite for sync_nodes. This is quite tricky.
+%%
+%% Should be started in a CC view with:
+%% erl -sname XXX where XX not in [cp1, cp2]
+%%-----------------------------------------------------------------
+sync(doc) -> [];
+sync(suite) -> [];
+sync(Conf) when list(Conf) ->
+ ?line Dog = ?t:timetrap(?t:seconds(120)),
+ % Write a config file
+ Dir = ?config(priv_dir,Conf),
+ {ok, Fd} = file:open(Dir ++ "sys.config", [write]),
+ config(Fd),
+ file:close(Fd),
+ Config = Dir ++ "sys",
+
+ %% Reset wall_clock
+ {T1,_} = erlang:statistics(wall_clock),
+ io:format("~p~n", [{t1, T1}]),
+ ?line Command = lists:concat([lib:progname(),
+ " -detached -sname cp1 ",
+ "-config ", Config,
+ " -env ERL_CRASH_DUMP erl_crash_dump.cp1"]),
+ io:format("Command: ~s", [Command]),
+ ?line open_port({spawn, Command}, [stream]),
+ io:format("started~n"),
+ ?line ?t:sleep(12000),
+ io:format("waited12~n"),
+ ?line Host = from($@, atom_to_list(node())),
+ ?line Cp1 = list_to_atom("cp1@"++Host),
+ ?line wait_for_node(Cp1),
+ io:format("waitednode~n"),
+ %% Check time since last call
+ ?line {TT, T} = erlang:statistics(wall_clock),
+ io:format("~p~n", [{t2, {TT, T}}]),
+ ?line stop_node(cp1),
+ if
+ TT-T1 < 15000 -> ?line ?t:fail({too_short_time, TT-T1});
+ true -> ok
+ end,
+ ?line ?t:timetrap_cancel(Dog),
+ ok.
+
+wait_for_node(Node) ->
+ case rpc:call(Node, init, get_status, []) of
+ {started,_} -> ok;
+ {badrpc, R} -> ?line ?t:fail({rpc_failed, R});
+ _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, []).
diff --git a/lib/kernel/test/loose_node.erl b/lib/kernel/test/loose_node.erl
new file mode 100644
index 0000000000..ac1ddb8d9a
--- /dev/null
+++ b/lib/kernel/test/loose_node.erl
@@ -0,0 +1,193 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%-------------------------------------------------------------------
+%%% File : loose_node.erl
+%%% Author : Rickard Green <[email protected]>
+%%% Description : Creation of nodes which are not supervised by
+%%% the test_server. Currently needed by init_SUITE
+%%% and heart_SUITE (until the test_server can
+%%% handle node restart).
+%%%
+%%% Created : 22 Sep 2004 by Rickard Green <[email protected]>
+%%%-------------------------------------------------------------------
+-module(loose_node).
+-author('[email protected]').
+
+%%
+%% Exports
+%%
+-export([start/3, start/2, stop/1]).
+
+%%
+%% Internal exports
+%%
+-export([loose_node_started/1]).
+
+%%
+%% Exported functions for internal use.
+%%
+
+%%
+%% Defines
+%%
+-define(L2A, list_to_atom).
+-define(A2L, atom_to_list).
+-define(I2L, integer_to_list).
+
+%%
+%% Exported functions.
+%%
+
+stop(Node) when atom(Node) ->
+ rpc:cast(Node, erlang, halt, []),
+ io:format("Stopped loose node ~p~n", [Node]),
+ ok.
+
+start(Name, Args) ->
+ start(Name, Args, -1).
+
+start(Name, Args, TimeOut) when atom(Name) ->
+ start(atom_to_list(Name), Args, TimeOut);
+start(Name, Args, TimeOut) when list(Name), list(Args), integer(TimeOut) ->
+ Parent = self(),
+ Ref = make_ref(),
+ Starter
+ = fun () ->
+ Erl = case init:get_argument(progname) of
+ {ok,[[Prog]]} ->
+ Prog;
+ _ ->
+ "erl"
+ end,
+ RegName = until_success(fun () ->
+ {A, B, C} = now(),
+ Reg =
+ ?L2A(?A2L(?MODULE)
+ ++ "-" ++ ?I2L(A)
+ ++ "-" ++ ?I2L(B)
+ ++ "-" ++ ?I2L(C)),
+ true = register(Reg, self()),
+ Reg
+ end),
+ NameCmd = case net_kernel:longnames() of
+ true -> " -name " ++ Name;
+ false -> " -sname " ++ Name
+ end,
+ Cookie = " -setcookie " ++ atom_to_list(auth:get_cookie()),
+ Pa = " -pa " ++ filename:dirname(code:which(?MODULE)),
+ ThisNode = node(),
+ NodeStarted
+ = " -run "
+ ++ atom_to_list(?MODULE)
+ ++ " loose_node_started "
+ ++ atom_to_list(RegName)
+ ++ " "
+ ++ atom_to_list(ThisNode)
+ ++ " "
+ ++ integer_to_list(TimeOut),
+ CrashDump =
+ " -env ERL_CRASH_DUMP"
+ ++ " erl_crash.dump.loose_node."
+ ++ Name,
+ Cmd =
+ Erl
+ ++ " -detached"
+ ++ NameCmd
+ ++ Cookie
+ ++ Pa
+ ++ NodeStarted
+ ++ CrashDump
+ ++ " "
+ ++ Args,
+ io:format("Trying to start loose node...~n"
+ " --> ~p~n", [Cmd]),
+ Res = case open_port({spawn, Cmd}, []) of
+ P when port(P) ->
+ receive
+ {loose_node_started,
+ Node,
+ {RegName, ThisNode}} ->
+ io:format("Loose node ~p started.~n",
+ [Node]),
+ {ok, Node}
+ after 10000 ->
+ io:format("Start of loose node ~p "
+ "timed out.", [Name]),
+ {error, timeout}
+ end;
+ _ ->
+ io:format("Start of loose node ~p failed.",
+ [Name]),
+ {error, open_port_failed}
+ end,
+ Parent ! {Ref, Res}
+ end,
+ spawn_opt(Starter, [link, {priority, max}]),
+ receive
+ {Ref, Result} ->
+ Result
+ end.
+
+
+%%
+%% Exported functions for internal use.
+%%
+
+loose_node_started([Name, Node, TimeOutSecs]) when list(Name),
+ list(Node),
+ list(TimeOutSecs) ->
+ spawn_opt(fun () ->
+ process_flag(trap_exit, true),
+ Proc = {list_to_atom(Name), list_to_atom(Node)},
+ Timeout = case catch list_to_integer(TimeOutSecs) of
+ I when integer(I), I >= 0 -> I*1000;
+ _ -> infinity
+ end,
+ wait_until(fun () -> is_alive() end),
+ Proc ! {loose_node_started, node(), Proc},
+ receive
+ after Timeout ->
+ timeout
+ end,
+ erlang:halt("Loose node timeout")
+ end,
+ [{priority, max}]),
+ ok.
+
+%%
+%% Internal functions.
+%%
+
+until_success(Fun) ->
+ case catch Fun() of
+ {'EXIT', _} -> until_success(Fun);
+ Res -> Res
+ end.
+
+wait_until(Fun) ->
+ case Fun() of
+ true -> true;
+ _ ->
+ receive
+ after 100 ->
+ wait_until(Fun)
+ end
+ end.
+
diff --git a/lib/kernel/test/myApp.app b/lib/kernel/test/myApp.app
new file mode 100644
index 0000000000..62959545e3
--- /dev/null
+++ b/lib/kernel/test/myApp.app
@@ -0,0 +1,7 @@
+ {application, myApp,
+ [{description, "Test of start phase"},
+ {id, "CXC 138 38"},
+ {applications, [kernel]},
+ {included_applications, []},
+ {start_phases, [{init, [initArgs]}, {go, [goArgs]}]},
+ {mod, {myApp, {myApp, 1, 3}} }]}.
diff --git a/lib/kernel/test/myApp.erl b/lib/kernel/test/myApp.erl
new file mode 100644
index 0000000000..2b92046141
--- /dev/null
+++ b/lib/kernel/test/myApp.erl
@@ -0,0 +1,48 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(myApp).
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2, stop/1, start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, {_AppN, Low, High}) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok,P} = supervisor:start_link({local, Name}, ch_sup,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) -> ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl
new file mode 100644
index 0000000000..667f267079
--- /dev/null
+++ b/lib/kernel/test/os_SUITE.erl
@@ -0,0 +1,212 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(os_SUITE).
+
+-export([all/1]).
+-export([space_in_cwd/1, quoting/1, space_in_name/1, bad_command/1,
+ find_executable/1, unix_comment_in_command/1]).
+
+-include("test_server.hrl").
+
+all(suite) ->
+ [space_in_cwd, quoting, space_in_name, bad_command, find_executable,
+ unix_comment_in_command].
+
+space_in_cwd(doc) ->
+ "Test that executing a command in a current working directory "
+ "with space in its name works.";
+space_in_cwd(suite) -> [];
+space_in_cwd(Config) when list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Dirname = filename:join(PrivDir, "cwd with space"),
+ ?line ok = file:make_dir(Dirname),
+ ?line ok = file:set_cwd(Dirname),
+
+ %% Using `more' gives the almost the same result on both Unix and Windows.
+
+ Cmd = case os:type() of
+ {win32, _} ->
+ "more";
+ {unix, _} ->
+ "more </dev/null"
+ end,
+
+ ?line case os:cmd(Cmd) of
+ [] -> ok; % Unix.
+ "\r\n" -> ok; % Windows.
+ Other ->
+ ?line test_server:fail({unexpected, Other})
+ end,
+
+ ?t:sleep(5),
+ ?line [] = receive_all(),
+ ok.
+
+quoting(doc) -> "Test that various ways of quoting arguments work.";
+quoting(suite) -> [];
+quoting(Config) when list(Config) ->
+ ?line DataDir = ?config(data_dir, Config),
+ ?line Echo = filename:join(DataDir, "my_echo"),
+
+ ?line comp("one", os:cmd(Echo ++ " one")),
+ ?line comp("one::two", os:cmd(Echo ++ " one two")),
+ ?line comp("one two", os:cmd(Echo ++ " \"one two\"")),
+ ?line comp("x::one two::y", os:cmd(Echo ++ " x \"one two\" y")),
+ ?line comp("x::one two", os:cmd(Echo ++ " x \"one two\"")),
+ ?line comp("one two::y", os:cmd(Echo ++ " \"one two\" y")),
+ ?line comp("x::::y", os:cmd(Echo ++ " x \"\" y")),
+ ?t:sleep(5),
+ ?line [] = receive_all(),
+ ok.
+
+space_in_name(doc) ->
+ "Test that program with a space in its name can be executed.";
+space_in_name(suite) -> [];
+space_in_name(Config) when list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line DataDir = ?config(data_dir, Config),
+ ?line Spacedir = filename:join(PrivDir, "program files"),
+ Ext = case os:type() of
+ {win32,_} -> ".exe";
+ _ -> ""
+ end,
+ ?line OrigEcho = filename:join(DataDir, "my_echo" ++ Ext),
+ ?line Echo0 = filename:join(Spacedir, "my_echo" ++ Ext),
+
+ %% Copy the `my_echo' program to a directory whose name contains a space.
+
+ ?line ok = file:make_dir(Spacedir),
+ ?line {ok, Bin} = file:read_file(OrigEcho),
+ ?line ok = file:write_file(Echo0, Bin),
+ ?line Echo = filename:nativename(Echo0),
+ ?line ok = file:change_mode(Echo, 8#777), % Make it executable on Unix.
+
+ %% Run the echo program.
+
+ ?line comp("", os:cmd("\"" ++ Echo ++ "\"")),
+ ?line comp("a::b::c", os:cmd("\"" ++ Echo ++ "\" a b c")),
+ ?t:sleep(5),
+ ?line [] = receive_all(),
+ ok.
+
+bad_command(doc) ->
+ "Check that a bad command doesn't crasch the server or the emulator (it used to).";
+bad_command(suite) -> [];
+bad_command(Config) when list(Config) ->
+ ?line catch os:cmd([a|b]),
+ ?line catch os:cmd({bad, thing}),
+
+ %% This should at least not crash (on Unix it typically returns
+ %% a message from the shell).
+ ?line os:cmd("xxxxx"),
+
+ ok.
+
+find_executable(suite) -> [];
+find_executable(doc) -> [];
+find_executable(Config) when list(Config) ->
+ case os:type() of
+ {win32, _} ->
+ ?line DataDir = filename:join(?config(data_dir, Config), "win32"),
+ ?line ok = file:set_cwd(filename:join([DataDir, "current"])),
+ ?line Bin = filename:join(DataDir, "bin"),
+ ?line Abin = filename:join(DataDir, "abin"),
+ ?line UsrBin = filename:join([DataDir, "usr", "bin"]),
+ ?line {ok, Current} = file:get_cwd(),
+
+ ?line Path = lists:concat([Bin, ";", Abin, ";", UsrBin]),
+ ?line io:format("Path = ~s", [Path]),
+
+ %% Search for programs in Bin (second element in PATH).
+ ?line find_exe(Abin, "my_ar", ".exe", Path),
+ ?line find_exe(Abin, "my_ascii", ".com", Path),
+ ?line find_exe(Abin, "my_adb", ".bat", Path),
+
+ %% Search for programs in Abin (second element in PATH).
+ ?line find_exe(Abin, "my_ar", ".exe", Path),
+ ?line find_exe(Abin, "my_ascii", ".com", Path),
+ ?line find_exe(Abin, "my_adb", ".bat", Path),
+
+ %% Search for programs in the current working directory.
+ ?line find_exe(Current, "my_program", ".exe", Path),
+ ?line find_exe(Current, "my_command", ".com", Path),
+ ?line find_exe(Current, "my_batch", ".bat", Path),
+ ok;
+ {unix, _} ->
+ ok;
+ vxworks ->
+ ok
+ end.
+
+find_exe(Where, Name, Ext, Path) ->
+ Expected = filename:join(Where, Name++Ext),
+ case os:find_executable(Name, Path) of
+ Expected ->
+ ok;
+ Name when list(Name) ->
+ case filename:absname(Name) of
+ Expected ->
+ ok;
+ Other ->
+ io:format("Expected ~p; got (converted to absolute) ~p",
+ [Expected, Other]),
+ test_server:fail()
+ end;
+ Other ->
+ io:format("Expected ~p; got ~p", [Expected, Other]),
+ test_server:fail()
+ end.
+
+unix_comment_in_command(doc) ->
+ "OTP-1805: Test that os:cmd(\"ls #\") works correctly (used to hang).";
+unix_comment_in_command(suite) -> [];
+unix_comment_in_command(Config) when list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(20)),
+ ?line Priv = ?config(priv_dir, Config),
+ ?line ok = file:set_cwd(Priv),
+ ?line _ = os:cmd("ls #"), % Any result is ok.
+ ?t:sleep(5),
+ ?line [] = receive_all(),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+comp(Expected, Got) ->
+ case strip_nl(Got) of
+ Expected ->
+ ok;
+ Other ->
+ ok = io:format("Expected: ~s\n", [Expected]),
+ ok = io:format("Got: ~s\n", [Other]),
+ test_server:fail()
+ end.
+
+%% Like lib:nonl/1, but strips \r as well as \n.
+
+strip_nl([$\r, $\n]) -> [];
+strip_nl([$\n]) -> [];
+strip_nl([H|T]) -> [H|strip_nl(T)];
+strip_nl([]) -> [].
+
+receive_all() ->
+ receive
+ X -> [X|receive_all()]
+ after 0 -> []
+ end.
+
diff --git a/lib/kernel/test/os_SUITE_data/Makefile.src b/lib/kernel/test/os_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..912d0cbcb1
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/Makefile.src
@@ -0,0 +1,14 @@
+CC = @CC@
+LD = @LD@
+CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@
+CROSSLDFLAGS = @CROSSLDFLAGS@
+
+PROGS = my_echo@exe@
+
+all: $(PROGS)
+
+my_echo@exe@: my_echo@obj@
+ $(LD) $(CROSSLDFLAGS) -o my_echo my_echo@obj@ @LIBS@
+
+my_echo@obj@: my_echo.c
+ $(CC) -c -o my_echo@obj@ $(CFLAGS) my_echo.c
diff --git a/lib/kernel/test/os_SUITE_data/my_echo.c b/lib/kernel/test/os_SUITE_data/my_echo.c
new file mode 100644
index 0000000000..2127511dd1
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/my_echo.c
@@ -0,0 +1,19 @@
+#include <stdio.h>
+
+int
+main(int argc, char** argv)
+{
+ char* sep = "";
+
+ /*
+ * Echo all arguments separated with '::', so that we can check that
+ * quotes are interpreted correctly.
+ */
+
+ while (argc-- > 1) {
+ printf("%s%s", sep, argv++[1]);
+ sep = "::";
+ }
+ putchar('\n');
+ return 0;
+}
diff --git a/lib/kernel/test/os_SUITE_data/unix/.gitignore b/lib/kernel/test/os_SUITE_data/unix/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/unix/.gitignore
diff --git a/lib/kernel/test/os_SUITE_data/win32/abin/hello.exe b/lib/kernel/test/os_SUITE_data/win32/abin/hello.exe
new file mode 100755
index 0000000000..631d40ccaf
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/abin/hello.exe
Binary files differ
diff --git a/lib/kernel/test/os_SUITE_data/win32/abin/my_adb.bat b/lib/kernel/test/os_SUITE_data/win32/abin/my_adb.bat
new file mode 100644
index 0000000000..a633f83ea5
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/abin/my_adb.bat
@@ -0,0 +1,2 @@
+@echo off
+echo A real batch file.
diff --git a/lib/kernel/test/os_SUITE_data/win32/abin/my_ar.exe b/lib/kernel/test/os_SUITE_data/win32/abin/my_ar.exe
new file mode 100644
index 0000000000..49d0d254c0
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/abin/my_ar.exe
@@ -0,0 +1 @@
+Not really an EXE file.
diff --git a/lib/kernel/test/os_SUITE_data/win32/abin/my_ascii.com b/lib/kernel/test/os_SUITE_data/win32/abin/my_ascii.com
new file mode 100644
index 0000000000..7c7f5729d5
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/abin/my_ascii.com
Binary files differ
diff --git a/lib/kernel/test/os_SUITE_data/win32/bin/.gitignore b/lib/kernel/test/os_SUITE_data/win32/bin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/bin/.gitignore
diff --git a/lib/kernel/test/os_SUITE_data/win32/current/my_batch.bat b/lib/kernel/test/os_SUITE_data/win32/current/my_batch.bat
new file mode 100644
index 0000000000..a633f83ea5
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/current/my_batch.bat
@@ -0,0 +1,2 @@
+@echo off
+echo A real batch file.
diff --git a/lib/kernel/test/os_SUITE_data/win32/current/my_command.com b/lib/kernel/test/os_SUITE_data/win32/current/my_command.com
new file mode 100644
index 0000000000..847d9fe544
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/current/my_command.com
@@ -0,0 +1 @@
+Not a real COM file.
diff --git a/lib/kernel/test/os_SUITE_data/win32/current/my_program.exe b/lib/kernel/test/os_SUITE_data/win32/current/my_program.exe
new file mode 100644
index 0000000000..90bbf20b8b
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/current/my_program.exe
@@ -0,0 +1 @@
+Not a real EXE file.
diff --git a/lib/kernel/test/os_SUITE_data/win32/usr/bin/.gitignore b/lib/kernel/test/os_SUITE_data/win32/usr/bin/.gitignore
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/lib/kernel/test/os_SUITE_data/win32/usr/bin/.gitignore
diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl
new file mode 100644
index 0000000000..6aa434b614
--- /dev/null
+++ b/lib/kernel/test/pdict_SUITE.erl
@@ -0,0 +1,323 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(pdict_SUITE).
+%% NB: The ?line macro cannot be used when testing the dictionary.
+
+
+-include("test_server.hrl").
+
+-define(M(A,B),m(A,B,?MODULE,?LINE)).
+-ifdef(DEBUG).
+-define(DEBUGF(A,B), io:format(A,B)).
+-else.
+-define(DEBUGF(A,B), noop).
+-endif.
+
+-export([all/1,
+ simple/1, complicated/1, heavy/1, info/1]).
+-export([init_per_testcase/2, fin_per_testcase/2]).
+-export([other_process/2]).
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog = ?t:timetrap(test_server:minutes(10)),
+ [{watchdog, Dog} | Config].
+fin_per_testcase(_Case, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+all(suite) ->
+ [simple, complicated, heavy, info].
+
+simple(doc) ->
+ ["Tests simple functionality in process dictionary."];
+simple(suite) ->
+ [];
+simple(Config) when list(Config) ->
+ XX = get(),
+ erase(),
+ L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,
+ q,r,s,t,u,v,x,y,z,'A','B','C','D'],
+ ins_list_0(L),
+ ins_list_1(L),
+ L2 = lists:keysort(1, lists:map(fun(X) ->
+ {X, atom_to_list(X)}
+ end,
+ L)),
+ ?DEBUGF("~p~n",[L2]),
+ ?M(L2,lists:keysort(1, get())),
+ ins_list_2(L),
+ L3 = lists:keysort(1, lists:map(fun(X) ->
+ {hd(atom_to_list(X)) - $a,
+ atom_to_list(X)}
+ end,
+ L) ++ L2),
+ ?DEBUGF("~p~n",[L3]),
+ ?M(L3, lists:keysort(1, get())),
+ L4 = lists:map(fun(X) ->
+ lists:sort(get_keys(atom_to_list(X)))
+ end,
+ L),
+ ?DEBUGF("~p~n",[L4]),
+ ?M(L4,lists:map(fun(X) ->
+ lists:sort([X, hd(atom_to_list(X)) - $a])
+ end,
+ L)),
+ erase(),
+ ?M([],get()),
+ [put(Key, Value) || {Key,Value} <- XX],
+ ok.
+
+complicated(Config) when is_list(Config) ->
+ Previous = get(),
+ Previous = erase(),
+ N = case ?t:is_debug() of
+ false -> 500000;
+ true -> 5000
+ end,
+ comp_1(N),
+ comp_2(N),
+ N = comp_3(lists:sort(get()), 1),
+ comp_4(get()),
+ [] = get(),
+ [put(Key, Value) || {Key,Value} <- Previous],
+ ok.
+
+comp_1(0) -> ok;
+comp_1(N) ->
+ undefined = put({key,N}, {value,N}),
+ comp_1(N-1).
+
+comp_2(0) -> ok;
+comp_2(N) ->
+ {value,N} = put({key,N}, {value,N*N}),
+ comp_2(N-1).
+
+comp_3([{{key,K},{value,V}}], K) when V =:= K*K ->
+ K;
+comp_3([{{key,K},{value,V}}|T], K) when V =:= K*K ->
+ comp_3(T, K+1).
+
+comp_4([{{key,_}=K,{value,_}=Val}|T]) ->
+ Val = erase(K),
+ comp_4(T);
+comp_4([]) -> ok.
+
+heavy(doc) ->
+ ["Tests heavy usage of the process dictionary"];
+heavy(suite) ->
+ [];
+heavy(Config) when is_list(Config) ->
+ XX = get(),
+ erase(),
+ time(50),
+ ?M([],get()),
+ time(500),
+ ?M([],get()),
+ time(5000),
+ ?M([],get()),
+ case {os:type(),?t:is_debug()} of
+ {vxworks,_} -> ok;
+ {_,true} -> ok;
+ _ ->
+ time(50000),
+ ?M([], get())
+ end,
+ [put(Key, Value) || {Key,Value} <- XX],
+ ok.
+
+info(doc) ->
+ ["Tests process_info(Pid, dictionary)"];
+info(suite) ->
+ [];
+info(Config) when list(Config) ->
+ L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,
+ q,r,s,t,u,v,x,y,z,'A','B','C','D'],
+ process_flag(trap_exit,true),
+ Pid = spawn_link(?MODULE, other_process, [L,self()]),
+ Dict = receive
+ {Pid, D} ->
+ D
+ end,
+ ?M({dictionary, Dict}, process_info(Pid, dictionary)),
+ Pid ! bye,
+ receive
+ {'EXIT', Pid, _} ->
+ ok
+ end,
+ ok.
+
+other_process(List,From) ->
+ erase(),
+ ins_list_1(List),
+ From ! {self(), get()},
+ receive
+ bye ->
+ ok
+ end.
+
+ins_list_2([]) ->
+ done;
+ins_list_2([H|T]) ->
+ X = {hd(atom_to_list(H)) - $a, atom_to_list(H)},
+ _Y = put(element(1,X), element(2,X)),
+ ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
+ ins_list_2(T).
+
+ins_list_1([]) ->
+ done;
+ins_list_1([H|T]) ->
+ X = {H, atom_to_list(H)},
+ _Y = put(element(1,X), element(2,X)),
+ ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
+ ins_list_1(T).
+
+ins_list_0([]) ->
+ done;
+ins_list_0([H|T]) ->
+ X = {H, H},
+ _Y = put(element(1,X), element(2,X)),
+ ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]),
+ ins_list_0(T).
+
+time(N) ->
+ ?DEBUGF("~p~n",[erlang:process_info(self())]),
+ TT1 = erlang:now(),
+ T1 = insert_testloop(N,N,0),
+ TT2 = erlang:now(),
+ T2 = lookup_testloop(N,N,0),
+ TT3 = erlang:now(),
+ T5 = delete_testloop(N,N,0),
+ TT6 = erlang:now(),
+ io:format("~p inserts took ~.2f(~.2f) seconds~n",
+ [N, nowdiff3(TT1,TT2), T1 / 100]),
+ io:format("~p lookups took ~.2f(~.2f) seconds~n",
+ [N, nowdiff3(TT2,TT3), T2 / 100]),
+ io:format("~p deletes took ~.2f(~.2f) seconds~n",
+ [N, nowdiff3(TT3,TT6), T5 / 100]),
+ io:format("Total time for ~p elements is ~.2f(~.2f) seconds~n",
+ [N, nowdiff3(TT1,TT6), (T1+T2+T5) / 100]),
+ ok.
+
+key_to_object(Key) ->
+ {Key, Key,[Key, Key, {Key, banan}]}.
+
+time_call(Fun,Acc) ->
+ T1 = erlang:now(),
+ Ret = Fun(),
+ T2 = erlang:now(),
+ {nowdiff2(T1,T2)+Acc,Ret}.
+
+delete_testloop(0, _X, Acc) ->
+ ?DEBUGF("all ~p deleted~n",[_X]),
+ Acc;
+
+delete_testloop(N, X, Acc) ->
+ Key = gen_key(N),
+ Obj = key_to_object(Key),
+ case get(Key) of
+ Obj ->
+ ok;
+ Y ->
+ io:format("Error - Object ~p does not exist when we are "
+ "gonna delete!(N=~p, result=~p)~n",[Obj,N,Y]),
+ exit({inconsistent_1, delete_testloop, Obj, N, Y})
+ end,
+
+ {T, Obj2} = time_call(fun() -> erase(Key) end, Acc),
+ ?M(Obj,Obj2),
+ case {(X-N) rem 10000,(X-N)} of
+ {_,0} ->
+ ok;
+ {0,_} ->
+ ?DEBUGF("~p~n",[X-N]);
+ _ ->
+ ok
+ end,
+ case get(Key) of
+ undefined ->
+ ok;
+ Else ->
+ io:format("Error - Object ~p does still exist after "
+ "delete!(N=~p, result=~p)~n",[Obj,N,Else]),
+ exit({inconsistent_2, delete_testloop, Obj, N, Else})
+ end,
+ delete_testloop(N-1,X,T).
+
+lookup_testloop(0, X, Acc) ->
+ io:format("all ~p looked up~n",[X]),
+ Acc;
+lookup_testloop(N, X, Acc) ->
+ Key = gen_key(N),
+ D = key_to_object(Key),
+ {T, D2} = time_call(fun() -> get(Key) end, Acc),
+ ?M(D,D2),
+ case {(X-N) rem 10000,(X-N)} of
+ {_,0} ->
+ ok;
+ {0,_} ->
+ ?DEBUGF("~p~n",[X-N]);
+ _ ->
+ ok
+ end,
+ lookup_testloop(N-1,X,T).
+
+insert_testloop(0,X,Acc) ->
+ io:format("all ~p inserted~n",[X]),
+ Acc;
+insert_testloop(N,X,Acc) ->
+ Key = gen_key(N),
+ D = key_to_object(Key),
+ {T,_} = time_call(fun() -> put(Key,D) end, Acc),
+ case {(X-N) rem 10000,(X-N)} of
+ {_,0} ->
+ ok;
+ {0,_} ->
+ ?DEBUGF("~p~n",[X-N]);
+ _ ->
+ ok
+ end,
+ insert_testloop(N-1,X,T).
+
+
+gen_key(0,A)->
+ A;
+gen_key(N,A) ->
+ X = ((N-1) rem 26) + $a,
+ gen_key((N-1) div 26, [X|A]).
+gen_key(N) ->
+ gen_key(N+1,[]).
+
+nowtonumber({Mega, Secs, Milli}) ->
+ Milli div 10000 + Secs * 100 + Mega * 100000000.
+
+nowdiff2(T1,T2) ->
+ nowtonumber(T2) - nowtonumber(T1).
+nowdiff3(T1,T2) ->
+ (nowtonumber(T2) - nowtonumber(T1)) / 100.
+
+m(A,B,Module,Line) ->
+ case A == B of
+ true ->
+ ok;
+ _ ->
+ io:format("~p does not match ~p in module ~p, line ~p, exit.~n",
+ [A,B,Module,Line]),
+ exit({no_match,{A,B},Module,Line})
+ end.
diff --git a/lib/kernel/test/pg2_SUITE.erl b/lib/kernel/test/pg2_SUITE.erl
new file mode 100644
index 0000000000..8eb1a7ca19
--- /dev/null
+++ b/lib/kernel/test/pg2_SUITE.erl
@@ -0,0 +1,718 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%----------------------------------------------------------------
+%% Purpose:Test Suite for the 'pg2' module.
+%%-----------------------------------------------------------------
+-module(pg2_SUITE).
+
+-include("test_server.hrl").
+-define(datadir, ?config(data_dir, Config)).
+-define(privdir, ?config(priv_dir, Config)).
+
+-export([all/1, init_per_testcase/2, fin_per_testcase/2]).
+
+-export([tickets/1,
+ otp_7277/1, otp_8259/1,
+ compat/1, basic/1]).
+
+% Default timetrap timeout (set in init_per_testcase).
+-define(default_timeout, ?t:minutes(1)).
+
+-define(TESTCASE, testcase_name).
+-define(testcase, ?config(?TESTCASE, Config)).
+
+%% Internal export.
+-export([mk_part_node/3, part1/5, p_init/3, start_proc/1, sane/0]).
+
+init_per_testcase(Case, Config) ->
+ ?line Dog = ?t:timetrap(?default_timeout),
+ [{?TESTCASE, Case}, {watchdog, Dog} | Config].
+
+fin_per_testcase(_Case, _Config) ->
+ Dog = ?config(watchdog, _Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+all(suite) ->
+ [tickets].
+
+tickets(suite) ->
+ [otp_7277, otp_8259, compat, basic].
+
+otp_7277(doc) ->
+ "OTP-7277. Bugfix leave().";
+otp_7277(suite) -> [];
+otp_7277(Config) when is_list(Config) ->
+ ?line ok = pg2:create(a),
+ ?line ok = pg2:create(b),
+ P = spawn(forever()),
+ ?line ok = pg2:join(a, P),
+ ?line ok = pg2:leave(b, P),
+ ?line true = exit(P, kill),
+ case {pg2:get_members(a), pg2:get_local_members(a)} of
+ {[], []} ->
+ ok;
+ _ ->
+ timer:sleep(100),
+ ?line [] = pg2:get_members(a),
+ ?line [] = pg2:get_local_members(a)
+ end,
+ ?line _ = pg2:delete(a),
+ ?line _ = pg2:delete(b),
+ ok.
+
+-define(UNTIL(Seq), loop_until_true(fun() -> Seq end, Config)).
+-define(UNTIL_LOOP, 300).
+
+otp_8259(suite) -> [];
+otp_8259(doc) ->
+ ["OTP-8259. Member was not removed after being killed."];
+otp_8259(Config) when is_list(Config) ->
+ Timeout = 15,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+
+ ?line [A, B, C] = start_nodes([a, b, c], peer, Config),
+
+ ?line wait_for_ready_net(Config),
+
+ G = pg2_otp_8259,
+ Name = otp_8259_a_global_name,
+
+ % start different processes in both partitions
+ ?line {Pid, yes} = rpc:call(A, ?MODULE, start_proc, [Name]),
+
+ ?line ok = pg2:create(G),
+ ?line ok = pg2:join(G, Pid),
+
+ % make b and c connected, partitioned from node() and a
+ ?line rpc_cast(B, ?MODULE, part1, [Config, node(), A, C, Name]),
+ ?line ?UNTIL(is_ready_partition(Config)),
+
+ % Connect to the other partition.
+ % The resolver on node b will be called.
+ ?line pong = net_adm:ping(B),
+ timer:sleep(100),
+ ?line pong = net_adm:ping(C),
+ ?line _ = global:sync(),
+ ?line [A, B, C] = lists:sort(nodes()),
+
+ %% Pid has been killed by the resolver.
+ %% Pid has been removed from pg2 on all nodes, in particular node B.
+ ?line ?UNTIL([] =:= rpc:call(B, pg2, get_members, [G])),
+ ?line ?UNTIL([] =:= pg2:get_members(G)),
+ ?line ?UNTIL([] =:= rpc:call(A, pg2, get_members, [G])),
+ ?line ?UNTIL([] =:= rpc:call(C, pg2, get_members, [G])),
+
+ ?line ok = pg2:delete(G),
+ ?line stop_nodes([A,B,C]),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+part1(Config, Main, A, C, Name) ->
+ case catch begin
+ make_partition(Config, [Main, A], [node(), C]),
+ ?line {_Pid, yes} = start_proc(Name)
+ end of
+ {_, yes} -> ok
+ end.
+
+start_proc(Name) ->
+ Pid = spawn(?MODULE, p_init, [self(), Name, node()]),
+ receive
+ {Pid, Res} -> {Pid, Res}
+ end.
+
+p_init(Parent, Name, TestServer) ->
+ Resolve = fun(_Name, Pid1, Pid2) ->
+ %% The pid on node a will be chosen.
+ [{_,Min}, {_,Max}] =
+ lists:sort([{node(Pid1),Pid1}, {node(Pid2),Pid2}]),
+ %% b is connected to test_server.
+ %% exit(Min, kill), % would ping a
+ rpc:cast(TestServer, erlang, exit, [Min, kill]),
+ Max
+ end,
+ X = global:register_name(Name, self(), Resolve),
+ Parent ! {self(),X},
+ loop().
+
+loop() ->
+ receive
+ die ->
+ exit(normal)
+ end.
+
+compat(suite) -> [];
+compat(doc) ->
+ ["OTP-8259. Check that 'exchange' and 'del_member' work."];
+compat(Config) when is_list(Config) ->
+ case ?t:is_release_available("r13b") of
+ true ->
+ Timeout = 15,
+ ?line Dog = test_server:timetrap({seconds,Timeout}),
+ Pid = spawn(forever()),
+ G = a,
+ ?line ok = pg2:create(G),
+ ?line ok = pg2:join(G, Pid),
+ ?line ok = pg2:join(G, Pid),
+ ?line {ok, A} = start_node_rel(r13, r13b, slave),
+ ?line pong = net_adm:ping(A),
+ ?line wait_for_ready_net(Config),
+ ?line {ok, _} = rpc:call(A, pg2, start, []),
+ ?line ?UNTIL([Pid,Pid] =:= rpc:call(A, pg2, get_members, [a])),
+ ?line true = exit(Pid, kill),
+ ?line ?UNTIL([] =:= pg2:get_members(a)),
+ ?line ?UNTIL([] =:= rpc:call(A, pg2, get_members, [a])),
+ ?t:stop_node(A),
+ ?line test_server:timetrap_cancel(Dog);
+ false ->
+ {skipped, "No support for old node"}
+ end.
+
+basic(suite) -> [];
+basic(doc) ->
+ ["OTP-8259. Some basic tests."];
+basic(Config) when is_list(Config) ->
+ _ = [pg2:delete(G) || G <- pg2:which_groups()],
+ ?line _ = [do(Cs, T, Config) || {T,Cs} <- ts()],
+ ok.
+
+ts() ->
+ [
+ {t1,
+ [{create,[a],ignore},
+ {which_groups,[],[a]},
+ {get_closest_pid,[a],{error, {no_process, a}}},
+ {delete,[a],ignore}]},
+ {t2,
+ [{create,[a],ignore},
+ {join,[a,self()],ok},
+ {get_closest_pid,[a],self()},
+ {delete,[a],ignore}]},
+ {t3,
+ [{create,[a],ignore},
+ {new,p1},
+ {leave,[a,p1],ok},
+ {join,[b,p1],{error,{no_such_group,b}}},
+ {leave,[b,p1],{error,{no_such_group,b}}},
+ {get_members,[c],{error,{no_such_group,c}}},
+ {get_local_members,[c],{error,{no_such_group,c}}},
+ {join,[a,p1],ok},
+ {leave,[a,p1],ok},
+ {join,[a,p1],ok},
+ {join,[a,p1],ok},
+ {create,[a],ignore},
+ {get_closest_pid,[a],p1},
+ {leave,[a,p1],ok},
+ {get_closest_pid,[a],p1},
+ {leave,[a,p1],ok},
+ {get_closest_pid,[a],{error,{no_process, a}}},
+ {kill,p1},
+ {delete,[a],ignore}]},
+ {t4,
+ [{create,[a],ignore},
+ {new,p1},
+ {join,[a,p1],ok},
+ {get_members,[a],[p1]},
+ {get_local_members,[a],[p1]},
+ {kill,p1},
+ {get_members,[a],[]},
+ {get_local_members,[a],[]},
+ {delete,[a],ignore}]},
+ {t5,
+ [{create,[a],ignore},
+ {nodeup,n1},
+ {create,[a],ignore},
+ {join,[a,self()],ok},
+ {new,n1,p1},
+ {n1,{create,[b],ignore}},
+ {join,[a,p1],ok},
+ {join,[b,p1],ok},
+ {n1,{which_groups,[],[a,b]}},
+ {n1,{join,[a,p1],ok}},
+ {n1,{join,[b,p1],ok}},
+ {leave,[a,self()],ok},
+ {n1,{leave,[a,self()],ok}}, % noop
+ {n1,{leave,[b,p1],ok}},
+ {leave,[b,p1],ok},
+ {kill,n1,p1},
+ {nodedown,n1},
+ {delete,[b],ignore},
+ {delete,[a],ignore}]},
+ {t6,
+ [{create,[a],ignore}, % otp_7277
+ {create,[b],ignore},
+ {new,p},
+ {join,[a,p],ok},
+ {leave,[b,p],ok},
+ {kill,p},
+ {get_members,[a],[]},
+ {get_local_members,[a],[]},
+ {delete,[a],ignore},
+ {delete,[b],ignore}]},
+ {t7, % p1 joins twice, the new node gets informed about that
+ [{create,[a],ignore},
+ {new,p1},
+ {join,[a,p1],ok},
+ {join,[a,p1],ok},
+ {get_members,[a],[p1,p1]},
+ {get_local_members,[a],[p1,p1]},
+ {nodeup,n1},
+ {leave,[a,p1],ok},
+ {get_members,[a],[p1]},
+ {get_local_members,[a],[p1]},
+ {n1,{get_members,[a],[p1]}},
+ {leave,[a,p1],ok},
+ {get_members,[a],[]},
+ {n1,{get_members,[a],[]}},
+ {nodedown,n1},
+ {delete,[a],ignore},
+ {kill,p1}]},
+ {t8,
+ [{create,[a],ignore},
+ {new,p1},
+ {join,[a,p1],ok},
+ {join,[a,p1],ok},
+ {delete,[a],ignore},
+ {get_members,[a],{error,{no_such_group,a}}},
+ {kill,p1}]}
+ ].
+
+do(Cs, T, Config) ->
+ ?t:format("*** Test ~p ***~n", [T]),
+ {ok,T} = (catch {do(Cs, [], [], Config),T}).
+
+do([{nodeup,N} | Cs], Ps, Ns, Config) ->
+ [TestNode] = start_nodes([N], peer, Config),
+ pr(node(), {nodeup,N,TestNode}),
+ global:sync(),
+ timer:sleep(100),
+ {ok,_} = rpc:call(TestNode, pg2, start, []),
+ NNs = [{N,TestNode} | Ns],
+ sane(NNs),
+ do(Cs, Ps, NNs, Config);
+do([{nodedown,N}=C | Cs], Ps, Ns, Config) ->
+ {N, TestNode} = lists:keyfind(N, 1, Ns),
+ stop_node(TestNode),
+ timer:sleep(100),
+ pr(node(), C),
+ do(Cs, Ps, lists:keydelete(N, 1, Ns), Config);
+do([{new,P} | Cs], Ps, Ns, Config) ->
+ NPs = new_proc(node(), P, Ps, Ns),
+ do(Cs, NPs, Ns, Config);
+do([{new,N,P} | Cs], Ps, Ns, Config) ->
+ NPs = new_proc(N, P, Ps, Ns),
+ do(Cs, NPs, Ns, Config);
+do([{kill,P} | Cs], Ps, Ns, Config) ->
+ NPs = killit(node(), P, Ps, Ns),
+ do(Cs, NPs, Ns, Config);
+do([{kill,N,P} | Cs], Ps, Ns, Config) ->
+ NPs = killit(N, P, Ps, Ns),
+ do(Cs, NPs, Ns, Config);
+do([{Node,{_,_,_}=C} | Cs], Ps, Ns, Config) ->
+ doit(Node, C, Ps, Ns),
+ do(Cs, Ps, Ns, Config);
+do([C | Cs], Ps, Ns, Config) ->
+ doit(node(), C, Ps, Ns),
+ do(Cs, Ps, Ns, Config);
+do([], Ps, Ns, _Config) ->
+ [] = Ns,
+ [] = Ps,
+ [] = pg2:which_groups(),
+ [] = ets:tab2list(pg2_table),
+ [] = nodes(),
+ ok.
+
+doit(N, C, Ps, Ns) ->
+ Node = get_node(N, Ns),
+ pr(Node, C),
+ {F,As,R} = replace_pids(C, Ps),
+ case rpc:call(Node, erlang, apply, [pg2, F, As]) of
+ Result when Result =:= R orelse R =:= ignore ->
+ sane(Ns);
+ Else ->
+ ?t:format("~p and ~p: expected ~p, but got ~p~n",
+ [F, As, R, Else]),
+ throw({error,{F, As, R, Else}})
+ end.
+
+new_proc(N, P, Ps, Ns) ->
+ Node = get_node(N, Ns),
+ Pid = rpc:call(Node, erlang, spawn, [forever()]),
+ pr(Node, {new,P,Pid}),
+ [{P,Pid}|Ps].
+
+killit(N, P, Ps, Ns) ->
+ {P, Pid} = lists:keyfind(P, 1, Ps),
+ Node = get_node(N, Ns),
+ pr(Node, {kill,P,Pid}),
+ rpc:call(Node, erlang, exit, [Pid, kill]),
+ timer:sleep(100),
+ sane(Ns),
+ lists:keydelete(P, 1, Ps).
+
+pr(Node, C) ->
+ _ = [?t:format("~p: ", [Node]) || Node =/= node()],
+ ?t:format("do ~p~n", [C]).
+
+get_node(N, Ns) ->
+ if
+ N =:= node() ->
+ node();
+ true ->
+ {N, TestNode} = lists:keyfind(N, 1, Ns),
+ TestNode
+ end.
+
+forever() ->
+ fun() -> receive after infinity -> ok end end.
+
+replace_pids(T, Ps) when is_tuple(T) ->
+ list_to_tuple(replace_pids(tuple_to_list(T), Ps));
+replace_pids([E | Es], Ps) ->
+ [replace_pids(E, Ps) | replace_pids(Es, Ps)];
+replace_pids(A, Ps) ->
+ case lists:keyfind(A, 1, Ps) of
+ {A, Pid} ->
+ Pid;
+ _ ->
+ A
+ end.
+
+sane(Ns) ->
+ Nodes = [node()] ++ [NN || {_,NN} <- Ns],
+ _ = [?t:format("~p, pg2_table:~n ~p~n", % debug
+ [N, rpc:call(N, ets, tab2list, [pg2_table])]) ||
+ N <- Nodes],
+ R = [case rpc:call(Node, ?MODULE, sane, []) of
+ {'EXIT',Error} ->
+ {error, Node, Error};
+ _ ->
+ ok
+ end || Node <- Nodes],
+ case lists:usort(R) of
+ [ok] -> wsane(Nodes);
+ _ -> throw(R)
+ end.
+
+wsane(Ns) ->
+ %% Same members on all nodes:
+ {[_],gs} =
+ {lists:usort([rpc:call(N, pg2, which_groups, []) || N <- Ns]),gs},
+ _ = [{[_],ms,G} = {lists:usort([rpc:call(N, pg2, get_members, [G]) ||
+ N <- Ns]),ms,G} ||
+ G <- pg2:which_groups()],
+ %% The local members are a partitioning of the members:
+ [begin
+ LocalMembers =
+ lists:sort(lists:append(
+ [rpc:call(N, pg2, get_local_members, [G]) ||
+ N <- Ns])),
+ {part, LocalMembers} = {part, lists:sort(pg2:get_members(G))}
+ end || G <- pg2:which_groups()],
+ %% The closest pid should run on the local node, if possible.
+ [[case rpc:call(N, pg2, get_closest_pid, [G]) of
+ Pid when is_pid(Pid), node(Pid) =:= N ->
+ true =
+ lists:member(Pid, rpc:call(N, pg2, get_local_members, [G]));
+%% FIXME. Om annan nod: member, local = [].
+ _ -> [] = rpc:call(N, pg2, get_local_members, [G])
+ end || N <- Ns]
+ || G <- pg2:which_groups()].
+
+%% Look inside the pg2_table.
+sane() ->
+ L = ets:tab2list(pg2_table),
+ Gs = lists:sort([G || {{group,G}} <- L]),
+ MGs = lists:usort([G || {{member,G,_},_} <- L]),
+ MPs = lists:usort([P || {{member,_,P},_} <- L]),
+ {[],mg,MGs,Gs} = {MGs -- Gs,mg,MGs,Gs},
+ RPs = [P || {{ref,P},_RPid,_Ref,_C} <- L],
+ {MPs,rp} = {RPs,rp},
+ RPs2 = [P || {{ref,_Ref},P} <- L],
+ {MPs,rp2} = {RPs2,rp2},
+ _ = [true = C >= 1 || {{ref,_P},_RPid,_Ref,C} <- L],
+ LGs = lists:usort([G || {{local_member,G,_}} <- L]),
+ LPs = lists:usort([P || {{local_member,_,P}} <- L]),
+ {[],lg} = {LGs -- Gs,lg},
+ {[],lp} = {LPs -- MPs,lp},
+ PGs = lists:usort([G || {{pid,_,G}} <- L]),
+ PPs = lists:usort([P || {{pid,P,_}} <- L]),
+ {[],pg} = {PGs -- Gs,pg},
+ {MPs,pp} = {PPs,pp},
+ _ = [true = C >= 1 || {{member,_,_},C} <- L],
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Mostly copied from global_SUITE.erl
+%% (Setting up a partition is quite tricky.)
+
+loop_until_true(Fun, Config) ->
+ case Fun() of
+ true ->
+ true;
+ _ ->
+ timer:sleep(?UNTIL_LOOP),
+ loop_until_true(Fun, Config)
+ end.
+
+start_node_rel(Name, Rel, How) ->
+ {Release, Compat} = case Rel of
+ this ->
+ {[this], "+R8"};
+ Rel when is_atom(Rel) ->
+ {[{release, atom_to_list(Rel)}], ""};
+ RelList ->
+ {RelList, ""}
+ end,
+ ?line Pa = filename:dirname(code:which(?MODULE)),
+ ?line Res = test_server:start_node(Name, How,
+ [{args,
+ Compat ++
+ " -kernel net_setuptime 100 "
+ " -pa " ++ Pa},
+ {erl, Release}]),
+ Res.
+
+start_nodes(L, How, Config) ->
+ start_nodes2(L, How, 0, Config),
+ Nodes = collect_nodes(0, length(L)),
+ ?line ?UNTIL([] =:= Nodes -- nodes()),
+ %% Pinging doesn't help, we have to wait too, for nodes() to become
+ %% correct on the other node.
+ lists:foreach(fun(E) ->
+ net_adm:ping(E)
+ end,
+ Nodes),
+ verify_nodes(Nodes, Config),
+ Nodes.
+
+verify_nodes(Nodes, Config) ->
+ verify_nodes(Nodes, lists:sort([node() | Nodes]), Config).
+
+verify_nodes([], _N, _Config) ->
+ [];
+verify_nodes([Node | Rest], N, Config) ->
+ ?line ?UNTIL(
+ case rpc:call(Node, erlang, nodes, []) of
+ Nodes when is_list(Nodes) ->
+ case N =:= lists:sort([Node | Nodes]) of
+ true ->
+ true;
+ false ->
+ lists:foreach(fun(Nd) ->
+ rpc:call(Nd, net_adm, ping,
+ [Node])
+ end,
+ nodes()),
+ false
+ end;
+ _ ->
+ false
+ end
+ ),
+ verify_nodes(Rest, N, Config).
+
+
+start_nodes2([], _How, _, _Config) ->
+ [];
+start_nodes2([Name | Rest], How, N, Config) ->
+ Self = self(),
+ spawn(fun() ->
+ erlang:display({starting, Name}),
+ {ok, R} = start_node(Name, How, Config),
+ erlang:display({started, Name, R}),
+ Self ! {N, R},
+ %% sleeping is necessary, or with peer nodes, they will
+ %% go down again, despite {linked, false}.
+ test_server:sleep(100000)
+ end),
+ start_nodes2(Rest, How, N+1, Config).
+
+collect_nodes(N, N) ->
+ [];
+collect_nodes(N, Max) ->
+ receive
+ {N, Node} ->
+ [Node | collect_nodes(N+1, Max)]
+ end.
+
+start_node(Name, How, Config) ->
+ start_node(Name, How, "", Config).
+
+start_node(Name0, How, Args, Config) ->
+ Name = node_name(Name0, Config),
+ Pa = filename:dirname(code:which(?MODULE)),
+ test_server:start_node(Name, How, [{args,
+ Args ++ " " ++
+ "-kernel net_setuptime 100 "
+ "-noshell "
+ "-pa " ++ Pa},
+ {linked, false}]).
+stop_nodes(Nodes) ->
+ lists:foreach(fun(Node) -> stop_node(Node) end, Nodes).
+
+stop_node(Node) ->
+ ?t:stop_node(Node).
+
+get_known(Node) ->
+ case catch gen_server:call({global_name_server,Node},get_known,infinity) of
+ {'EXIT', _} ->
+ [list, without, nodenames];
+ Known when is_list(Known) ->
+ lists:sort([Node | Known])
+ end.
+
+node_name(Name, Config) ->
+ U = "_",
+ {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()),
+ Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w",
+ [Y,M,D, H,Min,S]),
+ L = lists:flatten(Date),
+ lists:concat([Name,U,?testcase,U,U,L]).
+
+%% this one runs on one node in Part2
+%% The partition is ready when is_ready_partition(Config) returns (true).
+%% this one runs on one node in Part2
+%% The partition is ready when is_ready_partition(Config) returns (true).
+make_partition(Config, Part1, Part2) ->
+ Dir = ?config(priv_dir, Config),
+ Ns = [begin
+ Name = lists:concat([atom_to_list(N),"_",msec(),".part"]),
+ File = filename:join([Dir, Name]),
+ file:delete(File),
+ rpc_cast(N, ?MODULE, mk_part_node, [File, Part, Config], File),
+ {N, File}
+ end || Part <- [Part1, Part2], N <- Part],
+ all_nodes_files(Ns, "done", Config),
+ lists:foreach(fun({_N,File}) -> file:delete(File) end, Ns),
+ PartFile = make_partition_file(Config),
+ touch(PartFile, "done").
+
+%% The node signals its success by touching a file.
+mk_part_node(File, MyPart0, Config) ->
+ touch(File, "start"), % debug
+ MyPart = lists:sort(MyPart0),
+ ?UNTIL(is_node_in_part(File, MyPart)),
+ touch(File, "done").
+
+%% The calls to append_to_file are for debugging.
+is_node_in_part(File, MyPart) ->
+ lists:foreach(fun(N) ->
+ _ = erlang:disconnect_node(N)
+ end, nodes() -- MyPart),
+ case {(Known = get_known(node())) =:= MyPart,
+ (Nodes = lists:sort([node() | nodes()])) =:= MyPart} of
+ {true, true} ->
+ %% Make sure the resolvers have been terminated,
+ %% otherwise they may pop up and send some message.
+ %% (This check is probably unnecessary.)
+ case element(5, global:info()) of
+ [] ->
+ true;
+ Rs ->
+ append_to_file(File, {now(), Known, Nodes, Rs}),
+ false
+ end;
+ _ ->
+ append_to_file(File, {now(), Known, Nodes}),
+ false
+ end.
+
+is_ready_partition(Config) ->
+ File = make_partition_file(Config),
+ file_contents(File, "done", Config),
+ file:delete(File),
+ true.
+
+wait_for_ready_net(Config) ->
+ wait_for_ready_net([node()|nodes()], Config).
+
+wait_for_ready_net(Nodes0, Config) ->
+ Nodes = lists:sort(Nodes0),
+ ?t:format("wait_for_ready_net ~p~n", [Nodes]),
+ ?UNTIL(begin
+ lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and
+ lists:all(fun(N) ->
+ LNs = rpc:call(N, erlang, nodes, []),
+ Nodes =:= lists:sort([N | LNs])
+ end, Nodes)
+ end).
+
+%% To make it less probable that some low-level problem causes
+%% problems, the receiving node is ping:ed.
+rpc_cast(Node, Module, Function, Args) ->
+ {_,pong,Node}= {node(),net_adm:ping(Node),Node},
+ rpc:cast(Node, Module, Function, Args).
+
+rpc_cast(Node, Module, Function, Args, File) ->
+ case net_adm:ping(Node) of
+ pong ->
+ rpc:cast(Node, Module, Function, Args);
+ Else ->
+ append_to_file(File, {now(), {rpc_cast, Node, Module, Function,
+ Args, Else}})
+ %% Maybe we should crash, but it probably doesn't matter.
+ end.
+
+touch(File, List) ->
+ ok = file:write_file(File, list_to_binary(List)).
+
+append_to_file(File, Term) ->
+ {ok, Fd} = file:open(File, [raw,binary,append]),
+ ok = file:write(Fd, io_lib:format("~p.~n", [Term])),
+ ok = file:close(Fd).
+
+all_nodes_files(Files, ContentsList, Config) ->
+ lists:all(fun({_N,File}) ->
+ file_contents(File, ContentsList, Config)
+ end, Files).
+
+file_contents(File, ContentsList, Config) ->
+ file_contents(File, ContentsList, Config, no_log_file).
+
+file_contents(File, ContentsList, Config, LogFile) ->
+ Contents = list_to_binary(ContentsList),
+ Sz = size(Contents),
+ ?UNTIL(begin
+ case file:read_file(File) of
+ {ok, FileContents}=Reply ->
+ case catch split_binary(FileContents, Sz) of
+ {Contents,_} ->
+ true;
+ _ ->
+ catch append_to_file(LogFile,
+ {File,Contents,Reply}),
+ false
+ end;
+ Reply ->
+ catch append_to_file(LogFile, {File, Contents, Reply}),
+ false
+ end
+ end).
+
+make_partition_file(Config) ->
+ Dir = ?config(priv_dir, Config),
+ filename:join([Dir, atom_to_list(make_partition_done)]).
+
+msec() ->
+ msec(now()).
+
+msec(T) ->
+ element(1,T)*1000000000 + element(2,T)*1000 + element(3,T) div 1000.
diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl
new file mode 100644
index 0000000000..860aeecbf4
--- /dev/null
+++ b/lib/kernel/test/prim_file_SUITE.erl
@@ -0,0 +1,1810 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(prim_file_SUITE).
+-export([all/1,
+ init/1, fini/1,
+ read_write_file/1, dirs/1, files/1]).
+-export([cur_dir_0a/1, cur_dir_0b/1,
+ cur_dir_1a/1, cur_dir_1b/1,
+ make_del_dir_a/1, make_del_dir_b/1,
+ pos/1, pos1/1, pos2/1]).
+-export([close/1,
+ delete_a/1, delete_b/1]).
+-export([open/1, open1/1, modes/1]).
+-export([file_info/1,
+ file_info_basic_file_a/1, file_info_basic_file_b/1,
+ file_info_basic_directory_a/1, file_info_basic_directory_b/1,
+ file_info_bad_a/1, file_info_bad_b/1,
+ file_info_times_a/1, file_info_times_b/1,
+ file_write_file_info_a/1, file_write_file_info_b/1]).
+-export([rename_a/1, rename_b/1,
+ access/1, truncate/1, sync/1,
+ read_write/1, pread_write/1, append/1]).
+-export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]).
+
+-export([compression/1, read_not_really_compressed/1,
+ read_compressed/1, write_compressed/1,
+ compress_errors/1]).
+
+-export([links/1,
+ make_link_a/1, make_link_b/1,
+ read_link_info_for_non_link/1,
+ symlinks_a/1, symlinks_b/1,
+ list_dir_limit/1]).
+
+-include("test_server.hrl").
+-include_lib("kernel/include/file.hrl").
+
+-define(PRIM_FILE, prim_file).
+
+%% Calls ?PRIM_FILE:F with arguments A and an optional handle H
+%% as first argument, unless the handle is [], i.e no handle.
+%% This is a macro to give the compiler and thereby
+%% the cross reference tool the possibility to interprete
+%% the call, since M, F, A (or [H | A]) can all be known at
+%% compile time.
+-define(PRIM_FILE_call(F, H, A),
+ case H of
+ [] -> apply(?PRIM_FILE, F, A);
+ _ -> apply(?PRIM_FILE, F, [H | A])
+ end).
+
+all(suite) -> {req, [kernel],
+ {conf, init,
+ [read_write_file, dirs, files,
+ delete_a, delete_b, rename_a, rename_b, errors,
+ compression, links, list_dir_limit],
+ fini}}.
+
+init(Config) when is_list(Config) ->
+ case os:type() of
+ {win32, _} ->
+ Priv = ?config(priv_dir, Config),
+ HasAccessTime =
+ case file:read_file_info(Priv) of
+ {ok, #file_info{atime={_, {0, 0, 0}}}} ->
+ %% This is a unfortunately a FAT file system.
+ [no_access_time];
+ {ok, _} ->
+ []
+ end,
+ HasAccessTime++Config;
+ _ ->
+ Config
+ end.
+
+fini(Config) when is_list(Config) ->
+ case os:type() of
+ {win32, _} ->
+ os:cmd("subst z: /d");
+ _ ->
+ ok
+ end,
+ Config.
+
+%% Matches a term (the last) against alternatives
+expect(X, _, X) ->
+ X;
+expect(_, X, X) ->
+ X.
+
+expect(X, _, _, X) ->
+ X;
+expect(_, X, _, X) ->
+ X;
+expect(_, _, X, X) ->
+ X.
+
+expect(X, _, _, _, X) ->
+ X;
+expect(_, X, _, _, X) ->
+ X;
+expect(_, _, X, _, X) ->
+ X;
+expect(_, _, _, X, X) ->
+ X.
+
+%% Calculate the time difference
+time_dist({YY, MM, DD, H, M, S}, DT) ->
+ time_dist({{YY, MM, DD}, {H, M, S}}, DT);
+time_dist(DT, {YY, MM, DD, H, M, S}) ->
+ time_dist(DT, {{YY, MM, DD}, {H, M, S}});
+time_dist({_D1, _T1} = DT1, {_D2, _T2} = DT2) ->
+ calendar:datetime_to_gregorian_seconds(DT2)
+ - calendar:datetime_to_gregorian_seconds(DT1).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+read_write_file(suite) -> [];
+read_write_file(doc) -> [];
+read_write_file(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_read_write_file"),
+
+ %% Try writing and reading back some term
+ ?line SomeTerm = {"This term",{will,be},[written,$t,$o],1,file,[]},
+ ?line ok = ?PRIM_FILE:write_file(Name,term_to_binary(SomeTerm)),
+ ?line {ok,Bin1} = ?PRIM_FILE:read_file(Name),
+ ?line SomeTerm = binary_to_term(Bin1),
+
+ %% Try a "null" term
+ ?line NullTerm = [],
+ ?line ok = ?PRIM_FILE:write_file(Name,term_to_binary(NullTerm)),
+ ?line {ok,Bin2} = ?PRIM_FILE:read_file(Name),
+ ?line NullTerm = binary_to_term(Bin2),
+
+ %% Try some "complicated" types
+ ?line BigNum = 123456789012345678901234567890,
+ ?line ComplTerm = {self(),make_ref(),BigNum,3.14159},
+ ?line ok = ?PRIM_FILE:write_file(Name,term_to_binary(ComplTerm)),
+ ?line {ok,Bin3} = ?PRIM_FILE:read_file(Name),
+ ?line ComplTerm = binary_to_term(Bin3),
+
+ %% Try reading a nonexistent file
+ ?line Name2 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_nonexistent_file"),
+ ?line {error, enoent} = ?PRIM_FILE:read_file(Name2),
+ ?line {error, enoent} = ?PRIM_FILE:read_file(""),
+
+ % Try writing to a bad filename
+ ?line {error, enoent} =
+ ?PRIM_FILE:write_file("",term_to_binary(NullTerm)),
+
+ % Try writing something else than a binary
+ ?line {error, badarg} = ?PRIM_FILE:write_file(Name,{1,2,3}),
+ ?line {error, badarg} = ?PRIM_FILE:write_file(Name,self()),
+
+ %% Some non-term binaries
+ ?line ok = ?PRIM_FILE:write_file(Name,[]),
+ ?line {ok,Bin4} = ?PRIM_FILE:read_file(Name),
+ ?line 0 = byte_size(Bin4),
+
+ ?line ok = ?PRIM_FILE:write_file(Name,[Bin1,[],[[Bin2]]]),
+ ?line {ok,Bin5} = ?PRIM_FILE:read_file(Name),
+ ?line {Bin1,Bin2} = split_binary(Bin5,byte_size(Bin1)),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+dirs(suite) -> [make_del_dir_a, make_del_dir_b,
+ cur_dir_0a, cur_dir_0b,
+ cur_dir_1a, cur_dir_1b].
+
+make_del_dir_a(suite) -> [];
+make_del_dir_a(doc) -> [];
+make_del_dir_a(Config) when is_list(Config) ->
+ make_del_dir(Config, [], "_a").
+
+make_del_dir_b(suite) -> [];
+make_del_dir_b(doc) -> [];
+make_del_dir_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = make_del_dir(Config, Handle, "_b"),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ %% Just to make sure the state of the server makes a difference
+ ?line {error, einval} = ?PRIM_FILE_call(get_cwd, Handle, []),
+ Result.
+
+make_del_dir(Config, Handle, Suffix) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_mk-dir"++Suffix),
+ ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
+ ?line {error, eexist} = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
+ ?line ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]),
+ ?line {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [NewDir]),
+
+ %% Check that we get an error when trying to create...
+ %% a deep directory
+ ?line NewDir2 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_mk-dir/foo"),
+ ?line {error, enoent} = ?PRIM_FILE_call(make_dir, Handle, [NewDir2]),
+ %% a nameless directory
+ ?line {error, enoent} = ?PRIM_FILE_call(make_dir, Handle, [""]),
+ %% a directory with illegal name
+ ?line {error, badarg} = ?PRIM_FILE_call(make_dir, Handle, ['mk-dir']),
+
+ %% a directory with illegal name, even if it's a (bad) list
+ ?line {error, badarg} = ?PRIM_FILE_call(make_dir, Handle, [[1,2,3,{}]]),
+
+ %% Maybe this isn't an error, exactly, but worth mentioning anyway:
+ %% ok = ?PRIM_FILE:make_dir([$f,$o,$o,0,$b,$a,$r])),
+ %% The above line works, and created a directory "./foo"
+ %% More elegant would maybe have been to fail, or to really create
+ %% a directory, but with a name that incorporates the "bar" part of
+ %% the list, so that [$f,$o,$o,0,$f,$o,$o] wouldn't refer to the same
+ %% dir. But this would slow it down.
+
+ %% Try deleting some bad directories
+ %% Deleting the parent directory to the current, sounds dangerous, huh?
+ %% Don't worry ;-) the parent directory should never be empty, right?
+ ?line {error, eexist} = ?PRIM_FILE_call(del_dir, Handle, [".."]),
+ ?line {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [""]),
+ ?line {error, badarg} = ?PRIM_FILE_call(del_dir, Handle, [[3,2,1,{}]]),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+cur_dir_0a(suite) -> [];
+cur_dir_0a(doc) -> [];
+cur_dir_0a(Config) when is_list(Config) ->
+ cur_dir_0(Config, []).
+
+cur_dir_0b(suite) -> [];
+cur_dir_0b(doc) -> [];
+cur_dir_0b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = cur_dir_0(Config, Handle),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+cur_dir_0(Config, Handle) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ %% Find out the current dir, and cd to it ;-)
+ ?line {ok,BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []),
+ ?line Dir1 = BaseDir ++ "", %% Check that it's a string
+ ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]),
+ ?line DirName = atom_to_list(?MODULE) ++
+ case Handle of
+ [] ->
+ "_curdir";
+ _ ->
+ "_curdir_h"
+ end,
+
+ %% Make a new dir, and cd to that
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line NewDir = filename:join(RootDir, DirName),
+ ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
+ ?line io:format("cd to ~s",[NewDir]),
+ ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]),
+
+ %% Create a file in the new current directory, and check that it
+ %% really is created there
+ ?line UncommonName = "uncommon.fil",
+ ?line {ok,Fd} = ?PRIM_FILE:open(UncommonName, [read, write]),
+ ?line ok = ?PRIM_FILE:close(Fd),
+ ?line {ok,NewDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]),
+ ?line true = lists:member(UncommonName,NewDirFiles),
+
+ %% Delete the directory and return to the old current directory
+ %% and check that the created file isn't there (too!)
+ ?line expect({error, einval}, {error, eacces}, {error, eexist},
+ ?PRIM_FILE_call(del_dir, Handle, [NewDir])),
+ ?line ?PRIM_FILE_call(delete, Handle, [UncommonName]),
+ ?line {ok,[]} = ?PRIM_FILE_call(list_dir, Handle, ["."]),
+ ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]),
+ ?line io:format("cd back to ~s",[Dir1]),
+ ?line ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]),
+ ?line {error, enoent} = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]),
+ ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]),
+ ?line io:format("cd back to ~s",[Dir1]),
+ ?line {ok,OldDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]),
+ ?line false = lists:member(UncommonName,OldDirFiles),
+
+ %% Try doing some bad things
+ ?line {error, badarg} =
+ ?PRIM_FILE_call(set_cwd, Handle, [{foo,bar}]),
+ ?line {error, enoent} =
+ ?PRIM_FILE_call(set_cwd, Handle, [""]),
+ ?line {error, enoent} =
+ ?PRIM_FILE_call(set_cwd, Handle, [".......a......"]),
+ ?line {ok,BaseDir} =
+ ?PRIM_FILE_call(get_cwd, Handle, []), %% Still there?
+
+ %% On Windows, there should only be slashes, no backslashes,
+ %% in the return value of get_cwd().
+ %% (The test is harmless on Unix, because filenames usually
+ %% don't contain backslashes.)
+
+ ?line {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []),
+ ?line false = lists:member($\\, BaseDir),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Tests ?PRIM_FILE:get_cwd/1.
+
+cur_dir_1a(suite) -> [];
+cur_dir_1a(doc) -> [];
+cur_dir_1a(Config) when is_list(Config) ->
+ cur_dir_1(Config, []).
+
+cur_dir_1b(suite) -> [];
+cur_dir_1b(doc) -> [];
+cur_dir_1b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = cur_dir_1(Config, Handle),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+cur_dir_1(Config, Handle) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+
+ ?line case os:type() of
+ {unix, _} ->
+ ?line {error, enotsup} =
+ ?PRIM_FILE_call(get_cwd, Handle, ["d:"]);
+ vxworks ->
+ ?line {error, enotsup} =
+ ?PRIM_FILE_call(get_cwd, Handle, ["d:"]);
+ {win32, _} ->
+ win_cur_dir_1(Config, Handle)
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+win_cur_dir_1(_Config, Handle) ->
+ ?line {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []),
+
+ %% Get the drive letter from the current directory,
+ %% and try to get current directory for that drive.
+
+ ?line [Drive, $:|_] = BaseDir,
+ ?line {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, [[Drive, $:]]),
+ io:format("BaseDir = ~s\n", [BaseDir]),
+
+ %% Unfortunately, there is no way to move away from the
+ %% current drive as we can't use the "subst" command from
+ %% a SSH connection. We can't test any more. Too bad.
+
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+files(suite) -> [open,pos,file_info,truncate,sync].
+
+open(suite) -> [open1,modes,close,access,read_write,
+ pread_write,append].
+
+open1(suite) -> [];
+open1(doc) -> [];
+open1(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_files"),
+ ?line ok = ?PRIM_FILE:make_dir(NewDir),
+ ?line Name = filename:join(NewDir, "foo1.fil"),
+ ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [read, write]),
+ ?line {ok,Fd2} = ?PRIM_FILE:open(Name, [read]),
+ ?line Str = "{a,tuple}.\n",
+ ?line Length = length(Str),
+ ?line ?PRIM_FILE:write(Fd1,Str),
+ ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof),
+ ?line {ok, Str} = ?PRIM_FILE:read(Fd1,Length),
+ ?line {ok, Str} = ?PRIM_FILE:read(Fd2,Length),
+ ?line ok = ?PRIM_FILE:close(Fd2),
+ ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof),
+ ?line ok = ?PRIM_FILE:truncate(Fd1),
+ ?line eof = ?PRIM_FILE:read(Fd1,Length),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+ ?line {ok,Fd3} = ?PRIM_FILE:open(Name, [read]),
+ ?line eof = ?PRIM_FILE:read(Fd3,Length),
+ ?line ok = ?PRIM_FILE:close(Fd3),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Tests all open modes.
+
+modes(suite) -> [];
+modes(doc) -> [];
+modes(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_open_modes"),
+ ?line ok = ?PRIM_FILE:make_dir(NewDir),
+ ?line Name1 = filename:join(NewDir, "foo1.fil"),
+ ?line Marker = "hello, world",
+ ?line Length = length(Marker),
+
+ %% write
+ ?line {ok, Fd1} = ?PRIM_FILE:open(Name1, [write]),
+ ?line ok = ?PRIM_FILE:write(Fd1, Marker),
+ ?line ok = ?PRIM_FILE:write(Fd1, ".\n"),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+
+ %% read
+ ?line {ok, Fd2} = ?PRIM_FILE:open(Name1, [read]),
+ ?line {ok, Marker} = ?PRIM_FILE:read(Fd2, Length),
+ ?line ok = ?PRIM_FILE:close(Fd2),
+
+ %% read and write
+ ?line {ok, Fd3} = ?PRIM_FILE:open(Name1, [read, write]),
+ ?line {ok, Marker} = ?PRIM_FILE:read(Fd3, Length),
+ ?line ok = ?PRIM_FILE:write(Fd3, Marker),
+ ?line ok = ?PRIM_FILE:close(Fd3),
+
+ %% read by default
+ ?line {ok, Fd4} = ?PRIM_FILE:open(Name1, []),
+ ?line {ok, Marker} = ?PRIM_FILE:read(Fd4, Length),
+ ?line ok = ?PRIM_FILE:close(Fd4),
+
+ %% read and binary
+ ?line BinaryMarker = list_to_binary(Marker),
+ ?line {ok, Fd5} = ?PRIM_FILE:open(Name1, [read, binary]),
+ ?line {ok, BinaryMarker} = ?PRIM_FILE:read(Fd5, Length),
+ ?line ok = ?PRIM_FILE:close(Fd5),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+close(suite) -> [];
+close(doc) -> [];
+close(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_close.fil"),
+ ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [read, write]),
+ %% Just closing it is no fun, we did that a million times already
+ %% This is a common error, for code written before Erlang 4.3
+ %% bacause then ?PRIM_FILE:open just returned a Pid, and not everyone
+ %% really checked what they got.
+ ?line {'EXIT',_Msg} = (catch ok = ?PRIM_FILE:close({ok,Fd1})),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+
+ %% Try closing one more time
+ ?line Val = ?PRIM_FILE:close(Fd1),
+ ?line io:format("Second close gave: ~p", [Val]),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+access(suite) -> [];
+access(doc) -> [];
+access(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_access.fil"),
+ ?line Str = "ABCDEFGH",
+ ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [write]),
+ ?line ?PRIM_FILE:write(Fd1,Str),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+ %% Check that we can't write when in read only mode
+ ?line {ok,Fd2} = ?PRIM_FILE:open(Name, [read]),
+ ?line case catch ?PRIM_FILE:write(Fd2,"XXXX") of
+ ok ->
+ test_server:fail({access,write});
+ _ ->
+ ok
+ end,
+ ?line ok = ?PRIM_FILE:close(Fd2),
+ ?line {ok, Fd3} = ?PRIM_FILE:open(Name, [read]),
+ ?line {ok, Str} = ?PRIM_FILE:read(Fd3,length(Str)),
+ ?line ok = ?PRIM_FILE:close(Fd3),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Tests ?PRIM_FILE:read/2 and ?PRIM_FILE:write/2.
+
+read_write(suite) -> [];
+read_write(doc) -> [];
+read_write(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_read_write"),
+ ?line ok = ?PRIM_FILE:make_dir(NewDir),
+
+ %% Raw file.
+ ?line Name = filename:join(NewDir, "raw.fil"),
+ ?line {ok, Fd} = ?PRIM_FILE:open(Name, [read, write]),
+ ?line read_write_test(Fd),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+read_write_test(File) ->
+ ?line Marker = "hello, world",
+ ?line ok = ?PRIM_FILE:write(File, Marker),
+ ?line {ok, 0} = ?PRIM_FILE:position(File, 0),
+ ?line {ok, Marker} = ?PRIM_FILE:read(File, 100),
+ ?line eof = ?PRIM_FILE:read(File, 100),
+ ?line ok = ?PRIM_FILE:close(File),
+ ok.
+
+
+%% Tests ?PRIM_FILE:pread/2 and ?PRIM_FILE:pwrite/2.
+
+pread_write(suite) -> [];
+pread_write(doc) -> [];
+pread_write(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_pread_write"),
+ ?line ok = ?PRIM_FILE:make_dir(NewDir),
+
+ %% Raw file.
+ ?line Name = filename:join(NewDir, "raw.fil"),
+ ?line {ok, Fd} = ?PRIM_FILE:open(Name, [read, write]),
+ ?line pread_write_test(Fd),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+pread_write_test(File) ->
+ ?line Marker = "hello, world",
+ ?line Len = length(Marker),
+ ?line ok = ?PRIM_FILE:write(File, Marker),
+ ?line {ok, Marker} = ?PRIM_FILE:pread(File, 0, 100),
+ ?line eof = ?PRIM_FILE:pread(File, 100, 1),
+ ?line ok = ?PRIM_FILE:pwrite(File, Len, Marker),
+ ?line {ok, Marker} = ?PRIM_FILE:pread(File, Len, 100),
+ ?line eof = ?PRIM_FILE:pread(File, 100, 1),
+ ?line MM = Marker ++ Marker,
+ ?line {ok, MM} = ?PRIM_FILE:pread(File, 0, 100),
+ ?line ok = ?PRIM_FILE:close(File),
+ ok.
+
+append(doc) -> "Test appending to a file.";
+append(suite) -> [];
+append(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_append"),
+ ?line ok = ?PRIM_FILE:make_dir(NewDir),
+
+ ?line First = "First line\n",
+ ?line Second = "Seond lines comes here\n",
+ ?line Third = "And here is the third line\n",
+
+ %% Write a small text file.
+ ?line Name1 = filename:join(NewDir, "a_file.txt"),
+ ?line {ok, Fd1} = ?PRIM_FILE:open(Name1, [write]),
+ ?line ok = ?PRIM_FILE:write(Fd1, First),
+ ?line ok = ?PRIM_FILE:write(Fd1, Second),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+
+ %% Open it a again and a append a line to it.
+ ?line {ok, Fd2} = ?PRIM_FILE:open(Name1, [append]),
+ ?line ok = ?PRIM_FILE:write(Fd2, Third),
+ ?line ok = ?PRIM_FILE:close(Fd2),
+
+ %% Read it back and verify.
+ ?line Expected = list_to_binary([First, Second, Third]),
+ ?line {ok, Expected} = ?PRIM_FILE:read_file(Name1),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+pos(suite) -> [pos1,pos2].
+
+pos1(suite) -> [];
+pos1(doc) -> [];
+pos1(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_pos1.fil"),
+ ?line {ok, Fd1} = ?PRIM_FILE:open(Name, [write]),
+ ?line ?PRIM_FILE:write(Fd1,"ABCDEFGH"),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+ ?line {ok, Fd2} = ?PRIM_FILE:open(Name, [read]),
+
+ %% Start pos is first char
+ ?line io:format("Relative positions"),
+ ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 2} = ?PRIM_FILE:position(Fd2,{cur,1}),
+ ?line {ok, "C"} = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 0} = ?PRIM_FILE:position(Fd2,{cur,-3}),
+ ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1),
+ %% Backwards from first char should be an error
+ ?line {ok,0} = ?PRIM_FILE:position(Fd2,{cur,-1}),
+ ?line {error, einval} = ?PRIM_FILE:position(Fd2,{cur,-1}),
+ %% Reset position and move again
+ ?line {ok, 0} = ?PRIM_FILE:position(Fd2,0),
+ ?line {ok, 2} = ?PRIM_FILE:position(Fd2,{cur,2}),
+ ?line {ok, "C"} = ?PRIM_FILE:read(Fd2,1),
+ %% Go a lot forwards
+ ?line {ok, 13} = ?PRIM_FILE:position(Fd2,{cur,10}),
+ ?line eof = ?PRIM_FILE:read(Fd2,1),
+
+ %% Try some fixed positions
+ ?line io:format("Fixed positions"),
+ ?line {ok, 8} = ?PRIM_FILE:position(Fd2,8),
+ ?line eof = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 8} = ?PRIM_FILE:position(Fd2,cur),
+ ?line eof = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 7} = ?PRIM_FILE:position(Fd2,7),
+ ?line {ok, "H"} = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 0} = ?PRIM_FILE:position(Fd2,0),
+ ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 3} = ?PRIM_FILE:position(Fd2,3),
+ ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 12} = ?PRIM_FILE:position(Fd2,12),
+ ?line eof = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 3} = ?PRIM_FILE:position(Fd2,3),
+ ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1),
+ %% Try the {bof,X} notation
+ ?line {ok, 3} = ?PRIM_FILE:position(Fd2,{bof,3}),
+ ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1),
+
+ %% Try eof positions
+ ?line io:format("EOF positions"),
+ ?line {ok, 8} = ?PRIM_FILE:position(Fd2,{eof,0}),
+ ?line eof = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 7} = ?PRIM_FILE:position(Fd2,{eof,-1}),
+ ?line {ok, "H"} = ?PRIM_FILE:read(Fd2,1),
+ ?line {ok, 0} = ?PRIM_FILE:position(Fd2,{eof,-8}),
+ ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1),
+ ?line {error, einval} = ?PRIM_FILE:position(Fd2,{eof,-9}),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+pos2(suite) -> [];
+pos2(doc) -> [];
+pos2(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_pos2.fil"),
+ ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [write]),
+ ?line ?PRIM_FILE:write(Fd1,"ABCDEFGH"),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+ ?line {ok, Fd2} = ?PRIM_FILE:open(Name, [read]),
+ ?line {error, einval} = ?PRIM_FILE:position(Fd2,-1),
+
+ %% Make sure that we still can search after an error.
+ ?line {ok, 0} = ?PRIM_FILE:position(Fd2, 0),
+ ?line {ok, 3} = ?PRIM_FILE:position(Fd2, {bof,3}),
+ ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1),
+
+ ?line io:format("DONE"),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+file_info(suite) -> [file_info_basic_file_a, file_info_basic_file_b,
+ file_info_basic_directory_a,
+ file_info_basic_directory_b,
+ file_info_bad_a, file_info_bad_b,
+ file_info_times_a, file_info_times_b,
+ file_write_file_info_a, file_write_file_info_b].
+
+file_info_basic_file_a(suite) -> [];
+file_info_basic_file_a(doc) -> [];
+file_info_basic_file_a(Config) when is_list(Config) ->
+ file_info_basic_file(Config, [], "_a").
+
+file_info_basic_file_b(suite) -> [];
+file_info_basic_file_b(doc) -> [];
+file_info_basic_file_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = file_info_basic_file(Config, Handle, "_b"),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+file_info_basic_file(Config, Handle, Suffix) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir, Config),
+
+ %% Create a short file.
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_basic_test"++Suffix++".fil"),
+ ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [write]),
+ ?line ?PRIM_FILE:write(Fd1, "foo bar"),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+
+ %% Test that the file has the expected attributes.
+ %% The times are tricky, so we will save them to a separate test case.
+ ?line {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?line #file_info{size = Size, type = Type, access = Access,
+ atime = AccessTime, mtime = ModifyTime} =
+ FileInfo,
+ ?line io:format("Access ~p, Modify ~p", [AccessTime, ModifyTime]),
+ ?line Size = 7,
+ ?line Type = regular,
+ ?line Access = read_write,
+ ?line true = abs(time_dist(filter_atime(AccessTime, Config),
+ filter_atime(ModifyTime,
+ Config))) < 2,
+ ?line {AD, AT} = AccessTime,
+ ?line all_integers(tuple_to_list(AD) ++ tuple_to_list(AT)),
+ ?line {MD, MT} = ModifyTime,
+ ?line all_integers(tuple_to_list(MD) ++ tuple_to_list(MT)),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+file_info_basic_directory_a(suite) -> [];
+file_info_basic_directory_a(doc) -> [];
+file_info_basic_directory_a(Config) when is_list(Config) ->
+ file_info_basic_directory(Config, []).
+
+file_info_basic_directory_b(suite) -> [];
+file_info_basic_directory_b(doc) -> [];
+file_info_basic_directory_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = file_info_basic_directory(Config, Handle),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+file_info_basic_directory(Config, Handle) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+
+ %% Note: filename:join/1 removes any trailing slash,
+ %% which is essential for ?PRIM_FILE:read_file_info/1 to work on
+ %% platforms such as Windows95.
+ ?line RootDir = filename:join([?config(priv_dir, Config)]),
+
+ %% Test that the RootDir directory has the expected attributes.
+ ?line test_directory(RootDir, read_write, Handle),
+
+ %% Note that on Windows file systems, "/" or "c:/" are *NOT* directories.
+ %% Therefore, test that ?PRIM_FILE:read_file_info/1 behaves
+ %% as if they were directories.
+ ?line case os:type() of
+ {win32, _} ->
+ ?line test_directory("/", read_write, Handle),
+ ?line test_directory("c:/", read_write, Handle),
+ ?line test_directory("c:\\", read_write, Handle);
+ {unix, _} ->
+ ?line test_directory("/", read, Handle);
+ vxworks ->
+ %% Check is just done for owner
+ ?line test_directory("/", read_write, Handle)
+ end,
+ ?line test_server:timetrap_cancel(Dog).
+
+test_directory(Name, ExpectedAccess, Handle) ->
+ ?line {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?line #file_info{size = Size, type = Type, access = Access,
+ atime = AccessTime, mtime = ModifyTime} =
+ FileInfo,
+ ?line io:format("Testing directory ~s", [Name]),
+ ?line io:format("Directory size is ~p", [Size]),
+ ?line io:format("Access ~p", [Access]),
+ ?line io:format("Access time ~p; Modify time~p",
+ [AccessTime, ModifyTime]),
+ ?line Type = directory,
+ ?line Access = ExpectedAccess,
+ ?line {AD, AT} = AccessTime,
+ ?line all_integers(tuple_to_list(AD) ++ tuple_to_list(AT)),
+ ?line {MD, MT} = ModifyTime,
+ ?line all_integers(tuple_to_list(MD) ++ tuple_to_list(MT)),
+ ok.
+
+all_integers([Int|Rest]) when is_integer(Int) ->
+ ?line all_integers(Rest);
+all_integers([]) ->
+ ok.
+
+%% Try something nonexistent.
+
+file_info_bad_a(suite) -> [];
+file_info_bad_a(doc) -> [];
+file_info_bad_a(Config) when is_list(Config) ->
+ file_info_bad(Config, []).
+
+file_info_bad_b(suite) -> [];
+file_info_bad_b(doc) -> [];
+file_info_bad_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = file_info_bad(Config, Handle),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+file_info_bad(Config, Handle) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = filename:join([?config(priv_dir, Config)]),
+ ?line {error, enoent} =
+ ?PRIM_FILE_call(
+ read_file_info, Handle,
+ [filename:join(RootDir,
+ atom_to_list(?MODULE)++"_nonexistent")]),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Test that the file times behave as they should.
+
+file_info_times_a(suite) -> [];
+file_info_times_a(doc) -> [];
+file_info_times_a(Config) when is_list(Config) ->
+ file_info_times(Config, [], "_a").
+
+file_info_times_b(suite) -> [];
+file_info_times_b(doc) -> [];
+file_info_times_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = file_info_times(Config, Handle, "_b"),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+file_info_times(Config, Handle, Suffix) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(60)),
+ %% We have to try this twice, since if the test runs across the change
+ %% of a month the time diff calculations will fail. But it won't happen
+ %% if you run it twice in succession.
+ ?line test_server:m_out_of_n(
+ 1,2,
+ fun() -> ?line file_info_int(Config, Handle, Suffix) end),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+file_info_int(Config, Handle, Suffix) ->
+ %% Note: filename:join/1 removes any trailing slash,
+ %% which is essential for ?PRIM_FILE:read_file_info/1 to work on
+ %% platforms such as Windows95.
+
+ ?line RootDir = filename:join([?config(priv_dir, Config)]),
+ ?line test_server:format("RootDir = ~p", [RootDir]),
+
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_file_info"++Suffix++".fil"),
+ ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [write]),
+ ?line ?PRIM_FILE:write(Fd1,"foo"),
+
+ %% check that the file got a modify date max a few seconds away from now
+ ?line {ok, #file_info{type = regular,
+ atime = AccTime1, mtime = ModTime1}} =
+ ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?line Now = erlang:localtime(),
+ ?line io:format("Now ~p",[Now]),
+ ?line io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]),
+ ?line true = abs(time_dist(filter_atime(Now, Config),
+ filter_atime(AccTime1,
+ Config))) < 8,
+ ?line true = abs(time_dist(Now, ModTime1)) < 8,
+
+ %% Sleep until we can be sure the seconds value has changed.
+ %% Note: FAT-based filesystem (like on Windows 95) have
+ %% a resolution of 2 seconds.
+ ?line test_server:sleep(test_server:seconds(2.2)),
+
+ %% close the file, and watch the modify date change
+ ?line ok = ?PRIM_FILE:close(Fd1),
+ ?line {ok, #file_info{size = Size, type = regular, access = Access,
+ atime = AccTime2, mtime = ModTime2}} =
+ ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?line io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]),
+ ?line true = time_dist(ModTime1, ModTime2) >= 0,
+
+ %% this file is supposed to be binary, so it'd better keep it's size
+ ?line Size = 3,
+ ?line Access = read_write,
+
+ %% Do some directory checking
+ ?line {ok, #file_info{size = DSize, type = directory,
+ access = DAccess,
+ atime = AccTime3, mtime = ModTime3}} =
+ ?PRIM_FILE_call(read_file_info, Handle, [RootDir]),
+ %% this dir was modified only a few secs ago
+ ?line io:format("Dir Acc ~p; Mod ~p; Now ~p",
+ [AccTime3, ModTime3, Now]),
+ ?line true = abs(time_dist(Now, ModTime3)) < 5,
+ ?line DAccess = read_write,
+ ?line io:format("Dir size is ~p",[DSize]),
+ ok.
+
+%% Filter access times, to cope with a deficiency of FAT file systems
+%% (on Windows): The access time is actually only a date.
+
+filter_atime(Atime, Config) ->
+ case lists:member(no_access_time, Config) of
+ true ->
+ case Atime of
+ {Date, _} ->
+ {Date, {0, 0, 0}};
+ {Y, M, D, _, _, _} ->
+ {Y, M, D, 0, 0, 0}
+ end;
+ false ->
+ Atime
+ end.
+
+%% Test the write_file_info/2 function.
+
+file_write_file_info_a(suite) -> [];
+file_write_file_info_a(doc) -> [];
+file_write_file_info_a(Config) when is_list(Config) ->
+ file_write_file_info(Config, [], "_a").
+
+file_write_file_info_b(suite) -> [];
+file_write_file_info_b(doc) -> [];
+file_write_file_info_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = file_write_file_info(Config, Handle, "_b"),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+file_write_file_info(Config, Handle, Suffix) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = get_good_directory(Config),
+ ?line test_server:format("RootDir = ~p", [RootDir]),
+
+ %% Set the file to read only AND update the file times at the same time.
+ %% (This used to fail on Windows NT/95 for a local filesystem.)
+ %% Note: Seconds must be even; see note in file_info_times/1.
+
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_write_file_info_ro"++Suffix),
+ ?line ok = ?PRIM_FILE:write_file(Name, "hello"),
+ ?line Time = {{1997, 01, 02}, {12, 35, 42}},
+ ?line Info = #file_info{mode=8#400, atime=Time, mtime=Time, ctime=Time},
+ ?line ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, Info]),
+
+ %% Read back the times.
+
+ ?line {ok, ActualInfo} =
+ ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?line #file_info{mode=_Mode, atime=ActAtime, mtime=Time,
+ ctime=ActCtime} = ActualInfo,
+ ?line FilteredAtime = filter_atime(Time, Config),
+ ?line FilteredAtime = filter_atime(ActAtime, Config),
+ ?line case os:type() of
+ {win32, _} ->
+ %% On Windows, "ctime" means creation time and it can
+ %% be set.
+ ActCtime = Time;
+ _ ->
+ ok
+ end,
+ ?line {error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"),
+
+ %% Make the file writable again.
+
+ ?line ?PRIM_FILE_call(write_file_info, Handle,
+ [Name, #file_info{mode=8#600}]),
+ ?line ok = ?PRIM_FILE:write_file(Name, "hello again"),
+
+ %% And unwritable.
+ ?line ?PRIM_FILE_call(write_file_info, Handle,
+ [Name, #file_info{mode=8#400}]),
+ ?line {error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"),
+
+ %% Write the times again.
+ %% Note: Seconds must be even; see note in file_info_times/1.
+
+ ?line NewTime = {{1997, 02, 15}, {13, 18, 20}},
+ ?line NewInfo = #file_info{atime=NewTime, mtime=NewTime, ctime=NewTime},
+ ?line ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, NewInfo]),
+ ?line {ok, ActualInfo2} =
+ ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?line #file_info{atime=NewActAtime, mtime=NewTime,
+ ctime=NewActCtime} = ActualInfo2,
+ ?line NewFilteredAtime = filter_atime(NewTime, Config),
+ ?line NewFilteredAtime = filter_atime(NewActAtime, Config),
+ ?line case os:type() of
+ {win32, _} -> NewActCtime = NewTime;
+ _ -> ok
+ end,
+
+ %% The file should still be unwritable.
+ ?line {error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"),
+
+ %% Make the file writeable again, so that we can remove the
+ %% test suites ... :-)
+ ?line ?PRIM_FILE_call(write_file_info, Handle,
+ [Name, #file_info{mode=8#600}]),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Returns a directory on a file system that has correct file times.
+
+get_good_directory(Config) ->
+ ?line ?config(priv_dir, Config).
+
+truncate(suite) -> [];
+truncate(doc) -> [];
+truncate(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_truncate.fil"),
+
+ %% Create a file with some data.
+ ?line MyData = "0123456789abcdefghijklmnopqrstuvxyz",
+ ?line ok = ?PRIM_FILE:write_file(Name, MyData),
+
+ %% Truncate the file to 10 characters.
+ ?line {ok, Fd} = ?PRIM_FILE:open(Name, [read, write]),
+ ?line {ok, 10} = ?PRIM_FILE:position(Fd, 10),
+ ?line ok = ?PRIM_FILE:truncate(Fd),
+ ?line ok = ?PRIM_FILE:close(Fd),
+
+ %% Read back the file and check that it has been truncated.
+ ?line Expected = list_to_binary("0123456789"),
+ ?line {ok, Expected} = ?PRIM_FILE:read_file(Name),
+
+ %% Open the file read only and verify that it is not possible to
+ %% truncate it, OTP-1960
+ ?line {ok, Fd2} = ?PRIM_FILE:open(Name, [read]),
+ ?line {ok, 5} = ?PRIM_FILE:position(Fd2, 5),
+ ?line {error, _} = ?PRIM_FILE:truncate(Fd2),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+sync(suite) -> [];
+sync(doc) -> "Tests that ?PRIM_FILE:sync/1 at least doesn't crash.";
+sync(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Sync = filename:join(PrivDir,
+ atom_to_list(?MODULE)
+ ++"_sync.fil"),
+
+ %% Raw open.
+ ?line {ok, Fd} = ?PRIM_FILE:open(Sync, [write]),
+ ?line ok = ?PRIM_FILE:sync(Fd),
+ ?line ok = ?PRIM_FILE:close(Fd),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+delete_a(suite) -> [];
+delete_a(doc) -> [];
+delete_a(Config) when is_list(Config) ->
+ delete(Config, [], "_a").
+
+delete_b(suite) -> [];
+delete_b(doc) -> [];
+delete_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = delete(Config, Handle, "_b"),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+delete(Config, Handle, Suffix) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line Name = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_delete"++Suffix++".fil"),
+ ?line {ok, Fd1} = ?PRIM_FILE:open(Name, [write]),
+ ?line ?PRIM_FILE:write(Fd1,"ok.\n"),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+ %% Check that the file is readable
+ ?line {ok, Fd2} = ?PRIM_FILE:open(Name, [read]),
+ ?line ok = ?PRIM_FILE:close(Fd2),
+ ?line ok = ?PRIM_FILE_call(delete, Handle, [Name]),
+ %% Check that the file is not readable anymore
+ ?line {error, _} = ?PRIM_FILE:open(Name, [read]),
+ %% Try deleting a nonexistent file
+ ?line {error, enoent} = ?PRIM_FILE_call(delete, Handle, [Name]),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+rename_a(suite) ->[];
+rename_a(doc) ->[];
+rename_a(Config) when is_list(Config) ->
+ rename(Config, [], "_a").
+
+rename_b(suite) ->[];
+rename_b(doc) ->[];
+rename_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = rename(Config, Handle, "_b"),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+rename(Config, Handle, Suffix) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(5)),
+ ?line RootDir = ?config(priv_dir,Config),
+ ?line FileName1 = atom_to_list(?MODULE)++"_rename"++Suffix++".fil",
+ ?line FileName2 = atom_to_list(?MODULE)++"_rename"++Suffix++".ful",
+ ?line Name1 = filename:join(RootDir, FileName1),
+ ?line Name2 = filename:join(RootDir, FileName2),
+ ?line {ok,Fd1} = ?PRIM_FILE:open(Name1, [write]),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+ %% Rename, and check that it really changed name
+ ?line ok = ?PRIM_FILE_call(rename, Handle, [Name1, Name2]),
+ ?line {error, _} = ?PRIM_FILE:open(Name1, [read]),
+ ?line {ok, Fd2} = ?PRIM_FILE:open(Name2, [read]),
+ ?line ok = ?PRIM_FILE:close(Fd2),
+ %% Try renaming something to itself
+ ?line ok = ?PRIM_FILE_call(rename, Handle, [Name2, Name2]),
+ %% Try renaming something that doesn't exist
+ ?line {error, enoent} =
+ ?PRIM_FILE_call(rename, Handle, [Name1, Name2]),
+ %% Try renaming to something else than a string
+ ?line {error, badarg} =
+ ?PRIM_FILE_call(rename, Handle, [Name1, foobar]),
+
+ %% Move between directories
+ ?line DirName1 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_rename_dir"++Suffix),
+ ?line DirName2 = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_second_rename_dir"++Suffix),
+ ?line Name1foo = filename:join(DirName1, "foo.fil"),
+ ?line Name2foo = filename:join(DirName2, "foo.fil"),
+ ?line Name2bar = filename:join(DirName2, "bar.dir"),
+ ?line ok = ?PRIM_FILE:make_dir(DirName1),
+ %% The name has to include the full file name, path is not enough
+ ?line expect(
+ {error, eexist}, {error, eisdir},
+ ?PRIM_FILE_call(rename, Handle, [Name2, DirName1])),
+ ?line ok =
+ ?PRIM_FILE_call(rename, Handle, [Name2, Name1foo]),
+ %% Now rename the directory
+ ?line ok = ?PRIM_FILE_call(rename, Handle, [DirName1, DirName2]),
+ %% And check that the file is there now
+ ?line {ok,Fd3} = ?PRIM_FILE:open(Name2foo, [read]),
+ ?line ok = ?PRIM_FILE:close(Fd3),
+ %% Try some dirty things now: move the directory into itself
+ ?line {error, Msg1} =
+ ?PRIM_FILE_call(rename, Handle, [DirName2, Name2bar]),
+ ?line io:format("Errmsg1: ~p",[Msg1]),
+ %% move dir into a file in itself
+ ?line {error, Msg2} =
+ ?PRIM_FILE_call(rename, Handle, [DirName2, Name2foo]),
+ ?line io:format("Errmsg2: ~p",[Msg2]),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+errors(suite) -> [e_delete, e_rename, e_make_dir, e_del_dir].
+
+e_delete(suite) -> [];
+e_delete(doc) -> [];
+e_delete(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_e_delete"),
+ ?line ok = ?PRIM_FILE:make_dir(Base),
+
+ %% Delete a non-existing file.
+ ?line {error, enoent} =
+ ?PRIM_FILE:delete(filename:join(Base, "non_existing")),
+
+ %% Delete a directory.
+ ?line {error, eperm} = ?PRIM_FILE:delete(Base),
+
+ %% Use a path-name with a non-directory component.
+ ?line Afile = filename:join(Base, "a_file"),
+ ?line ok = ?PRIM_FILE:write_file(Afile, "hello\n"),
+ ?line {error, E} =
+ expect(
+ {error, enotdir}, {error, enoent},
+ ?PRIM_FILE:delete(filename:join(Afile, "another_file"))),
+ ?line io:format("Result: ~p~n", [E]),
+
+ %% No permission.
+ ?line case os:type() of
+ {unix, _} ->
+ ?line ?PRIM_FILE:write_file_info(
+ Base, #file_info {mode=0}),
+ ?line {error, eacces} = ?PRIM_FILE:delete(Afile),
+ ?line ?PRIM_FILE:write_file_info(
+ Base, #file_info {mode=8#600});
+ {win32, _} ->
+ %% Remove a character device.
+ ?line {error, eacces} = ?PRIM_FILE:delete("nul");
+ vxworks ->
+ ok
+ end,
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+%%% FreeBSD gives EEXIST when renaming a file to an empty dir, although the
+%%% manual page can be interpreted as saying that EISDIR should be given.
+%%% (What about FreeBSD? We store our nightly build results on a FreeBSD
+%%% file system, that's what.)
+
+e_rename(suite) -> [];
+e_rename(doc) -> [];
+e_rename(Config) when is_list(Config) ->
+ case os:type() of
+ vxworks ->
+ {comment, "Windriver: dosFs must be fixed first!"};
+ _ ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_e_rename"),
+ ?line ok = ?PRIM_FILE:make_dir(Base),
+
+ %% Create an empty directory.
+ ?line EmptyDir = filename:join(Base, "empty_dir"),
+ ?line ok = ?PRIM_FILE:make_dir(EmptyDir),
+
+ %% Create a non-empty directory.
+ ?line NonEmptyDir = filename:join(Base, "non_empty_dir"),
+ ?line ok = ?PRIM_FILE:make_dir(NonEmptyDir),
+ ?line ok = ?PRIM_FILE:write_file(
+ filename:join(NonEmptyDir, "a_file"),
+ "hello\n"),
+
+ %% Create another non-empty directory.
+ ?line ADirectory = filename:join(Base, "a_directory"),
+ ?line ok = ?PRIM_FILE:make_dir(ADirectory),
+ ?line ok = ?PRIM_FILE:write_file(
+ filename:join(ADirectory, "a_file"),
+ "howdy\n\n"),
+
+ %% Create a data file.
+ ?line File = filename:join(Base, "just_a_file"),
+ ?line ok = ?PRIM_FILE:write_file(File, "anything goes\n\n"),
+
+ %% Move an existing directory to a non-empty directory.
+ ?line {error, eexist} =
+ ?PRIM_FILE:rename(ADirectory, NonEmptyDir),
+
+ %% Move a root directory.
+ ?line {error, einval} = ?PRIM_FILE:rename("/", "arne"),
+
+ %% Move Base into Base/new_name.
+ ?line {error, einval} =
+ ?PRIM_FILE:rename(Base, filename:join(Base, "new_name")),
+
+ %% Overwrite a directory with a file.
+ ?line expect({error, eexist}, % FreeBSD (?)
+ {error, eisdir},
+ ?PRIM_FILE:rename(File, EmptyDir)),
+ ?line expect({error, eexist}, % FreeBSD (?)
+ {error, eisdir},
+ ?PRIM_FILE:rename(File, NonEmptyDir)),
+
+ %% Move a non-existing file.
+ ?line NonExistingFile = filename:join(
+ Base, "non_existing_file"),
+ ?line {error, enoent} =
+ ?PRIM_FILE:rename(NonExistingFile, NonEmptyDir),
+
+ %% Overwrite a file with a directory.
+ ?line expect({error, eexist}, % FreeBSD (?)
+ {error, enotdir},
+ ?PRIM_FILE:rename(ADirectory, File)),
+
+ %% Move a file to another filesystem.
+ %% XXX - This test case is bogus. We cannot be guaranteed that
+ %% the source and destination are on
+ %% different filesystems.
+ %%
+ %% XXX - Gross hack!
+ ?line Comment =
+ case os:type() of
+ {unix, _} ->
+ OtherFs = "/tmp",
+ ?line NameOnOtherFs =
+ filename:join(OtherFs,
+ filename:basename(File)),
+ ?line {ok, Com} =
+ case ?PRIM_FILE:rename(
+ File, NameOnOtherFs) of
+ {error, exdev} ->
+ %% The file could be in
+ %% the same filesystem!
+ {ok, ok};
+ ok ->
+ {ok, {comment,
+ "Moving between filesystems "
+ "suceeded, files are probably "
+ "in the same filesystem!"}};
+ {error, eperm} ->
+ {ok, {comment, "SBS! You don't "
+ "have the permission to do "
+ "this test!"}};
+ Else ->
+ Else
+ end,
+ Com;
+ {win32, _} ->
+ %% At least Windows NT can
+ %% successfully move a file to
+ %% another drive.
+ ok
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ Comment
+ end.
+
+e_make_dir(suite) -> [];
+e_make_dir(doc) -> [];
+e_make_dir(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_e_make_dir"),
+ ?line ok = ?PRIM_FILE:make_dir(Base),
+
+ %% A component of the path does not exist.
+ ?line {error, enoent} =
+ ?PRIM_FILE:make_dir(filename:join([Base, "a", "b"])),
+
+ %% Use a path-name with a non-directory component.
+ ?line Afile = filename:join(Base, "a_directory"),
+ ?line ok = ?PRIM_FILE:write_file(Afile, "hello\n"),
+ ?line case ?PRIM_FILE:make_dir(
+ filename:join(Afile, "another_directory")) of
+ {error, enotdir} -> io:format("Result: enotdir");
+ {error, enoent} -> io:format("Result: enoent")
+ end,
+
+ %% No permission (on Unix only).
+ case os:type() of
+ {unix, _} ->
+ ?line ?PRIM_FILE:write_file_info(Base, #file_info {mode=0}),
+ ?line {error, eacces} =
+ ?PRIM_FILE:make_dir(filename:join(Base, "xxxx")),
+ ?line
+ ?PRIM_FILE:write_file_info(Base, #file_info {mode=8#600});
+ {win32, _} ->
+ ok;
+ vxworks ->
+ ok
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+e_del_dir(suite) -> [];
+e_del_dir(doc) -> [];
+e_del_dir(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line Base = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_e_del_dir"),
+ ?line io:format("Base: ~p", [Base]),
+ ?line ok = ?PRIM_FILE:make_dir(Base),
+
+ %% Delete a non-existent directory.
+ ?line {error, enoent} =
+ ?PRIM_FILE:del_dir(filename:join(Base, "non_existing")),
+
+ %% Use a path-name with a non-directory component.
+ ?line Afile = filename:join(Base, "a_directory"),
+ ?line ok = ?PRIM_FILE:write_file(Afile, "hello\n"),
+ ?line {error, E1} =
+ expect({error, enotdir}, {error, enoent},
+ ?PRIM_FILE:del_dir(
+ filename:join(Afile, "another_directory"))),
+ ?line io:format("Result: ~p", [E1]),
+
+ %% Delete a non-empty directory.
+ %% Delete a non-empty directory.
+ ?line {error, E2} =
+ expect({error, enotempty}, {error, eexist}, {error, eacces},
+ ?PRIM_FILE:del_dir(Base)),
+ ?line io:format("Result: ~p", [E2]),
+
+ %% Remove the current directory.
+ ?line {error, E3} =
+ expect({error, einval},
+ {error, eperm}, % Linux and DUX
+ {error, eacces},
+ {error, ebusy},
+ ?PRIM_FILE:del_dir(".")),
+ ?line io:format("Result: ~p", [E3]),
+
+ %% No permission.
+ case os:type() of
+ {unix, _} ->
+ ?line ADirectory = filename:join(Base, "no_perm"),
+ ?line ok = ?PRIM_FILE:make_dir(ADirectory),
+ ?line ?PRIM_FILE:write_file_info(Base, #file_info {mode=0}),
+ ?line {error, eacces} = ?PRIM_FILE:del_dir(ADirectory),
+ ?line ?PRIM_FILE:write_file_info(
+ Base, #file_info {mode=8#600});
+ {win32, _} ->
+ ok;
+ vxworks ->
+ ok
+ end,
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+compression(suite) -> [read_compressed, read_not_really_compressed,
+ write_compressed, compress_errors].
+
+%% Trying reading and positioning from a compressed file.
+
+read_compressed(suite) -> [];
+read_compressed(doc) -> [];
+read_compressed(Config) when is_list(Config) ->
+ ?line Data = ?config(data_dir, Config),
+ ?line Real = filename:join(Data, "realmen.html.gz"),
+ ?line {ok, Fd} = ?PRIM_FILE:open(Real, [read, compressed]),
+ ?line try_read_file(Fd).
+
+%% Trying reading and positioning from an uncompressed file,
+%% but with the compressed flag given.
+
+read_not_really_compressed(suite) -> [];
+read_not_really_compressed(doc) -> [];
+read_not_really_compressed(Config) when is_list(Config) ->
+ ?line Data = ?config(data_dir, Config),
+ ?line Priv = ?config(priv_dir, Config),
+
+ %% The file realmen.html might have got CRs added (by WinZip).
+ %% Remove them, or the file positions will not be correct.
+
+ ?line Real = filename:join(Data, "realmen.html"),
+ ?line RealPriv = filename:join(Priv,
+ atom_to_list(?MODULE)++"_realmen.html"),
+ ?line {ok, RealDataBin} = ?PRIM_FILE:read_file(Real),
+ ?line RealData = remove_crs(binary_to_list(RealDataBin), []),
+ ?line ok = ?PRIM_FILE:write_file(RealPriv, RealData),
+ ?line {ok, Fd} = ?PRIM_FILE:open(RealPriv, [read, compressed]),
+ ?line try_read_file(Fd).
+
+remove_crs([$\r|Rest], Result) ->
+ remove_crs(Rest, Result);
+remove_crs([C|Rest], Result) ->
+ remove_crs(Rest, [C|Result]);
+remove_crs([], Result) ->
+ lists:reverse(Result).
+
+try_read_file(Fd) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+
+ %% Seek to the current position (nothing should happen).
+
+ ?line {ok, 0} = ?PRIM_FILE:position(Fd, 0),
+ ?line {ok, 0} = ?PRIM_FILE:position(Fd, {cur, 0}),
+
+ %% Read a few lines from a compressed file.
+
+ ?line ShouldBe = "<TITLE>Real Programmers Don't Use PASCAL</TITLE>\n",
+ ?line {ok, ShouldBe} = ?PRIM_FILE:read(Fd, length(ShouldBe)),
+
+ %% Now seek forward.
+
+ ?line {ok, 381} = ?PRIM_FILE:position(Fd, 381),
+ ?line Back = "Back in the good old days -- the \"Golden Era\" " ++
+ "of computers, it was\n",
+ ?line {ok, Back} = ?PRIM_FILE:read(Fd, length(Back)),
+
+ %% Try to search forward relative to the current position.
+
+ ?line {ok, CurPos} = ?PRIM_FILE:position(Fd, {cur, 0}),
+ ?line RealPos = 4273,
+ ?line {ok, RealPos} = ?PRIM_FILE:position(Fd, {cur, RealPos-CurPos}),
+ ?line RealProg = "<LI> Real Programmers aren't afraid to use GOTOs.\n",
+ ?line {ok, RealProg} = ?PRIM_FILE:read(Fd, length(RealProg)),
+
+ %% Seek backward.
+
+ ?line AfterTitle = length("<TITLE>"),
+ ?line {ok, AfterTitle} = ?PRIM_FILE:position(Fd, AfterTitle),
+ ?line Title = "Real Programmers Don't Use PASCAL</TITLE>\n",
+ ?line {ok, Title} = ?PRIM_FILE:read(Fd, length(Title)),
+
+ %% Done.
+
+ ?line ?PRIM_FILE:close(Fd),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+write_compressed(suite) -> [];
+write_compressed(doc) -> [];
+write_compressed(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line Priv = ?config(priv_dir, Config),
+ ?line MyFile = filename:join(Priv,
+ atom_to_list(?MODULE)++"_test.gz"),
+
+ %% Write a file.
+
+ ?line {ok, Fd} = ?PRIM_FILE:open(MyFile, [write, compressed]),
+ ?line {ok, 0} = ?PRIM_FILE:position(Fd, 0),
+ ?line Prefix = "hello\n",
+ ?line End = "end\n",
+ ?line ok = ?PRIM_FILE:write(Fd, Prefix),
+ ?line {ok, 143} = ?PRIM_FILE:position(Fd, 143),
+ ?line ok = ?PRIM_FILE:write(Fd, End),
+ ?line ok = ?PRIM_FILE:close(Fd),
+
+ %% Read the file and verify the contents.
+
+ ?line {ok, Fd1} = ?PRIM_FILE:open(MyFile, [read, compressed]),
+ ?line {ok, Prefix} = ?PRIM_FILE:read(Fd1, length(Prefix)),
+ ?line Second = lists:duplicate(143-length(Prefix), 0) ++ End,
+ ?line {ok, Second} = ?PRIM_FILE:read(Fd1, length(Second)),
+ ?line ok = ?PRIM_FILE:close(Fd1),
+
+ %% Ensure that the file is compressed.
+
+ TotalSize = 143 + length(End),
+ case ?PRIM_FILE:read_file_info(MyFile) of
+ {ok, #file_info{size=Size}} when Size < TotalSize ->
+ ok;
+ {ok, #file_info{size=Size}} when Size == TotalSize ->
+ test_server:fail(file_not_compressed)
+ end,
+
+ %% Write again to ensure that the file is truncated.
+
+ ?line {ok, Fd2} = ?PRIM_FILE:open(MyFile, [write, compressed]),
+ ?line NewString = "aaaaaaaaaaa",
+ ?line ok = ?PRIM_FILE:write(Fd2, NewString),
+ ?line ok = ?PRIM_FILE:close(Fd2),
+ ?line {ok, Fd3} = ?PRIM_FILE:open(MyFile, [read, compressed]),
+ ?line {ok, NewString} = ?PRIM_FILE:read(Fd3, 1024),
+ ?line ok = ?PRIM_FILE:close(Fd3),
+
+ %% Done.
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+compress_errors(suite) -> [];
+compress_errors(doc) -> [];
+compress_errors(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line Data = ?config(data_dir, Config),
+ ?line {error, enoent} = ?PRIM_FILE:open("non_existing__",
+ [compressed, read]),
+ ?line {error, einval} = ?PRIM_FILE:open("non_existing__",
+ [compressed, read, write]),
+
+ %% Read a corrupted .gz file.
+
+ ?line Corrupted = filename:join(Data, "corrupted.gz"),
+ ?line {ok, Fd} = ?PRIM_FILE:open(Corrupted, [read, compressed]),
+ ?line {error, eio} = ?PRIM_FILE:read(Fd, 100),
+ ?line ?PRIM_FILE:close(Fd),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+links(doc) -> "Test the link functions.";
+links(suite) ->
+ [make_link_a, make_link_b,
+ read_link_info_for_non_link,
+ symlinks_a, symlinks_b].
+
+make_link_a(doc) -> "Test creating a hard link.";
+make_link_a(suite) -> [];
+make_link_a(Config) when is_list(Config) ->
+ make_link(Config, [], "_a").
+
+make_link_b(doc) -> "Test creating a hard link.";
+make_link_b(suite) -> [];
+make_link_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = make_link(Config, Handle, "_b"),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+make_link(Config, Handle, Suffix) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_make_link"++Suffix),
+ ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
+
+ ?line Name = filename:join(NewDir, "a_file"),
+ ?line ok = ?PRIM_FILE:write_file(Name, "some contents\n"),
+
+ ?line Alias = filename:join(NewDir, "an_alias"),
+ ?line Result =
+ case ?PRIM_FILE_call(make_link, Handle, [Name, Alias]) of
+ {error, enotsup} ->
+ {skipped, "Links not supported on this platform"};
+ ok ->
+ %% Note: We take the opportunity to test
+ %% ?PRIM_FILE:read_link_info/1,
+ %% which should in behave exactly as
+ %% ?PRIM_FILE:read_file_info/1
+ %% since they are not used on symbolic links.
+
+ ?line {ok, Info} =
+ ?PRIM_FILE_call(read_link_info, Handle, [Name]),
+ ?line {ok, Info} =
+ ?PRIM_FILE_call(read_link_info, Handle, [Alias]),
+ ?line #file_info{links = 2, type = regular} = Info,
+ ?line {error, eexist} =
+ ?PRIM_FILE_call(make_link, Handle, [Name, Alias]),
+ ok
+ end,
+
+ ?line test_server:timetrap_cancel(Dog),
+ Result.
+
+read_link_info_for_non_link(doc) ->
+ "Test that reading link info for an ordinary file or directory works "
+ "(on all platforms).";
+read_link_info_for_non_link(suite) -> [];
+read_link_info_for_non_link(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+
+ ?line {ok, #file_info{type=directory}} = ?PRIM_FILE:read_link_info("."),
+
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+symlinks_a(doc) -> "Test operations on symbolic links (for Unix).";
+symlinks_a(suite) -> [];
+symlinks_a(Config) when is_list(Config) ->
+ symlinks(Config, [], "_a").
+
+symlinks_b(doc) -> "Test operations on symbolic links (for Unix).";
+symlinks_b(suite) -> [];
+symlinks_b(Config) when is_list(Config) ->
+ ?line {ok, Handle} = ?PRIM_FILE:start(),
+ Result = symlinks(Config, Handle, "_b"),
+ ?line ok = ?PRIM_FILE:stop(Handle),
+ Result.
+
+symlinks(Config, Handle, Suffix) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(10)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)
+ ++"_make_symlink"++Suffix),
+ ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]),
+
+ ?line Name = filename:join(NewDir, "a_plain_file"),
+ ?line ok = ?PRIM_FILE:write_file(Name, "some stupid content\n"),
+
+ ?line Alias = filename:join(NewDir, "a_symlink_alias"),
+ ?line Result =
+ case ?PRIM_FILE_call(make_symlink, Handle, [Name, Alias]) of
+ {error, enotsup} ->
+ {skipped, "Links not supported on this platform"};
+ ok ->
+ ?line {ok, Info1} =
+ ?PRIM_FILE_call(read_file_info, Handle, [Name]),
+ ?line {ok, Info1} =
+ ?PRIM_FILE_call(read_file_info, Handle, [Alias]),
+ ?line {ok, Info1} =
+ ?PRIM_FILE_call(read_link_info, Handle, [Name]),
+ ?line #file_info{links = 1, type = regular} = Info1,
+
+ ?line {ok, Info2} =
+ ?PRIM_FILE_call(read_link_info, Handle, [Alias]),
+ ?line #file_info{links=1, type=symlink} = Info2,
+ ?line {ok, Name} =
+ ?PRIM_FILE_call(read_link, Handle, [Alias]),
+ ok
+ end,
+
+ ?line test_server:timetrap_cancel(Dog),
+ Result.
+
+%% Creates as many files as possible during a certain time,
+%% periodically calls list_dir/2 to check if it works,
+%% then deletes all files.
+
+list_dir_limit(doc) ->
+ "Tests if large directories can be read";
+list_dir_limit(suite) ->
+ [];
+list_dir_limit(Config) when is_list(Config) ->
+ ?line MaxTime = 120,
+ ?line MaxNumber = 20000,
+ ?line Dog = test_server:timetrap(
+ test_server:seconds(2*MaxTime + MaxTime)),
+ ?line RootDir = ?config(priv_dir, Config),
+ ?line NewDir = filename:join(RootDir,
+ atom_to_list(?MODULE)++"_list_dir_limit"),
+ ?line {ok, Handle1} = ?PRIM_FILE:start(),
+ ?line ok = ?PRIM_FILE_call(make_dir, Handle1, [NewDir]),
+ Ref = erlang:start_timer(MaxTime*1000, self(), []),
+ ?line Result = list_dir_limit_loop(NewDir, Handle1, Ref, MaxNumber, 0),
+ ?line Time = case erlang:cancel_timer(Ref) of
+ false -> MaxTime;
+ T -> MaxTime - (T div 1000)
+ end,
+ ?line Number = case Result of
+ {ok, N} -> N;
+ {error, _Reason, N} -> N;
+ _ -> 0
+ end,
+ ?line {ok, Handle2} = ?PRIM_FILE:start(),
+ ?line list_dir_limit_cleanup(NewDir, Handle2, Number, 0),
+ ?line ok = ?PRIM_FILE:stop(Handle1),
+ ?line ok = ?PRIM_FILE:stop(Handle2),
+ ?line {ok, Number} = Result,
+ ?line test_server:timetrap_cancel(Dog),
+ {comment,
+ "Created " ++ integer_to_list(Number) ++ " files in "
+ ++ integer_to_list(Time) ++ " seconds."}.
+
+list_dir_limit_loop(Dir, Handle, _Ref, N, Cnt) when Cnt >= N ->
+ list_dir_check(Dir, Handle, Cnt);
+list_dir_limit_loop(Dir, Handle, Ref, N, Cnt) ->
+ receive
+ {timeout, Ref, []} ->
+ list_dir_check(Dir, Handle, Cnt)
+ after 0 ->
+ Name = integer_to_list(Cnt),
+ case ?PRIM_FILE:write_file(filename:join(Dir, Name), Name) of
+ ok ->
+ Next = Cnt + 1,
+ case Cnt rem 100 of
+ 0 ->
+ case list_dir_check(Dir, Handle, Next) of
+ {ok, Next} ->
+ list_dir_limit_loop(
+ Dir, Handle, Ref, N, Next);
+ Other ->
+ Other
+ end;
+ _ ->
+ list_dir_limit_loop(Dir, Handle, Ref, N, Next)
+ end;
+ {error, Reason} ->
+ {error, Reason, Cnt}
+ end
+ end.
+
+list_dir_check(Dir, Handle, Cnt) ->
+ case ?PRIM_FILE:list_dir(Handle, Dir) of
+ {ok, ListDir} ->
+ case length(ListDir) of
+ Cnt ->
+ {ok, Cnt};
+ X ->
+ {error,
+ {wrong_nof_files, X, ?LINE},
+ Cnt}
+ end;
+ {error, Reason} ->
+ {error, Reason, Cnt}
+ end.
+
+%% Deletes N files while ignoring errors, then continues deleting
+%% as long as they exist.
+
+list_dir_limit_cleanup(Dir, Handle, N, Cnt) when Cnt >= N ->
+ Name = integer_to_list(Cnt),
+ case ?PRIM_FILE:delete(Handle, filename:join(Dir, Name)) of
+ ok ->
+ list_dir_limit_cleanup(Dir, Handle, N, Cnt+1);
+ _ ->
+ ok
+ end;
+list_dir_limit_cleanup(Dir, Handle, N, Cnt) ->
+ Name = integer_to_list(Cnt),
+ ?PRIM_FILE:delete(Handle, filename:join(Dir, Name)),
+ list_dir_limit_cleanup(Dir, Handle, N, Cnt+1).
+
diff --git a/lib/kernel/test/prim_file_SUITE_data/corrupted.gz b/lib/kernel/test/prim_file_SUITE_data/corrupted.gz
new file mode 100644
index 0000000000..16331b350c
--- /dev/null
+++ b/lib/kernel/test/prim_file_SUITE_data/corrupted.gz
@@ -0,0 +1,5 @@
+�
+==========================================
+This file has a correct GZIP magic ID, but the rest of the
+header is corrupt. Reading this file should result in an
+error.
diff --git a/lib/kernel/test/prim_file_SUITE_data/realmen.html b/lib/kernel/test/prim_file_SUITE_data/realmen.html
new file mode 100644
index 0000000000..c810a5d088
--- /dev/null
+++ b/lib/kernel/test/prim_file_SUITE_data/realmen.html
@@ -0,0 +1,520 @@
+<TITLE>Real Programmers Don't Use PASCAL</TITLE>
+
+<H2 align=center>Real Programmers Don't Use PASCAL</H2>
+
+<H4 align=center><em>Ed Post<br>
+Graphic Software Systems<br>
+
+P.O. Box 673<br>
+25117 S.W. Parkway<br>
+Wilsonville, OR 97070<br>
+Copyright (c) 1982<br>
+</H4></EM>
+
+
+<H4 align=center><KBD> (decvax | ucbvax | cbosg | pur-ee | lbl-unix)!teklabs!ogcvax!gss1144!evp</KBD></H4>
+
+
+Back in the good old days -- the "Golden Era" of computers, it was
+easy to separate the men from the boys (sometimes called "Real Men"
+and "Quiche Eaters" in the literature). During this period, the Real
+Men were the ones that understood computer programming, and the Quiche
+Eaters were the ones that didn't. A real computer programmer said
+things like <KBD>"DO 10 I=1,10"</KBD> and <KBD>"ABEND"</KBD> (they
+actually talked in capital letters, you understand), and the rest of
+the world said things like <EM>"computers are too complicated for
+me"</EM> and <EM>"I can't relate to computers -- they're so
+impersonal"</EM>. (A previous work [1] points out that Real Men don't
+"relate" to anything, and aren't afraid of being impersonal.) <P>
+
+But, as usual, times change. We are faced today with a world in which
+little old ladies can get computerized microwave ovens, 12 year old
+kids can blow Real Men out of the water playing Asteroids and Pac-Man,
+and anyone can buy and even understand their very own Personal
+Computer. The Real Programmer is in danger of becoming extinct, of
+being replaced by high-school students with TRASH-80s! <P>
+
+There is a clear need to point out the differences between the typical
+high-school junior Pac-Man player and a Real Programmer. Understanding
+these differences will give these kids something to aspire to -- a
+role model, a Father Figure. It will also help employers of Real
+Programmers to realize why it would be a mistake to replace the Real
+Programmers on their staff with 12 year old Pac-Man players (at a
+considerable salary savings). <P>
+
+
+<H3>LANGUAGES</H3>
+
+The easiest way to tell a Real Programmer from the crowd is by the
+programming language he (or she) uses. Real Programmers use FORTRAN.
+Quiche Eaters use PASCAL. Nicklaus Wirth, the designer of PASCAL, was
+once asked, <EM>"How do you pronounce your name?"</EM>. He replied
+<EM>"You can either call me by name, pronouncing it 'Veert', or call
+me by value, 'Worth'."</EM> One can tell immediately from this comment
+that Nicklaus Wirth is a Quiche Eater. The only parameter passing
+mechanism endorsed by Real Programmers is call-by-value-return, as
+implemented in the IBM/370 FORTRAN G and H compilers. Real
+programmers don't need abstract concepts to get their jobs done: they
+are perfectly happy with a keypunch, a FORTRAN IV compiler, and a
+beer. <P>
+
+<UL>
+<LI> Real Programmers do List Processing in FORTRAN.
+
+<LI> Real Programmers do String Manipulation in FORTRAN.
+
+<LI> Real Programmers do Accounting (if they do it at all) in FORTRAN.
+
+<LI> Real Programmers do Artificial Intelligence programs in FORTRAN.
+</UL> <P>
+
+If you can't do it in FORTRAN, do it in assembly language. If you can't do
+it in assembly language, it isn't worth doing. <P>
+
+
+<H3> STRUCTURED PROGRAMMING</H3>
+
+Computer science academicians have gotten into the "structured pro-
+gramming" rut over the past several years. They claim that programs
+are more easily understood if the programmer uses some special
+language constructs and techniques. They don't all agree on exactly
+which constructs, of course, and the examples they use to show their
+particular point of view invariably fit on a single page of some
+obscure journal or another -- clearly not enough of an example to
+convince anyone. When I got out of school, I thought I was the best
+programmer in the world. I could write an unbeatable tic-tac-toe
+program, use five different computer languages, and create 1000 line
+programs that WORKED. (Really!) Then I got out into the Real
+World. My first task in the Real World was to read and understand a
+200,000 line FORTRAN program, then speed it up by a factor of two. Any
+Real Programmer will tell you that all the Structured Coding in the
+world won't help you solve a problem like that -- it takes actual
+talent. Some quick observations on Real Programmers and Structured
+Programming: <P>
+
+<UL>
+<LI> Real Programmers aren't afraid to use GOTOs.
+
+<LI> Real Programmers can write five page long DO loops without
+getting confused.
+
+<LI> Real Programmers enjoy Arithmetic IF statements because they make
+the code more interesting.
+
+<LI> Real Programmers write self-modifying code, especially if it
+saves them 20 nanoseconds in the middle of a tight loop.
+
+<LI> Programmers don't need comments: the code is obvious.
+
+<LI> Since FORTRAN doesn't have a structured <KBD>IF, REPEAT
+... UNTIL</KBD>, or <KBD>CASE</KBD> statement, Real Programmers don't
+have to worry about not using them. Besides, they can be simulated
+when necessary using assigned <KBD>GOTO</KBD>s.
+
+</UL> <P>
+
+Data structures have also gotten a lot of press lately. Abstract Data
+Types, Structures, Pointers, Lists, and Strings have become popular in
+certain circles. Wirth (the above-mentioned Quiche Eater) actually
+wrote an entire book [2] contending that you could write a program
+based on data structures, instead of the other way around. As all Real
+Programmers know, the only useful data structure is the
+array. Strings, lists, structures, sets -- these are all special cases
+of arrays and and can be treated that way just as easily without
+messing up your programing language with all sorts of
+complications. The worst thing about fancy data types is that you have
+to declare them, and Real Programming Languages, as we all know, have
+implicit typing based on the first letter of the (six character)
+variable name. <P>
+
+
+<H3> OPERATING SYSTEMS</H3>
+
+What kind of operating system is used by a Real Programmer? CP/M? God
+forbid -- CP/M, after all, is basically a toy operating system. Even
+little old ladies and grade school students can understand and use
+CP/M. <P>
+
+Unix is a lot more complicated of course -- the typical Unix hacker
+never can remember what the <KBD>PRINT</KBD> command is called this
+week -- but when it gets right down to it, Unix is a glorified video
+game. People don't do Serious Work on Unix systems: they send jokes
+around the world on USENET and write adventure games and research
+papers. <P>
+
+No, your Real Programmer uses OS/370. A good programmer can find and
+understand the description of the IJK305I error he just got in his JCL
+manual. A great programmer can write JCL without referring to the
+manual at all. A truly outstanding programmer can find bugs buried in
+a 6 megabyte core dump without using a hex calculator. (I have
+actually seen this done.) <P>
+
+OS/370 is a truly remarkable operating system. It's possible to des-
+troy days of work with a single misplaced space, so alertness in the
+programming staff is encouraged. The best way to approach the system
+is through a keypunch. Some people claim there is a Time Sharing
+system that runs on OS/370, but after careful study I have come to the
+conclusion that they are mistaken. <P>
+
+
+<H3> PROGRAMMING TOOLS</H3>
+
+What kind of tools does a Real Programmer use? In theory, a Real
+Programmer could run his programs by keying them into the front panel
+of the computer. Back in the days when computers had front panels,
+this was actually done occasionally. Your typical Real Programmer
+knew the entire bootstrap loader by memory in hex, and toggled it in
+whenever it got destroyed by his program. (Back then, memory was
+memory -- it didn't go away when the power went off. Today, memory
+either forgets things when you don't want it to, or remembers things
+long after they're better forgotten.) Legend has it that Seymour
+Cray, inventor of the Cray I supercomputer and most of Control Data's
+computers, actually toggled the first operating system for the CDC7600
+in on the front panel from memory when it was first powered
+on. Seymour, needless to say, is a Real Programmer. <P>
+
+One of my favorite Real Programmers was a systems programmer for Texas
+Instruments. One day, he got a long distance call from a user whose
+system had crashed in the middle of some important work. Jim was able
+to repair the damage over the phone, getting the user to toggle in
+disk I/O instructions at the front panel, repairing system tables in
+hex, reading register contents back over the phone. The moral of this
+story: while a Real Programmer usually includes a keypunch and
+lineprinter in his toolkit, he can get along with just a front panel
+and a telephone in emergencies. <P>
+
+In some companies, text editing no longer consists of ten engineers
+standing in line to use an 029 keypunch. In fact, the building I work
+in doesn't contain a single keypunch. The Real Programmer in this
+situation has to do his work with a text editor program. Most systems
+supply several text editors to select from, and the Real Programmer
+must be careful to pick one that reflects his personal style. Many
+people believe that the best text editors in the world were written at
+Xerox Palo Alto Research Center for use on their Alto and Dorado
+computers [3]. Unfortunately, no Real Programmer would ever use a
+computer whose operating system is called SmallTalk, and would
+certainly not talk to the computer with a mouse. <P>
+
+Some of the concepts in these Xerox editors have been incorporated
+into editors running on more reasonably named operating systems. EMACS
+and VI are probably the most well known of this class of editors. The
+problem with these editors is that Real Programmers consider "what you
+see is what you get" to be just as bad a concept in text editors as it
+is in women. No, the Real Programmer wants a "you asked for it, you
+got it" text editor -- complicated, cryptic, powerful, unforgiving,
+dangerous. TECO, to be precise. <P>
+
+It has been observed that a TECO command sequence more closely resem-
+bles transmission line noise than readable text [4]. One of the more
+entertaining games to play with TECO is to type your name in as a
+command line and try to guess what it does. Just about any possible
+typing error while talking with TECO will probably destroy your
+program, or even worse -- introduce subtle and mysterious bugs in a
+once working subroutine. <P>
+
+For this reason, Real Programmers are reluctant to actually edit a
+program that is close to working. They find it much easier to just
+patch the binary object code directly, using a wonderful program
+called SUPERZAP (or its equivalent on non-IBM machines). This works so
+well that many working programs on IBM systems bear no relation to
+the original FORTRAN code. In many cases, the original source code is
+no longer available. When it comes time to fix a program like this, no
+manager would even think of sending anything less than a Real
+Programmer to do the job -- no Quiche Eating structured programmer
+would even know where to start. This is called "job security". <P>
+
+Some programming tools NOT used by Real Programmers: <P>
+<UL>
+
+<LI> FORTRAN preprocessors like MORTRAN and RATFOR. The Cuisinarts of
+programming -- great for making Quiche. See comments above on
+structured programming.
+
+<LI> Source language debuggers. Real Programmers can read core dumps.
+
+<LI> Compilers with array bounds checking. They stifle creativity,
+destroy most of the interesting uses for EQUIVALENCE, and make it
+impossible to modify the operating system code with negative
+subscripts. Worst of all, bounds checking is inefficient.
+
+<LI> Source code maintainance systems. A Real Programmer keeps his
+code locked up in a card file, because it implies that its owner
+cannot leave his important programs unguarded [5].
+
+</UL> <P>
+
+
+<H3> THE REAL PROGRAMMER AT WORK</H3>
+
+Where does the typical Real Programmer work? What kind of programs are
+worthy of the efforts of so talented an individual? You can be sure
+that no real Programmer would be caught dead writing
+accounts-receivable programs in COBOL, or sorting mailing lists for
+People magazine. A Real Programmer wants tasks of earth-shaking
+importance (literally!): <P>
+
+<UL>
+
+<LI> Real Programmers work for Los Alamos National Laboratory, writing
+atomic bomb simulations to run on Cray I supercomputers.
+
+<LI> Real Programmers work for the National Security Agency, decoding
+Russian transmissions.
+
+<LI> It was largely due to the efforts of thousands of Real
+Programmers working for NASA that our boys got to the moon and back
+before the cosmonauts.
+
+<LI> The computers in the Space Shuttle were programmed by Real
+Programmers.
+
+<LI> Programmers are at work for Boeing designing the operating
+systems for cruise missiles.
+
+</UL> <P>
+
+Some of the most awesome Real Programmers of all work at the Jet Pro-
+pulsion Laboratory in California. Many of them know the entire
+operating system of the Pioneer and Voyager spacecraft by heart. With
+a combination of large ground-based FORTRAN programs and small
+spacecraft-based assembly language programs, they can to do incredible
+feats of navigation and improvisation, such as hitting ten-kilometer
+wide windows at Saturn after six years in space, and repairing or
+bypassing damaged sensor platforms, radios, and batteries. Allegedly,
+one Real Programmer managed to tuck a pattern-matching program into a
+few hundred bytes of unused memory in a Voyager spacecraft that
+searched for, located, and photographed a new moon of Jupiter. <P>
+
+One plan for the upcoming Galileo spacecraft mission is to use a grav-
+ity assist trajectory past Mars on the way to Jupiter. This trajectory
+passes within 80 +/- 3 kilometers of the surface of Mars. Nobody is
+going to trust a PASCAL program (or PASCAL programmer) for navigation
+to these tolerances. <P>
+
+As you can tell, many of the world's Real Programmers work for the
+U.S. Government, mainly the Defense Department. This is as it should
+be. Recently, however, a black cloud has formed on the Real
+Programmer horizon. <P>
+
+It seems that some highly placed Quiche Eaters at the Defense
+Department decided that all Defense programs should be written in some
+grand unified language called "ADA" (registered trademark, DoD). For
+a while, it seemed that ADA was destined to become a language that
+went against all the precepts of Real Programming -- a language with
+structure, a language with data types, strong typing, and
+semicolons. In short, a language designed to cripple the creativity of
+the typical Real Programmer. Fortunately, the language adopted by DoD
+has enough interesting features to make it approachable: it's
+incredibly complex, includes methods for messing with the operating
+system and rearranging memory, and Edsgar Dijkstra doesn't like it
+[6]. (Dijkstra, as I'm sure you know, was the author of <EM>"GoTos
+Considered Harmful"</EM> -- a landmark work in programming
+methodology, applauded by Pascal Programmers and Quiche Eaters alike.)
+Besides, the determined Real Programmer can write FORTRAN programs in
+any language. <P>
+
+The real programmer might compromise his principles and work on some-
+thing slightly more trivial than the destruction of life as we know
+it, providing there's enough money in it. There are several Real
+Programmers building video games at Atari, for example. (But not
+playing them. A Real Programmer knows how to beat the machine every
+time: no challange in that.) Everyone working at LucasFilm is a Real
+Programmer. (It would be crazy to turn down the money of 50 million
+Star Wars fans.) The proportion of Real Programmers in Computer
+Graphics is somewhat lower than the norm, mostly because nobody has
+found a use for Computer Graphics yet. On the other hand, all
+Computer Graphics is done in FORTRAN, so there are a fair number
+people doing Graphics in order to avoid having to write COBOL
+programs. <P>
+
+
+<H3> THE REAL PROGRAMMER AT PLAY</H3>
+
+Generally, the Real Programmer plays the same way he works -- with
+computers. He is constantly amazed that his employer actually pays
+him to do what he would be doing for fun anyway, although he is
+careful not to express this opinion out loud. Occasionally, the Real
+Programmer does step out of the office for a breath of fresh air and a
+beer or two. Some tips on recognizing real programmers away from the
+computer room: <P>
+<UL>
+
+<LI> At a party, the Real Programmers are the ones in the corner
+talking about operating system security and how to get around it.
+
+<LI> At a football game, the Real Programmer is the one comparing the
+plays against his simulations printed on 11 by 14 fanfold paper.
+
+<LI> At the beach, the Real Programmer is the one drawing flowcharts
+in the sand.
+
+<LI> A Real Programmer goes to a disco to watch the light show.
+
+<LI> At a funeral, the Real Programmer is the one saying <EM>"Poor
+George. And he almost had the sort routine working before the
+coronary."</EM>
+
+<LI> In a grocery store, the Real Programmer is the one who insists on
+running the cans past the laser checkout scanner himself, because he
+never could trust keypunch operators to get it right the first time.
+
+</UL> <P>
+
+
+<H3> THE REAL PROGRAMMER'S NATURAL HABITAT</H3>
+
+What sort of environment does the Real Programmer function best in?
+This is an important question for the managers of Real
+Programmers. Considering the amount of money it costs to keep one on
+the staff, it's best to put him (or her) in an environment where he
+can get his work done. <P>
+
+The typical Real Programmer lives in front of a computer terminal.
+Surrounding this terminal are: <P>
+<UL>
+
+<LI> Listings of all programs the Real Programmer has ever worked on,
+piled in roughly chronological order on every flat surface in the office.
+
+<LI> Some half-dozen or so partly filled cups of cold
+coffee. Occasionally, there will be cigarette butts floating in the
+coffee. In some cases, the cups will contain Orange Crush.
+
+<LI> Unless he is very good, there will be copies of the OS JCL manual
+and the Principles of Operation open to some particularly interesting
+pages.
+
+<LI> Taped to the wall is a line-printer Snoopy calender for the year
+1969.
+
+<LI> Strewn about the floor are several wrappers for peanut butter
+filled cheese bars (the type that are made stale at the bakery so they
+can't get any worse while waiting in the vending machine).
+
+<LI> Hiding in the top left-hand drawer of the desk is a stash of
+double stuff Oreos for special occasions.
+
+<LI> Underneath the Oreos is a flow-charting template, left there by
+the previous occupant of the office. (Real Programmers write programs,
+not documentation. Leave that to the maintainence people.)
+
+</UL> <P>
+
+The Real Programmer is capable of working 30, 40, even 50 hours at a
+stretch, under intense pressure. In fact, he prefers it that way. Bad
+response time doesn't bother the Real Programmer -- it gives him a
+chance to catch a little sleep between compiles. If there is not
+enough schedule pressure on the Real Programmer, he tends to make
+things more challenging by working on some small but interesting part
+of the problem for the first nine weeks, then finishing the rest in
+the last week, in two or three 50-hour marathons. This not only
+inpresses his manager, who was despairing of ever getting the project
+done on time, but creates a convenient excuse for not doing the
+documentation. In general: <P>
+
+<UL>
+
+<LI> No Real Programmer works 9 to 5. (Unless it's 9 in the evening to
+5 in the morning.)
+
+<LI> Real Programmers don't wear neckties.
+
+<LI> Real Programmers don't wear high heeled shoes.
+
+<LI> Real Programmers arrive at work in time for lunch. [9]
+
+<LI> A Real Programmer might or might not know his wife's name. He
+does, however, know the entire ASCII (or EBCDIC) code table.
+
+<LI> Real Programmers don't know how to cook. Grocery stores aren't
+often open at 3 a.m., so they survive on Twinkies and coffee.
+
+</UL> <P>
+
+<H3> THE FUTURE</H3>
+
+What of the future? It is a matter of some concern to Real Programmers
+that the latest generation of computer programmers are not being
+brought up with the same outlook on life as their elders. Many of them
+have never seen a computer with a front panel. Hardly anyone
+graduating from school these days can do hex arithmetic without a
+calculator. College graduates these days are soft -- protected from
+the realities of programming by source level debuggers, text editors
+that count parentheses, and user friendly operating systems. Worst of
+all, some of these alleged computer scientists manage to get degrees
+without ever learning FORTRAN! Are we destined to become an industry
+of Unix hackers and Pascal programmers? <P>
+
+On the contrary. From my experience, I can only report that the
+future is bright for Real Programmers everywhere. Neither OS/370 nor
+FORTRAN show any signs of dying out, despite all the efforts of
+Pascal programmers the world over. Even more subtle tricks, like
+adding structured coding constructs to FORTRAN have failed. Oh sure,
+some computer vendors have come out with FORTRAN 77 compilers, but
+every one of them has a way of converting itself back into a FORTRAN
+66 compiler at the drop of an option card -- to compile DO loops like
+God meant them to be. <P>
+
+Even Unix might not be as bad on Real Programmers as it once was. The
+latest release of Unix has the potential of an operating system worthy
+of any Real Programmer. It has two different and subtly incompatible
+user interfaces, an arcane and complicated terminal driver, virtual
+memory. If you ignore the fact that it's structured, even C
+programming can be appreciated by the Real Programmer: after all,
+there's no type checking, variable names are seven (ten? eight?)
+characters long, and the added bonus of the Pointer data type is
+thrown in. It's like having the best parts of FORTRAN and assembly
+language in one place. (Not to mention some of the more creative uses
+for <KBD>#define</KBD>.) <P>
+
+No, the future isn't all that bad. Why, in the past few years, the
+popular press has even commented on the bright new crop of computer
+nerds and hackers ([7] and [8]) leaving places like Stanford and
+M.I.T. for the Real World. From all evidence, the spirit of Real
+Programming lives on in these young men and women. As long as there
+are ill-defined goals, bizarre bugs, and unrealistic schedules, there
+will be Real Programmers willing to jump in and Solve The Problem,
+saving the documentation for later. Long live FORTRAN! <P>
+
+<H3>ACKNOWLEGEMENT</H3>
+
+I would like to thank Jan E., Dave S., Rich G., Rich E. for their help
+in characterizing the Real Programmer, Heather B. for the
+illustration, Kathy E. for putting up with it, and <kbd>atd!avsdS:mark</kbd> for
+the initial inspriration. <P>
+
+<H3>REFERENCES</H3>
+
+[1] Feirstein, B., <em>Real Men Don't Eat Quiche</em>, New York,
+ Pocket Books, 1982. <P>
+
+[2] Wirth, N., <em>Algorithms + Datastructures = Programs</em>,
+ Prentice Hall, 1976. <P>
+
+[3] Xerox PARC editors . . . <P>
+
+[4] Finseth, C., <em>Theory and Practice of Text Editors -
+ or - a Cookbook for an EMACS</em>, B.S. Thesis,
+ MIT/LCS/TM-165, Massachusetts Institute of Technology,
+ May 1980. <P>
+
+[5] Weinberg, G., <em>The Psychology of Computer Programming</em>,
+ New York, Van Nostrabd Reinhold, 1971, page 110. <P>
+
+[6] Dijkstra, E., <em>On the GREEN Language Submitted to the DoD</em>,
+ Sigplan notices, Volume 3, Number 10, October 1978. <P>
+
+[7] Rose, Frank, <em>Joy of Hacking</em>, Science 82, Volume 3, Number 9,
+ November 1982, pages 58 - 66. <P>
+
+[8] The Hacker Papers, <em>Psychology Today</em>, August 1980. <P>
+
+[9] <em>Datamation</em>, July, 1983, pp. 263-265. <P>
+
+<hr>
+
+<ADDRESS> <a href="index.html">Hacker's Wisdom</a>/ Real Programmers
+Don't Use PASCAL </ADDRESS>
+
+<!-- hhmts start -->
+Last modified: Wed Mar 27 17:48:50 EST 1996
diff --git a/lib/kernel/test/prim_file_SUITE_data/realmen.html.gz b/lib/kernel/test/prim_file_SUITE_data/realmen.html.gz
new file mode 100644
index 0000000000..9c662ff3c0
--- /dev/null
+++ b/lib/kernel/test/prim_file_SUITE_data/realmen.html.gz
Binary files differ
diff --git a/lib/kernel/test/ram_file_SUITE.erl b/lib/kernel/test/ram_file_SUITE.erl
new file mode 100644
index 0000000000..55c9497670
--- /dev/null
+++ b/lib/kernel/test/ram_file_SUITE.erl
@@ -0,0 +1,651 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(ram_file_SUITE).
+
+-export([all/1,
+ %% init/1, fini/1,
+ init_per_testcase/2, fin_per_testcase/2]).
+-export([open_modes/1, open_old_modes/1, pread_pwrite/1, position/1,
+ truncate/1, sync/1, get_set_file/1, compress/1, uuencode/1,
+ large_file_errors/1, large_file_light/1, large_file_heavy/1]).
+
+-include("test_server.hrl").
+-include_lib("kernel/include/file.hrl").
+
+-define(FILE_MODULE, file). % Name of module to test
+-define(RAM_FILE_MODULE, ram_file). % Name of module to test
+
+%%--------------------------------------------------------------------------
+
+all(suite) ->
+ [open_modes, open_old_modes, pread_pwrite, position,
+ truncate, sync, get_set_file, compress, uuencode,
+ large_file_errors, large_file_light, large_file_heavy].
+
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ Time =
+ case Func of
+ large_file_heavy ->
+ ?t:minutes(5);
+ _ ->
+ ?t:seconds(10)
+ end,
+ Dog = ?t:timetrap(Time),
+ %% error_logger:info_msg("~p:~p *****~n", [?MODULE, Func]),
+ [{watchdog, Dog} | Config].
+
+fin_per_testcase(_Func, Config) ->
+ %% error_logger:info_msg("~p:~p END *****~n", [?MODULE, Func]),
+ Dog = ?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog).
+
+%%--------------------------------------------------------------------------
+%% Test suites
+
+open_modes(suite) ->
+ [];
+open_modes(doc) ->
+ ["Test that the basic read, write and binary options works for open/2."];
+open_modes(Config) when is_list(Config) ->
+ ?line Str1 = "The quick brown fox ",
+ ?line Str2 = "jumps over a lazy dog ",
+ ?line Str = Str1 ++ Str2,
+ ?line Bin1 = list_to_binary(Str1),
+ ?line Bin2 = list_to_binary(Str2),
+ ?line Bin = list_to_binary(Str),
+ %%
+ open_read_write(?FILE_MODULE, Str1, [ram, read, write], Str2),
+ open_read(?FILE_MODULE, Str, [ram]),
+ open_read_write(?FILE_MODULE, Bin1, [ram, binary, read, write], Bin2),
+ open_read(?FILE_MODULE, Bin, [ram, binary, read]),
+ %%
+ ok.
+
+open_old_modes(suite) ->
+ [];
+open_old_modes(doc) ->
+ ["Test that the old style read, write and binary options ",
+ "works for open/2."];
+open_old_modes(Config) when is_list(Config) ->
+ ?line Str1 = "The quick brown fox ",
+ ?line Str2 = "jumps over a lazy dog ",
+ ?line Str = Str1 ++ Str2,
+ ?line Bin1 = list_to_binary(Str1),
+ ?line Bin2 = list_to_binary(Str2),
+ ?line Bin = list_to_binary(Str),
+ %%
+ open_read_write(?RAM_FILE_MODULE, Str1, read_write, Str2),
+ open_read(?RAM_FILE_MODULE, Str, read),
+ open_read_write(?RAM_FILE_MODULE, Bin1, {binary, read_write}, Bin2),
+ open_read(?RAM_FILE_MODULE, Bin, {binary, read}),
+ %%
+ ok.
+
+open_read_write(Module, Data1, Options, Data2) ->
+ ?line io:format("~p:open_read_write(~p, ~p, ~p, ~p)~n",
+ [?MODULE, Module, Data1, Options, Data2]),
+ %%
+ ?line Size1 = sizeof(Data1),
+ ?line Size2 = sizeof(Data2),
+ ?line Data = append(Data1, Data2),
+ ?line Size = Size1 + Size2,
+ %%
+ ?line {ok, Fd} = Module:open(Data1, Options),
+ ?line {ok, Data1} = Module:read(Fd, Size1),
+ ?line eof = Module:read(Fd, 1),
+ ?line {ok, Zero} = Module:read(Fd, 0),
+ ?line 0 = sizeof(Zero),
+ ?line ok = Module:write(Fd, Data2),
+ ?line {ok, 0} = Module:position(Fd, bof),
+ ?line {ok, Data} = Module:read(Fd, Size),
+ ?line eof = Module:read(Fd, 1),
+ ?line {ok, Zero} = Module:read(Fd, 0),
+ ?line ok = Module:close(Fd),
+ %%
+ ?line ok.
+
+open_read(Module, Data, Options) ->
+ ?line io:format("~p:open_read(~p, ~p, ~p)~n",
+ [?MODULE, Module, Data, Options]),
+ %%
+ ?line Size = sizeof(Data),
+ %%
+ ?line {ok, Fd} = Module:open(Data, Options),
+ ?line {ok, Data} = Module:read(Fd, Size),
+ ?line eof = Module:read(Fd, 1),
+ ?line {ok, Zero} = Module:read(Fd, 0),
+ ?line 0 = sizeof(Zero),
+ ?line {error, ebadf} = Module:write(Fd, Data),
+ ?line {ok, 0} = Module:position(Fd, bof),
+ ?line {ok, Data} = Module:read(Fd, Size),
+ ?line eof = Module:read(Fd, 1),
+ ?line {ok, Zero} = Module:read(Fd, 0),
+ ?line ok = Module:close(Fd),
+ %%
+ ?line ok.
+
+
+
+pread_pwrite(suite) ->
+ [];
+pread_pwrite(doc) ->
+ ["Test that pread/2,3 and pwrite/2,3 works."];
+pread_pwrite(Config) when is_list(Config) ->
+ ?line Str = "Flygande b�ckaziner s�ka hwila p� mjuqa tuvor x",
+ ?line Bin = list_to_binary(Str),
+ %%
+ pread_pwrite_test(?FILE_MODULE, Str, [ram, read, write]),
+ pread_pwrite_test(?FILE_MODULE, Bin, [ram, binary, read, write]),
+ pread_pwrite_test(?RAM_FILE_MODULE, Str, [read, write]),
+ pread_pwrite_test(?RAM_FILE_MODULE, Bin, {binary, read_write}),
+ %%
+ ok.
+
+pread_pwrite_test(Module, Data, Options) ->
+ ?line io:format("~p:pread_pwrite_test(~p, ~p, ~p)~n",
+ [?MODULE, Module, Data, Options]),
+ %%
+ ?line Size = sizeof(Data),
+ %%
+ ?line {ok, Fd} = Module:open([], Options),
+ ?line ok = Module:pwrite(Fd, 0, Data),
+ ?line {ok, Data} = Module:pread(Fd, 0, Size+1),
+ ?line eof = Module:pread(Fd, Size+1, 1),
+ ?line {ok, Zero} = Module:pread(Fd, Size+1, 0),
+ ?line 0 = sizeof(Zero),
+ ?line ok = Module:pwrite(Fd, [{0, Data}, {Size+17, Data}]),
+ ?line {ok, [Data,
+ eof,
+ Data,
+ Zero]} = Module:pread(Fd, [{Size+17, Size+1},
+ {2*Size+17+1, 1},
+ {0, Size},
+ {2*Size+17+1, 0}]),
+ ?line ok = Module:close(Fd),
+ %%
+ ?line ok.
+
+position(suite) ->
+ [];
+position(doc) ->
+ ["Test that position/2 works."];
+position(Config) when is_list(Config) ->
+ ?line Str = "Att vara eller icke vara, det �r fr�gan. ",
+ ?line Bin = list_to_binary(Str),
+ %%
+ position_test(?FILE_MODULE, Str, [ram, read]),
+ position_test(?FILE_MODULE, Bin, [ram, binary]),
+ position_test(?RAM_FILE_MODULE, Str, [read]),
+ position_test(?RAM_FILE_MODULE, Bin, {binary, read}),
+ %%
+ ok.
+
+position_test(Module, Data, Options) ->
+ ?line io:format("~p:position_test(~p, ~p, ~p)~n",
+ [?MODULE, Module, Data, Options]),
+ %%
+ ?line Size = sizeof(Data),
+ ?line Size_7 = Size+7,
+ %%
+ ?line Slice_0_2 = slice(Data, 0, 2),
+ ?line Slice_0_3 = slice(Data, 0, 3),
+ ?line Slice_2_5 = slice(Data, 2, 5),
+ ?line Slice_3_4 = slice(Data, 3, 4),
+ ?line Slice_5 = slice(Data, 5, Size),
+ %%
+ ?line {ok, Fd} = Module:open(Data, Options),
+ %%
+ ?line io:format("CUR positions"),
+ ?line {ok, Slice_0_2} = Module:read(Fd, 2),
+ ?line {ok, 2} = Module:position(Fd, cur),
+ ?line {ok, Slice_2_5} = Module:read(Fd, 5),
+ ?line {ok, 3} = Module:position(Fd, {cur, -4}),
+ ?line {ok, Slice_3_4} = Module:read(Fd, 4),
+ ?line {ok, 0} = Module:position(Fd, {cur, -7}),
+ ?line {ok, Slice_0_3} = Module:read(Fd, 3),
+ ?line {ok, 0} = Module:position(Fd, {cur, -3}),
+ ?line {error, einval} = Module:position(Fd, {cur, -1}),
+ ?line {ok, 0} = Module:position(Fd, 0),
+ ?line {ok, 2} = Module:position(Fd, {cur, 2}),
+ ?line {ok, Slice_2_5} = Module:read(Fd, 5),
+ ?line {ok, Size_7} = Module:position(Fd, {cur, Size}),
+ ?line {ok, Zero} = Module:read(Fd, 0),
+ ?line 0 = sizeof(Zero),
+ ?line eof = Module:read(Fd, 1),
+ %%
+ ?line io:format("Absolute and BOF positions"),
+ ?line {ok, Size} = Module:position(Fd, Size),
+ ?line eof = Module:read(Fd, 1),
+ ?line {ok, 5} = Module:position(Fd, 5),
+ ?line {ok, Slice_5} = Module:read(Fd, Size),
+ ?line {ok, 2} = Module:position(Fd, {bof, 2}),
+ ?line {ok, Slice_2_5} = Module:read(Fd, 5),
+ ?line {ok, 3} = Module:position(Fd, 3),
+ ?line {ok, Slice_3_4} = Module:read(Fd, 4),
+ ?line {ok, 0} = Module:position(Fd, bof),
+ ?line {ok, Slice_0_2} = Module:read(Fd, 2),
+ ?line {ok, Size_7} = Module:position(Fd, {bof, Size_7}),
+ ?line {ok, Zero} = Module:read(Fd, 0),
+ %%
+ ?line io:format("EOF positions"),
+ ?line {ok, Size} = Module:position(Fd, eof),
+ ?line eof = Module:read(Fd, 1),
+ ?line {ok, 5} = Module:position(Fd, {eof, -Size+5}),
+ ?line {ok, Slice_5} = Module:read(Fd, Size),
+ ?line {ok, 2} = Module:position(Fd, {eof, -Size+2}),
+ ?line {ok, Slice_2_5} = Module:read(Fd, 5),
+ ?line {ok, 3} = Module:position(Fd, {eof, -Size+3}),
+ ?line {ok, Slice_3_4} = Module:read(Fd, 4),
+ ?line {ok, 0} = Module:position(Fd, {eof, -Size}),
+ ?line {ok, Slice_0_2} = Module:read(Fd, 2),
+ ?line {ok, Size_7} = Module:position(Fd, {eof, 7}),
+ ?line {ok, Zero} = Module:read(Fd, 0),
+ ?line eof = Module:read(Fd, 1),
+ %%
+ ?line ok.
+
+
+
+truncate(suite) ->
+ [];
+truncate(doc) ->
+ ["Test that truncate/1 works."];
+truncate(Config) when is_list(Config) ->
+ ?line Str = "M�n �dlare att lida och f�rdraga "
+ ++ "ett bittert �des stygn av pilar, ",
+ ?line Bin = list_to_binary(Str),
+ %%
+ ok = truncate_test(?FILE_MODULE, Str, [ram, read, write]),
+ ok = truncate_test(?FILE_MODULE, Bin, [ram, binary, read, write]),
+ ok = truncate_test(?RAM_FILE_MODULE, Str, read_write),
+ ok = truncate_test(?RAM_FILE_MODULE, Bin, [binary, read, write]),
+ %%
+ {error, eacces} = truncate_test(?FILE_MODULE, Str, [ram]),
+ {error, eacces} = truncate_test(?FILE_MODULE, Bin, [ram, binary, read]),
+ {error, eacces} = truncate_test(?RAM_FILE_MODULE, Str, read),
+ {error, eacces} = truncate_test(?RAM_FILE_MODULE, Bin, {binary, read}),
+ %%
+ ok.
+
+truncate_test(Module, Data, Options) ->
+ ?line io:format("~p:truncate_test(~p, ~p, ~p)~n",
+ [?MODULE, Module, Data, Options]),
+ %%
+ ?line Size = sizeof(Data),
+ ?line Size1 = Size-2,
+ ?line Data1 = slice(Data, 0, Size1),
+ %%
+ ?line {ok, Fd} = Module:open(Data, Options),
+ ?line {ok, Size1} = Module:position(Fd, Size1),
+ ?line case Module:truncate(Fd) of
+ ok ->
+ ?line {ok, 0} = Module:position(Fd, 0),
+ ?line {ok, Data1} = Module:read(Fd, Size),
+ ?line ok = Module:close(Fd),
+ ?line ok;
+ Error ->
+ ?line ok = Module:close(Fd),
+ ?line Error
+ end.
+
+
+
+sync(suite) ->
+ [];
+sync(doc) ->
+ ["Test that sync/1 at least does not crash."];
+sync(Config) when is_list(Config) ->
+ ?line Str = "�n att ta till vapen mot ett hav av kval. ",
+ ?line Bin = list_to_binary(Str),
+ %%
+ sync_test(?FILE_MODULE, Str, [ram, read, write]),
+ sync_test(?FILE_MODULE, Bin, [ram, binary, read, write]),
+ sync_test(?RAM_FILE_MODULE, Str, read_write),
+ sync_test(?RAM_FILE_MODULE, Bin, [binary, read, write]),
+ %%
+ sync_test(?FILE_MODULE, Str, [ram]),
+ sync_test(?FILE_MODULE, Bin, [ram, binary, read]),
+ sync_test(?RAM_FILE_MODULE, Str, read),
+ sync_test(?RAM_FILE_MODULE, Bin, {binary, read}),
+ %%
+ ok.
+
+sync_test(Module, Data, Options) ->
+ ?line io:format("~p:sync_test(~p, ~p, ~p)~n",
+ [?MODULE, Module, Data, Options]),
+ %%
+ ?line Size = sizeof(Data),
+ %%
+ ?line {ok, Fd} = Module:open(Data, Options),
+ ?line ok = Module:sync(Fd),
+ ?line {ok, Data} = Module:read(Fd, Size+1),
+ ?line ok.
+
+
+
+get_set_file(suite) ->
+ [];
+get_set_file(doc) ->
+ ["Tests get_file/1, set_file/2, get_file_close/1 and get_size/1."];
+get_set_file(Config) when is_list(Config) ->
+ %% These two strings should not be of equal length.
+ ?line Str = "N�r h�gan nord blir sn�bet�ckt, ",
+ ?line Str2 = "f�r alla harar byta dr�kt. ",
+ ?line Bin = list_to_binary(Str),
+ ?line Bin2 = list_to_binary(Str2),
+ %%
+ ok = get_set_file_test(Str, read_write, Str2),
+ ok = get_set_file_test(Bin, [binary, read, write], Bin2),
+ ok = get_set_file_test(Str, read, Str2),
+ ok = get_set_file_test(Bin, [binary, read], Bin2),
+ %%
+ ok.
+
+get_set_file_test(Data, Options, Data2) ->
+ ?line io:format("~p:get_set_file_test(~p, ~p, ~p)~n",
+ [?MODULE, Data, Options, Data2]),
+ %%
+ ?line Size = sizeof(Data),
+ ?line Size2 = sizeof(Data2),
+ %%
+ ?line {ok, Fd} = ?RAM_FILE_MODULE:open(Data, Options),
+ ?line {ok, Size} = ?RAM_FILE_MODULE:get_size(Fd),
+ ?line {ok, Data} = ?RAM_FILE_MODULE:get_file(Fd),
+ ?line {ok, Data} = ?RAM_FILE_MODULE:get_file_close(Fd),
+ ?line {error, einval} = ?RAM_FILE_MODULE:get_size(Fd),
+ ?line {ok, Fd2} = ?RAM_FILE_MODULE:open(Data, Options),
+ ?line case ?RAM_FILE_MODULE:set_file(Fd2, Data2) of
+ {ok, Size2} ->
+ ?line {ok, Size2} = ?RAM_FILE_MODULE:get_size(Fd2),
+ ?line {ok, Data2} = ?RAM_FILE_MODULE:get_file(Fd2),
+ ?line {ok, Data2} = ?RAM_FILE_MODULE:get_file_close(Fd2),
+ ?line ok;
+ {error, _} = Error ->
+ ?line {ok, Data} = ?RAM_FILE_MODULE:get_file_close(Fd2),
+ ?line Error
+ end.
+
+
+
+compress(suite) ->
+ [];
+compress(doc) ->
+ ["Test that compress/1 and uncompress/1 works."];
+compress(Config) when is_list(Config) ->
+ ?line Data = ?config(data_dir, Config),
+ ?line Real = filename:join(Data, "realmen.html"),
+ ?line RealGz = filename:join(Data, "realmen.html.gz"),
+ %%
+ %% Uncompress test
+ %%
+ ?line {ok, FdReal} = ?FILE_MODULE:open(Real, []),
+ ?line {ok, Fd} = ?FILE_MODULE:open([], [ram, read, write]),
+ ?line {ok, FdRealGz} = ?FILE_MODULE:open(RealGz, []),
+ %%
+ ?line {ok, SzGz} = ?FILE_MODULE:copy(FdRealGz, Fd),
+ ?line {ok, Sz} = ?RAM_FILE_MODULE:uncompress(Fd),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof),
+ ?line true = compare(FdReal, Fd),
+ %%
+ ?line true = (SzGz =< Sz),
+ %%
+ %% Compress and uncompress test
+ %%
+ ?line {ok, 0} = ?FILE_MODULE:position(FdReal, bof),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof),
+ ?line ok = ?FILE_MODULE:truncate(Fd),
+ ?line {ok, Sz} = ?FILE_MODULE:copy(FdReal, Fd),
+ ?line {ok, SzGz} = ?RAM_FILE_MODULE:compress(Fd),
+ ?line {ok, Sz} = ?RAM_FILE_MODULE:uncompress(Fd),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof),
+ ?line {ok, 0} = ?FILE_MODULE:position(FdReal, bof),
+ ?line true = compare(FdReal, Fd),
+ %%
+ ?line ok = ?FILE_MODULE:close(FdReal),
+ ?line ok = ?FILE_MODULE:close(Fd),
+ ?line ok = ?FILE_MODULE:close(FdRealGz),
+
+
+ %% Test uncompressing data that will be expanded many times.
+ ?line Huge = iolist_to_binary(mk_42(18)),
+ ?line HugeSize = byte_size(Huge),
+ ?line HugeGz = zlib:gzip(Huge),
+
+ ?line {ok,HugeFd} = ?FILE_MODULE:open([], [ram,read,write,binary]),
+ ?line ok = ?FILE_MODULE:write(HugeFd, HugeGz),
+ ?line {ok,HugeSize} = ?RAM_FILE_MODULE:uncompress(HugeFd),
+ ?line {ok,0} = ?FILE_MODULE:position(HugeFd, bof),
+ ?line {ok,Huge} = ?FILE_MODULE:read(HugeFd, HugeSize),
+
+ %% Uncompressing again should do nothing.
+ ?line {ok,HugeSize} = ?RAM_FILE_MODULE:uncompress(HugeFd),
+ ?line {ok,0} = ?FILE_MODULE:position(HugeFd, bof),
+ ?line {ok,Huge} = ?FILE_MODULE:read(HugeFd, HugeSize),
+
+ ?line ok = ?FILE_MODULE:close(HugeFd),
+
+ ok.
+
+mk_42(0) ->
+ [42];
+mk_42(N) ->
+ B = mk_42(N-1),
+ [B|B].
+
+uuencode(suite) ->
+ [];
+uuencode(doc) ->
+ ["Test that uuencode/1 and uudecode/1 works."];
+uuencode(Config) when is_list(Config) ->
+ ?line Data = ?config(data_dir, Config),
+ ?line Real = filename:join(Data, "realmen.html"),
+ ?line RealUu = filename:join(Data, "realmen.html.uu"),
+ %%
+ %% Uudecode test
+ %%
+ ?line {ok, FdReal} = ?FILE_MODULE:open(Real, []),
+ ?line {ok, Fd} = ?FILE_MODULE:open([], [ram, read, write]),
+ ?line {ok, FdRealUu} = ?FILE_MODULE:open(RealUu, []),
+ %%
+ ?line {ok, SzUu} = ?FILE_MODULE:copy(FdRealUu, Fd),
+ ?line {ok, Sz} = ?RAM_FILE_MODULE:uudecode(Fd),
+ ?line true = (Sz =< SzUu),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof),
+ ?line true = compare(FdReal, Fd),
+ %%
+ %% Uuencode and decode test
+ %%
+ ?line {ok, 0} = ?FILE_MODULE:position(FdReal, bof),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof),
+ ?line ok = ?FILE_MODULE:truncate(Fd),
+ ?line {ok, Sz} = ?FILE_MODULE:copy(FdReal, Fd),
+ ?line {ok, SzUu} = ?RAM_FILE_MODULE:uuencode(Fd),
+ ?line true = (Sz =< SzUu),
+ ?line {ok, Sz } = ?RAM_FILE_MODULE:uudecode(Fd),
+ ?line {ok, 0} = ?FILE_MODULE:position(FdReal, bof),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof),
+ ?line true = compare(FdReal, Fd),
+ %%
+ ?line ok = ?FILE_MODULE:close(FdReal),
+ ?line ok = ?FILE_MODULE:close(Fd),
+ ?line ok = ?FILE_MODULE:close(FdRealUu),
+ ok.
+
+
+
+large_file_errors(suite) ->
+ [];
+large_file_errors(doc) ->
+ ["Test error checking of large file offsets."];
+large_file_errors(Config) when is_list(Config) ->
+ ?line TwoGig = 1 bsl 31,
+ ?line {ok,Fd} = ?RAM_FILE_MODULE:open("1234567890", [read,write]),
+ ?line {error, einval} = ?FILE_MODULE:read(Fd, TwoGig),
+ ?line {error, badarg} = ?FILE_MODULE:read(Fd, -1),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd, {bof,TwoGig}),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd, {bof,-TwoGig-1}),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd, {bof,-1}),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd, {cur,TwoGig}),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd, {cur,-TwoGig-1}),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd, {eof,TwoGig}),
+ ?line {error, einval} = ?FILE_MODULE:position(Fd, {eof,-TwoGig-1}),
+ ?line {error, einval} = ?FILE_MODULE:pread(Fd, TwoGig, 1),
+ ?line {error, einval} = ?FILE_MODULE:pread(Fd, -TwoGig-1, 1),
+ ?line {error, einval} = ?FILE_MODULE:pread(Fd, -1, 1),
+ ?line {error, einval} = ?FILE_MODULE:pwrite(Fd, TwoGig, "@"),
+ ?line {error, einval} = ?FILE_MODULE:pwrite(Fd, -TwoGig-1, "@"),
+ ?line {error, einval} = ?FILE_MODULE:pwrite(Fd, -1, "@"),
+ ?line {error, einval} = ?FILE_MODULE:pread(Fd, TwoGig, 0),
+ ?line {error, einval} = ?FILE_MODULE:pread(Fd, -TwoGig-1, 0),
+ ?line {error, einval} = ?FILE_MODULE:pread(Fd, -1, 0),
+ ?line ok = ?FILE_MODULE:close(Fd),
+ ok.
+
+
+
+large_file_light(suite) ->
+ [];
+large_file_light(doc) ->
+ ["Test light operations on a \"large\" ram_file."];
+large_file_light(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ %% Marker for next test case that is to heavy to run in a suite.
+ ?line ok = ?FILE_MODULE:write_file(
+ filename:join(PrivDir, large_file_light),
+ <<"TAG">>),
+ %%
+ ?line Data = "abcdefghijklmnopqrstuvwzyz",
+ ?line Size = sizeof(Data),
+ ?line Max = (1 bsl 31) - 1,
+ ?line Max__1 = Max - 1,
+ ?line {ok, Fd} = ?RAM_FILE_MODULE:open(Data, [read]),
+ ?line {ok, Data} = ?FILE_MODULE:read(Fd, Size+1),
+ ?line {ok, Max__1} = ?FILE_MODULE:position(Fd, {eof, Max-Size-1}),
+ ?line eof = ?FILE_MODULE:read(Fd, 1),
+ ?line {ok, Max} = ?FILE_MODULE:position(Fd, {bof, Max}),
+ ?line {ok, Zero} = ?FILE_MODULE:read(Fd, 0),
+ ?line 0 = sizeof(Zero),
+ ?line eof = ?FILE_MODULE:read(Fd, 1),
+ ?line eof = ?FILE_MODULE:pread(Fd, Max__1, 1),
+ ?line {ok, Zero} = ?FILE_MODULE:pread(Fd, Max, 0),
+ ?line eof = ?FILE_MODULE:pread(Fd, Max, 1),
+ ok.
+
+
+
+large_file_heavy(suite) ->
+ [];
+large_file_heavy(doc) ->
+ ["Test operations on a maximum size (2 GByte - 1) ram_file."];
+large_file_heavy(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ %% Check previous test case marker.
+ case ?FILE_MODULE:read_file_info(
+ filename:join(PrivDir, large_file_light)) of
+ {ok,_} ->
+ {skipped,"Too heavy for casual testing!"};
+ _ ->
+ do_large_file_heavy(Config)
+ end.
+
+do_large_file_heavy(_Config) ->
+ ?line Data = "qwertyuiopasdfghjklzxcvbnm",
+ ?line Size = sizeof(Data),
+ ?line Max = (1 bsl 31) - 1,
+ ?line Max__1 = Max - 1,
+ ?line Max__3 = Max - 3,
+ ?line {ok, Fd} = ?RAM_FILE_MODULE:open(Data, [read,write]),
+ ?line {ok, Data} = ?FILE_MODULE:read(Fd, Size+1),
+ ?line {ok, Max} = ?FILE_MODULE:position(Fd, {eof, Max-Size}),
+ ?line eof = ?FILE_MODULE:read(Fd, 1),
+ ?line erlang:display({allocating,2,'GByte',please,be,patient,'...'}),
+ ?line ok = ?FILE_MODULE:write(Fd, ""),
+ ?line erlang:display({allocating,2,'GByte',succeeded}),
+ ?line {ok, Max__1} = ?FILE_MODULE:position(Fd, {eof, -1}),
+ ?line {ok, [0]} = ?FILE_MODULE:read(Fd, 1),
+ ?line {ok, []} = ?FILE_MODULE:read(Fd, 0),
+ ?line eof = ?FILE_MODULE:read(Fd, 1),
+ ?line ok = ?FILE_MODULE:pwrite(Fd, Max-3, "TAG"),
+ ?line {ok, Max} = ?FILE_MODULE:position(Fd, cur),
+ ?line {ok, Max__3} = ?FILE_MODULE:position(Fd, {eof, -3}),
+ ?line {ok, "TAG"} = ?FILE_MODULE:read(Fd, 3+1),
+ ?line {ok, Max__3} = ?FILE_MODULE:position(Fd, {cur, -3}),
+ ?line ok = ?FILE_MODULE:write(Fd, "tag"),
+ ?line {ok, Max} = ?FILE_MODULE:position(Fd, cur),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof),
+ ?line {ok, "tag"} = ?FILE_MODULE:pread(Fd, Max__3, 3+1),
+ ?line {ok, 0} = ?FILE_MODULE:position(Fd, cur),
+ ?line ok = ?FILE_MODULE:close(Fd),
+ ok.
+
+%%--------------------------------------------------------------------------
+%% Utility functions
+
+compare(FdA, FdB) ->
+ Size = 65536,
+ case {?FILE_MODULE:read(FdA, Size), ?FILE_MODULE:read(FdB, Size)} of
+ {{error, _} = Error, _} ->
+ Error;
+ {_, {error, _} = Error} ->
+ Error;
+ {{ok, A}, {ok, B}} ->
+ case compare_data(A, B) of
+ true ->
+ compare(FdA, FdB);
+ false ->
+ false
+ end;
+ {eof, eof} ->
+ true;
+ _ ->
+ false
+ end.
+
+compare_data(A, B) when is_list(A), is_list(B) ->
+ list_to_binary(A) == list_to_binary(B);
+compare_data(A, B) when is_list(A), is_binary(B) ->
+ list_to_binary(A) == B;
+compare_data(A, B) when is_binary(A), is_list(B) ->
+ A == list_to_binary(B);
+compare_data(A, B) when is_binary(A), is_binary(B) ->
+ A == B.
+
+sizeof(Data) when is_list(Data) ->
+ length(Data);
+sizeof(Data) when is_binary(Data) ->
+ byte_size(Data).
+
+append(Data1, Data2) when is_list(Data1), is_list(Data2) ->
+ Data1 ++ Data2;
+append(Data1, Data2) when is_binary(Data1), is_binary(Data2) ->
+ list_to_binary([Data1 | Data2]).
+
+slice(Data, Start, Length) when is_list(Data) ->
+ lists:sublist(Data, Start+1, Length);
+slice(Data, Start, Length) when is_binary(Data) ->
+ {_, Bin} = split_binary(Data, Start),
+ if
+ Length >= byte_size(Bin) ->
+ Bin;
+ true ->
+ {B, _} = split_binary(Bin, Length),
+ B
+ end.
+
diff --git a/lib/kernel/test/ram_file_SUITE_data/corrupted.gz b/lib/kernel/test/ram_file_SUITE_data/corrupted.gz
new file mode 100644
index 0000000000..16331b350c
--- /dev/null
+++ b/lib/kernel/test/ram_file_SUITE_data/corrupted.gz
@@ -0,0 +1,5 @@
+�
+==========================================
+This file has a correct GZIP magic ID, but the rest of the
+header is corrupt. Reading this file should result in an
+error.
diff --git a/lib/kernel/test/ram_file_SUITE_data/corrupted.uu b/lib/kernel/test/ram_file_SUITE_data/corrupted.uu
new file mode 100644
index 0000000000..213cd22320
--- /dev/null
+++ b/lib/kernel/test/ram_file_SUITE_data/corrupted.uu
@@ -0,0 +1,528 @@
+M/%1)5$Q%/E)E86P@4')O9W)A;6UE<G,@1&]N)W0@57-E(%!!4T-!3#PO5$E4
+M3$4^"@H\2#(@86QI9VX]8V5N=&5R/E)E86P@4')O9W)A;6UE<G,@1&]N)W0@
+M57-E(%!!4T-!3#PO2#(^"@H\2#0@86QI9VX]8V5N=&5R/CQE;3Y%9"!0;W-T
+M/&)R/@I'<F%P:&EC(%-O9G1W87)E(%-Y<W1E;7,\8G(^"@I0+D\N($)O>" V
+M-S,\8G(^"C(U,3$W(%,N5RX@4&%R:W=A>3QB<CX*5VEL<V]N=FEL;&4L($]2
+M(#DW,#<P/&)R/@I#;W!Y<FEG:'0@*&,I(#$Y.#(\8G(^"CPO2#0^/"]%33X*
+M"@H\2#0@86QI9VX]8V5N=&5R/CQ+0D0^("AD96-V87@@?"!U8V)V87@@?"!C
+M8F]S9R!\('!U<BUE92!\(&QB;"UU;FEX*2%T96ML86)S(6]G8W9A>"%G<W,Q
+M,30T(65V<#PO2T)$/CPO2#0^"@H*0F%C:R!I;B!T:&4@9V]O9"!O;&0@9&%Y
+M<R M+2!T:&4@(D=O;&1E;B!%<F$B(&]F(&-O;7!U=&5R<RP@:70@=V%S"F5A
+M<WD@=&\@<V5P87)A=&4@=&AE(&UE;B!F<F]M('1H92!B;WES("AS;VUE=&EM
+M97,@8V%L;&5D(")296%L($UE;B(*86YD(")1=6EC:&4@16%T97)S(B!I;B!T
+M:&4@;&ET97)A='5R92DN($1U<FEN9R!T:&ES('!E<FEO9"P@=&AE(%)E86P*
+M365N('=E<F4@=&AE(&]N97,@=&AA="!U;F1E<G-T;V]D(&-O;7!U=&5R('!R
+M;V=R86UM:6YG+"!A;F0@=&AE(%%U:6-H90I%871E<G,@=V5R92!T:&4@;VYE
+M<R!T:&%T(&1I9&XG="X@02!R96%L(&-O;7!U=&5R('!R;V=R86UM97(@<V%I
+M9 IT:&EN9W,@;&EK92 \2T)$/B)$3R Q,"!)/3$L,3 B/"]+0D0^(&%N9" \
+M2T)$/B)!0D5.1"(\+TM"1#X@*'1H97D*86-T=6%L;'D@=&%L:V5D(&EN(&-A
+M<&ET86P@;&5T=&5R<RP@>6]U('5N9&5R<W1A;F0I+"!A;F0@=&AE(')E<W0@
+M;V8*=&AE('=O<FQD('-A:60@=&AI;F=S(&QI:V4@/$5-/B)C;VUP=71E<G,@
+M87)E('1O;R!C;VUP;&EC871E9"!F;W(*;64B/"]%33X@86YD(#Q%33XB22!C
+M86XG="!R96QA=&4@=&\@8V]M<'5T97)S("TM('1H97DG<F4@<V\*:6UP97)S
+M;VYA;"(\+T5-/BX@("A!('!R979I;W5S('=O<FL@6S%=('!O:6YT<R!O=70@
+M=&AA="!296%L($UE;B!D;VXG= HB<F5L871E(B!T;R!A;GET:&EN9RP@86YD
+M(&%R96XG="!A9G)A:60@;V8@8F5I;F<@:6UP97)S;VYA;"XI(#Q0/@H*0G5T
+M+"!A<R!U<W5A;"P@=&EM97,@8VAA;F=E+B!792!A<F4@9F%C960@=&]D87D@
+M=VET:"!A('=O<FQD(&EN('=H:6-H"FQI='1L92!O;&0@;&%D:65S(&-A;B!G
+M970@8V]M<'5T97)I>F5D(&UI8W)O=V%V92!O=F5N<RP@,3(@>65A<B!O;&0*
+M:VED<R!C86X@8FQO=R!296%L($UE;B!O=70@;V8@=&AE('=A=&5R('!L87EI
+M;F<@07-T97)O:61S(&%N9"!086,M36%N+ IA;F0@86YY;VYE(&-A;B!B=7D@
+M86YD(&5V96X@=6YD97)S=&%N9"!T:&5I<B!V97)Y(&]W;B!097)S;VYA; I#
+M;VUP=71E<BX@5&AE(%)E86P@4')O9W)A;6UE<B!I<R!I;B!D86YG97(@;V8@
+M8F5C;VUI;F<@97AT:6YC="P@;V8*8F5I;F<@<F5P;&%C960@8GD@:&EG:"US
+M8VAO;VP@<W1U9&5N=',@=VET:"!44D%32"TX,',A(#Q0/@H*5&AE<F4@:7,@
+M82!C;&5A<B!N965D('1O('!O:6YT(&]U="!T:&4@9&EF9F5R96YC97,@8F5T
+M=V5E;B!T:&4@='EP:6-A; IH:6=H+7-C:&]O;"!J=6YI;W(@4&%C+4UA;B!P
+M;&%Y97(@86YD(&$@4F5A;"!0<F]G<F%M;65R+B!5;F1E<G-T86YD:6YG"G1H
+M97-E(&1I9F9E<F5N8V5S('=I;&P@9VEV92!T:&5S92!K:61S('-O;65T:&EN
+M9R!T;R!A<W!I<F4@=&\@+2T@80IR;VQE(&UO9&5L+"!A($9A=&AE<B!&:6=U
+M<F4N($ET('=I;&P@86QS;R!H96QP(&5M<&QO>65R<R!O9B!296%L"E!R;V=R
+M86UM97)S('1O(')E86QI>F4@=VAY(&ET('=O=6QD(&)E(&$@;6ES=&%K92!T
+M;R!R97!L86-E('1H92!296%L"E!R;V=R86UM97)S(&]N('1H96ER('-T869F
+M('=I=&@@,3(@>65A<B!O;&0@4&%C+4UA;B!P;&%Y97)S("AA="!A"F-O;G-I
+M9&5R86)L92!S86QA<GD@<V%V:6YG<RDN(#Q0/@H*"CQ(,SY,04Y'54%'15,\
+M+T@S/@H*5&AE(&5A<VEE<W0@=V%Y('1O('1E;&P@82!296%L(%!R;V=R86UM
+M97(@9G)O;2!T:&4@8W)O=V0@:7,@8GD@=&AE"G!R;V=R86UM:6YG(&QA;F=U
+M86=E(&AE("AO<B!S:&4I('5S97,N("!296%L(%!R;V=R86UM97)S('5S92!&
+M3U)44D%.+@I1=6EC:&4@16%T97)S('5S92!005-#04PN($YI8VML875S(%=I
+M<G1H+"!T:&4@9&5S:6=N97(@;V8@4$%30T%,+"!W87,*;VYC92!A<VME9"P@
+M/$5-/B)(;W<@9&\@>6]U('!R;VYO=6YC92!Y;W5R(&YA;64_(CPO14T^+B!(
+M92!R97!L:65D"CQ%33XB66]U(&-A;B!E:71H97(@8V%L;"!M92!B>2!N86UE
+M+"!P<F]N;W5N8VEN9R!I=" G5F5E<G0G+"!O<B!C86QL"FUE(&)Y('9A;'5E
+M+" G5V]R=&@G+B(\+T5-/B!/;F4@8V%N('1E;&P@:6UM961I871E;'D@9G)O
+M;2!T:&ES(&-O;6UE;G0*=&AA="!.:6-K;&%U<R!7:7)T:"!I<R!A(%%U:6-H
+M92!%871E<BX@(%1H92!O;FQY('!A<F%M971E<B!P87-S:6YG"FUE8VAA;FES
+M;2!E;F1O<G-E9"!B>2!296%L(%!R;V=R86UM97)S(&ES(&-A;&PM8GDM=F%L
+M=64M<F5T=7)N+"!A<PII;7!L96UE;G1E9"!I;B!T:&4@24)-+S,W,"!&3U)4
+M4D%.($<@86YD($@@8V]M<&EL97)S+B @4F5A; IP<F]G<F%M;65R<R!D;VXG
+M="!N965D(&%B<W1R86-T(&-O;F-E<'1S('1O(&=E="!T:&5I<B!J;V)S(&1O
+M;F4Z('1H97D*87)E('!E<F9E8W1L>2!H87!P>2!W:71H(&$@:V5Y<'5N8V@L
+M(&$@1D]25%)!3B!)5B!C;VUP:6QE<BP@86YD(&$*8F5E<BX@/% ^"@H\54P^
+M"CQ,23X@4F5A;"!0<F]G<F%M;65R<R!D;R!,:7-T(%!R;V-E<W-I;F<@:6X@
+M1D]25%)!3BX*"CQ,23X@(%)E86P@4')O9W)A;6UE<G,@9&\@4W1R:6YG($UA
+M;FEP=6QA=&EO;B!I;B!&3U)44D%.+@H*/$Q)/B @4F5A;"!0<F]G<F%M;65R
+M<R!D;R!!8V-O=6YT:6YG("AI9B!T:&5Y(&1O(&ET(&%T(&%L;"D@:6X@1D]2
+M5%)!3BX*"CQ,23X@(%)E86P@4')O9W)A;6UE<G,@9&\@07)T:69I8VEA;"!)
+M;G1E;&QI9V5N8V4@<')O9W)A;7,@:6X@1D]25%)!3BX*/"]53#X@/% ^"@I)
+M9B!Y;W4@8V%N)W0@9&\@:70@:6X@1D]25%)!3BP@9&\@:70@:6X@87-S96UB
+M;'D@;&%N9W5A9V4N($EF('EO=2!C86XG=" @9&\*:70@:6X@87-S96UB;'D@
+M;&%N9W5A9V4L(&ET(&ES;B=T('=O<G1H(&1O:6YG+B \4#X*"@H\2#,^("!3
+M5%)50U154D5$(%!23T=204U-24Y'/"](,SX*"D-O;7!U=&5R('-C:65N8V4@
+M86-A9&5M:6-I86YS(&AA=F4@9V]T=&5N(&EN=&\@=&AE(")S=')U8W1U<F5D
+M('!R;RT*9W)A;6UI;F<B(')U="!O=F5R('1H92!P87-T('-E=F5R86P@>65A
+M<G,N(%1H97D@8VQA:6T@=&AA="!P<F]G<F%M<PIA<F4@;6]R92!E87-I;'D@
+M=6YD97)S=&]O9"!I9B!T:&4@<')O9W)A;6UE<B!U<V5S('-O;64@<W!E8VEA
+M; IL86YG=6%G92!C;VYS=')U8W1S(&%N9"!T96-H;FEQ=65S+B!4:&5Y(&1O
+M;B=T(&%L;"!A9W)E92!O;B!E>&%C=&QY"G=H:6-H(&-O;G-T<G5C=',L(&]F
+M(&-O=7)S92P@86YD('1H92!E>&%M<&QE<R!T:&5Y('5S92!T;R!S:&]W('1H
+M96ER"G!A<G1I8W5L87(@<&]I;G0@;V8@=FEE=R!I;G9A<FEA8FQY(&9I="!O
+M;B!A('-I;F=L92!P86=E(&]F('-O;64*;V)S8W5R92!J;W5R;F%L(&]R(&%N
+M;W1H97(@+2T@8VQE87)L>2!N;W0@96YO=6=H(&]F(&%N(&5X86UP;&4@=&\*
+M8V]N=FEN8V4@86YY;VYE+B @5VAE;B!)(&=O="!O=70@;V8@<V-H;V]L+"!)
+M('1H;W5G:'0@22!W87,@=&AE(&)E<W0*<')O9W)A;6UE<B!I;B!T:&4@=V]R
+M;&0N($D@8V]U;&0@=W)I=&4@86X@=6YB96%T86)L92!T:6,M=&%C+71O90IP
+M<F]G<F%M+"!U<V4@9FEV92!D:69F97)E;G0@8V]M<'5T97(@;&%N9W5A9V5S
+M+"!A;F0@8W)E871E(#$P,# @;&EN90IP<F]G<F%M<R!T:&%T(%=/4DM%1"X@
+M("A296%L;'DA*2!4:&5N($D@9V]T(&]U="!I;G1O('1H92!296%L"E=O<FQD
+M+B!->2!F:7)S="!T87-K(&EN('1H92!296%L(%=O<FQD('=A<R!T;R!R96%D
+M(&%N9"!U;F1E<G-T86YD(&$*,C P+# P,"!L:6YE($9/4E1204X@<')O9W)A
+M;2P@=&AE;B!S<&5E9"!I="!U<"!B>2!A(&9A8W1O<B!O9B!T=V\N($%N>0I2
+M96%L(%!R;V=R86UM97(@=VEL;"!T96QL('EO=2!T:&%T(&%L;"!T:&4@4W1R
+M=6-T=7)E9"!#;V1I;F<@:6X@=&AE"G=O<FQD('=O;B=T(&AE;' @>6]U('-O
+M;'9E(&$@<')O8FQE;2!L:6ME('1H870@+2T@:70@=&%K97,@86-T=6%L"G1A
+M;&5N="X@4V]M92!Q=6EC:R!O8G-E<G9A=&EO;G,@;VX@4F5A;"!0<F]G<F%M
+M;65R<R!A;F0@4W1R=6-T=7)E9 I0<F]G<F%M;6EN9SH@/% ^"@H\54P^"CQ,
+M23X@4F5A;"!0<F]G<F%M;65R<R!A<F5N)W0@869R86ED('1O('5S92!'3U1/
+M<RX*"CQ,23X@4F5A;"!0<F]G<F%M;65R<R!C86X@=W)I=&4@9FEV92!P86=E
+M(&QO;F<@1$\@;&]O<',@=VET:&]U= IG971T:6YG(&-O;F9U<V5D+@H*/$Q)
+M/B!296%L(%!R;V=R86UM97)S(&5N:F]Y($%R:71H;65T:6,@248@<W1A=&5M
+M96YT<R!B96-A=7-E('1H97D@;6%K90IT:&4@8V]D92!M;W)E(&EN=&5R97-T
+M:6YG+@H*/$Q)/B!296%L(%!R;V=R86UM97)S('=R:71E('-E;&8M;6]D:69Y
+M:6YG(&-O9&4L(&5S<&5C:6%L;'D@:68@:70*<V%V97,@=&AE;2 R,"!N86YO
+M<V5C;VYD<R!I;B!T:&4@;6ED9&QE(&]F(&$@=&EG:'0@;&]O<"X*"CQ,23X@
+M(%!R;V=R86UM97)S(&1O;B=T(&YE960@8V]M;65N=',Z('1H92!C;V1E(&ES
+M(&]B=FEO=7,N"@H\3$D^(%-I;F-E($9/4E1204X@9&]E<VXG="!H879E(&$@
+M<W1R=6-T=7)E9" \2T)$/DE&+"!215!%050*+BXN(%5.5$E,/"]+0D0^+"!O
+M<B \2T)$/D-!4T4\+TM"1#X@<W1A=&5M96YT+"!296%L(%!R;V=R86UM97)S
+M(&1O;B=T"FAA=F4@=&\@=V]R<GD@86)O=70@;F]T('5S:6YG('1H96TN($)E
+M<VED97,L('1H97D@8V%N(&)E('-I;75L871E9 IW:&5N(&YE8V5S<V%R>2!U
+M<VEN9R!A<W-I9VYE9" \2T)$/D=/5$\\+TM"1#YS+@H*/"]53#X@/% ^"@I$
+M871A('-T<G5C='5R97,@:&%V92!A;'-O(&=O='1E;B!A(&QO="!O9B!P<F5S
+M<R!L871E;'DN($%B<W1R86-T($1A=&$*5'EP97,L(%-T<G5C='5R97,L(%!O
+M:6YT97)S+"!,:7-T<RP@86YD(%-T<FEN9W,@:&%V92!B96-O;64@<&]P=6QA
+M<B!I;@IC97)T86EN(&-I<F-L97,N(%=I<G1H("AT:&4@86)O=F4M;65N=&EO
+M;F5D(%%U:6-H92!%871E<BD@86-T=6%L;'D*=W)O=&4@86X@96YT:7)E(&)O
+M;VL@6S)=(&-O;G1E;F1I;F<@=&AA="!Y;W4@8V]U;&0@=W)I=&4@82!P<F]G
+M<F%M"F)A<V5D(&]N(&1A=&$@<W1R=6-T=7)E<RP@:6YS=&5A9"!O9B!T:&4@
+M;W1H97(@=V%Y(&%R;W5N9"X@07,@86QL(%)E86P*4')O9W)A;6UE<G,@:VYO
+M=RP@=&AE(&]N;'D@=7-E9G5L(&1A=&$@<W1R=6-T=7)E(&ES('1H90IA<G)A
+M>2X@4W1R:6YG<RP@;&ES=',L('-T<G5C='5R97,L('-E=',@+2T@=&AE<V4@
+M87)E(&%L;"!S<&5C:6%L(&-A<V5S"F]F(&%R<F%Y<R!A;F0@86YD(&-A;B!B
+M92!T<F5A=&5D('1H870@=V%Y(&IU<W0@87,@96%S:6QY('=I=&AO=70*;65S
+M<VEN9R!U<"!Y;W5R('!R;V=R86UI;F<@;&%N9W5A9V4@=VET:"!A;&P@<V]R
+M=',@;V8*8V]M<&QI8V%T:6]N<RX@5&AE('=O<G-T('1H:6YG(&%B;W5T(&9A
+M;F-Y(&1A=&$@='EP97,@:7,@=&AA="!Y;W4@:&%V90IT;R!D96-L87)E('1H
+M96TL(&%N9"!296%L(%!R;V=R86UM:6YG($QA;F=U86=E<RP@87,@=V4@86QL
+M(&MN;W<L(&AA=F4*:6UP;&EC:70@='EP:6YG(&)A<V5D(&]N('1H92!F:7)S
+M="!L971T97(@;V8@=&AE("AS:7@@8VAA<F%C=&5R*0IV87)I86)L92!N86UE
+M+B \4#X*"@H\2#,^("!/4$52051)3D<@4UE35$5-4SPO2#,^"@I7:&%T(&MI
+M;F0@;V8@;W!E<F%T:6YG('-Y<W1E;2!I<R!U<V5D(&)Y(&$@4F5A;"!0<F]G
+M<F%M;65R/R @0U O33\@1V]D"F9O<F)I9" M+2!#4"]-+"!A9G1E<B!A;&PL
+M(&ES(&)A<VEC86QL>2!A('1O>2!O<&5R871I;F<@<WES=&5M+B @179E;@IL
+M:71T;&4@;VQD(&QA9&EE<R!A;F0@9W)A9&4@<V-H;V]L('-T=61E;G1S(&-A
+M;B!U;F1E<G-T86YD(&%N9"!U<V4*0U O32X@/% ^"@I5;FEX(&ES(&$@;&]T
+M(&UO<F4@8V]M<&QI8V%T960@;V8@8V]U<G-E("TM('1H92!T>7!I8V%L(%5N
+M:7@@:&%C:V5R"FYE=F5R(&-A;B!R96UE;6)E<B!W:&%T('1H92 \2T)$/E!2
+M24Y4/"]+0D0^(&-O;6UA;F0@:7,@8V%L;&5D('1H:7,*=V5E:R M+2!B=70@
+M=VAE;B!I="!G971S(')I9VAT(&1O=VX@=&\@:70L(%5N:7@@:7,@82!G;&]R
+M:69I960@=FED96\*9V%M92X@4&5O<&QE(&1O;B=T(&1O(%-E<FEO=7,@5V]R
+M:R!O;B!5;FEX('-Y<W1E;7,Z('1H97D@<V5N9"!J;VME<PIA<F]U;F0@=&AE
+M('=O<FQD(&]N(%5314Y%5"!A;F0@=W)I=&4@861V96YT=7)E(&=A;65S(&%N
+M9"!R97-E87)C: IP87!E<G,N(#Q0/@H*3F\L('EO=7(@4F5A;"!0<F]G<F%M
+M;65R('5S97,@3U,O,S<P+B!!(&=O;V0@<')O9W)A;6UE<B!C86X@9FEN9"!A
+M;F0*=6YD97)S=&%N9"!T:&4@9&5S8W)I<'1I;VX@;V8@=&AE($E*2S,P-4D@
+M97)R;W(@:&4@:G5S="!G;W0@:6X@:&ES($I#3 IM86YU86PN("!!(&=R96%T
+M('!R;V=R86UM97(@8V%N('=R:71E($I#3"!W:71H;W5T(')E9F5R<FEN9R!T
+M;R!T:&4*;6%N=6%L(&%T(&%L;"X@02!T<G5L>2!O=71S=&%N9&EN9R!P<F]G
+M<F%M;65R(&-A;B!F:6YD(&)U9W,@8G5R:65D(&EN"F$@-B!M96=A8GET92!C
+M;W)E(&1U;7 @=VET:&]U="!U<VEN9R!A(&AE>"!C86QC=6QA=&]R+B H22!H
+M879E"F%C='5A;&QY('-E96X@=&AI<R!D;VYE+BD@/% ^"@I/4R\S-S @:7,@
+M82!T<G5L>2!R96UA<FMA8FQE(&]P97)A=&EN9R!S>7-T96TN($ET)W,@<&]S
+M<VEB;&4@=&\@9&5S+0IT<F]Y(&1A>7,@;V8@=V]R:R!W:71H(&$@<VEN9VQE
+M(&UI<W!L86-E9"!S<&%C92P@<V\@86QE<G1N97-S(&EN('1H90IP<F]G<F%M
+M;6EN9R!S=&%F9B!I<R!E;F-O=7)A9V5D+B!4:&4@8F5S="!W87D@=&\@87!P
+M<F]A8V@@=&AE('-Y<W1E;0II<R!T:')O=6=H(&$@:V5Y<'5N8V@N("!3;VUE
+M('!E;W!L92!C;&%I;2!T:&5R92!I<R!A(%1I;64@4VAA<FEN9PIS>7-T96T@
+M=&AA="!R=6YS(&]N($]3+S,W,"P@8G5T(&%F=&5R(&-A<F5F=6P@<W1U9'D@
+M22!H879E(&-O;64@=&\@=&AE"F-O;F-L=7-I;VX@=&AA="!T:&5Y(&%R92!M
+M:7-T86ME;BX@/% ^"@H*/$@S/B @4%)/1U)!34U)3D<@5$]/3%,\+T@S/@H*
+M5VAA="!K:6YD(&]F('1O;VQS(&1O97,@82!296%L(%!R;V=R86UM97(@=7-E
+M/R!);B!T:&5O<GDL(&$@4F5A; I0<F]G<F%M;65R(&-O=6QD(')U;B!H:7,@
+M<')O9W)A;7,@8GD@:V5Y:6YG('1H96T@:6YT;R!T:&4@9G)O;G0@<&%N96P*
+M;V8@=&AE(&-O;7!U=&5R+B!"86-K(&EN('1H92!D87ES('=H96X@8V]M<'5T
+M97)S(&AA9"!F<F]N="!P86YE;',L"G1H:7,@=V%S(&%C='5A;&QY(&1O;F4@
+M;V-C87-I;VYA;&QY+B @66]U<B!T>7!I8V%L(%)E86P@4')O9W)A;6UE<@IK
+M;F5W('1H92!E;G1I<F4@8F]O='-T<F%P(&QO861E<B!B>2!M96UO<GD@:6X@
+M:&5X+"!A;F0@=&]G9VQE9"!I="!I;@IW:&5N979E<B!I="!G;W0@9&5S=')O
+M>65D(&)Y(&AI<R!P<F]G<F%M+B H0F%C:R!T:&5N+"!M96UO<GD@=V%S"FUE
+M;6]R>2 M+2!I="!D:61N)W0@9V\@87=A>2!W:&5N('1H92!P;W=E<B!W96YT
+M(&]F9BX@5&]D87DL(&UE;6]R>0IE:71H97(@9F]R9V5T<R!T:&EN9W,@=VAE
+M;B!Y;W4@9&]N)W0@=V%N="!I="!T;RP@;W(@<F5M96UB97)S('1H:6YG<PIL
+M;VYG(&%F=&5R('1H97DG<F4@8F5T=&5R(&9O<F=O='1E;BXI("!,96=E;F0@
+M:&%S(&ET('1H870@4V5Y;6]U<@I#<F%Y+"!I;G9E;G1O<B!O9B!T:&4@0W)A
+M>2!)('-U<&5R8V]M<'5T97(@86YD(&UO<W0@;V8@0V]N=')O;"!$871A)W,*
+M8V]M<'5T97)S+"!A8W1U86QL>2!T;V=G;&5D('1H92!F:7)S="!O<&5R871I
+M;F<@<WES=&5M(&9O<B!T:&4@0T1#-S8P, II;B!O;B!T:&4@9G)O;G0@<&%N
+M96P@9G)O;2!M96UO<GD@=VAE;B!I="!W87,@9FER<W0@<&]W97)E9 IO;BX@
+M4V5Y;6]U<BP@;F5E9&QE<W,@=&\@<V%Y+"!I<R!A(%)E86P@4')O9W)A;6UE
+M<BX@/% ^"@I/;F4@;V8@;7D@9F%V;W)I=&4@4F5A;"!0<F]G<F%M;65R<R!W
+M87,@82!S>7-T96US('!R;V=R86UM97(@9F]R(%1E>&%S"DEN<W1R=6UE;G1S
+M+B @3VYE(&1A>2P@:&4@9V]T(&$@;&]N9R!D:7-T86YC92!C86QL(&9R;VT@
+M82!U<V5R('=H;W-E"G-Y<W1E;2!H860@8W)A<VAE9"!I;B!T:&4@;6ED9&QE
+M(&]F('-O;64@:6UP;W)T86YT('=O<FLN($II;2!W87,@86)L90IT;R!R97!A
+M:7(@=&AE(&1A;6%G92!O=F5R('1H92!P:&]N92P@9V5T=&EN9R!T:&4@=7-E
+M<B!T;R!T;V=G;&4@:6X*9&ES:R!)+T\@:6YS=')U8W1I;VYS(&%T('1H92!F
+M<F]N="!P86YE;"P@<F5P86ER:6YG('-Y<W1E;2!T86)L97,@:6X*:&5X+"!R
+M96%D:6YG(')E9VES=&5R(&-O;G1E;G1S(&)A8VL@;W9E<B!T:&4@<&AO;F4N
+M(%1H92!M;W)A;"!O9B!T:&ES"G-T;W)Y.B!W:&EL92!A(%)E86P@4')O9W)A
+M;6UE<B!U<W5A;&QY(&EN8VQU9&5S(&$@:V5Y<'5N8V@@86YD"FQI;F5P<FEN
+M=&5R(&EN(&AI<R!T;V]L:VET+"!H92!C86X@9V5T(&%L;VYG('=I=&@@:G5S
+M="!A(&9R;VYT('!A;F5L"F%N9"!A('1E;&5P:&]N92!I;B!E;65R9V5N8VEE
+M<RX@/% ^"@I);B!S;VUE(&-O;7!A;FEE<RP@=&5X="!E9&ET:6YG(&YO(&QO
+M;F=E<B!C;VYS:7-T<R!O9B!T96X@96YG:6YE97)S"G-T86YD:6YG(&EN(&QI
+M;F4@=&\@=7-E(&%N(# R.2!K97EP=6YC:"X@26X@9F%C="P@=&AE(&)U:6QD
+M:6YG($D@=V]R:PII;B!D;V5S;B=T(&-O;G1A:6X@82!S:6YG;&4@:V5Y<'5N
+M8V@N(%1H92!296%L(%!R;V=R86UM97(@:6X@=&AI<PIS:71U871I;VX@:&%S
+M('1O(&1O(&AI<R!W;W)K('=I=&@@82!T97AT(&5D:71O<B!P<F]G<F%M+B!-
+M;W-T('-Y<W1E;7,*<W5P<&QY('-E=F5R86P@=&5X="!E9&ET;W)S('1O('-E
+M;&5C="!F<F]M+"!A;F0@=&AE(%)E86P@4')O9W)A;6UE<@IM=7-T(&)E(&-A
+M<F5F=6P@=&\@<&EC:R!O;F4@=&AA="!R969L96-T<R!H:7,@<&5R<V]N86P@
+M<W1Y;&4N($UA;GD*<&5O<&QE(&)E;&EE=F4@=&AA="!T:&4@8F5S="!T97AT
+M(&5D:71O<G,@:6X@=&AE('=O<FQD('=E<F4@=W)I='1E;B!A= I897)O>"!0
+M86QO($%L=&\@4F5S96%R8V@@0V5N=&5R(&9O<B!U<V4@;VX@=&AE:7(@06QT
+M;R!A;F0@1&]R861O"F-O;7!U=&5R<R!;,UTN(%5N9F]R='5N871E;'DL(&YO
+M(%)E86P@4')O9W)A;6UE<B!W;W5L9"!E=F5R('5S92!A"F-O;7!U=&5R('=H
+M;W-E(&]P97)A=&EN9R!S>7-T96T@:7,@8V%L;&5D(%-M86QL5&%L:RP@86YD
+M('=O=6QD"F-E<G1A:6YL>2!N;W0@=&%L:R!T;R!T:&4@8V]M<'5T97(@=VET
+M:"!A(&UO=7-E+B \4#X*"E-O;64@;V8@=&AE(&-O;F-E<'1S(&EN('1H97-E
+M(%AE<F]X(&5D:71O<G,@:&%V92!B965N(&EN8V]R<&]R871E9 II;G1O(&5D
+M:71O<G,@<G5N;FEN9R!O;B!M;W)E(')E87-O;F%B;'D@;F%M960@;W!E<F%T
+M:6YG('-Y<W1E;7,N($5-04-3"F%N9"!622!A<F4@<')O8F%B;'D@=&AE(&UO
+M<W0@=V5L;"!K;F]W;B!O9B!T:&ES(&-L87-S(&]F(&5D:71O<G,N("!4:&4*
+M<')O8FQE;2!W:71H('1H97-E(&5D:71O<G,@:7,@=&AA="!296%L(%!R;V=R
+M86UM97)S(&-O;G-I9&5R(")W:&%T('EO=0IS964@:7,@=VAA="!Y;W4@9V5T
+M(B!T;R!B92!J=7-T(&%S(&)A9"!A(&-O;F-E<'0@:6X@=&5X="!E9&ET;W)S
+M(&%S(&ET"FES(&EN('=O;65N+B!.;RP@=&AE(%)E86P@4')O9W)A;6UE<B!W
+M86YT<R!A(")Y;W4@87-K960@9F]R(&ET+"!Y;W4*9V]T(&ET(B!T97AT(&5D
+M:71O<B M+2!C;VUP;&EC871E9"P@8W)Y<'1I8RP@<&]W97)F=6PL('5N9F]R
+M9VEV:6YG+ ID86YG97)O=7,N(%1%0T\L('1O(&)E('!R96-I<V4N(#Q0/@H*
+M270@:&%S(&)E96X@;V)S97)V960@=&AA="!A(%1%0T\@8V]M;6%N9"!S97%U
+M96YC92!M;W)E(&-L;W-E;'D@<F5S96TM"F)L97,@=')A;G-M:7-S:6]N(&QI
+M;F4@;F]I<V4@=&AA;B!R96%D86)L92!T97AT(%LT72X@3VYE(&]F('1H92!M
+M;W)E"F5N=&5R=&%I;FEN9R!G86UE<R!T;R!P;&%Y('=I=&@@5$5#3R!I<R!T
+M;R!T>7!E('EO=7(@;F%M92!I;B!A<R!A"F-O;6UA;F0@;&EN92!A;F0@=')Y
+M('1O(&=U97-S('=H870@:70@9&]E<RX@2G5S="!A8F]U="!A;GD@<&]S<VEB
+M;&4*='EP:6YG(&5R<F]R('=H:6QE('1A;&MI;F<@=VET:"!414-/('=I;&P@
+M<')O8F%B;'D@9&5S=')O>2!Y;W5R"G!R;V=R86TL(&]R(&5V96X@=V]R<V4@
+M+2T@:6YT<F]D=6-E('-U8G1L92!A;F0@;7ES=&5R:6]U<R!B=6=S(&EN(&$*
+M;VYC92!W;W)K:6YG('-U8G)O=71I;F4N(#Q0/@H*1F]R('1H:7,@<F5A<V]N
+M+"!296%L(%!R;V=R86UM97)S(&%R92!R96QU8W1A;G0@=&\@86-T=6%L;'D@
+M961I="!A"G!R;V=R86T@=&AA="!I<R!C;&]S92!T;R!W;W)K:6YG+B!4:&5Y
+M(&9I;F0@:70@;75C:"!E87-I97(@=&\@:G5S= IP871C:"!T:&4@8FEN87)Y
+M(&]B:F5C="!C;V1E(&1I<F5C=&QY+"!U<VEN9R!A('=O;F1E<F9U;"!P<F]G
+M<F%M"F-A;&QE9"!355!%4EI!4" H;W(@:71S(&5Q=6EV86QE;G0@;VX@;F]N
+M+4E"32!M86-H:6YE<RDN(%1H:7,@=V]R:W,@<V\*=V5L;"!T:&%T(&UA;GD@
+M=V]R:VEN9R!P<F]G<F%M<R!O;B!)0DT@<WES=&5M<R!B96%R(&YO(')E;&%T
+M:6]N('1O"G1H92!O<FEG:6YA;"!&3U)44D%.(&-O9&4N("!);B!M86YY(&-A
+M<V5S+"!T:&4@;W)I9VEN86P@<V]U<F-E(&-O9&4@:7,*;F\@;&]N9V5R(&%V
+M86EL86)L92X@5VAE;B!I="!C;VUE<R!T:6UE('1O(&9I>"!A('!R;V=R86T@
+M;&EK92!T:&ES+"!N;PIM86YA9V5R('=O=6QD(&5V96X@=&AI;FL@;V8@<V5N
+M9&EN9R!A;GET:&EN9R!L97-S('1H86X@82!296%L"E!R;V=R86UM97(@=&\@
+M9&\@=&AE(&IO8B M+2!N;R!1=6EC:&4@16%T:6YG('-T<G5C='5R960@<')O
+M9W)A;6UE<@IW;W5L9"!E=F5N(&MN;W<@=VAE<F4@=&\@<W1A<G0N(%1H:7,@
+M:7,@8V%L;&5D(")J;V(@<V5C=7)I='DB+B \4#X*"E-O;64@<')O9W)A;6UI
+M;F<@=&]O;',@3D]4('5S960@8GD@4F5A;"!0<F]G<F%M;65R<SH@/% ^"CQ5
+M3#X*"CQ,23X@1D]25%)!3B!P<F5P<F]C97-S;W)S(&QI:V4@34]25%)!3B!A
+M;F0@4D%41D]2+B!4:&4@0W5I<VEN87)T<R!O9@IP<F]G<F%M;6EN9R M+2!G
+M<F5A="!F;W(@;6%K:6YG(%%U:6-H92X@4V5E(&-O;6UE;G1S(&%B;W9E(&]N
+M"G-T<G5C='5R960@<')O9W)A;6UI;F<N"@H\3$D^("!3;W5R8V4@;&%N9W5A
+M9V4@9&5B=6=G97)S+B!296%L(%!R;V=R86UM97)S(&-A;B!R96%D(&-O<F4@
+M9'5M<',N"@H\3$D^($-O;7!I;&5R<R!W:71H(&%R<F%Y(&)O=6YD<R!C:&5C
+M:VEN9RX@5&AE>2!S=&EF;&4@8W)E871I=FET>2P*9&5S=')O>2!M;W-T(&]F
+M('1H92!I;G1E<F5S=&EN9R!U<V5S(&9O<B!%455)5D%,14Y#12P@86YD(&UA
+M:V4@:70*:6UP;W-S:6)L92!T;R!M;V1I9GD@=&AE(&]P97)A=&EN9R!S>7-T
+M96T@8V]D92!W:71H(&YE9V%T:79E"G-U8G-C<FEP=',N(%=O<G-T(&]F(&%L
+M;"P@8F]U;F1S(&-H96-K:6YG(&ES(&EN969F:6-I96YT+@H*/$Q)/B!3;W5R
+M8V4@8V]D92!M86EN=&%I;F%N8V4@<WES=&5M<RX@02!296%L(%!R;V=R86UM
+M97(@:V5E<',@:&ES"F-O9&4@;&]C:V5D('5P(&EN(&$@8V%R9"!F:6QE+"!B
+M96-A=7-E(&ET(&EM<&QI97,@=&AA="!I=',@;W=N97(*8V%N;F]T(&QE879E
+M(&AI<R!I;7!O<G1A;G0@<')O9W)A;7,@=6YG=6%R9&5D(%LU72X*"CPO54P^
+M(#Q0/@H*"CQ(,SX@(%1(12!214%,(%!23T=204U-15(@050@5T]22SPO2#,^
+M"@I7:&5R92!D;V5S('1H92!T>7!I8V%L(%)E86P@4')O9W)A;6UE<B!W;W)K
+M/R!7:&%T(&MI;F0@;V8@<')O9W)A;7,@87)E"G=O<G1H>2!O9B!T:&4@969F
+M;W)T<R!O9B!S;R!T86QE;G1E9"!A;B!I;F1I=FED=6%L/R!9;W4@8V%N(&)E
+M('-U<F4*=&AA="!N;R!R96%L(%!R;V=R86UM97(@=V]U;&0@8F4@8V%U9VAT
+M(&1E860@=W)I=&EN9PIA8V-O=6YT<RUR96-E:79A8FQE('!R;V=R86US(&EN
+M($-/0D],+"!O<B!S;W)T:6YG(&UA:6QI;F<@;&ES=',@9F]R"E!E;W!L92!M
+M86=A>FEN92X@02!296%L(%!R;V=R86UM97(@=V%N=',@=&%S:W,@;V8@96%R
+M=&@M<VAA:VEN9PII;7!O<G1A;F-E("AL:71E<F%L;'DA*3H@/% ^"@H\54P^
+M"@H\3$D^(%)E86P@4')O9W)A;6UE<G,@=V]R:R!F;W(@3&]S($%L86UO<R!.
+M871I;VYA;"!,86)O<F%T;W)Y+"!W<FET:6YG"F%T;VUI8R!B;VUB('-I;75L
+M871I;VYS('1O(')U;B!O;B!#<F%Y($D@<W5P97)C;VUP=71E<G,N"@H\3$D^
+M(%)E86P@4')O9W)A;6UE<G,@=V]R:R!F;W(@=&AE($YA=&EO;F%L(%-E8W5R
+M:71Y($%G96YC>2P@9&5C;V1I;F<*4G5S<VEA;B!T<F%N<VUI<W-I;VYS+@H*
+M/$Q)/B!)="!W87,@;&%R9V5L>2!D=64@=&\@=&AE(&5F9F]R=',@;V8@=&AO
+M=7-A;F1S(&]F(%)E86P*4')O9W)A;6UE<G,@=V]R:VEN9R!F;W(@3D%302!T
+M:&%T(&]U<B!B;WES(&=O="!T;R!T:&4@;6]O;B!A;F0@8F%C:PIB969O<F4@
+M=&AE(&-O<VUO;F%U=',N"@H\3$D^(%1H92!C;VUP=71E<G,@:6X@=&AE(%-P
+M86-E(%-H=71T;&4@=V5R92!P<F]G<F%M;65D(&)Y(%)E86P*4')O9W)A;6UE
+M<G,N"B @(" */$Q)/B!0<F]G<F%M;65R<R!A<F4@870@=V]R:R!F;W(@0F]E
+M:6YG(&1E<VEG;FEN9R!T:&4@;W!E<F%T:6YG"G-Y<W1E;7,@9F]R(&-R=6ES
+M92!M:7-S:6QE<RX*"CPO54P^(#Q0/@H*4V]M92!O9B!T:&4@;6]S="!A=V5S
+M;VUE(%)E86P@4')O9W)A;6UE<G,@;V8@86QL('=O<FL@870@=&AE($IE="!0
+M<F\M"G!U;'-I;VX@3&%B;W)A=&]R>2!I;B!#86QI9F]R;FEA+B!-86YY(&]F
+M('1H96T@:VYO=R!T:&4@96YT:7)E"F]P97)A=&EN9R!S>7-T96T@;V8@=&AE
+M(%!I;VYE97(@86YD(%9O>6%G97(@<W!A8V5C<F%F="!B>2!H96%R="X@5VET
+M: IA(&-O;6)I;F%T:6]N(&]F(&QA<F=E(&=R;W5N9"UB87-E9"!&3U)44D%.
+M('!R;V=R86US(&%N9"!S;6%L; IS<&%C96-R869T+6)A<V5D(&%S<V5M8FQY
+M(&QA;F=U86=E('!R;V=R86US+"!T:&5Y(&-A;B!T;R!D;R!I;F-R961I8FQE
+M"F9E871S(&]F(&YA=FEG871I;VX@86YD(&EM<')O=FES871I;VXL('-U8V@@
+M87,@:&ET=&EN9R!T96XM:VEL;VUE=&5R"G=I9&4@=VEN9&]W<R!A="!3871U
+M<FX@869T97(@<VEX('EE87)S(&EN('-P86-E+"!A;F0@<F5P86ER:6YG(&]R
+M"F)Y<&%S<VEN9R!D86UA9V5D('-E;G-O<B!P;&%T9F]R;7,L(')A9&EO<RP@
+M86YD(&)A='1E<FEE<RX@($%L;&5G961L>2P*;VYE(%)E86P@4')O9W)A;6UE
+M<B!M86YA9V5D('1O('1U8VL@82!P871T97)N+6UA=&-H:6YG('!R;V=R86T@
+M:6YT;R!A"F9E=R!H=6YD<F5D(&)Y=&5S(&]F('5N=7-E9"!M96UO<GD@:6X@
+M82!6;WEA9V5R('-P86-E8W)A9G0@=&AA= IS96%R8VAE9"!F;W(L(&QO8V%T
+M960L(&%N9"!P:&]T;V=R87!H960@82!N97<@;6]O;B!O9B!*=7!I=&5R+B \
+M4#X*"D]N92!P;&%N(&9O<B!T:&4@=7!C;VUI;F<@1V%L:6QE;R!S<&%C96-R
+M869T(&UI<W-I;VX@:7,@=&\@=7-E(&$@9W)A=BT*:71Y(&%S<VES="!T<F%J
+M96-T;W)Y('!A<W0@36%R<R!O;B!T:&4@=V%Y('1O($IU<&ET97(N(%1H:7,@
+M=')A:F5C=&]R>0IP87-S97,@=VET:&EN(#@P("LO+2 S(&MI;&]M971E<G,@
+M;V8@=&AE('-U<F9A8V4@;V8@36%R<RX@3F]B;V1Y(&ES"F=O:6YG('1O('1R
+M=7-T(&$@4$%30T%,('!R;V=R86T@*&]R(%!!4T-!3"!P<F]G<F%M;65R*2!F
+M;W(@;F%V:6=A=&EO;@IT;R!T:&5S92!T;VQE<F%N8V5S+B \4#X@"@I!<R!Y
+M;W4@8V%N('1E;&PL(&UA;GD@;V8@=&AE('=O<FQD)W,@4F5A;"!0<F]G<F%M
+M;65R<R!W;W)K(&9O<B!T:&4*52Y3+B @1V]V97)N;65N="P@;6%I;FQY('1H
+M92!$969E;G-E($1E<&%R=&UE;G0N(%1H:7,@:7,@87,@:70@<VAO=6QD"F)E
+M+B @4F5C96YT;'DL(&AO=V5V97(L(&$@8FQA8VL@8VQO=60@:&%S(&9O<FUE
+M9"!O;B!T:&4@4F5A; I0<F]G<F%M;65R(&AO<FEZ;VXN(#Q0/@H*270@<V5E
+M;7,@=&AA="!S;VUE(&AI9VAL>2!P;&%C960@475I8VAE($5A=&5R<R!A="!T
+M:&4@1&5F96YS90I$97!A<G1M96YT(&1E8VED960@=&AA="!A;&P@1&5F96YS
+M92!P<F]G<F%M<R!S:&]U;&0@8F4@=W)I='1E;B!I;B!S;VUE"F=R86YD('5N
+M:69I960@;&%N9W5A9V4@8V%L;&5D(")!1$$B("AR96=I<W1E<F5D('1R861E
+M;6%R:RP@1&]$*2X@($9O<@IA('=H:6QE+"!I="!S965M960@=&AA="!!1$$@
+M=V%S(&1E<W1I;F5D('1O(&)E8V]M92!A(&QA;F=U86=E('1H870*=V5N="!A
+M9V%I;G-T(&%L;"!T:&4@<')E8V5P=',@;V8@4F5A;"!0<F]G<F%M;6EN9R M
+M+2!A(&QA;F=U86=E('=I=&@*<W1R=6-T=7)E+"!A(&QA;F=U86=E('=I=&@@
+M9&%T82!T>7!E<RP@<W1R;VYG('1Y<&EN9RP@86YD"G-E;6EC;VQO;G,N($EN
+M('-H;W)T+"!A(&QA;F=U86=E(&1E<VEG;F5D('1O(&-R:7!P;&4@=&AE(&-R
+M96%T:79I='D@;V8*=&AE('1Y<&EC86P@4F5A;"!0<F]G<F%M;65R+B @1F]R
+M='5N871E;'DL('1H92!L86YG=6%G92!A9&]P=&5D(&)Y($1O1 IH87,@96YO
+M=6=H(&EN=&5R97-T:6YG(&9E871U<F5S('1O(&UA:V4@:70@87!P<F]A8VAA
+M8FQE.B!I="=S"FEN8W)E9&EB;'D@8V]M<&QE>"P@:6YC;'5D97,@;65T:&]D
+M<R!F;W(@;65S<VEN9R!W:71H('1H92!O<&5R871I;F<*<WES=&5M(&%N9"!R
+M96%R<F%N9VEN9R!M96UO<GDL(&%N9"!%9'-G87(@1&EJ:W-T<F$@9&]E<VXG
+M="!L:6ME(&ET"ELV72X@*$1I:FMS=')A+"!A<R!))VT@<W5R92!Y;W4@:VYO
+M=RP@=V%S('1H92!A=71H;W(@;V8@/$5-/B)';U1O<PI#;VYS:61E<F5D($AA
+M<FUF=6PB/"]%33X@+2T@82!L86YD;6%R:R!W;W)K(&EN('!R;V=R86UM:6YG
+M"FUE=&AO9&]L;V=Y+"!A<'!L875D960@8GD@4&%S8V%L(%!R;V=R86UM97)S
+M(&%N9"!1=6EC:&4@16%T97)S(&%L:6ME+BD*0F5S:61E<RP@=&AE(&1E=&5R
+M;6EN960@4F5A;"!0<F]G<F%M;65R(&-A;B!W<FET92!&3U)44D%.('!R;V=R
+M86US(&EN"F%N>2!L86YG=6%G92X@/% ^"@I4:&4@<F5A;"!P<F]G<F%M;65R
+M(&UI9VAT(&-O;7!R;VUI<V4@:&ES('!R:6YC:7!L97,@86YD('=O<FL@;VX@
+M<V]M92T*=&AI;F<@<VQI9VAT;'D@;6]R92!T<FEV:6%L('1H86X@=&AE(&1E
+M<W1R=6-T:6]N(&]F(&QI9F4@87,@=V4@:VYO=PII="P@<')O=FED:6YG('1H
+M97)E)W,@96YO=6=H(&UO;F5Y(&EN(&ET+B!4:&5R92!A<F4@<V5V97)A;"!2
+M96%L"E!R;V=R86UM97)S(&)U:6QD:6YG('9I9&5O(&=A;65S(&%T($%T87)I
+M+"!F;W(@97AA;7!L92X@*$)U="!N;W0*<&QA>6EN9R!T:&5M+B!!(%)E86P@
+M4')O9W)A;6UE<B!K;F]W<R!H;W<@=&\@8F5A="!T:&4@;6%C:&EN92!E=F5R
+M>0IT:6UE.B!N;R!C:&%L;&%N9V4@:6X@=&AA="XI("!%=F5R>6]N92!W;W)K
+M:6YG(&%T($QU8V%S1FEL;2!I<R!A(%)E86P*4')O9W)A;6UE<BX@*$ET('=O
+M=6QD(&)E(&-R87IY('1O('1U<FX@9&]W;B!T:&4@;6]N97D@;V8@-3 @;6EL
+M;&EO;@I3=&%R(%=A<G,@9F%N<RXI(%1H92!P<F]P;W)T:6]N(&]F(%)E86P@
+M4')O9W)A;6UE<G,@:6X@0V]M<'5T97(*1W)A<&AI8W,@:7,@<V]M97=H870@
+M;&]W97(@=&AA;B!T:&4@;F]R;2P@;6]S=&QY(&)E8V%U<V4@;F]B;V1Y(&AA
+M<PIF;W5N9"!A('5S92!F;W(@0V]M<'5T97(@1W)A<&AI8W,@>65T+B @3VX@
+M=&AE(&]T:&5R(&AA;F0L(&%L; I#;VUP=71E<B!'<F%P:&EC<R!I<R!D;VYE
+M(&EN($9/4E1204XL('-O('1H97)E(&%R92!A(&9A:7(@;G5M8F5R"G!E;W!L
+M92!D;VEN9R!'<F%P:&EC<R!I;B!O<F1E<B!T;R!A=F]I9"!H879I;F<@=&\@
+M=W)I=&4@0T]"3TP*<')O9W)A;7,N(#Q0/@H*"CQ(,SX@(%1(12!214%,(%!2
+M3T=204U-15(@050@4$Q!63PO2#,^"@I'96YE<F%L;'DL('1H92!296%L(%!R
+M;V=R86UM97(@<&QA>7,@=&AE('-A;64@=V%Y(&AE('=O<FMS("TM('=I=&@*
+M8V]M<'5T97)S+B @2&4@:7,@8V]N<W1A;G1L>2!A;6%Z960@=&AA="!H:7,@
+M96UP;&]Y97(@86-T=6%L;'D@<&%Y<PIH:6T@=&\@9&\@=VAA="!H92!W;W5L
+M9"!B92!D;VEN9R!F;W(@9G5N(&%N>7=A>2P@86QT:&]U9V@@:&4@:7,*8V%R
+M969U;"!N;W0@=&\@97AP<F5S<R!T:&ES(&]P:6YI;VX@;W5T(&QO=60N($]C
+M8V%S:6]N86QL>2P@=&AE(%)E86P*4')O9W)A;6UE<B!D;V5S('-T97 @;W5T
+M(&]F('1H92!O9F9I8V4@9F]R(&$@8G)E871H(&]F(&9R97-H(&%I<B!A;F0@
+M80IB965R(&]R('1W;RX@4V]M92!T:7!S(&]N(')E8V]G;FEZ:6YG(')E86P@
+M<')O9W)A;6UE<G,@87=A>2!F<F]M('1H90IC;VUP=71E<B!R;V]M.B \4#X*
+M/%5,/@H*/$Q)/B!!="!A('!A<G1Y+"!T:&4@4F5A;"!0<F]G<F%M;65R<R!A
+M<F4@=&AE(&]N97,@:6X@=&AE(&-O<FYE<@IT86QK:6YG(&%B;W5T(&]P97)A
+M=&EN9R!S>7-T96T@<V5C=7)I='D@86YD(&AO=R!T;R!G970@87)O=6YD(&ET
+M+@H*/$Q)/B!!="!A(&9O;W1B86QL(&=A;64L('1H92!296%L(%!R;V=R86UM
+M97(@:7,@=&AE(&]N92!C;VUP87)I;F<@=&AE"G!L87ES(&%G86EN<W0@:&ES
+M('-I;75L871I;VYS('!R:6YT960@;VX@,3$@8GD@,30@9F%N9F]L9"!P87!E
+M<BX*"CQ,23X@070@=&AE(&)E86-H+"!T:&4@4F5A;"!0<F]G<F%M;65R(&ES
+M('1H92!O;F4@9')A=VEN9R!F;&]W8VAA<G1S"FEN('1H92!S86YD+@H*/$Q)
+M/B!!(%)E86P@4')O9W)A;6UE<B!G;V5S('1O(&$@9&ES8V\@=&\@=V%T8V@@
+M=&AE(&QI9VAT('-H;W<N"@H\3$D^($%T(&$@9G5N97)A;"P@=&AE(%)E86P@
+M4')O9W)A;6UE<B!I<R!T:&4@;VYE('-A>6EN9R \14T^(E!O;W(*1V5O<F=E
+M+B @06YD(&AE(&%L;6]S="!H860@=&AE('-O<G0@<F]U=&EN92!W;W)K:6YG
+M(&)E9F]R92!T:&4*8V]R;VYA<GDN(CPO14T^"@H\3$D^($EN(&$@9W)O8V5R
+M>2!S=&]R92P@=&AE(%)E86P@4')O9W)A;6UE<B!I<R!T:&4@;VYE('=H;R!I
+M;G-I<W1S(&]N"G)U;FYI;F<@=&AE(&-A;G,@<&%S="!T:&4@;&%S97(@8VAE
+M8VMO=70@<V-A;FYE<B!H:6US96QF+"!B96-A=7-E(&AE"FYE=F5R(&-O=6QD
+M('1R=7-T(&ME>7!U;F-H(&]P97)A=&]R<R!T;R!G970@:70@<FEG:'0@=&AE
+M(&9I<G-T('1I;64N"@H\+U5,/B \4#X*"@H\2#,^("!42$4@4D5!3"!04D]'
+M4D%-3452)U,@3D%455)!3"!(04))5$%4/"](,SX*"E=H870@<V]R="!O9B!E
+M;G9I<F]N;65N="!D;V5S('1H92!296%L(%!R;V=R86UM97(@9G5N8W1I;VX@
+M8F5S="!I;C\*5&AI<R!I<R!A;B!I;7!O<G1A;G0@<75E<W1I;VX@9F]R('1H
+M92!M86YA9V5R<R!O9B!296%L"E!R;V=R86UM97)S+B!#;VYS:61E<FEN9R!T
+M:&4@86UO=6YT(&]F(&UO;F5Y(&ET(&-O<W1S('1O(&ME97 @;VYE(&]N"G1H
+M92!S=&%F9BP@:70G<R!B97-T('1O('!U="!H:6T@*&]R(&AE<BD@:6X@86X@
+M96YV:7)O;FUE;G0@=VAE<F4@:&4*8V%N(&=E="!H:7,@=V]R:R!D;VYE+B \
+M4#X*"E1H92!T>7!I8V%L(%)E86P@4')O9W)A;6UE<B!L:79E<R!I;B!F<F]N
+M="!O9B!A(&-O;7!U=&5R('1E<FUI;F%L+@I3=7)R;W5N9&EN9R!T:&ES('1E
+M<FUI;F%L(&%R93H@/% ^"CQ53#X*"CQ,23X@3&ES=&EN9W,@;V8@86QL('!R
+M;V=R86US('1H92!296%L(%!R;V=R86UM97(@:&%S(&5V97(@=V]R:V5D(&]N
+M+ IP:6QE9"!I;B!R;W5G:&QY(&-H<F]N;VQO9VEC86P@;W)D97(@;VX@979E
+M<GD@9FQA="!S=7)F86-E(&EN('1H92!O9F9I8V4N"@H\3$D^(%-O;64@:&%L
+M9BUD;WIE;B!O<B!S;R!P87)T;'D@9FEL;&5D(&-U<',@;V8@8V]L9 IC;V9F
+M964N($]C8V%S:6]N86QL>2P@=&AE<F4@=VEL;"!B92!C:6=A<F5T=&4@8G5T
+M=',@9FQO871I;F<@:6X@=&AE"F-O9F9E92X@26X@<V]M92!C87-E<RP@=&AE
+M(&-U<',@=VEL;"!C;VYT86EN($]R86YG92!#<G5S:"X*"CQ,23X@56YL97-S
+M(&AE(&ES('9E<GD@9V]O9"P@=&AE<F4@=VEL;"!B92!C;W!I97,@;V8@=&AE
+M($]3($I#3"!M86YU86P*86YD('1H92!0<FEN8VEP;&5S(&]F($]P97)A=&EO
+M;B!O<&5N('1O('-O;64@<&%R=&EC=6QA<FQY(&EN=&5R97-T:6YG"G!A9V5S
+M+@H*/$Q)/B!487!E9"!T;R!T:&4@=V%L;"!I<R!A(&QI;F4M<')I;G1E<B!3
+M;F]O<'D@8V%L96YD97(@9F]R('1H92!Y96%R"C$Y-CDN"@H\3$D^(%-T<F5W
+M;B!A8F]U="!T:&4@9FQO;W(@87)E('-E=F5R86P@=W)A<'!E<G,@9F]R('!E
+M86YU="!B=71T97(*9FEL;&5D(&-H965S92!B87)S("AT:&4@='EP92!T:&%T
+M(&%R92!M861E('-T86QE(&%T('1H92!B86ME<GD@<V\@=&AE>0IC86XG="!G
+M970@86YY('=O<G-E('=H:6QE('=A:71I;F<@:6X@=&AE('9E;F1I;F<@;6%C
+M:&EN92DN"@H\3$D^($AI9&EN9R!I;B!T:&4@=&]P(&QE9G0M:&%N9"!D<F%W
+M97(@;V8@=&AE(&1E<VL@:7,@82!S=&%S:"!O9@ID;W5B;&4@<W1U9F8@3W)E
+M;W,@9F]R('-P96-I86P@;V-C87-I;VYS+@H*/$Q)/B!5;F1E<FYE871H('1H
+M92!/<F5O<R!I<R!A(&9L;W<M8VAA<G1I;F<@=&5M<&QA=&4L(&QE9G0@=&AE
+M<F4@8GD*=&AE('!R979I;W5S(&]C8W5P86YT(&]F('1H92!O9F9I8V4N("A2
+M96%L(%!R;V=R86UM97)S('=R:71E('!R;V=R86US+ IN;W0@9&]C=6UE;G1A
+M=&EO;BX@3&5A=F4@=&AA="!T;R!T:&4@;6%I;G1A:6YE;F-E('!E;W!L92XI
+M"@H\+U5,/B \4#X*"E1H92!296%L(%!R;V=R86UM97(@:7,@8V%P86)L92!O
+M9B!W;W)K:6YG(#,P+" T,"P@979E;B U,"!H;W5R<R!A="!A"G-T<F5T8V@L
+M('5N9&5R(&EN=&5N<V4@<')E<W-U<F4N("!);B!F86-T+"!H92!P<F5F97)S
+M(&ET('1H870@=V%Y+B!"860*<F5S<&]N<V4@=&EM92!D;V5S;B=T(&)O=&AE
+M<B!T:&4@4F5A;"!0<F]G<F%M;65R("TM(&ET(&=I=F5S(&AI;2!A"F-H86YC
+M92!T;R!C871C:"!A(&QI='1L92!S;&5E<"!B971W965N(&-O;7!I;&5S+B!)
+M9B!T:&5R92!I<R!N;W0*96YO=6=H('-C:&5D=6QE('!R97-S=7)E(&]N('1H
+M92!296%L(%!R;V=R86UM97(L(&AE('1E;F1S('1O(&UA:V4*=&AI;F=S(&UO
+M<F4@8VAA;&QE;F=I;F<@8GD@=V]R:VEN9R!O;B!S;VUE('-M86QL(&)U="!I
+M;G1E<F5S=&EN9R!P87)T"F]F('1H92!P<F]B;&5M(&9O<B!T:&4@9FER<W0@
+M;FEN92!W965K<RP@=&AE;B!F:6YI<VAI;F<@=&AE(')E<W0@:6X*=&AE(&QA
+M<W0@=V5E:RP@:6X@='=O(&]R('1H<F5E(#4P+6AO=7(@;6%R871H;VYS+B!4
+M:&ES(&YO="!O;FQY"FEN<')E<W-E<R!H:7,@;6%N86=E<BP@=VAO('=A<R!D
+M97-P86ER:6YG(&]F(&5V97(@9V5T=&EN9R!T:&4@<')O:F5C= ID;VYE(&]N
+M('1I;64L(&)U="!C<F5A=&5S(&$@8V]N=F5N:65N="!E>&-U<V4@9F]R(&YO
+M="!D;VEN9R!T:&4*9&]C=6UE;G1A=&EO;BX@26X@9V5N97)A;#H@/% ^"@H\
+M54P^"@H\3$D^($YO(%)E86P@4')O9W)A;6UE<B!W;W)K<R Y('1O(#4N("A5
+M;FQE<W,@:70G<R Y(&EN('1H92!E=F5N:6YG('1O"C4@:6X@=&AE(&UO<FYI
+M;F<N*0H*/$Q)/B!296%L(%!R;V=R86UM97)S(&1O;B=T('=E87(@;F5C:W1I
+M97,N"@H\3$D^("!296%L(%!R;V=R86UM97)S(&1O;B=T('=E87(@:&EG:"!H
+M965L960@<VAO97,N"@H\3$D^("!296%L(%!R;V=R86UM97)S(&%R<FEV92!A
+M="!W;W)K(&EN('1I;64@9F]R(&QU;F-H+B!;.5T*"CQ,23X@02!296%L(%!R
+M;V=R86UM97(@;6EG:'0@;W(@;6EG:'0@;F]T(&MN;W<@:&ES('=I9F4G<R!N
+M86UE+B @2&4*9&]E<RP@:&]W979E<BP@:VYO=R!T:&4@96YT:7)E($%30TE)
+M("AO<B!%0D-$24,I(&-O9&4@=&%B;&4N"@H\3$D^(%)E86P@4')O9W)A;6UE
+M<G,@9&]N)W0@:VYO=R!H;W<@=&\@8V]O:RX@1W)O8V5R>2!S=&]R97,@87)E
+M;B=T"F]F=&5N(&]P96X@870@,R!A+FTN+"!S;R!T:&5Y('-U<G9I=F4@;VX@
+M5'=I;FMI97,@86YD(&-O9F9E92X*"CPO54P^(#Q0/@H*/$@S/B!42$4@1E54
+M55)%/"](,SX*"E=H870@;V8@=&AE(&9U='5R93\@270@:7,@82!M871T97(@
+M;V8@<V]M92!C;VYC97)N('1O(%)E86P@4')O9W)A;6UE<G,*=&AA="!T:&4@
+M;&%T97-T(&=E;F5R871I;VX@;V8@8V]M<'5T97(@<')O9W)A;6UE<G,@87)E
+M(&YO="!B96EN9PIB<F]U9VAT('5P('=I=&@@=&AE('-A;64@;W5T;&]O:R!O
+M;B!L:69E(&%S('1H96ER(&5L9&5R<RX@36%N>2!O9B!T:&5M"FAA=F4@;F5V
+M97(@<V5E;B!A(&-O;7!U=&5R('=I=&@@82!F<F]N="!P86YE;"X@2&%R9&QY
+M(&%N>6]N90IG<F%D=6%T:6YG(&9R;VT@<V-H;V]L('1H97-E(&1A>7,@8V%N
+M(&1O(&AE>"!A<FET:&UE=&EC('=I=&AO=70@80IC86QC=6QA=&]R+B @0V]L
+M;&5G92!G<F%D=6%T97,@=&AE<V4@9&%Y<R!A<F4@<V]F=" M+2!P<F]T96-T
+M960@9G)O;0IT:&4@<F5A;&ET:65S(&]F('!R;V=R86UM:6YG(&)Y('-O=7)C
+M92!L979E;"!D96)U9V=E<G,L('1E>'0@961I=&]R<PIT:&%T(&-O=6YT('!A
+M<F5N=&AE<V5S+"!A;F0@=7-E<B!F<FEE;F1L>2!O<&5R871I;F<@<WES=&5M
+M<RX@(%=O<G-T(&]F"F%L;"P@<V]M92!O9B!T:&5S92!A;&QE9V5D(&-O;7!U
+M=&5R('-C:65N=&ES=',@;6%N86=E('1O(&=E="!D96=R965S"G=I=&AO=70@
+M979E<B!L96%R;FEN9R!&3U)44D%.(2 @07)E('=E(&1E<W1I;F5D('1O(&)E
+M8V]M92!A;B!I;F1U<W1R>0IO9B!5;FEX(&AA8VME<G,@86YD(%!A<V-A;"!P
+M<F]G<F%M;65R<S\@/% ^"@I/;B!T:&4@8V]N=')A<GDN("!&<F]M(&UY(&5X
+M<&5R:65N8V4L($D@8V%N(&]N;'D@<F5P;W)T('1H870@=&AE"F9U='5R92!I
+M<R!B<FEG:'0@9F]R(%)E86P@4')O9W)A;6UE<G,@979E<GEW:&5R92X@3F5I
+M=&AE<B!/4R\S-S @;F]R"D9/4E1204X@<VAO=R!A;GD@<VEG;G,@;V8@9'EI
+M;F<@;W5T+"!D97-P:71E(&%L;"!T:&4@969F;W)T<R!O9@I087-C86P@<')O
+M9W)A;6UE<G,@=&AE('=O<FQD(&]V97(N($5V96X@;6]R92!S=6)T;&4@=')I
+M8VMS+"!L:6ME"F%D9&EN9R!S=')U8W1U<F5D(&-O9&EN9R!C;VYS=')U8W1S
+M('1O($9/4E1204X@:&%V92!F86EL960N("!/:"!S=7)E+ IS;VUE(&-O;7!U
+M=&5R('9E;F1O<G,@:&%V92!C;VUE(&]U="!W:71H($9/4E1204X@-S<@8V]M
+M<&EL97)S+"!B=70*979E<GD@;VYE(&]F('1H96T@:&%S(&$@=V%Y(&]F(&-O
+M;G9E<G1I;F<@:71S96QF(&)A8VL@:6YT;R!A($9/4E1204X*-C8@8V]M<&EL
+M97(@870@=&AE(&1R;W @;V8@86X@;W!T:6]N(&-A<F0@+2T@=&\@8V]M<&EL
+M92!$3R!L;V]P<R!L:6ME"D=O9"!M96%N="!T:&5M('1O(&)E+B \4#X*"D5V
+M96X@56YI>"!M:6=H="!N;W0@8F4@87,@8F%D(&]N(%)E86P@4')O9W)A;6UE
+M<G,@87,@:70@;VYC92!W87,N(%1H90IL871E<W0@<F5L96%S92!O9B!5;FEX
+M(&AA<R!T:&4@<&]T96YT:6%L(&]F(&%N(&]P97)A=&EN9R!S>7-T96T@=V]R
+M=&AY"F]F(&%N>2!296%L(%!R;V=R86UM97(N($ET(&AA<R!T=V\@9&EF9F5R
+M96YT(&%N9"!S=6)T;'D@:6YC;VUP871I8FQE"G5S97(@:6YT97)F86-E<RP@
+M86X@87)C86YE(&%N9"!C;VUP;&EC871E9"!T97)M:6YA;"!D<FEV97(L('9I
+M<G1U86P*;65M;W)Y+B!)9B!Y;W4@:6=N;W)E('1H92!F86-T('1H870@:70G
+M<R!S=')U8W1U<F5D+"!E=F5N($,*<')O9W)A;6UI;F<@8V%N(&)E(&%P<')E
+M8VEA=&5D(&)Y('1H92!296%L(%!R;V=R86UM97(Z(&%F=&5R(&%L;"P*=&AE
+M<F4G<R!N;R!T>7!E(&-H96-K:6YG+"!V87)I86)L92!N86UE<R!A<F4@<V5V
+M96X@*'1E;C\@(&5I9VAT/RD*8VAA<F%C=&5R<R!L;VYG+"!A;F0@=&AE(&%D
+M9&5D(&)O;G5S(&]F('1H92!0;VEN=&5R(&1A=&$@='EP92!I<PIT:')O=VX@
+M:6XN($ET)W,@;&EK92!H879I;F<@=&AE(&)E<W0@<&%R=',@;V8@1D]25%)!
+M3B!A;F0@87-S96UB;'D*;&%N9W5A9V4@:6X@;VYE('!L86-E+B @*$YO="!T
+M;R!M96YT:6]N('-O;64@;V8@=&AE(&UO<F4@8W)E871I=F4@=7-E<PIF;W(@
+M/$M"1#XC9&5F:6YE/"]+0D0^+BD@/% ^"@I.;RP@=&AE(&9U='5R92!I<VXG
+M="!A;&P@=&AA="!B860N("!7:'DL(&EN('1H92!P87-T(&9E=R!Y96%R<RP@
+M=&AE"G!O<'5L87(@<')E<W,@:&%S(&5V96X@8V]M;65N=&5D(&]N('1H92!B
+M<FEG:'0@;F5W(&-R;W @;V8@8V]M<'5T97(*;F5R9',@86YD(&AA8VME<G,@
+M*%LW72!A;F0@6SA=*2!L96%V:6YG('!L86-E<R!L:6ME(%-T86YF;W)D(&%N
+M9 I-+DDN5"X@(&9O<B!T:&4@4F5A;"!7;W)L9"X@($9R;VT@86QL(&5V:61E
+M;F-E+"!T:&4@<W!I<FET(&]F(%)E86P*4')O9W)A;6UI;F<@;&EV97,@;VX@
+M:6X@=&AE<V4@>6]U;F<@;65N(&%N9"!W;VUE;BX@($%S(&QO;F<@87,@=&AE
+M<F4*87)E(&EL;"UD969I;F5D(&=O86QS+"!B:7IA<G)E(&)U9W,L(&%N9"!U
+M;G)E86QI<W1I8R!S8VAE9'5L97,L('1H97)E"G=I;&P@8F4@4F5A;"!0<F]G
+M<F%M;65R<R!W:6QL:6YG('1O(&IU;7 @:6X@86YD(%-O;'9E(%1H92!0<F]B
+M;&5M+ IS879I;F<@=&AE(&1O8W5M96YT871I;VX@9F]R(&QA=&5R+B @3&]N
+M9R!L:79E($9/4E1204XA(#Q0/@H*/$@S/D%#2TY/5TQ%1T5-14Y4/"](,SX*
+M"DD@=V]U;&0@;&EK92!T;R!T:&%N:R!*86X@12XL($1A=F4@4RXL(%)I8V@@
+M1RXL(%)I8V@@12X@9F]R('1H96ER(&AE;' *:6X@8VAA<F%C=&5R:7II;F<@
+M=&AE(%)E86P@4')O9W)A;6UE<BP@2&5A=&AE<B!"+B!F;W(@=&AE"FEL;'5S
+M=')A=&EO;BP@2V%T:'D@12X@9F]R('!U='1I;F<@=7 @=VET:"!I="P@86YD
+M(#QK8F0^871D(6%V<V13.FUA<FL\+VMB9#X@9F]R"G1H92!I;FET:6%L(&EN
+M<W!R:7)A=&EO;BX@/% ^"@H\2#,^4D5&15)%3D-%4SPO2#,^"@I;,5T@(" @
+M1F5I<G-T96EN+"!"+BP@/&5M/E)E86P@365N($1O;B=T($5A="!1=6EC:&4\
+M+V5M/BP@3F5W(%EO<FLL"B @(" @("!0;V-K970@0F]O:W,L(#$Y.#(N(#Q0
+M/@H*6S)=(" @(%=I<G1H+"!.+BP@/&5M/D%L9V]R:71H;7,@*R!$871A<W1R
+M=6-T=7)E<R ](%!R;V=R86US/"]E;3XL"B @(" @("!0<F5N=&EC92!(86QL
+M+" Q.3<V+B \4#X*"ELS72 @("!897)O>"!005)#(&5D:71O<G,@+B N("X@
+M/% ^"@I;-%T@(" @1FEN<V5T:"P@0RXL(#QE;3Y4:&5O<GD@86YD(%!R86-T
+M:6-E(&]F(%1E>'0@161I=&]R<R M"B @(" @("!O<B M(&$@0V]O:V)O;VL@
+M9F]R(&%N($5-04-3/"]E;3XL($(N4RX@5&AE<VES+ H@(" @(" @34E4+TQ#
+M4R]432TQ-C4L($UA<W-A8VAU<V5T=',@26YS=&ET=71E(&]F(%1E8VAN;VQO
+M9WDL"B @(" @("!-87D@,3DX,"X@/% ^"@I;-5T@(" @5V5I;F)E<F<L($<N
+M+" \96T^5&AE(%!S>6-H;VQO9WD@;V8@0V]M<'5T97(@4')O9W)A;6UI;F<\
+M+V5M/BP*(" @(" @($YE=R!9;W)K+"!686X@3F]S=')A8F0@4F5I;FAO;&0L
+M(#$Y-S$L('!A9V4@,3$P+B \4#X*"ELV72 @("!$:6IK<W1R82P@12XL(#QE
+M;3Y/;B!T:&4@1U)%14X@3&%N9W5A9V4@4W5B;6ET=&5D('1O('1H92!$;T0\
+M+V5M/BP*(" @(" @(%-I9W!L86X@;F]T:6-E<RP@5F]L=6UE(#,L($YU;6)E
+M<B Q,"P@3V-T;V)E<B Q.3<X+B \4#X*"ELW72 @("!2;W-E+"!&<F%N:RP@
+M/&5M/DIO>2!O9B!(86-K:6YG/"]E;3XL(%-C:65N8V4@.#(L(%9O;'5M92 S
+M+"!.=6UB97(@.2P*(" @(" @($YO=F5M8F5R(#$Y.#(L('!A9V5S(#4X("T@
+M-C8N(#Q0/@H*6SA=(" @(%1H92!(86-K97(@4&%P97)S+" \96T^4'-Y8VAO
+M;&]G>2!4;V1A>3PO96T^+"!!=6=U<W0@,3DX,"X@/% ^"@I;.5T@(" @/&5M
+M/D1A=&%M871I;VX\+V5M/BP@2G5L>2P@,3DX,RP@<' N(#(V,RTR-C4N(#Q0
+M/@H*/&AR/@H*/$%$1%)%4U,^(#QA(&AR968](FEN9&5X+FAT;6PB/DAA8VME
+M<B=S(%=I<V1O;3PO83XO(%)E86P@4')O9W)A;6UE<G,*1&]N)W0@57-E(%!!
+M4T-!3" \+T%$1%)%4U,^"@H\(2TM(&AH;71S('-T87)T("TM/@I,87-T(&UO
+E9&EF:65D.B!7960@36%R(#(W(#$W.C0X.C4P($535" Q.3DV"@
diff --git a/lib/kernel/test/ram_file_SUITE_data/realmen.html b/lib/kernel/test/ram_file_SUITE_data/realmen.html
new file mode 100644
index 0000000000..c810a5d088
--- /dev/null
+++ b/lib/kernel/test/ram_file_SUITE_data/realmen.html
@@ -0,0 +1,520 @@
+<TITLE>Real Programmers Don't Use PASCAL</TITLE>
+
+<H2 align=center>Real Programmers Don't Use PASCAL</H2>
+
+<H4 align=center><em>Ed Post<br>
+Graphic Software Systems<br>
+
+P.O. Box 673<br>
+25117 S.W. Parkway<br>
+Wilsonville, OR 97070<br>
+Copyright (c) 1982<br>
+</H4></EM>
+
+
+<H4 align=center><KBD> (decvax | ucbvax | cbosg | pur-ee | lbl-unix)!teklabs!ogcvax!gss1144!evp</KBD></H4>
+
+
+Back in the good old days -- the "Golden Era" of computers, it was
+easy to separate the men from the boys (sometimes called "Real Men"
+and "Quiche Eaters" in the literature). During this period, the Real
+Men were the ones that understood computer programming, and the Quiche
+Eaters were the ones that didn't. A real computer programmer said
+things like <KBD>"DO 10 I=1,10"</KBD> and <KBD>"ABEND"</KBD> (they
+actually talked in capital letters, you understand), and the rest of
+the world said things like <EM>"computers are too complicated for
+me"</EM> and <EM>"I can't relate to computers -- they're so
+impersonal"</EM>. (A previous work [1] points out that Real Men don't
+"relate" to anything, and aren't afraid of being impersonal.) <P>
+
+But, as usual, times change. We are faced today with a world in which
+little old ladies can get computerized microwave ovens, 12 year old
+kids can blow Real Men out of the water playing Asteroids and Pac-Man,
+and anyone can buy and even understand their very own Personal
+Computer. The Real Programmer is in danger of becoming extinct, of
+being replaced by high-school students with TRASH-80s! <P>
+
+There is a clear need to point out the differences between the typical
+high-school junior Pac-Man player and a Real Programmer. Understanding
+these differences will give these kids something to aspire to -- a
+role model, a Father Figure. It will also help employers of Real
+Programmers to realize why it would be a mistake to replace the Real
+Programmers on their staff with 12 year old Pac-Man players (at a
+considerable salary savings). <P>
+
+
+<H3>LANGUAGES</H3>
+
+The easiest way to tell a Real Programmer from the crowd is by the
+programming language he (or she) uses. Real Programmers use FORTRAN.
+Quiche Eaters use PASCAL. Nicklaus Wirth, the designer of PASCAL, was
+once asked, <EM>"How do you pronounce your name?"</EM>. He replied
+<EM>"You can either call me by name, pronouncing it 'Veert', or call
+me by value, 'Worth'."</EM> One can tell immediately from this comment
+that Nicklaus Wirth is a Quiche Eater. The only parameter passing
+mechanism endorsed by Real Programmers is call-by-value-return, as
+implemented in the IBM/370 FORTRAN G and H compilers. Real
+programmers don't need abstract concepts to get their jobs done: they
+are perfectly happy with a keypunch, a FORTRAN IV compiler, and a
+beer. <P>
+
+<UL>
+<LI> Real Programmers do List Processing in FORTRAN.
+
+<LI> Real Programmers do String Manipulation in FORTRAN.
+
+<LI> Real Programmers do Accounting (if they do it at all) in FORTRAN.
+
+<LI> Real Programmers do Artificial Intelligence programs in FORTRAN.
+</UL> <P>
+
+If you can't do it in FORTRAN, do it in assembly language. If you can't do
+it in assembly language, it isn't worth doing. <P>
+
+
+<H3> STRUCTURED PROGRAMMING</H3>
+
+Computer science academicians have gotten into the "structured pro-
+gramming" rut over the past several years. They claim that programs
+are more easily understood if the programmer uses some special
+language constructs and techniques. They don't all agree on exactly
+which constructs, of course, and the examples they use to show their
+particular point of view invariably fit on a single page of some
+obscure journal or another -- clearly not enough of an example to
+convince anyone. When I got out of school, I thought I was the best
+programmer in the world. I could write an unbeatable tic-tac-toe
+program, use five different computer languages, and create 1000 line
+programs that WORKED. (Really!) Then I got out into the Real
+World. My first task in the Real World was to read and understand a
+200,000 line FORTRAN program, then speed it up by a factor of two. Any
+Real Programmer will tell you that all the Structured Coding in the
+world won't help you solve a problem like that -- it takes actual
+talent. Some quick observations on Real Programmers and Structured
+Programming: <P>
+
+<UL>
+<LI> Real Programmers aren't afraid to use GOTOs.
+
+<LI> Real Programmers can write five page long DO loops without
+getting confused.
+
+<LI> Real Programmers enjoy Arithmetic IF statements because they make
+the code more interesting.
+
+<LI> Real Programmers write self-modifying code, especially if it
+saves them 20 nanoseconds in the middle of a tight loop.
+
+<LI> Programmers don't need comments: the code is obvious.
+
+<LI> Since FORTRAN doesn't have a structured <KBD>IF, REPEAT
+... UNTIL</KBD>, or <KBD>CASE</KBD> statement, Real Programmers don't
+have to worry about not using them. Besides, they can be simulated
+when necessary using assigned <KBD>GOTO</KBD>s.
+
+</UL> <P>
+
+Data structures have also gotten a lot of press lately. Abstract Data
+Types, Structures, Pointers, Lists, and Strings have become popular in
+certain circles. Wirth (the above-mentioned Quiche Eater) actually
+wrote an entire book [2] contending that you could write a program
+based on data structures, instead of the other way around. As all Real
+Programmers know, the only useful data structure is the
+array. Strings, lists, structures, sets -- these are all special cases
+of arrays and and can be treated that way just as easily without
+messing up your programing language with all sorts of
+complications. The worst thing about fancy data types is that you have
+to declare them, and Real Programming Languages, as we all know, have
+implicit typing based on the first letter of the (six character)
+variable name. <P>
+
+
+<H3> OPERATING SYSTEMS</H3>
+
+What kind of operating system is used by a Real Programmer? CP/M? God
+forbid -- CP/M, after all, is basically a toy operating system. Even
+little old ladies and grade school students can understand and use
+CP/M. <P>
+
+Unix is a lot more complicated of course -- the typical Unix hacker
+never can remember what the <KBD>PRINT</KBD> command is called this
+week -- but when it gets right down to it, Unix is a glorified video
+game. People don't do Serious Work on Unix systems: they send jokes
+around the world on USENET and write adventure games and research
+papers. <P>
+
+No, your Real Programmer uses OS/370. A good programmer can find and
+understand the description of the IJK305I error he just got in his JCL
+manual. A great programmer can write JCL without referring to the
+manual at all. A truly outstanding programmer can find bugs buried in
+a 6 megabyte core dump without using a hex calculator. (I have
+actually seen this done.) <P>
+
+OS/370 is a truly remarkable operating system. It's possible to des-
+troy days of work with a single misplaced space, so alertness in the
+programming staff is encouraged. The best way to approach the system
+is through a keypunch. Some people claim there is a Time Sharing
+system that runs on OS/370, but after careful study I have come to the
+conclusion that they are mistaken. <P>
+
+
+<H3> PROGRAMMING TOOLS</H3>
+
+What kind of tools does a Real Programmer use? In theory, a Real
+Programmer could run his programs by keying them into the front panel
+of the computer. Back in the days when computers had front panels,
+this was actually done occasionally. Your typical Real Programmer
+knew the entire bootstrap loader by memory in hex, and toggled it in
+whenever it got destroyed by his program. (Back then, memory was
+memory -- it didn't go away when the power went off. Today, memory
+either forgets things when you don't want it to, or remembers things
+long after they're better forgotten.) Legend has it that Seymour
+Cray, inventor of the Cray I supercomputer and most of Control Data's
+computers, actually toggled the first operating system for the CDC7600
+in on the front panel from memory when it was first powered
+on. Seymour, needless to say, is a Real Programmer. <P>
+
+One of my favorite Real Programmers was a systems programmer for Texas
+Instruments. One day, he got a long distance call from a user whose
+system had crashed in the middle of some important work. Jim was able
+to repair the damage over the phone, getting the user to toggle in
+disk I/O instructions at the front panel, repairing system tables in
+hex, reading register contents back over the phone. The moral of this
+story: while a Real Programmer usually includes a keypunch and
+lineprinter in his toolkit, he can get along with just a front panel
+and a telephone in emergencies. <P>
+
+In some companies, text editing no longer consists of ten engineers
+standing in line to use an 029 keypunch. In fact, the building I work
+in doesn't contain a single keypunch. The Real Programmer in this
+situation has to do his work with a text editor program. Most systems
+supply several text editors to select from, and the Real Programmer
+must be careful to pick one that reflects his personal style. Many
+people believe that the best text editors in the world were written at
+Xerox Palo Alto Research Center for use on their Alto and Dorado
+computers [3]. Unfortunately, no Real Programmer would ever use a
+computer whose operating system is called SmallTalk, and would
+certainly not talk to the computer with a mouse. <P>
+
+Some of the concepts in these Xerox editors have been incorporated
+into editors running on more reasonably named operating systems. EMACS
+and VI are probably the most well known of this class of editors. The
+problem with these editors is that Real Programmers consider "what you
+see is what you get" to be just as bad a concept in text editors as it
+is in women. No, the Real Programmer wants a "you asked for it, you
+got it" text editor -- complicated, cryptic, powerful, unforgiving,
+dangerous. TECO, to be precise. <P>
+
+It has been observed that a TECO command sequence more closely resem-
+bles transmission line noise than readable text [4]. One of the more
+entertaining games to play with TECO is to type your name in as a
+command line and try to guess what it does. Just about any possible
+typing error while talking with TECO will probably destroy your
+program, or even worse -- introduce subtle and mysterious bugs in a
+once working subroutine. <P>
+
+For this reason, Real Programmers are reluctant to actually edit a
+program that is close to working. They find it much easier to just
+patch the binary object code directly, using a wonderful program
+called SUPERZAP (or its equivalent on non-IBM machines). This works so
+well that many working programs on IBM systems bear no relation to
+the original FORTRAN code. In many cases, the original source code is
+no longer available. When it comes time to fix a program like this, no
+manager would even think of sending anything less than a Real
+Programmer to do the job -- no Quiche Eating structured programmer
+would even know where to start. This is called "job security". <P>
+
+Some programming tools NOT used by Real Programmers: <P>
+<UL>
+
+<LI> FORTRAN preprocessors like MORTRAN and RATFOR. The Cuisinarts of
+programming -- great for making Quiche. See comments above on
+structured programming.
+
+<LI> Source language debuggers. Real Programmers can read core dumps.
+
+<LI> Compilers with array bounds checking. They stifle creativity,
+destroy most of the interesting uses for EQUIVALENCE, and make it
+impossible to modify the operating system code with negative
+subscripts. Worst of all, bounds checking is inefficient.
+
+<LI> Source code maintainance systems. A Real Programmer keeps his
+code locked up in a card file, because it implies that its owner
+cannot leave his important programs unguarded [5].
+
+</UL> <P>
+
+
+<H3> THE REAL PROGRAMMER AT WORK</H3>
+
+Where does the typical Real Programmer work? What kind of programs are
+worthy of the efforts of so talented an individual? You can be sure
+that no real Programmer would be caught dead writing
+accounts-receivable programs in COBOL, or sorting mailing lists for
+People magazine. A Real Programmer wants tasks of earth-shaking
+importance (literally!): <P>
+
+<UL>
+
+<LI> Real Programmers work for Los Alamos National Laboratory, writing
+atomic bomb simulations to run on Cray I supercomputers.
+
+<LI> Real Programmers work for the National Security Agency, decoding
+Russian transmissions.
+
+<LI> It was largely due to the efforts of thousands of Real
+Programmers working for NASA that our boys got to the moon and back
+before the cosmonauts.
+
+<LI> The computers in the Space Shuttle were programmed by Real
+Programmers.
+
+<LI> Programmers are at work for Boeing designing the operating
+systems for cruise missiles.
+
+</UL> <P>
+
+Some of the most awesome Real Programmers of all work at the Jet Pro-
+pulsion Laboratory in California. Many of them know the entire
+operating system of the Pioneer and Voyager spacecraft by heart. With
+a combination of large ground-based FORTRAN programs and small
+spacecraft-based assembly language programs, they can to do incredible
+feats of navigation and improvisation, such as hitting ten-kilometer
+wide windows at Saturn after six years in space, and repairing or
+bypassing damaged sensor platforms, radios, and batteries. Allegedly,
+one Real Programmer managed to tuck a pattern-matching program into a
+few hundred bytes of unused memory in a Voyager spacecraft that
+searched for, located, and photographed a new moon of Jupiter. <P>
+
+One plan for the upcoming Galileo spacecraft mission is to use a grav-
+ity assist trajectory past Mars on the way to Jupiter. This trajectory
+passes within 80 +/- 3 kilometers of the surface of Mars. Nobody is
+going to trust a PASCAL program (or PASCAL programmer) for navigation
+to these tolerances. <P>
+
+As you can tell, many of the world's Real Programmers work for the
+U.S. Government, mainly the Defense Department. This is as it should
+be. Recently, however, a black cloud has formed on the Real
+Programmer horizon. <P>
+
+It seems that some highly placed Quiche Eaters at the Defense
+Department decided that all Defense programs should be written in some
+grand unified language called "ADA" (registered trademark, DoD). For
+a while, it seemed that ADA was destined to become a language that
+went against all the precepts of Real Programming -- a language with
+structure, a language with data types, strong typing, and
+semicolons. In short, a language designed to cripple the creativity of
+the typical Real Programmer. Fortunately, the language adopted by DoD
+has enough interesting features to make it approachable: it's
+incredibly complex, includes methods for messing with the operating
+system and rearranging memory, and Edsgar Dijkstra doesn't like it
+[6]. (Dijkstra, as I'm sure you know, was the author of <EM>"GoTos
+Considered Harmful"</EM> -- a landmark work in programming
+methodology, applauded by Pascal Programmers and Quiche Eaters alike.)
+Besides, the determined Real Programmer can write FORTRAN programs in
+any language. <P>
+
+The real programmer might compromise his principles and work on some-
+thing slightly more trivial than the destruction of life as we know
+it, providing there's enough money in it. There are several Real
+Programmers building video games at Atari, for example. (But not
+playing them. A Real Programmer knows how to beat the machine every
+time: no challange in that.) Everyone working at LucasFilm is a Real
+Programmer. (It would be crazy to turn down the money of 50 million
+Star Wars fans.) The proportion of Real Programmers in Computer
+Graphics is somewhat lower than the norm, mostly because nobody has
+found a use for Computer Graphics yet. On the other hand, all
+Computer Graphics is done in FORTRAN, so there are a fair number
+people doing Graphics in order to avoid having to write COBOL
+programs. <P>
+
+
+<H3> THE REAL PROGRAMMER AT PLAY</H3>
+
+Generally, the Real Programmer plays the same way he works -- with
+computers. He is constantly amazed that his employer actually pays
+him to do what he would be doing for fun anyway, although he is
+careful not to express this opinion out loud. Occasionally, the Real
+Programmer does step out of the office for a breath of fresh air and a
+beer or two. Some tips on recognizing real programmers away from the
+computer room: <P>
+<UL>
+
+<LI> At a party, the Real Programmers are the ones in the corner
+talking about operating system security and how to get around it.
+
+<LI> At a football game, the Real Programmer is the one comparing the
+plays against his simulations printed on 11 by 14 fanfold paper.
+
+<LI> At the beach, the Real Programmer is the one drawing flowcharts
+in the sand.
+
+<LI> A Real Programmer goes to a disco to watch the light show.
+
+<LI> At a funeral, the Real Programmer is the one saying <EM>"Poor
+George. And he almost had the sort routine working before the
+coronary."</EM>
+
+<LI> In a grocery store, the Real Programmer is the one who insists on
+running the cans past the laser checkout scanner himself, because he
+never could trust keypunch operators to get it right the first time.
+
+</UL> <P>
+
+
+<H3> THE REAL PROGRAMMER'S NATURAL HABITAT</H3>
+
+What sort of environment does the Real Programmer function best in?
+This is an important question for the managers of Real
+Programmers. Considering the amount of money it costs to keep one on
+the staff, it's best to put him (or her) in an environment where he
+can get his work done. <P>
+
+The typical Real Programmer lives in front of a computer terminal.
+Surrounding this terminal are: <P>
+<UL>
+
+<LI> Listings of all programs the Real Programmer has ever worked on,
+piled in roughly chronological order on every flat surface in the office.
+
+<LI> Some half-dozen or so partly filled cups of cold
+coffee. Occasionally, there will be cigarette butts floating in the
+coffee. In some cases, the cups will contain Orange Crush.
+
+<LI> Unless he is very good, there will be copies of the OS JCL manual
+and the Principles of Operation open to some particularly interesting
+pages.
+
+<LI> Taped to the wall is a line-printer Snoopy calender for the year
+1969.
+
+<LI> Strewn about the floor are several wrappers for peanut butter
+filled cheese bars (the type that are made stale at the bakery so they
+can't get any worse while waiting in the vending machine).
+
+<LI> Hiding in the top left-hand drawer of the desk is a stash of
+double stuff Oreos for special occasions.
+
+<LI> Underneath the Oreos is a flow-charting template, left there by
+the previous occupant of the office. (Real Programmers write programs,
+not documentation. Leave that to the maintainence people.)
+
+</UL> <P>
+
+The Real Programmer is capable of working 30, 40, even 50 hours at a
+stretch, under intense pressure. In fact, he prefers it that way. Bad
+response time doesn't bother the Real Programmer -- it gives him a
+chance to catch a little sleep between compiles. If there is not
+enough schedule pressure on the Real Programmer, he tends to make
+things more challenging by working on some small but interesting part
+of the problem for the first nine weeks, then finishing the rest in
+the last week, in two or three 50-hour marathons. This not only
+inpresses his manager, who was despairing of ever getting the project
+done on time, but creates a convenient excuse for not doing the
+documentation. In general: <P>
+
+<UL>
+
+<LI> No Real Programmer works 9 to 5. (Unless it's 9 in the evening to
+5 in the morning.)
+
+<LI> Real Programmers don't wear neckties.
+
+<LI> Real Programmers don't wear high heeled shoes.
+
+<LI> Real Programmers arrive at work in time for lunch. [9]
+
+<LI> A Real Programmer might or might not know his wife's name. He
+does, however, know the entire ASCII (or EBCDIC) code table.
+
+<LI> Real Programmers don't know how to cook. Grocery stores aren't
+often open at 3 a.m., so they survive on Twinkies and coffee.
+
+</UL> <P>
+
+<H3> THE FUTURE</H3>
+
+What of the future? It is a matter of some concern to Real Programmers
+that the latest generation of computer programmers are not being
+brought up with the same outlook on life as their elders. Many of them
+have never seen a computer with a front panel. Hardly anyone
+graduating from school these days can do hex arithmetic without a
+calculator. College graduates these days are soft -- protected from
+the realities of programming by source level debuggers, text editors
+that count parentheses, and user friendly operating systems. Worst of
+all, some of these alleged computer scientists manage to get degrees
+without ever learning FORTRAN! Are we destined to become an industry
+of Unix hackers and Pascal programmers? <P>
+
+On the contrary. From my experience, I can only report that the
+future is bright for Real Programmers everywhere. Neither OS/370 nor
+FORTRAN show any signs of dying out, despite all the efforts of
+Pascal programmers the world over. Even more subtle tricks, like
+adding structured coding constructs to FORTRAN have failed. Oh sure,
+some computer vendors have come out with FORTRAN 77 compilers, but
+every one of them has a way of converting itself back into a FORTRAN
+66 compiler at the drop of an option card -- to compile DO loops like
+God meant them to be. <P>
+
+Even Unix might not be as bad on Real Programmers as it once was. The
+latest release of Unix has the potential of an operating system worthy
+of any Real Programmer. It has two different and subtly incompatible
+user interfaces, an arcane and complicated terminal driver, virtual
+memory. If you ignore the fact that it's structured, even C
+programming can be appreciated by the Real Programmer: after all,
+there's no type checking, variable names are seven (ten? eight?)
+characters long, and the added bonus of the Pointer data type is
+thrown in. It's like having the best parts of FORTRAN and assembly
+language in one place. (Not to mention some of the more creative uses
+for <KBD>#define</KBD>.) <P>
+
+No, the future isn't all that bad. Why, in the past few years, the
+popular press has even commented on the bright new crop of computer
+nerds and hackers ([7] and [8]) leaving places like Stanford and
+M.I.T. for the Real World. From all evidence, the spirit of Real
+Programming lives on in these young men and women. As long as there
+are ill-defined goals, bizarre bugs, and unrealistic schedules, there
+will be Real Programmers willing to jump in and Solve The Problem,
+saving the documentation for later. Long live FORTRAN! <P>
+
+<H3>ACKNOWLEGEMENT</H3>
+
+I would like to thank Jan E., Dave S., Rich G., Rich E. for their help
+in characterizing the Real Programmer, Heather B. for the
+illustration, Kathy E. for putting up with it, and <kbd>atd!avsdS:mark</kbd> for
+the initial inspriration. <P>
+
+<H3>REFERENCES</H3>
+
+[1] Feirstein, B., <em>Real Men Don't Eat Quiche</em>, New York,
+ Pocket Books, 1982. <P>
+
+[2] Wirth, N., <em>Algorithms + Datastructures = Programs</em>,
+ Prentice Hall, 1976. <P>
+
+[3] Xerox PARC editors . . . <P>
+
+[4] Finseth, C., <em>Theory and Practice of Text Editors -
+ or - a Cookbook for an EMACS</em>, B.S. Thesis,
+ MIT/LCS/TM-165, Massachusetts Institute of Technology,
+ May 1980. <P>
+
+[5] Weinberg, G., <em>The Psychology of Computer Programming</em>,
+ New York, Van Nostrabd Reinhold, 1971, page 110. <P>
+
+[6] Dijkstra, E., <em>On the GREEN Language Submitted to the DoD</em>,
+ Sigplan notices, Volume 3, Number 10, October 1978. <P>
+
+[7] Rose, Frank, <em>Joy of Hacking</em>, Science 82, Volume 3, Number 9,
+ November 1982, pages 58 - 66. <P>
+
+[8] The Hacker Papers, <em>Psychology Today</em>, August 1980. <P>
+
+[9] <em>Datamation</em>, July, 1983, pp. 263-265. <P>
+
+<hr>
+
+<ADDRESS> <a href="index.html">Hacker's Wisdom</a>/ Real Programmers
+Don't Use PASCAL </ADDRESS>
+
+<!-- hhmts start -->
+Last modified: Wed Mar 27 17:48:50 EST 1996
diff --git a/lib/kernel/test/ram_file_SUITE_data/realmen.html.gz b/lib/kernel/test/ram_file_SUITE_data/realmen.html.gz
new file mode 100644
index 0000000000..040ef59b72
--- /dev/null
+++ b/lib/kernel/test/ram_file_SUITE_data/realmen.html.gz
Binary files differ
diff --git a/lib/kernel/test/ram_file_SUITE_data/realmen.html.uu b/lib/kernel/test/ram_file_SUITE_data/realmen.html.uu
new file mode 100644
index 0000000000..dcaaad512d
--- /dev/null
+++ b/lib/kernel/test/ram_file_SUITE_data/realmen.html.uu
@@ -0,0 +1,529 @@
+M/%1)5$Q%/E)E86P@4')O9W)A;6UE<G,@1&]N)W0@57-E(%!!4T-!3#PO5$E4
+M3$4^"@H\2#(@86QI9VX]8V5N=&5R/E)E86P@4')O9W)A;6UE<G,@1&]N)W0@
+M57-E(%!!4T-!3#PO2#(^"@H\2#0@86QI9VX]8V5N=&5R/CQE;3Y%9"!0;W-T
+M/&)R/@I'<F%P:&EC(%-O9G1W87)E(%-Y<W1E;7,\8G(^"@I0+D\N($)O>" V
+M-S,\8G(^"C(U,3$W(%,N5RX@4&%R:W=A>3QB<CX*5VEL<V]N=FEL;&4L($]2
+M(#DW,#<P/&)R/@I#;W!Y<FEG:'0@*&,I(#$Y.#(\8G(^"CPO2#0^/"]%33X*
+M"@H\2#0@86QI9VX]8V5N=&5R/CQ+0D0^("AD96-V87@@?"!U8V)V87@@?"!C
+M8F]S9R!\('!U<BUE92!\(&QB;"UU;FEX*2%T96ML86)S(6]G8W9A>"%G<W,Q
+M,30T(65V<#PO2T)$/CPO2#0^"@H*0F%C:R!I;B!T:&4@9V]O9"!O;&0@9&%Y
+M<R M+2!T:&4@(D=O;&1E;B!%<F$B(&]F(&-O;7!U=&5R<RP@:70@=V%S"F5A
+M<WD@=&\@<V5P87)A=&4@=&AE(&UE;B!F<F]M('1H92!B;WES("AS;VUE=&EM
+M97,@8V%L;&5D(")296%L($UE;B(*86YD(")1=6EC:&4@16%T97)S(B!I;B!T
+M:&4@;&ET97)A='5R92DN($1U<FEN9R!T:&ES('!E<FEO9"P@=&AE(%)E86P*
+M365N('=E<F4@=&AE(&]N97,@=&AA="!U;F1E<G-T;V]D(&-O;7!U=&5R('!R
+M;V=R86UM:6YG+"!A;F0@=&AE(%%U:6-H90I%871E<G,@=V5R92!T:&4@;VYE
+M<R!T:&%T(&1I9&XG="X@02!R96%L(&-O;7!U=&5R('!R;V=R86UM97(@<V%I
+M9 IT:&EN9W,@;&EK92 \2T)$/B)$3R Q,"!)/3$L,3 B/"]+0D0^(&%N9" \
+M2T)$/B)!0D5.1"(\+TM"1#X@*'1H97D*86-T=6%L;'D@=&%L:V5D(&EN(&-A
+M<&ET86P@;&5T=&5R<RP@>6]U('5N9&5R<W1A;F0I+"!A;F0@=&AE(')E<W0@
+M;V8*=&AE('=O<FQD('-A:60@=&AI;F=S(&QI:V4@/$5-/B)C;VUP=71E<G,@
+M87)E('1O;R!C;VUP;&EC871E9"!F;W(*;64B/"]%33X@86YD(#Q%33XB22!C
+M86XG="!R96QA=&4@=&\@8V]M<'5T97)S("TM('1H97DG<F4@<V\*:6UP97)S
+M;VYA;"(\+T5-/BX@("A!('!R979I;W5S('=O<FL@6S%=('!O:6YT<R!O=70@
+M=&AA="!296%L($UE;B!D;VXG= HB<F5L871E(B!T;R!A;GET:&EN9RP@86YD
+M(&%R96XG="!A9G)A:60@;V8@8F5I;F<@:6UP97)S;VYA;"XI(#Q0/@H*0G5T
+M+"!A<R!U<W5A;"P@=&EM97,@8VAA;F=E+B!792!A<F4@9F%C960@=&]D87D@
+M=VET:"!A('=O<FQD(&EN('=H:6-H"FQI='1L92!O;&0@;&%D:65S(&-A;B!G
+M970@8V]M<'5T97)I>F5D(&UI8W)O=V%V92!O=F5N<RP@,3(@>65A<B!O;&0*
+M:VED<R!C86X@8FQO=R!296%L($UE;B!O=70@;V8@=&AE('=A=&5R('!L87EI
+M;F<@07-T97)O:61S(&%N9"!086,M36%N+ IA;F0@86YY;VYE(&-A;B!B=7D@
+M86YD(&5V96X@=6YD97)S=&%N9"!T:&5I<B!V97)Y(&]W;B!097)S;VYA; I#
+M;VUP=71E<BX@5&AE(%)E86P@4')O9W)A;6UE<B!I<R!I;B!D86YG97(@;V8@
+M8F5C;VUI;F<@97AT:6YC="P@;V8*8F5I;F<@<F5P;&%C960@8GD@:&EG:"US
+M8VAO;VP@<W1U9&5N=',@=VET:"!44D%32"TX,',A(#Q0/@H*5&AE<F4@:7,@
+M82!C;&5A<B!N965D('1O('!O:6YT(&]U="!T:&4@9&EF9F5R96YC97,@8F5T
+M=V5E;B!T:&4@='EP:6-A; IH:6=H+7-C:&]O;"!J=6YI;W(@4&%C+4UA;B!P
+M;&%Y97(@86YD(&$@4F5A;"!0<F]G<F%M;65R+B!5;F1E<G-T86YD:6YG"G1H
+M97-E(&1I9F9E<F5N8V5S('=I;&P@9VEV92!T:&5S92!K:61S('-O;65T:&EN
+M9R!T;R!A<W!I<F4@=&\@+2T@80IR;VQE(&UO9&5L+"!A($9A=&AE<B!&:6=U
+M<F4N($ET('=I;&P@86QS;R!H96QP(&5M<&QO>65R<R!O9B!296%L"E!R;V=R
+M86UM97)S('1O(')E86QI>F4@=VAY(&ET('=O=6QD(&)E(&$@;6ES=&%K92!T
+M;R!R97!L86-E('1H92!296%L"E!R;V=R86UM97)S(&]N('1H96ER('-T869F
+M('=I=&@@,3(@>65A<B!O;&0@4&%C+4UA;B!P;&%Y97)S("AA="!A"F-O;G-I
+M9&5R86)L92!S86QA<GD@<V%V:6YG<RDN(#Q0/@H*"CQ(,SY,04Y'54%'15,\
+M+T@S/@H*5&AE(&5A<VEE<W0@=V%Y('1O('1E;&P@82!296%L(%!R;V=R86UM
+M97(@9G)O;2!T:&4@8W)O=V0@:7,@8GD@=&AE"G!R;V=R86UM:6YG(&QA;F=U
+M86=E(&AE("AO<B!S:&4I('5S97,N("!296%L(%!R;V=R86UM97)S('5S92!&
+M3U)44D%.+@I1=6EC:&4@16%T97)S('5S92!005-#04PN($YI8VML875S(%=I
+M<G1H+"!T:&4@9&5S:6=N97(@;V8@4$%30T%,+"!W87,*;VYC92!A<VME9"P@
+M/$5-/B)(;W<@9&\@>6]U('!R;VYO=6YC92!Y;W5R(&YA;64_(CPO14T^+B!(
+M92!R97!L:65D"CQ%33XB66]U(&-A;B!E:71H97(@8V%L;"!M92!B>2!N86UE
+M+"!P<F]N;W5N8VEN9R!I=" G5F5E<G0G+"!O<B!C86QL"FUE(&)Y('9A;'5E
+M+" G5V]R=&@G+B(\+T5-/B!/;F4@8V%N('1E;&P@:6UM961I871E;'D@9G)O
+M;2!T:&ES(&-O;6UE;G0*=&AA="!.:6-K;&%U<R!7:7)T:"!I<R!A(%%U:6-H
+M92!%871E<BX@(%1H92!O;FQY('!A<F%M971E<B!P87-S:6YG"FUE8VAA;FES
+M;2!E;F1O<G-E9"!B>2!296%L(%!R;V=R86UM97)S(&ES(&-A;&PM8GDM=F%L
+M=64M<F5T=7)N+"!A<PII;7!L96UE;G1E9"!I;B!T:&4@24)-+S,W,"!&3U)4
+M4D%.($<@86YD($@@8V]M<&EL97)S+B @4F5A; IP<F]G<F%M;65R<R!D;VXG
+M="!N965D(&%B<W1R86-T(&-O;F-E<'1S('1O(&=E="!T:&5I<B!J;V)S(&1O
+M;F4Z('1H97D*87)E('!E<F9E8W1L>2!H87!P>2!W:71H(&$@:V5Y<'5N8V@L
+M(&$@1D]25%)!3B!)5B!C;VUP:6QE<BP@86YD(&$*8F5E<BX@/% ^"@H\54P^
+M"CQ,23X@4F5A;"!0<F]G<F%M;65R<R!D;R!,:7-T(%!R;V-E<W-I;F<@:6X@
+M1D]25%)!3BX*"CQ,23X@(%)E86P@4')O9W)A;6UE<G,@9&\@4W1R:6YG($UA
+M;FEP=6QA=&EO;B!I;B!&3U)44D%.+@H*/$Q)/B @4F5A;"!0<F]G<F%M;65R
+M<R!D;R!!8V-O=6YT:6YG("AI9B!T:&5Y(&1O(&ET(&%T(&%L;"D@:6X@1D]2
+M5%)!3BX*"CQ,23X@(%)E86P@4')O9W)A;6UE<G,@9&\@07)T:69I8VEA;"!)
+M;G1E;&QI9V5N8V4@<')O9W)A;7,@:6X@1D]25%)!3BX*/"]53#X@/% ^"@I)
+M9B!Y;W4@8V%N)W0@9&\@:70@:6X@1D]25%)!3BP@9&\@:70@:6X@87-S96UB
+M;'D@;&%N9W5A9V4N($EF('EO=2!C86XG=" @9&\*:70@:6X@87-S96UB;'D@
+M;&%N9W5A9V4L(&ET(&ES;B=T('=O<G1H(&1O:6YG+B \4#X*"@H\2#,^("!3
+M5%)50U154D5$(%!23T=204U-24Y'/"](,SX*"D-O;7!U=&5R('-C:65N8V4@
+M86-A9&5M:6-I86YS(&AA=F4@9V]T=&5N(&EN=&\@=&AE(")S=')U8W1U<F5D
+M('!R;RT*9W)A;6UI;F<B(')U="!O=F5R('1H92!P87-T('-E=F5R86P@>65A
+M<G,N(%1H97D@8VQA:6T@=&AA="!P<F]G<F%M<PIA<F4@;6]R92!E87-I;'D@
+M=6YD97)S=&]O9"!I9B!T:&4@<')O9W)A;6UE<B!U<V5S('-O;64@<W!E8VEA
+M; IL86YG=6%G92!C;VYS=')U8W1S(&%N9"!T96-H;FEQ=65S+B!4:&5Y(&1O
+M;B=T(&%L;"!A9W)E92!O;B!E>&%C=&QY"G=H:6-H(&-O;G-T<G5C=',L(&]F
+M(&-O=7)S92P@86YD('1H92!E>&%M<&QE<R!T:&5Y('5S92!T;R!S:&]W('1H
+M96ER"G!A<G1I8W5L87(@<&]I;G0@;V8@=FEE=R!I;G9A<FEA8FQY(&9I="!O
+M;B!A('-I;F=L92!P86=E(&]F('-O;64*;V)S8W5R92!J;W5R;F%L(&]R(&%N
+M;W1H97(@+2T@8VQE87)L>2!N;W0@96YO=6=H(&]F(&%N(&5X86UP;&4@=&\*
+M8V]N=FEN8V4@86YY;VYE+B @5VAE;B!)(&=O="!O=70@;V8@<V-H;V]L+"!)
+M('1H;W5G:'0@22!W87,@=&AE(&)E<W0*<')O9W)A;6UE<B!I;B!T:&4@=V]R
+M;&0N($D@8V]U;&0@=W)I=&4@86X@=6YB96%T86)L92!T:6,M=&%C+71O90IP
+M<F]G<F%M+"!U<V4@9FEV92!D:69F97)E;G0@8V]M<'5T97(@;&%N9W5A9V5S
+M+"!A;F0@8W)E871E(#$P,# @;&EN90IP<F]G<F%M<R!T:&%T(%=/4DM%1"X@
+M("A296%L;'DA*2!4:&5N($D@9V]T(&]U="!I;G1O('1H92!296%L"E=O<FQD
+M+B!->2!F:7)S="!T87-K(&EN('1H92!296%L(%=O<FQD('=A<R!T;R!R96%D
+M(&%N9"!U;F1E<G-T86YD(&$*,C P+# P,"!L:6YE($9/4E1204X@<')O9W)A
+M;2P@=&AE;B!S<&5E9"!I="!U<"!B>2!A(&9A8W1O<B!O9B!T=V\N($%N>0I2
+M96%L(%!R;V=R86UM97(@=VEL;"!T96QL('EO=2!T:&%T(&%L;"!T:&4@4W1R
+M=6-T=7)E9"!#;V1I;F<@:6X@=&AE"G=O<FQD('=O;B=T(&AE;' @>6]U('-O
+M;'9E(&$@<')O8FQE;2!L:6ME('1H870@+2T@:70@=&%K97,@86-T=6%L"G1A
+M;&5N="X@4V]M92!Q=6EC:R!O8G-E<G9A=&EO;G,@;VX@4F5A;"!0<F]G<F%M
+M;65R<R!A;F0@4W1R=6-T=7)E9 I0<F]G<F%M;6EN9SH@/% ^"@H\54P^"CQ,
+M23X@4F5A;"!0<F]G<F%M;65R<R!A<F5N)W0@869R86ED('1O('5S92!'3U1/
+M<RX*"CQ,23X@4F5A;"!0<F]G<F%M;65R<R!C86X@=W)I=&4@9FEV92!P86=E
+M(&QO;F<@1$\@;&]O<',@=VET:&]U= IG971T:6YG(&-O;F9U<V5D+@H*/$Q)
+M/B!296%L(%!R;V=R86UM97)S(&5N:F]Y($%R:71H;65T:6,@248@<W1A=&5M
+M96YT<R!B96-A=7-E('1H97D@;6%K90IT:&4@8V]D92!M;W)E(&EN=&5R97-T
+M:6YG+@H*/$Q)/B!296%L(%!R;V=R86UM97)S('=R:71E('-E;&8M;6]D:69Y
+M:6YG(&-O9&4L(&5S<&5C:6%L;'D@:68@:70*<V%V97,@=&AE;2 R,"!N86YO
+M<V5C;VYD<R!I;B!T:&4@;6ED9&QE(&]F(&$@=&EG:'0@;&]O<"X*"CQ,23X@
+M(%!R;V=R86UM97)S(&1O;B=T(&YE960@8V]M;65N=',Z('1H92!C;V1E(&ES
+M(&]B=FEO=7,N"@H\3$D^(%-I;F-E($9/4E1204X@9&]E<VXG="!H879E(&$@
+M<W1R=6-T=7)E9" \2T)$/DE&+"!215!%050*+BXN(%5.5$E,/"]+0D0^+"!O
+M<B \2T)$/D-!4T4\+TM"1#X@<W1A=&5M96YT+"!296%L(%!R;V=R86UM97)S
+M(&1O;B=T"FAA=F4@=&\@=V]R<GD@86)O=70@;F]T('5S:6YG('1H96TN($)E
+M<VED97,L('1H97D@8V%N(&)E('-I;75L871E9 IW:&5N(&YE8V5S<V%R>2!U
+M<VEN9R!A<W-I9VYE9" \2T)$/D=/5$\\+TM"1#YS+@H*/"]53#X@/% ^"@I$
+M871A('-T<G5C='5R97,@:&%V92!A;'-O(&=O='1E;B!A(&QO="!O9B!P<F5S
+M<R!L871E;'DN($%B<W1R86-T($1A=&$*5'EP97,L(%-T<G5C='5R97,L(%!O
+M:6YT97)S+"!,:7-T<RP@86YD(%-T<FEN9W,@:&%V92!B96-O;64@<&]P=6QA
+M<B!I;@IC97)T86EN(&-I<F-L97,N(%=I<G1H("AT:&4@86)O=F4M;65N=&EO
+M;F5D(%%U:6-H92!%871E<BD@86-T=6%L;'D*=W)O=&4@86X@96YT:7)E(&)O
+M;VL@6S)=(&-O;G1E;F1I;F<@=&AA="!Y;W4@8V]U;&0@=W)I=&4@82!P<F]G
+M<F%M"F)A<V5D(&]N(&1A=&$@<W1R=6-T=7)E<RP@:6YS=&5A9"!O9B!T:&4@
+M;W1H97(@=V%Y(&%R;W5N9"X@07,@86QL(%)E86P*4')O9W)A;6UE<G,@:VYO
+M=RP@=&AE(&]N;'D@=7-E9G5L(&1A=&$@<W1R=6-T=7)E(&ES('1H90IA<G)A
+M>2X@4W1R:6YG<RP@;&ES=',L('-T<G5C='5R97,L('-E=',@+2T@=&AE<V4@
+M87)E(&%L;"!S<&5C:6%L(&-A<V5S"F]F(&%R<F%Y<R!A;F0@86YD(&-A;B!B
+M92!T<F5A=&5D('1H870@=V%Y(&IU<W0@87,@96%S:6QY('=I=&AO=70*;65S
+M<VEN9R!U<"!Y;W5R('!R;V=R86UI;F<@;&%N9W5A9V4@=VET:"!A;&P@<V]R
+M=',@;V8*8V]M<&QI8V%T:6]N<RX@5&AE('=O<G-T('1H:6YG(&%B;W5T(&9A
+M;F-Y(&1A=&$@='EP97,@:7,@=&AA="!Y;W4@:&%V90IT;R!D96-L87)E('1H
+M96TL(&%N9"!296%L(%!R;V=R86UM:6YG($QA;F=U86=E<RP@87,@=V4@86QL
+M(&MN;W<L(&AA=F4*:6UP;&EC:70@='EP:6YG(&)A<V5D(&]N('1H92!F:7)S
+M="!L971T97(@;V8@=&AE("AS:7@@8VAA<F%C=&5R*0IV87)I86)L92!N86UE
+M+B \4#X*"@H\2#,^("!/4$52051)3D<@4UE35$5-4SPO2#,^"@I7:&%T(&MI
+M;F0@;V8@;W!E<F%T:6YG('-Y<W1E;2!I<R!U<V5D(&)Y(&$@4F5A;"!0<F]G
+M<F%M;65R/R @0U O33\@1V]D"F9O<F)I9" M+2!#4"]-+"!A9G1E<B!A;&PL
+M(&ES(&)A<VEC86QL>2!A('1O>2!O<&5R871I;F<@<WES=&5M+B @179E;@IL
+M:71T;&4@;VQD(&QA9&EE<R!A;F0@9W)A9&4@<V-H;V]L('-T=61E;G1S(&-A
+M;B!U;F1E<G-T86YD(&%N9"!U<V4*0U O32X@/% ^"@I5;FEX(&ES(&$@;&]T
+M(&UO<F4@8V]M<&QI8V%T960@;V8@8V]U<G-E("TM('1H92!T>7!I8V%L(%5N
+M:7@@:&%C:V5R"FYE=F5R(&-A;B!R96UE;6)E<B!W:&%T('1H92 \2T)$/E!2
+M24Y4/"]+0D0^(&-O;6UA;F0@:7,@8V%L;&5D('1H:7,*=V5E:R M+2!B=70@
+M=VAE;B!I="!G971S(')I9VAT(&1O=VX@=&\@:70L(%5N:7@@:7,@82!G;&]R
+M:69I960@=FED96\*9V%M92X@4&5O<&QE(&1O;B=T(&1O(%-E<FEO=7,@5V]R
+M:R!O;B!5;FEX('-Y<W1E;7,Z('1H97D@<V5N9"!J;VME<PIA<F]U;F0@=&AE
+M('=O<FQD(&]N(%5314Y%5"!A;F0@=W)I=&4@861V96YT=7)E(&=A;65S(&%N
+M9"!R97-E87)C: IP87!E<G,N(#Q0/@H*3F\L('EO=7(@4F5A;"!0<F]G<F%M
+M;65R('5S97,@3U,O,S<P+B!!(&=O;V0@<')O9W)A;6UE<B!C86X@9FEN9"!A
+M;F0*=6YD97)S=&%N9"!T:&4@9&5S8W)I<'1I;VX@;V8@=&AE($E*2S,P-4D@
+M97)R;W(@:&4@:G5S="!G;W0@:6X@:&ES($I#3 IM86YU86PN("!!(&=R96%T
+M('!R;V=R86UM97(@8V%N('=R:71E($I#3"!W:71H;W5T(')E9F5R<FEN9R!T
+M;R!T:&4*;6%N=6%L(&%T(&%L;"X@02!T<G5L>2!O=71S=&%N9&EN9R!P<F]G
+M<F%M;65R(&-A;B!F:6YD(&)U9W,@8G5R:65D(&EN"F$@-B!M96=A8GET92!C
+M;W)E(&1U;7 @=VET:&]U="!U<VEN9R!A(&AE>"!C86QC=6QA=&]R+B H22!H
+M879E"F%C='5A;&QY('-E96X@=&AI<R!D;VYE+BD@/% ^"@I/4R\S-S @:7,@
+M82!T<G5L>2!R96UA<FMA8FQE(&]P97)A=&EN9R!S>7-T96TN($ET)W,@<&]S
+M<VEB;&4@=&\@9&5S+0IT<F]Y(&1A>7,@;V8@=V]R:R!W:71H(&$@<VEN9VQE
+M(&UI<W!L86-E9"!S<&%C92P@<V\@86QE<G1N97-S(&EN('1H90IP<F]G<F%M
+M;6EN9R!S=&%F9B!I<R!E;F-O=7)A9V5D+B!4:&4@8F5S="!W87D@=&\@87!P
+M<F]A8V@@=&AE('-Y<W1E;0II<R!T:')O=6=H(&$@:V5Y<'5N8V@N("!3;VUE
+M('!E;W!L92!C;&%I;2!T:&5R92!I<R!A(%1I;64@4VAA<FEN9PIS>7-T96T@
+M=&AA="!R=6YS(&]N($]3+S,W,"P@8G5T(&%F=&5R(&-A<F5F=6P@<W1U9'D@
+M22!H879E(&-O;64@=&\@=&AE"F-O;F-L=7-I;VX@=&AA="!T:&5Y(&%R92!M
+M:7-T86ME;BX@/% ^"@H*/$@S/B @4%)/1U)!34U)3D<@5$]/3%,\+T@S/@H*
+M5VAA="!K:6YD(&]F('1O;VQS(&1O97,@82!296%L(%!R;V=R86UM97(@=7-E
+M/R!);B!T:&5O<GDL(&$@4F5A; I0<F]G<F%M;65R(&-O=6QD(')U;B!H:7,@
+M<')O9W)A;7,@8GD@:V5Y:6YG('1H96T@:6YT;R!T:&4@9G)O;G0@<&%N96P*
+M;V8@=&AE(&-O;7!U=&5R+B!"86-K(&EN('1H92!D87ES('=H96X@8V]M<'5T
+M97)S(&AA9"!F<F]N="!P86YE;',L"G1H:7,@=V%S(&%C='5A;&QY(&1O;F4@
+M;V-C87-I;VYA;&QY+B @66]U<B!T>7!I8V%L(%)E86P@4')O9W)A;6UE<@IK
+M;F5W('1H92!E;G1I<F4@8F]O='-T<F%P(&QO861E<B!B>2!M96UO<GD@:6X@
+M:&5X+"!A;F0@=&]G9VQE9"!I="!I;@IW:&5N979E<B!I="!G;W0@9&5S=')O
+M>65D(&)Y(&AI<R!P<F]G<F%M+B H0F%C:R!T:&5N+"!M96UO<GD@=V%S"FUE
+M;6]R>2 M+2!I="!D:61N)W0@9V\@87=A>2!W:&5N('1H92!P;W=E<B!W96YT
+M(&]F9BX@5&]D87DL(&UE;6]R>0IE:71H97(@9F]R9V5T<R!T:&EN9W,@=VAE
+M;B!Y;W4@9&]N)W0@=V%N="!I="!T;RP@;W(@<F5M96UB97)S('1H:6YG<PIL
+M;VYG(&%F=&5R('1H97DG<F4@8F5T=&5R(&9O<F=O='1E;BXI("!,96=E;F0@
+M:&%S(&ET('1H870@4V5Y;6]U<@I#<F%Y+"!I;G9E;G1O<B!O9B!T:&4@0W)A
+M>2!)('-U<&5R8V]M<'5T97(@86YD(&UO<W0@;V8@0V]N=')O;"!$871A)W,*
+M8V]M<'5T97)S+"!A8W1U86QL>2!T;V=G;&5D('1H92!F:7)S="!O<&5R871I
+M;F<@<WES=&5M(&9O<B!T:&4@0T1#-S8P, II;B!O;B!T:&4@9G)O;G0@<&%N
+M96P@9G)O;2!M96UO<GD@=VAE;B!I="!W87,@9FER<W0@<&]W97)E9 IO;BX@
+M4V5Y;6]U<BP@;F5E9&QE<W,@=&\@<V%Y+"!I<R!A(%)E86P@4')O9W)A;6UE
+M<BX@/% ^"@I/;F4@;V8@;7D@9F%V;W)I=&4@4F5A;"!0<F]G<F%M;65R<R!W
+M87,@82!S>7-T96US('!R;V=R86UM97(@9F]R(%1E>&%S"DEN<W1R=6UE;G1S
+M+B @3VYE(&1A>2P@:&4@9V]T(&$@;&]N9R!D:7-T86YC92!C86QL(&9R;VT@
+M82!U<V5R('=H;W-E"G-Y<W1E;2!H860@8W)A<VAE9"!I;B!T:&4@;6ED9&QE
+M(&]F('-O;64@:6UP;W)T86YT('=O<FLN($II;2!W87,@86)L90IT;R!R97!A
+M:7(@=&AE(&1A;6%G92!O=F5R('1H92!P:&]N92P@9V5T=&EN9R!T:&4@=7-E
+M<B!T;R!T;V=G;&4@:6X*9&ES:R!)+T\@:6YS=')U8W1I;VYS(&%T('1H92!F
+M<F]N="!P86YE;"P@<F5P86ER:6YG('-Y<W1E;2!T86)L97,@:6X*:&5X+"!R
+M96%D:6YG(')E9VES=&5R(&-O;G1E;G1S(&)A8VL@;W9E<B!T:&4@<&AO;F4N
+M(%1H92!M;W)A;"!O9B!T:&ES"G-T;W)Y.B!W:&EL92!A(%)E86P@4')O9W)A
+M;6UE<B!U<W5A;&QY(&EN8VQU9&5S(&$@:V5Y<'5N8V@@86YD"FQI;F5P<FEN
+M=&5R(&EN(&AI<R!T;V]L:VET+"!H92!C86X@9V5T(&%L;VYG('=I=&@@:G5S
+M="!A(&9R;VYT('!A;F5L"F%N9"!A('1E;&5P:&]N92!I;B!E;65R9V5N8VEE
+M<RX@/% ^"@I);B!S;VUE(&-O;7!A;FEE<RP@=&5X="!E9&ET:6YG(&YO(&QO
+M;F=E<B!C;VYS:7-T<R!O9B!T96X@96YG:6YE97)S"G-T86YD:6YG(&EN(&QI
+M;F4@=&\@=7-E(&%N(# R.2!K97EP=6YC:"X@26X@9F%C="P@=&AE(&)U:6QD
+M:6YG($D@=V]R:PII;B!D;V5S;B=T(&-O;G1A:6X@82!S:6YG;&4@:V5Y<'5N
+M8V@N(%1H92!296%L(%!R;V=R86UM97(@:6X@=&AI<PIS:71U871I;VX@:&%S
+M('1O(&1O(&AI<R!W;W)K('=I=&@@82!T97AT(&5D:71O<B!P<F]G<F%M+B!-
+M;W-T('-Y<W1E;7,*<W5P<&QY('-E=F5R86P@=&5X="!E9&ET;W)S('1O('-E
+M;&5C="!F<F]M+"!A;F0@=&AE(%)E86P@4')O9W)A;6UE<@IM=7-T(&)E(&-A
+M<F5F=6P@=&\@<&EC:R!O;F4@=&AA="!R969L96-T<R!H:7,@<&5R<V]N86P@
+M<W1Y;&4N($UA;GD*<&5O<&QE(&)E;&EE=F4@=&AA="!T:&4@8F5S="!T97AT
+M(&5D:71O<G,@:6X@=&AE('=O<FQD('=E<F4@=W)I='1E;B!A= I897)O>"!0
+M86QO($%L=&\@4F5S96%R8V@@0V5N=&5R(&9O<B!U<V4@;VX@=&AE:7(@06QT
+M;R!A;F0@1&]R861O"F-O;7!U=&5R<R!;,UTN(%5N9F]R='5N871E;'DL(&YO
+M(%)E86P@4')O9W)A;6UE<B!W;W5L9"!E=F5R('5S92!A"F-O;7!U=&5R('=H
+M;W-E(&]P97)A=&EN9R!S>7-T96T@:7,@8V%L;&5D(%-M86QL5&%L:RP@86YD
+M('=O=6QD"F-E<G1A:6YL>2!N;W0@=&%L:R!T;R!T:&4@8V]M<'5T97(@=VET
+M:"!A(&UO=7-E+B \4#X*"E-O;64@;V8@=&AE(&-O;F-E<'1S(&EN('1H97-E
+M(%AE<F]X(&5D:71O<G,@:&%V92!B965N(&EN8V]R<&]R871E9 II;G1O(&5D
+M:71O<G,@<G5N;FEN9R!O;B!M;W)E(')E87-O;F%B;'D@;F%M960@;W!E<F%T
+M:6YG('-Y<W1E;7,N($5-04-3"F%N9"!622!A<F4@<')O8F%B;'D@=&AE(&UO
+M<W0@=V5L;"!K;F]W;B!O9B!T:&ES(&-L87-S(&]F(&5D:71O<G,N("!4:&4*
+M<')O8FQE;2!W:71H('1H97-E(&5D:71O<G,@:7,@=&AA="!296%L(%!R;V=R
+M86UM97)S(&-O;G-I9&5R(")W:&%T('EO=0IS964@:7,@=VAA="!Y;W4@9V5T
+M(B!T;R!B92!J=7-T(&%S(&)A9"!A(&-O;F-E<'0@:6X@=&5X="!E9&ET;W)S
+M(&%S(&ET"FES(&EN('=O;65N+B!.;RP@=&AE(%)E86P@4')O9W)A;6UE<B!W
+M86YT<R!A(")Y;W4@87-K960@9F]R(&ET+"!Y;W4*9V]T(&ET(B!T97AT(&5D
+M:71O<B M+2!C;VUP;&EC871E9"P@8W)Y<'1I8RP@<&]W97)F=6PL('5N9F]R
+M9VEV:6YG+ ID86YG97)O=7,N(%1%0T\L('1O(&)E('!R96-I<V4N(#Q0/@H*
+M270@:&%S(&)E96X@;V)S97)V960@=&AA="!A(%1%0T\@8V]M;6%N9"!S97%U
+M96YC92!M;W)E(&-L;W-E;'D@<F5S96TM"F)L97,@=')A;G-M:7-S:6]N(&QI
+M;F4@;F]I<V4@=&AA;B!R96%D86)L92!T97AT(%LT72X@3VYE(&]F('1H92!M
+M;W)E"F5N=&5R=&%I;FEN9R!G86UE<R!T;R!P;&%Y('=I=&@@5$5#3R!I<R!T
+M;R!T>7!E('EO=7(@;F%M92!I;B!A<R!A"F-O;6UA;F0@;&EN92!A;F0@=')Y
+M('1O(&=U97-S('=H870@:70@9&]E<RX@2G5S="!A8F]U="!A;GD@<&]S<VEB
+M;&4*='EP:6YG(&5R<F]R('=H:6QE('1A;&MI;F<@=VET:"!414-/('=I;&P@
+M<')O8F%B;'D@9&5S=')O>2!Y;W5R"G!R;V=R86TL(&]R(&5V96X@=V]R<V4@
+M+2T@:6YT<F]D=6-E('-U8G1L92!A;F0@;7ES=&5R:6]U<R!B=6=S(&EN(&$*
+M;VYC92!W;W)K:6YG('-U8G)O=71I;F4N(#Q0/@H*1F]R('1H:7,@<F5A<V]N
+M+"!296%L(%!R;V=R86UM97)S(&%R92!R96QU8W1A;G0@=&\@86-T=6%L;'D@
+M961I="!A"G!R;V=R86T@=&AA="!I<R!C;&]S92!T;R!W;W)K:6YG+B!4:&5Y
+M(&9I;F0@:70@;75C:"!E87-I97(@=&\@:G5S= IP871C:"!T:&4@8FEN87)Y
+M(&]B:F5C="!C;V1E(&1I<F5C=&QY+"!U<VEN9R!A('=O;F1E<F9U;"!P<F]G
+M<F%M"F-A;&QE9"!355!%4EI!4" H;W(@:71S(&5Q=6EV86QE;G0@;VX@;F]N
+M+4E"32!M86-H:6YE<RDN(%1H:7,@=V]R:W,@<V\*=V5L;"!T:&%T(&UA;GD@
+M=V]R:VEN9R!P<F]G<F%M<R!O;B!)0DT@<WES=&5M<R!B96%R(&YO(')E;&%T
+M:6]N('1O"G1H92!O<FEG:6YA;"!&3U)44D%.(&-O9&4N("!);B!M86YY(&-A
+M<V5S+"!T:&4@;W)I9VEN86P@<V]U<F-E(&-O9&4@:7,*;F\@;&]N9V5R(&%V
+M86EL86)L92X@5VAE;B!I="!C;VUE<R!T:6UE('1O(&9I>"!A('!R;V=R86T@
+M;&EK92!T:&ES+"!N;PIM86YA9V5R('=O=6QD(&5V96X@=&AI;FL@;V8@<V5N
+M9&EN9R!A;GET:&EN9R!L97-S('1H86X@82!296%L"E!R;V=R86UM97(@=&\@
+M9&\@=&AE(&IO8B M+2!N;R!1=6EC:&4@16%T:6YG('-T<G5C='5R960@<')O
+M9W)A;6UE<@IW;W5L9"!E=F5N(&MN;W<@=VAE<F4@=&\@<W1A<G0N(%1H:7,@
+M:7,@8V%L;&5D(")J;V(@<V5C=7)I='DB+B \4#X*"E-O;64@<')O9W)A;6UI
+M;F<@=&]O;',@3D]4('5S960@8GD@4F5A;"!0<F]G<F%M;65R<SH@/% ^"CQ5
+M3#X*"CQ,23X@1D]25%)!3B!P<F5P<F]C97-S;W)S(&QI:V4@34]25%)!3B!A
+M;F0@4D%41D]2+B!4:&4@0W5I<VEN87)T<R!O9@IP<F]G<F%M;6EN9R M+2!G
+M<F5A="!F;W(@;6%K:6YG(%%U:6-H92X@4V5E(&-O;6UE;G1S(&%B;W9E(&]N
+M"G-T<G5C='5R960@<')O9W)A;6UI;F<N"@H\3$D^("!3;W5R8V4@;&%N9W5A
+M9V4@9&5B=6=G97)S+B!296%L(%!R;V=R86UM97)S(&-A;B!R96%D(&-O<F4@
+M9'5M<',N"@H\3$D^($-O;7!I;&5R<R!W:71H(&%R<F%Y(&)O=6YD<R!C:&5C
+M:VEN9RX@5&AE>2!S=&EF;&4@8W)E871I=FET>2P*9&5S=')O>2!M;W-T(&]F
+M('1H92!I;G1E<F5S=&EN9R!U<V5S(&9O<B!%455)5D%,14Y#12P@86YD(&UA
+M:V4@:70*:6UP;W-S:6)L92!T;R!M;V1I9GD@=&AE(&]P97)A=&EN9R!S>7-T
+M96T@8V]D92!W:71H(&YE9V%T:79E"G-U8G-C<FEP=',N(%=O<G-T(&]F(&%L
+M;"P@8F]U;F1S(&-H96-K:6YG(&ES(&EN969F:6-I96YT+@H*/$Q)/B!3;W5R
+M8V4@8V]D92!M86EN=&%I;F%N8V4@<WES=&5M<RX@02!296%L(%!R;V=R86UM
+M97(@:V5E<',@:&ES"F-O9&4@;&]C:V5D('5P(&EN(&$@8V%R9"!F:6QE+"!B
+M96-A=7-E(&ET(&EM<&QI97,@=&AA="!I=',@;W=N97(*8V%N;F]T(&QE879E
+M(&AI<R!I;7!O<G1A;G0@<')O9W)A;7,@=6YG=6%R9&5D(%LU72X*"CPO54P^
+M(#Q0/@H*"CQ(,SX@(%1(12!214%,(%!23T=204U-15(@050@5T]22SPO2#,^
+M"@I7:&5R92!D;V5S('1H92!T>7!I8V%L(%)E86P@4')O9W)A;6UE<B!W;W)K
+M/R!7:&%T(&MI;F0@;V8@<')O9W)A;7,@87)E"G=O<G1H>2!O9B!T:&4@969F
+M;W)T<R!O9B!S;R!T86QE;G1E9"!A;B!I;F1I=FED=6%L/R!9;W4@8V%N(&)E
+M('-U<F4*=&AA="!N;R!R96%L(%!R;V=R86UM97(@=V]U;&0@8F4@8V%U9VAT
+M(&1E860@=W)I=&EN9PIA8V-O=6YT<RUR96-E:79A8FQE('!R;V=R86US(&EN
+M($-/0D],+"!O<B!S;W)T:6YG(&UA:6QI;F<@;&ES=',@9F]R"E!E;W!L92!M
+M86=A>FEN92X@02!296%L(%!R;V=R86UM97(@=V%N=',@=&%S:W,@;V8@96%R
+M=&@M<VAA:VEN9PII;7!O<G1A;F-E("AL:71E<F%L;'DA*3H@/% ^"@H\54P^
+M"@H\3$D^(%)E86P@4')O9W)A;6UE<G,@=V]R:R!F;W(@3&]S($%L86UO<R!.
+M871I;VYA;"!,86)O<F%T;W)Y+"!W<FET:6YG"F%T;VUI8R!B;VUB('-I;75L
+M871I;VYS('1O(')U;B!O;B!#<F%Y($D@<W5P97)C;VUP=71E<G,N"@H\3$D^
+M(%)E86P@4')O9W)A;6UE<G,@=V]R:R!F;W(@=&AE($YA=&EO;F%L(%-E8W5R
+M:71Y($%G96YC>2P@9&5C;V1I;F<*4G5S<VEA;B!T<F%N<VUI<W-I;VYS+@H*
+M/$Q)/B!)="!W87,@;&%R9V5L>2!D=64@=&\@=&AE(&5F9F]R=',@;V8@=&AO
+M=7-A;F1S(&]F(%)E86P*4')O9W)A;6UE<G,@=V]R:VEN9R!F;W(@3D%302!T
+M:&%T(&]U<B!B;WES(&=O="!T;R!T:&4@;6]O;B!A;F0@8F%C:PIB969O<F4@
+M=&AE(&-O<VUO;F%U=',N"@H\3$D^(%1H92!C;VUP=71E<G,@:6X@=&AE(%-P
+M86-E(%-H=71T;&4@=V5R92!P<F]G<F%M;65D(&)Y(%)E86P*4')O9W)A;6UE
+M<G,N"B @(" */$Q)/B!0<F]G<F%M;65R<R!A<F4@870@=V]R:R!F;W(@0F]E
+M:6YG(&1E<VEG;FEN9R!T:&4@;W!E<F%T:6YG"G-Y<W1E;7,@9F]R(&-R=6ES
+M92!M:7-S:6QE<RX*"CPO54P^(#Q0/@H*4V]M92!O9B!T:&4@;6]S="!A=V5S
+M;VUE(%)E86P@4')O9W)A;6UE<G,@;V8@86QL('=O<FL@870@=&AE($IE="!0
+M<F\M"G!U;'-I;VX@3&%B;W)A=&]R>2!I;B!#86QI9F]R;FEA+B!-86YY(&]F
+M('1H96T@:VYO=R!T:&4@96YT:7)E"F]P97)A=&EN9R!S>7-T96T@;V8@=&AE
+M(%!I;VYE97(@86YD(%9O>6%G97(@<W!A8V5C<F%F="!B>2!H96%R="X@5VET
+M: IA(&-O;6)I;F%T:6]N(&]F(&QA<F=E(&=R;W5N9"UB87-E9"!&3U)44D%.
+M('!R;V=R86US(&%N9"!S;6%L; IS<&%C96-R869T+6)A<V5D(&%S<V5M8FQY
+M(&QA;F=U86=E('!R;V=R86US+"!T:&5Y(&-A;B!T;R!D;R!I;F-R961I8FQE
+M"F9E871S(&]F(&YA=FEG871I;VX@86YD(&EM<')O=FES871I;VXL('-U8V@@
+M87,@:&ET=&EN9R!T96XM:VEL;VUE=&5R"G=I9&4@=VEN9&]W<R!A="!3871U
+M<FX@869T97(@<VEX('EE87)S(&EN('-P86-E+"!A;F0@<F5P86ER:6YG(&]R
+M"F)Y<&%S<VEN9R!D86UA9V5D('-E;G-O<B!P;&%T9F]R;7,L(')A9&EO<RP@
+M86YD(&)A='1E<FEE<RX@($%L;&5G961L>2P*;VYE(%)E86P@4')O9W)A;6UE
+M<B!M86YA9V5D('1O('1U8VL@82!P871T97)N+6UA=&-H:6YG('!R;V=R86T@
+M:6YT;R!A"F9E=R!H=6YD<F5D(&)Y=&5S(&]F('5N=7-E9"!M96UO<GD@:6X@
+M82!6;WEA9V5R('-P86-E8W)A9G0@=&AA= IS96%R8VAE9"!F;W(L(&QO8V%T
+M960L(&%N9"!P:&]T;V=R87!H960@82!N97<@;6]O;B!O9B!*=7!I=&5R+B \
+M4#X*"D]N92!P;&%N(&9O<B!T:&4@=7!C;VUI;F<@1V%L:6QE;R!S<&%C96-R
+M869T(&UI<W-I;VX@:7,@=&\@=7-E(&$@9W)A=BT*:71Y(&%S<VES="!T<F%J
+M96-T;W)Y('!A<W0@36%R<R!O;B!T:&4@=V%Y('1O($IU<&ET97(N(%1H:7,@
+M=')A:F5C=&]R>0IP87-S97,@=VET:&EN(#@P("LO+2 S(&MI;&]M971E<G,@
+M;V8@=&AE('-U<F9A8V4@;V8@36%R<RX@3F]B;V1Y(&ES"F=O:6YG('1O('1R
+M=7-T(&$@4$%30T%,('!R;V=R86T@*&]R(%!!4T-!3"!P<F]G<F%M;65R*2!F
+M;W(@;F%V:6=A=&EO;@IT;R!T:&5S92!T;VQE<F%N8V5S+B \4#X@"@I!<R!Y
+M;W4@8V%N('1E;&PL(&UA;GD@;V8@=&AE('=O<FQD)W,@4F5A;"!0<F]G<F%M
+M;65R<R!W;W)K(&9O<B!T:&4*52Y3+B @1V]V97)N;65N="P@;6%I;FQY('1H
+M92!$969E;G-E($1E<&%R=&UE;G0N(%1H:7,@:7,@87,@:70@<VAO=6QD"F)E
+M+B @4F5C96YT;'DL(&AO=V5V97(L(&$@8FQA8VL@8VQO=60@:&%S(&9O<FUE
+M9"!O;B!T:&4@4F5A; I0<F]G<F%M;65R(&AO<FEZ;VXN(#Q0/@H*270@<V5E
+M;7,@=&AA="!S;VUE(&AI9VAL>2!P;&%C960@475I8VAE($5A=&5R<R!A="!T
+M:&4@1&5F96YS90I$97!A<G1M96YT(&1E8VED960@=&AA="!A;&P@1&5F96YS
+M92!P<F]G<F%M<R!S:&]U;&0@8F4@=W)I='1E;B!I;B!S;VUE"F=R86YD('5N
+M:69I960@;&%N9W5A9V4@8V%L;&5D(")!1$$B("AR96=I<W1E<F5D('1R861E
+M;6%R:RP@1&]$*2X@($9O<@IA('=H:6QE+"!I="!S965M960@=&AA="!!1$$@
+M=V%S(&1E<W1I;F5D('1O(&)E8V]M92!A(&QA;F=U86=E('1H870*=V5N="!A
+M9V%I;G-T(&%L;"!T:&4@<')E8V5P=',@;V8@4F5A;"!0<F]G<F%M;6EN9R M
+M+2!A(&QA;F=U86=E('=I=&@*<W1R=6-T=7)E+"!A(&QA;F=U86=E('=I=&@@
+M9&%T82!T>7!E<RP@<W1R;VYG('1Y<&EN9RP@86YD"G-E;6EC;VQO;G,N($EN
+M('-H;W)T+"!A(&QA;F=U86=E(&1E<VEG;F5D('1O(&-R:7!P;&4@=&AE(&-R
+M96%T:79I='D@;V8*=&AE('1Y<&EC86P@4F5A;"!0<F]G<F%M;65R+B @1F]R
+M='5N871E;'DL('1H92!L86YG=6%G92!A9&]P=&5D(&)Y($1O1 IH87,@96YO
+M=6=H(&EN=&5R97-T:6YG(&9E871U<F5S('1O(&UA:V4@:70@87!P<F]A8VAA
+M8FQE.B!I="=S"FEN8W)E9&EB;'D@8V]M<&QE>"P@:6YC;'5D97,@;65T:&]D
+M<R!F;W(@;65S<VEN9R!W:71H('1H92!O<&5R871I;F<*<WES=&5M(&%N9"!R
+M96%R<F%N9VEN9R!M96UO<GDL(&%N9"!%9'-G87(@1&EJ:W-T<F$@9&]E<VXG
+M="!L:6ME(&ET"ELV72X@*$1I:FMS=')A+"!A<R!))VT@<W5R92!Y;W4@:VYO
+M=RP@=V%S('1H92!A=71H;W(@;V8@/$5-/B)';U1O<PI#;VYS:61E<F5D($AA
+M<FUF=6PB/"]%33X@+2T@82!L86YD;6%R:R!W;W)K(&EN('!R;V=R86UM:6YG
+M"FUE=&AO9&]L;V=Y+"!A<'!L875D960@8GD@4&%S8V%L(%!R;V=R86UM97)S
+M(&%N9"!1=6EC:&4@16%T97)S(&%L:6ME+BD*0F5S:61E<RP@=&AE(&1E=&5R
+M;6EN960@4F5A;"!0<F]G<F%M;65R(&-A;B!W<FET92!&3U)44D%.('!R;V=R
+M86US(&EN"F%N>2!L86YG=6%G92X@/% ^"@I4:&4@<F5A;"!P<F]G<F%M;65R
+M(&UI9VAT(&-O;7!R;VUI<V4@:&ES('!R:6YC:7!L97,@86YD('=O<FL@;VX@
+M<V]M92T*=&AI;F<@<VQI9VAT;'D@;6]R92!T<FEV:6%L('1H86X@=&AE(&1E
+M<W1R=6-T:6]N(&]F(&QI9F4@87,@=V4@:VYO=PII="P@<')O=FED:6YG('1H
+M97)E)W,@96YO=6=H(&UO;F5Y(&EN(&ET+B!4:&5R92!A<F4@<V5V97)A;"!2
+M96%L"E!R;V=R86UM97)S(&)U:6QD:6YG('9I9&5O(&=A;65S(&%T($%T87)I
+M+"!F;W(@97AA;7!L92X@*$)U="!N;W0*<&QA>6EN9R!T:&5M+B!!(%)E86P@
+M4')O9W)A;6UE<B!K;F]W<R!H;W<@=&\@8F5A="!T:&4@;6%C:&EN92!E=F5R
+M>0IT:6UE.B!N;R!C:&%L;&%N9V4@:6X@=&AA="XI("!%=F5R>6]N92!W;W)K
+M:6YG(&%T($QU8V%S1FEL;2!I<R!A(%)E86P*4')O9W)A;6UE<BX@*$ET('=O
+M=6QD(&)E(&-R87IY('1O('1U<FX@9&]W;B!T:&4@;6]N97D@;V8@-3 @;6EL
+M;&EO;@I3=&%R(%=A<G,@9F%N<RXI(%1H92!P<F]P;W)T:6]N(&]F(%)E86P@
+M4')O9W)A;6UE<G,@:6X@0V]M<'5T97(*1W)A<&AI8W,@:7,@<V]M97=H870@
+M;&]W97(@=&AA;B!T:&4@;F]R;2P@;6]S=&QY(&)E8V%U<V4@;F]B;V1Y(&AA
+M<PIF;W5N9"!A('5S92!F;W(@0V]M<'5T97(@1W)A<&AI8W,@>65T+B @3VX@
+M=&AE(&]T:&5R(&AA;F0L(&%L; I#;VUP=71E<B!'<F%P:&EC<R!I<R!D;VYE
+M(&EN($9/4E1204XL('-O('1H97)E(&%R92!A(&9A:7(@;G5M8F5R"G!E;W!L
+M92!D;VEN9R!'<F%P:&EC<R!I;B!O<F1E<B!T;R!A=F]I9"!H879I;F<@=&\@
+M=W)I=&4@0T]"3TP*<')O9W)A;7,N(#Q0/@H*"CQ(,SX@(%1(12!214%,(%!2
+M3T=204U-15(@050@4$Q!63PO2#,^"@I'96YE<F%L;'DL('1H92!296%L(%!R
+M;V=R86UM97(@<&QA>7,@=&AE('-A;64@=V%Y(&AE('=O<FMS("TM('=I=&@*
+M8V]M<'5T97)S+B @2&4@:7,@8V]N<W1A;G1L>2!A;6%Z960@=&AA="!H:7,@
+M96UP;&]Y97(@86-T=6%L;'D@<&%Y<PIH:6T@=&\@9&\@=VAA="!H92!W;W5L
+M9"!B92!D;VEN9R!F;W(@9G5N(&%N>7=A>2P@86QT:&]U9V@@:&4@:7,*8V%R
+M969U;"!N;W0@=&\@97AP<F5S<R!T:&ES(&]P:6YI;VX@;W5T(&QO=60N($]C
+M8V%S:6]N86QL>2P@=&AE(%)E86P*4')O9W)A;6UE<B!D;V5S('-T97 @;W5T
+M(&]F('1H92!O9F9I8V4@9F]R(&$@8G)E871H(&]F(&9R97-H(&%I<B!A;F0@
+M80IB965R(&]R('1W;RX@4V]M92!T:7!S(&]N(')E8V]G;FEZ:6YG(')E86P@
+M<')O9W)A;6UE<G,@87=A>2!F<F]M('1H90IC;VUP=71E<B!R;V]M.B \4#X*
+M/%5,/@H*/$Q)/B!!="!A('!A<G1Y+"!T:&4@4F5A;"!0<F]G<F%M;65R<R!A
+M<F4@=&AE(&]N97,@:6X@=&AE(&-O<FYE<@IT86QK:6YG(&%B;W5T(&]P97)A
+M=&EN9R!S>7-T96T@<V5C=7)I='D@86YD(&AO=R!T;R!G970@87)O=6YD(&ET
+M+@H*/$Q)/B!!="!A(&9O;W1B86QL(&=A;64L('1H92!296%L(%!R;V=R86UM
+M97(@:7,@=&AE(&]N92!C;VUP87)I;F<@=&AE"G!L87ES(&%G86EN<W0@:&ES
+M('-I;75L871I;VYS('!R:6YT960@;VX@,3$@8GD@,30@9F%N9F]L9"!P87!E
+M<BX*"CQ,23X@070@=&AE(&)E86-H+"!T:&4@4F5A;"!0<F]G<F%M;65R(&ES
+M('1H92!O;F4@9')A=VEN9R!F;&]W8VAA<G1S"FEN('1H92!S86YD+@H*/$Q)
+M/B!!(%)E86P@4')O9W)A;6UE<B!G;V5S('1O(&$@9&ES8V\@=&\@=V%T8V@@
+M=&AE(&QI9VAT('-H;W<N"@H\3$D^($%T(&$@9G5N97)A;"P@=&AE(%)E86P@
+M4')O9W)A;6UE<B!I<R!T:&4@;VYE('-A>6EN9R \14T^(E!O;W(*1V5O<F=E
+M+B @06YD(&AE(&%L;6]S="!H860@=&AE('-O<G0@<F]U=&EN92!W;W)K:6YG
+M(&)E9F]R92!T:&4*8V]R;VYA<GDN(CPO14T^"@H\3$D^($EN(&$@9W)O8V5R
+M>2!S=&]R92P@=&AE(%)E86P@4')O9W)A;6UE<B!I<R!T:&4@;VYE('=H;R!I
+M;G-I<W1S(&]N"G)U;FYI;F<@=&AE(&-A;G,@<&%S="!T:&4@;&%S97(@8VAE
+M8VMO=70@<V-A;FYE<B!H:6US96QF+"!B96-A=7-E(&AE"FYE=F5R(&-O=6QD
+M('1R=7-T(&ME>7!U;F-H(&]P97)A=&]R<R!T;R!G970@:70@<FEG:'0@=&AE
+M(&9I<G-T('1I;64N"@H\+U5,/B \4#X*"@H\2#,^("!42$4@4D5!3"!04D]'
+M4D%-3452)U,@3D%455)!3"!(04))5$%4/"](,SX*"E=H870@<V]R="!O9B!E
+M;G9I<F]N;65N="!D;V5S('1H92!296%L(%!R;V=R86UM97(@9G5N8W1I;VX@
+M8F5S="!I;C\*5&AI<R!I<R!A;B!I;7!O<G1A;G0@<75E<W1I;VX@9F]R('1H
+M92!M86YA9V5R<R!O9B!296%L"E!R;V=R86UM97)S+B!#;VYS:61E<FEN9R!T
+M:&4@86UO=6YT(&]F(&UO;F5Y(&ET(&-O<W1S('1O(&ME97 @;VYE(&]N"G1H
+M92!S=&%F9BP@:70G<R!B97-T('1O('!U="!H:6T@*&]R(&AE<BD@:6X@86X@
+M96YV:7)O;FUE;G0@=VAE<F4@:&4*8V%N(&=E="!H:7,@=V]R:R!D;VYE+B \
+M4#X*"E1H92!T>7!I8V%L(%)E86P@4')O9W)A;6UE<B!L:79E<R!I;B!F<F]N
+M="!O9B!A(&-O;7!U=&5R('1E<FUI;F%L+@I3=7)R;W5N9&EN9R!T:&ES('1E
+M<FUI;F%L(&%R93H@/% ^"CQ53#X*"CQ,23X@3&ES=&EN9W,@;V8@86QL('!R
+M;V=R86US('1H92!296%L(%!R;V=R86UM97(@:&%S(&5V97(@=V]R:V5D(&]N
+M+ IP:6QE9"!I;B!R;W5G:&QY(&-H<F]N;VQO9VEC86P@;W)D97(@;VX@979E
+M<GD@9FQA="!S=7)F86-E(&EN('1H92!O9F9I8V4N"@H\3$D^(%-O;64@:&%L
+M9BUD;WIE;B!O<B!S;R!P87)T;'D@9FEL;&5D(&-U<',@;V8@8V]L9 IC;V9F
+M964N($]C8V%S:6]N86QL>2P@=&AE<F4@=VEL;"!B92!C:6=A<F5T=&4@8G5T
+M=',@9FQO871I;F<@:6X@=&AE"F-O9F9E92X@26X@<V]M92!C87-E<RP@=&AE
+M(&-U<',@=VEL;"!C;VYT86EN($]R86YG92!#<G5S:"X*"CQ,23X@56YL97-S
+M(&AE(&ES('9E<GD@9V]O9"P@=&AE<F4@=VEL;"!B92!C;W!I97,@;V8@=&AE
+M($]3($I#3"!M86YU86P*86YD('1H92!0<FEN8VEP;&5S(&]F($]P97)A=&EO
+M;B!O<&5N('1O('-O;64@<&%R=&EC=6QA<FQY(&EN=&5R97-T:6YG"G!A9V5S
+M+@H*/$Q)/B!487!E9"!T;R!T:&4@=V%L;"!I<R!A(&QI;F4M<')I;G1E<B!3
+M;F]O<'D@8V%L96YD97(@9F]R('1H92!Y96%R"C$Y-CDN"@H\3$D^(%-T<F5W
+M;B!A8F]U="!T:&4@9FQO;W(@87)E('-E=F5R86P@=W)A<'!E<G,@9F]R('!E
+M86YU="!B=71T97(*9FEL;&5D(&-H965S92!B87)S("AT:&4@='EP92!T:&%T
+M(&%R92!M861E('-T86QE(&%T('1H92!B86ME<GD@<V\@=&AE>0IC86XG="!G
+M970@86YY('=O<G-E('=H:6QE('=A:71I;F<@:6X@=&AE('9E;F1I;F<@;6%C
+M:&EN92DN"@H\3$D^($AI9&EN9R!I;B!T:&4@=&]P(&QE9G0M:&%N9"!D<F%W
+M97(@;V8@=&AE(&1E<VL@:7,@82!S=&%S:"!O9@ID;W5B;&4@<W1U9F8@3W)E
+M;W,@9F]R('-P96-I86P@;V-C87-I;VYS+@H*/$Q)/B!5;F1E<FYE871H('1H
+M92!/<F5O<R!I<R!A(&9L;W<M8VAA<G1I;F<@=&5M<&QA=&4L(&QE9G0@=&AE
+M<F4@8GD*=&AE('!R979I;W5S(&]C8W5P86YT(&]F('1H92!O9F9I8V4N("A2
+M96%L(%!R;V=R86UM97)S('=R:71E('!R;V=R86US+ IN;W0@9&]C=6UE;G1A
+M=&EO;BX@3&5A=F4@=&AA="!T;R!T:&4@;6%I;G1A:6YE;F-E('!E;W!L92XI
+M"@H\+U5,/B \4#X*"E1H92!296%L(%!R;V=R86UM97(@:7,@8V%P86)L92!O
+M9B!W;W)K:6YG(#,P+" T,"P@979E;B U,"!H;W5R<R!A="!A"G-T<F5T8V@L
+M('5N9&5R(&EN=&5N<V4@<')E<W-U<F4N("!);B!F86-T+"!H92!P<F5F97)S
+M(&ET('1H870@=V%Y+B!"860*<F5S<&]N<V4@=&EM92!D;V5S;B=T(&)O=&AE
+M<B!T:&4@4F5A;"!0<F]G<F%M;65R("TM(&ET(&=I=F5S(&AI;2!A"F-H86YC
+M92!T;R!C871C:"!A(&QI='1L92!S;&5E<"!B971W965N(&-O;7!I;&5S+B!)
+M9B!T:&5R92!I<R!N;W0*96YO=6=H('-C:&5D=6QE('!R97-S=7)E(&]N('1H
+M92!296%L(%!R;V=R86UM97(L(&AE('1E;F1S('1O(&UA:V4*=&AI;F=S(&UO
+M<F4@8VAA;&QE;F=I;F<@8GD@=V]R:VEN9R!O;B!S;VUE('-M86QL(&)U="!I
+M;G1E<F5S=&EN9R!P87)T"F]F('1H92!P<F]B;&5M(&9O<B!T:&4@9FER<W0@
+M;FEN92!W965K<RP@=&AE;B!F:6YI<VAI;F<@=&AE(')E<W0@:6X*=&AE(&QA
+M<W0@=V5E:RP@:6X@='=O(&]R('1H<F5E(#4P+6AO=7(@;6%R871H;VYS+B!4
+M:&ES(&YO="!O;FQY"FEN<')E<W-E<R!H:7,@;6%N86=E<BP@=VAO('=A<R!D
+M97-P86ER:6YG(&]F(&5V97(@9V5T=&EN9R!T:&4@<')O:F5C= ID;VYE(&]N
+M('1I;64L(&)U="!C<F5A=&5S(&$@8V]N=F5N:65N="!E>&-U<V4@9F]R(&YO
+M="!D;VEN9R!T:&4*9&]C=6UE;G1A=&EO;BX@26X@9V5N97)A;#H@/% ^"@H\
+M54P^"@H\3$D^($YO(%)E86P@4')O9W)A;6UE<B!W;W)K<R Y('1O(#4N("A5
+M;FQE<W,@:70G<R Y(&EN('1H92!E=F5N:6YG('1O"C4@:6X@=&AE(&UO<FYI
+M;F<N*0H*/$Q)/B!296%L(%!R;V=R86UM97)S(&1O;B=T('=E87(@;F5C:W1I
+M97,N"@H\3$D^("!296%L(%!R;V=R86UM97)S(&1O;B=T('=E87(@:&EG:"!H
+M965L960@<VAO97,N"@H\3$D^("!296%L(%!R;V=R86UM97)S(&%R<FEV92!A
+M="!W;W)K(&EN('1I;64@9F]R(&QU;F-H+B!;.5T*"CQ,23X@02!296%L(%!R
+M;V=R86UM97(@;6EG:'0@;W(@;6EG:'0@;F]T(&MN;W<@:&ES('=I9F4G<R!N
+M86UE+B @2&4*9&]E<RP@:&]W979E<BP@:VYO=R!T:&4@96YT:7)E($%30TE)
+M("AO<B!%0D-$24,I(&-O9&4@=&%B;&4N"@H\3$D^(%)E86P@4')O9W)A;6UE
+M<G,@9&]N)W0@:VYO=R!H;W<@=&\@8V]O:RX@1W)O8V5R>2!S=&]R97,@87)E
+M;B=T"F]F=&5N(&]P96X@870@,R!A+FTN+"!S;R!T:&5Y('-U<G9I=F4@;VX@
+M5'=I;FMI97,@86YD(&-O9F9E92X*"CPO54P^(#Q0/@H*/$@S/B!42$4@1E54
+M55)%/"](,SX*"E=H870@;V8@=&AE(&9U='5R93\@270@:7,@82!M871T97(@
+M;V8@<V]M92!C;VYC97)N('1O(%)E86P@4')O9W)A;6UE<G,*=&AA="!T:&4@
+M;&%T97-T(&=E;F5R871I;VX@;V8@8V]M<'5T97(@<')O9W)A;6UE<G,@87)E
+M(&YO="!B96EN9PIB<F]U9VAT('5P('=I=&@@=&AE('-A;64@;W5T;&]O:R!O
+M;B!L:69E(&%S('1H96ER(&5L9&5R<RX@36%N>2!O9B!T:&5M"FAA=F4@;F5V
+M97(@<V5E;B!A(&-O;7!U=&5R('=I=&@@82!F<F]N="!P86YE;"X@2&%R9&QY
+M(&%N>6]N90IG<F%D=6%T:6YG(&9R;VT@<V-H;V]L('1H97-E(&1A>7,@8V%N
+M(&1O(&AE>"!A<FET:&UE=&EC('=I=&AO=70@80IC86QC=6QA=&]R+B @0V]L
+M;&5G92!G<F%D=6%T97,@=&AE<V4@9&%Y<R!A<F4@<V]F=" M+2!P<F]T96-T
+M960@9G)O;0IT:&4@<F5A;&ET:65S(&]F('!R;V=R86UM:6YG(&)Y('-O=7)C
+M92!L979E;"!D96)U9V=E<G,L('1E>'0@961I=&]R<PIT:&%T(&-O=6YT('!A
+M<F5N=&AE<V5S+"!A;F0@=7-E<B!F<FEE;F1L>2!O<&5R871I;F<@<WES=&5M
+M<RX@(%=O<G-T(&]F"F%L;"P@<V]M92!O9B!T:&5S92!A;&QE9V5D(&-O;7!U
+M=&5R('-C:65N=&ES=',@;6%N86=E('1O(&=E="!D96=R965S"G=I=&AO=70@
+M979E<B!L96%R;FEN9R!&3U)44D%.(2 @07)E('=E(&1E<W1I;F5D('1O(&)E
+M8V]M92!A;B!I;F1U<W1R>0IO9B!5;FEX(&AA8VME<G,@86YD(%!A<V-A;"!P
+M<F]G<F%M;65R<S\@/% ^"@I/;B!T:&4@8V]N=')A<GDN("!&<F]M(&UY(&5X
+M<&5R:65N8V4L($D@8V%N(&]N;'D@<F5P;W)T('1H870@=&AE"F9U='5R92!I
+M<R!B<FEG:'0@9F]R(%)E86P@4')O9W)A;6UE<G,@979E<GEW:&5R92X@3F5I
+M=&AE<B!/4R\S-S @;F]R"D9/4E1204X@<VAO=R!A;GD@<VEG;G,@;V8@9'EI
+M;F<@;W5T+"!D97-P:71E(&%L;"!T:&4@969F;W)T<R!O9@I087-C86P@<')O
+M9W)A;6UE<G,@=&AE('=O<FQD(&]V97(N($5V96X@;6]R92!S=6)T;&4@=')I
+M8VMS+"!L:6ME"F%D9&EN9R!S=')U8W1U<F5D(&-O9&EN9R!C;VYS=')U8W1S
+M('1O($9/4E1204X@:&%V92!F86EL960N("!/:"!S=7)E+ IS;VUE(&-O;7!U
+M=&5R('9E;F1O<G,@:&%V92!C;VUE(&]U="!W:71H($9/4E1204X@-S<@8V]M
+M<&EL97)S+"!B=70*979E<GD@;VYE(&]F('1H96T@:&%S(&$@=V%Y(&]F(&-O
+M;G9E<G1I;F<@:71S96QF(&)A8VL@:6YT;R!A($9/4E1204X*-C8@8V]M<&EL
+M97(@870@=&AE(&1R;W @;V8@86X@;W!T:6]N(&-A<F0@+2T@=&\@8V]M<&EL
+M92!$3R!L;V]P<R!L:6ME"D=O9"!M96%N="!T:&5M('1O(&)E+B \4#X*"D5V
+M96X@56YI>"!M:6=H="!N;W0@8F4@87,@8F%D(&]N(%)E86P@4')O9W)A;6UE
+M<G,@87,@:70@;VYC92!W87,N(%1H90IL871E<W0@<F5L96%S92!O9B!5;FEX
+M(&AA<R!T:&4@<&]T96YT:6%L(&]F(&%N(&]P97)A=&EN9R!S>7-T96T@=V]R
+M=&AY"F]F(&%N>2!296%L(%!R;V=R86UM97(N($ET(&AA<R!T=V\@9&EF9F5R
+M96YT(&%N9"!S=6)T;'D@:6YC;VUP871I8FQE"G5S97(@:6YT97)F86-E<RP@
+M86X@87)C86YE(&%N9"!C;VUP;&EC871E9"!T97)M:6YA;"!D<FEV97(L('9I
+M<G1U86P*;65M;W)Y+B!)9B!Y;W4@:6=N;W)E('1H92!F86-T('1H870@:70G
+M<R!S=')U8W1U<F5D+"!E=F5N($,*<')O9W)A;6UI;F<@8V%N(&)E(&%P<')E
+M8VEA=&5D(&)Y('1H92!296%L(%!R;V=R86UM97(Z(&%F=&5R(&%L;"P*=&AE
+M<F4G<R!N;R!T>7!E(&-H96-K:6YG+"!V87)I86)L92!N86UE<R!A<F4@<V5V
+M96X@*'1E;C\@(&5I9VAT/RD*8VAA<F%C=&5R<R!L;VYG+"!A;F0@=&AE(&%D
+M9&5D(&)O;G5S(&]F('1H92!0;VEN=&5R(&1A=&$@='EP92!I<PIT:')O=VX@
+M:6XN($ET)W,@;&EK92!H879I;F<@=&AE(&)E<W0@<&%R=',@;V8@1D]25%)!
+M3B!A;F0@87-S96UB;'D*;&%N9W5A9V4@:6X@;VYE('!L86-E+B @*$YO="!T
+M;R!M96YT:6]N('-O;64@;V8@=&AE(&UO<F4@8W)E871I=F4@=7-E<PIF;W(@
+M/$M"1#XC9&5F:6YE/"]+0D0^+BD@/% ^"@I.;RP@=&AE(&9U='5R92!I<VXG
+M="!A;&P@=&AA="!B860N("!7:'DL(&EN('1H92!P87-T(&9E=R!Y96%R<RP@
+M=&AE"G!O<'5L87(@<')E<W,@:&%S(&5V96X@8V]M;65N=&5D(&]N('1H92!B
+M<FEG:'0@;F5W(&-R;W @;V8@8V]M<'5T97(*;F5R9',@86YD(&AA8VME<G,@
+M*%LW72!A;F0@6SA=*2!L96%V:6YG('!L86-E<R!L:6ME(%-T86YF;W)D(&%N
+M9 I-+DDN5"X@(&9O<B!T:&4@4F5A;"!7;W)L9"X@($9R;VT@86QL(&5V:61E
+M;F-E+"!T:&4@<W!I<FET(&]F(%)E86P*4')O9W)A;6UI;F<@;&EV97,@;VX@
+M:6X@=&AE<V4@>6]U;F<@;65N(&%N9"!W;VUE;BX@($%S(&QO;F<@87,@=&AE
+M<F4*87)E(&EL;"UD969I;F5D(&=O86QS+"!B:7IA<G)E(&)U9W,L(&%N9"!U
+M;G)E86QI<W1I8R!S8VAE9'5L97,L('1H97)E"G=I;&P@8F4@4F5A;"!0<F]G
+M<F%M;65R<R!W:6QL:6YG('1O(&IU;7 @:6X@86YD(%-O;'9E(%1H92!0<F]B
+M;&5M+ IS879I;F<@=&AE(&1O8W5M96YT871I;VX@9F]R(&QA=&5R+B @3&]N
+M9R!L:79E($9/4E1204XA(#Q0/@H*/$@S/D%#2TY/5TQ%1T5-14Y4/"](,SX*
+M"DD@=V]U;&0@;&EK92!T;R!T:&%N:R!*86X@12XL($1A=F4@4RXL(%)I8V@@
+M1RXL(%)I8V@@12X@9F]R('1H96ER(&AE;' *:6X@8VAA<F%C=&5R:7II;F<@
+M=&AE(%)E86P@4')O9W)A;6UE<BP@2&5A=&AE<B!"+B!F;W(@=&AE"FEL;'5S
+M=')A=&EO;BP@2V%T:'D@12X@9F]R('!U='1I;F<@=7 @=VET:"!I="P@86YD
+M(#QK8F0^871D(6%V<V13.FUA<FL\+VMB9#X@9F]R"G1H92!I;FET:6%L(&EN
+M<W!R:7)A=&EO;BX@/% ^"@H\2#,^4D5&15)%3D-%4SPO2#,^"@I;,5T@(" @
+M1F5I<G-T96EN+"!"+BP@/&5M/E)E86P@365N($1O;B=T($5A="!1=6EC:&4\
+M+V5M/BP@3F5W(%EO<FLL"B @(" @("!0;V-K970@0F]O:W,L(#$Y.#(N(#Q0
+M/@H*6S)=(" @(%=I<G1H+"!.+BP@/&5M/D%L9V]R:71H;7,@*R!$871A<W1R
+M=6-T=7)E<R ](%!R;V=R86US/"]E;3XL"B @(" @("!0<F5N=&EC92!(86QL
+M+" Q.3<V+B \4#X*"ELS72 @("!897)O>"!005)#(&5D:71O<G,@+B N("X@
+M/% ^"@I;-%T@(" @1FEN<V5T:"P@0RXL(#QE;3Y4:&5O<GD@86YD(%!R86-T
+M:6-E(&]F(%1E>'0@161I=&]R<R M"B @(" @("!O<B M(&$@0V]O:V)O;VL@
+M9F]R(&%N($5-04-3/"]E;3XL($(N4RX@5&AE<VES+ H@(" @(" @34E4+TQ#
+M4R]432TQ-C4L($UA<W-A8VAU<V5T=',@26YS=&ET=71E(&]F(%1E8VAN;VQO
+M9WDL"B @(" @("!-87D@,3DX,"X@/% ^"@I;-5T@(" @5V5I;F)E<F<L($<N
+M+" \96T^5&AE(%!S>6-H;VQO9WD@;V8@0V]M<'5T97(@4')O9W)A;6UI;F<\
+M+V5M/BP*(" @(" @($YE=R!9;W)K+"!686X@3F]S=')A8F0@4F5I;FAO;&0L
+M(#$Y-S$L('!A9V4@,3$P+B \4#X*"ELV72 @("!$:6IK<W1R82P@12XL(#QE
+M;3Y/;B!T:&4@1U)%14X@3&%N9W5A9V4@4W5B;6ET=&5D('1O('1H92!$;T0\
+M+V5M/BP*(" @(" @(%-I9W!L86X@;F]T:6-E<RP@5F]L=6UE(#,L($YU;6)E
+M<B Q,"P@3V-T;V)E<B Q.3<X+B \4#X*"ELW72 @("!2;W-E+"!&<F%N:RP@
+M/&5M/DIO>2!O9B!(86-K:6YG/"]E;3XL(%-C:65N8V4@.#(L(%9O;'5M92 S
+M+"!.=6UB97(@.2P*(" @(" @($YO=F5M8F5R(#$Y.#(L('!A9V5S(#4X("T@
+M-C8N(#Q0/@H*6SA=(" @(%1H92!(86-K97(@4&%P97)S+" \96T^4'-Y8VAO
+M;&]G>2!4;V1A>3PO96T^+"!!=6=U<W0@,3DX,"X@/% ^"@I;.5T@(" @/&5M
+M/D1A=&%M871I;VX\+V5M/BP@2G5L>2P@,3DX,RP@<' N(#(V,RTR-C4N(#Q0
+M/@H*/&AR/@H*/$%$1%)%4U,^(#QA(&AR968](FEN9&5X+FAT;6PB/DAA8VME
+M<B=S(%=I<V1O;3PO83XO(%)E86P@4')O9W)A;6UE<G,*1&]N)W0@57-E(%!!
+M4T-!3" \+T%$1%)%4U,^"@H\(2TM(&AH;71S('-T87)T("TM/@I,87-T(&UO
+E9&EF:65D.B!7960@36%R(#(W(#$W.C0X.C4P($535" Q.3DV"@I,
+
diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl
new file mode 100644
index 0000000000..2b39e31a80
--- /dev/null
+++ b/lib/kernel/test/rpc_SUITE.erl
@@ -0,0 +1,518 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(rpc_SUITE).
+
+-export([all/1]).
+-export([call/1, block_call/1, multicall/1, multicall_timeout/1,
+ multicall_dies/1, multicall_node_dies/1,
+ called_dies/1, called_node_dies/1,
+ called_throws/1, call_benchmark/1, async_call/1]).
+
+-export([suicide/2, suicide/3, f/0, f2/0]).
+
+-include("test_server.hrl").
+
+all(suite) ->
+ [call, block_call, multicall, multicall_timeout,
+ multicall_dies, multicall_node_dies,
+ called_dies, called_node_dies,
+ called_throws, call_benchmark, async_call].
+
+
+call(doc) -> "Test different rpc calls";
+call(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(30)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ %% Note. First part of nodename sets response delay in seconds
+ ?line {ok, N1} = ?t:start_node('3_rpc_SUITE_call', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N2} = ?t:start_node('1_rcp_SUITE_call', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N3} = ?t:start_node('4_rcp_SUITE_call', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N4} = ?t:start_node('8_rcp_SUITE_call', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line ok = io:format("~p~n", [[N1, N2, N3]]),
+ ?line {hej,_,N1} = rpc:call(N1, ?MODULE, f, []),
+ ?line {hej,_,N2} = rpc:call(N2, ?MODULE, f, [], 2000),
+ ?line {badrpc,timeout} = rpc:call(N3, ?MODULE, f, [], 2000),
+ ?line receive after 6000 -> ok end,
+ ?line [] = flush([]),
+ ?line {hej,_,N4} = rpc:call(N4, ?MODULE, f, []),
+ ?line ?t:stop_node(N1),
+ ?line ?t:stop_node(N2),
+ ?line ?t:stop_node(N3),
+ ?line ?t:stop_node(N4),
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+block_call(doc) -> "Test different rpc calls";
+block_call(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(30)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ %% Note. First part of nodename sets response delay in seconds
+ ?line {ok, N1} = ?t:start_node('3_rpc_SUITE_block_call', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N2} = ?t:start_node('1_rcp_SUITE_block_call', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N3} = ?t:start_node('4_rcp_SUITE_block_call', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N4} = ?t:start_node('8_rcp_SUITE_block_call', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line ok = io:format("~p~n", [[N1, N2, N3]]),
+ ?line {hej,_,N1} = rpc:block_call(N1, ?MODULE, f, []),
+ ?line {hej,_,N2} = rpc:block_call(N2, ?MODULE, f, [], 2000),
+ ?line {badrpc,timeout} = rpc:block_call(N3, ?MODULE, f, [], 2000),
+ ?line receive after 6000 -> ok end,
+ ?line [] = flush([]),
+ ?line {hej,_,N4} = rpc:block_call(N4, ?MODULE, f, []),
+ ?line ?t:stop_node(N1),
+ ?line ?t:stop_node(N2),
+ ?line ?t:stop_node(N3),
+ ?line ?t:stop_node(N4),
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+
+multicall(doc) ->
+ "OTP-3449";
+multicall(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(20)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ %% Note. First part of nodename sets response delay in seconds
+ ?line {ok, N1} = ?t:start_node('3_rpc_SUITE_multicall', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N2} = ?t:start_node('1_rcp_SUITE_multicall', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line ok = io:format("~p~n", [[N1, N2]]),
+ ?line {[{hej,_,N1},{hej,_,N2}],[]} =
+ rpc:multicall([N1, N2], ?MODULE, f, []),
+ ?line Msgs = flush([]),
+ ?line [] = Msgs,
+ ?line ?t:stop_node(N1),
+ ?line ?t:stop_node(N2),
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+multicall_timeout(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(30)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ %% Note. First part of nodename sets response delay in seconds
+ ?line {ok, N1} = ?t:start_node('11_rpc_SUITE_multicall', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N2} = ?t:start_node('8_rpc_SUITE_multicall', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N3} = ?t:start_node('5_rpc_SUITE_multicall', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N4} = ?t:start_node('2_rcp_SUITE_multicall', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line ok = io:format("~p~n", [[N1, N2]]),
+ ?line {[{hej,_,N3},{hej,_,N4}],[N1, N2]} =
+ rpc:multicall([N3, N1, N2, N4], ?MODULE, f, [], ?t:seconds(6)),
+ ?t:sleep(?t:seconds(8)), %% Wait for late answers
+ ?line Msgs = flush([]),
+ ?line [] = Msgs,
+ ?line ?t:stop_node(N1),
+ ?line ?t:stop_node(N2),
+ ?line ?t:stop_node(N3),
+ ?line ?t:stop_node(N4),
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+multicall_dies(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(30)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, N1} = ?t:start_node('rpc_SUITE_multicall_dies_1', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N2} = ?t:start_node('rcp_SUITE_multicall_dies_2', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line Nodes = [N1, N2],
+ %%
+ ?line {[{badrpc, {'EXIT', normal}}, {badrpc, {'EXIT', normal}}], []} =
+ do_multicall(Nodes, erlang, exit, [normal]),
+ ?line {[{badrpc, {'EXIT', abnormal}}, {badrpc, {'EXIT', abnormal}}], []} =
+ do_multicall(Nodes, erlang, exit, [abnormal]),
+ ?line {[{badrpc, {'EXIT', {badarith, _}}},
+ {badrpc, {'EXIT', {badarith, _}}}],
+ []} =
+ do_multicall(Nodes, erlang, 'div', [1, 0]),
+ ?line {[{badrpc, {'EXIT', {badarg, _}}},
+ {badrpc, {'EXIT', {badarg, _}}}],
+ []} =
+ do_multicall(Nodes, erlang, atom_to_list, [1]),
+ ?line {[{badrpc, {'EXIT', {undef, _}}},
+ {badrpc, {'EXIT', {undef, _}}}],
+ []} =
+ do_multicall(Nodes, ?MODULE, suicide, []),
+ ?line {[timeout, timeout], []} =
+ do_multicall(Nodes, ?MODULE, suicide, [link, normal]),
+ ?line {[{badrpc, {'EXIT', abnormal}}, {badrpc, {'EXIT', abnormal}}], []} =
+ do_multicall(Nodes, ?MODULE, suicide, [link, abnormal]),
+ ?line {[timeout, timeout], []} =
+ do_multicall(Nodes, ?MODULE, suicide, [exit, normal]),
+ ?line {[{badrpc, {'EXIT', abnormal}}, {badrpc, {'EXIT', abnormal}}], []} =
+ do_multicall(Nodes, ?MODULE, suicide, [exit, abnormal]),
+ ?line {[{badrpc, {'EXIT', killed}}, {badrpc, {'EXIT', killed}}], []} =
+ do_multicall(Nodes, ?MODULE, suicide, [exit, kill]),
+ %%
+ ?line ?t:stop_node(N1),
+ ?line ?t:stop_node(N2),
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+do_multicall(Nodes, Mod, Func, Args) ->
+ ?line ok = io:format("~p:~p~p~n", [Mod, Func, Args]),
+ ?line Result = rpc:multicall(Nodes, Mod, Func, Args),
+ ?line Msgs = flush([]),
+ ?line [] = Msgs,
+ Result.
+
+
+
+multicall_node_dies(doc) ->
+ "";
+multicall_node_dies(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(60)),
+ %%
+ do_multicall_2_nodes_dies(?MODULE, suicide, [erlang, halt, []]),
+ do_multicall_2_nodes_dies(?MODULE, suicide, [init, stop, []]),
+ do_multicall_2_nodes_dies(?MODULE, suicide, [rpc, stop, []]),
+ %%
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+do_multicall_2_nodes_dies(Mod, Func, Args) ->
+ ?line ok = io:format("~p:~p~p~n", [Mod, Func, Args]),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, N1} = ?t:start_node('rpc_SUITE_multicall_node_dies_1', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line {ok, N2} = ?t:start_node('rcp_SUITE_multicall_node_dies_2', slave,
+ [{args, "-pa " ++ PA}]),
+ ?line Nodes = [N1, N2],
+ ?line {[], Nodes} = rpc:multicall(Nodes, Mod, Func, Args),
+ ?line Msgs = flush([]),
+ ?line [] = Msgs,
+ ok.
+
+
+
+called_dies(doc) ->
+ "OTP-3766";
+called_dies(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(210)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, N} = ?t:start_node(rpc_SUITE_called_dies, slave,
+ [{args, "-pa " ++ PA}]),
+ %%
+ ?line rep(fun (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',normal}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, erlang, exit, [normal]),
+ ?line rep(fun (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',abnormal}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, erlang, exit, [abnormal]),
+ ?line rep(fun (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',{badarith,_}}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, erlang, 'div', [1,0]),
+ ?line rep(fun (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',{badarg,_}}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, erlang, atom_to_list, [1]),
+ ?line rep(fun (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',{undef,_}}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, ?MODULE, suicide, []),
+ %%
+ TrapExit = process_flag(trap_exit, true),
+ %%
+ ?line rep(fun (Tag, Call, Args=[Node|_]) when Node == node() ->
+ {Tag,timeout} =
+ {Tag,apply(rpc, Call, Args)},
+ {Tag,flush,[{'EXIT',_,normal}]} =
+ {Tag,flush,flush([])};
+ (Tag, Call, Args) ->
+ {Tag,timeout} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, ?MODULE, suicide, [link,normal]),
+ ?line rep(fun (Tag, Call, Args=[Node|_]) when Node == node() ->
+ {Tag,timeout} =
+ {Tag,apply(rpc, Call, Args)},
+ {Tag,flush,[{'EXIT',_,abnormal}]} =
+ {Tag,flush,flush([])};
+ (Tag, block_call, Args) ->
+ {Tag,timeout} =
+ {Tag,apply(rpc, block_call, Args)};
+ (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',abnormal}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, ?MODULE, suicide, [link,abnormal]),
+ ?line rep(fun (Tag, Call, Args=[Node|_]) when Node == node() ->
+ {Tag,timeout} =
+ {Tag,apply(rpc, Call, Args)},
+ {Tag,flush,[{'EXIT',_,normal}]} =
+ {Tag,flush,flush([])};
+ (Tag, Call, Args) ->
+ {Tag,timeout} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, ?MODULE, suicide, [exit,normal]),
+ ?line rep(fun (Tag, Call, Args=[Node|_]) when Node == node() ->
+ {Tag,timeout} =
+ {Tag,apply(rpc, Call, Args)},
+ {Tag,flush,[{'EXIT',_,abnormal}]} =
+ {Tag,flush,flush([])};
+ (Tag, block_call, Args) ->
+ {Tag,timeout} =
+ {Tag,apply(rpc, block_call, Args)};
+ (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',abnormal}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, ?MODULE, suicide, [exit,abnormal]),
+ %%
+ process_flag(trap_exit, TrapExit),
+ %%
+ ?line rep(fun %% A local [exit,kill] would kill the test case process
+ (_Tag, _Call, [Node|_]) when Node == node() ->
+ ok;
+ %% A block_call [exit,kill] would kill the rpc server
+ (_Tag, block_call, _Args) -> ok;
+ (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',killed}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, ?MODULE, suicide, [exit,kill]),
+ %%
+ ?line [] = flush([]),
+ ?line ?t:stop_node(N),
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+rep(Fun, N, M, F, A) ->
+ Fun(1, call, [node(), M, F, A]),
+ Fun(2, call, [node(), M, F, A, infinity]),
+ Fun(3, call, [N, M, F, A]),
+ Fun(4, call, [N, M, F, A, infinity]),
+ Fun(5, call, [N, M, F, A, 3000]),
+ Fun(6, block_call, [node(), M, F, A]),
+ Fun(7, block_call, [node(), M, F, A, infinity]),
+ Fun(8, block_call, [N, M, F, A]),
+ Fun(9, block_call, [N, M, F, A, infinity]),
+ Fun(10, block_call, [N, M, F, A, 3000]),
+ ok.
+
+
+suicide(link, Reason) ->
+ spawn_link(
+ fun() ->
+ exit(Reason)
+ end),
+ receive after 2000 -> timeout end;
+suicide(exit, Reason) ->
+ Self = self(),
+ spawn(
+ fun() ->
+ exit(Self, Reason)
+ end),
+ receive after 2000 -> timeout end.
+
+suicide(erlang, exit, [Name, Reason]) when is_atom(Name) ->
+ case whereis(Name) of
+ Pid when pid(Pid) -> suicide(erlang, exit, [Pid, Reason])
+ end;
+suicide(Mod, Func, Args) ->
+ spawn_link(
+ fun() ->
+ apply(Mod, Func, Args)
+ end),
+ receive after 10000 -> timeout end.
+
+
+
+called_node_dies(doc) ->
+ "";
+called_node_dies(suite) -> [];
+called_node_dies(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:minutes(2)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ %%
+ ?line node_rep(
+ fun (Tag, Call, Args) ->
+ {Tag,{badrpc,nodedown}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, "rpc_SUITE_called_node_dies_1",
+ PA, ?MODULE, suicide, [erlang,halt,[]]),
+ ?line node_rep(
+ fun (Tag, Call, Args) ->
+ {Tag,{badrpc,nodedown}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, "rpc_SUITE_called_node_dies_2",
+ PA, ?MODULE, suicide, [init,stop,[]]),
+ ?line node_rep(
+ fun (Tag, Call, Args=[_|_]) ->
+ {Tag,{'EXIT',{killed,_}}} =
+ {Tag,catch {noexit,apply(rpc, Call, Args)}}
+ end, "rpc_SUITE_called_node_dies_3",
+ PA, ?MODULE, suicide, [erlang,exit,[rex,kill]]),
+ ?line node_rep(
+ fun %% Cannot block call rpc - will hang
+ (_Tag, block_call, _Args) -> ok;
+ (Tag, Call, Args=[_|_]) ->
+ {Tag,{'EXIT',{normal,_}}} =
+ {Tag,catch {noexit,apply(rpc, Call, Args)}}
+ end, "rpc_SUITE_called_node_dies_4",
+ PA, ?MODULE, suicide, [rpc,stop,[]]),
+ %%
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+node_rep(Fun, Name, PA, M, F, A) ->
+ {ok, Na} = ?t:start_node(list_to_atom(Name++"_a"), slave,
+ [{args, "-pa " ++ PA}]),
+ Fun(a, call, [Na, M, F, A]),
+ catch ?t:stop_node(Na),
+ {ok, Nb} = ?t:start_node(list_to_atom(Name++"_b"), slave,
+ [{args, "-pa " ++ PA}]),
+ Fun(b, call, [Nb, M, F, A, infinity]),
+ catch ?t:stop_node(Nb),
+ {ok, Nc} = ?t:start_node(list_to_atom(Name++"_c"), slave,
+ [{args, "-pa " ++ PA}]),
+ Fun(c, call, [Nc, M, F, A, infinity]),
+ catch ?t:stop_node(Nc),
+ %%
+ {ok, Nd} = ?t:start_node(list_to_atom(Name++"_d"), slave,
+ [{args, "-pa " ++ PA}]),
+ Fun(d, block_call, [Nd, M, F, A]),
+ catch ?t:stop_node(Nd),
+ {ok, Ne} = ?t:start_node(list_to_atom(Name++"_e"), slave,
+ [{args, "-pa " ++ PA}]),
+ Fun(e, block_call, [Ne, M, F, A, infinity]),
+ catch ?t:stop_node(Ne),
+ {ok, Nf} = ?t:start_node(list_to_atom(Name++"_f"), slave,
+ [{args, "-pa " ++ PA}]),
+ Fun(f, block_call, [Nf, M, F, A, infinity]),
+ catch ?t:stop_node(Nf),
+ ok.
+
+
+
+called_throws(doc) ->
+ "OTP-3766";
+called_throws(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(10)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ %%
+ ?line {ok, N} = ?t:start_node(rpc_SUITE_called_throws, slave,
+ [{args, "-pa " ++ PA}]),
+ %%
+ ?line rep(fun (Tag, Call, Args) ->
+ {Tag,up} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, erlang, throw, [up]),
+ ?line rep(fun (Tag, Call, Args) ->
+ {Tag,{badrpc,{'EXIT',reason}}} =
+ {Tag,apply(rpc, Call, Args)}
+ end, N, erlang, throw, [{'EXIT',reason}]),
+ %%
+ ?line ?t:stop_node(N),
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+
+
+call_benchmark(Config) when is_list(Config) ->
+ Timetrap = ?t:timetrap(?t:seconds(120)),
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line {ok, Node} = ?t:start_node(rpc_SUITE_call_benchmark, slave,
+ [{args, "-pa " ++ PA}]),
+ Iter = case erlang:system_info(modified_timing_level) of
+ undefined -> 10000;
+ _ -> 500 %Moified timing - spawn is slower
+ end,
+ ?line do_call_benchmark(Node, Iter),
+ ?t:timetrap_cancel(Timetrap),
+ ok.
+
+do_call_benchmark(Node, M) when integer(M), M > 0 ->
+ do_call_benchmark(Node, erlang:now(), 0, M).
+
+do_call_benchmark(Node, {A,B,C}, M, M) ->
+ ?line {D,E,F} = erlang:now(),
+ ?line T = float(D-A)*1000000.0 + float(E-B) + float(F-C)*0.000001,
+ ?line Q = 3.0 * float(M) / T,
+ ?line ?t:stop_node(Node),
+ {comment,
+ lists:flatten([float_to_list(Q)," RPC calls per second"])};
+do_call_benchmark(Node, Then, I, M) ->
+ ?line Node = rpc:call(Node, erlang, node, []),
+ ?line _ = rpc:call(Node, erlang, whereis, [rex]),
+ ?line 3 = rpc:call(Node, erlang, '+', [1,2]),
+ ?line do_call_benchmark(Node, Then, I+1, M).
+
+async_call(Config) when is_list(Config) ->
+ Dog = ?t:timetrap(?t:seconds(120)),
+
+ %% Note: First part of nodename sets response delay in seconds.
+ ?line PA = filename:dirname(code:which(?MODULE)),
+ ?line NodeArgs = [{args,"-pa "++ PA}],
+ ?line {ok,Node1} = ?t:start_node('1_rpc_SUITE_call', slave, NodeArgs),
+ ?line {ok,Node2} = ?t:start_node('10_rpc_SUITE_call', slave, NodeArgs),
+ ?line {ok,Node3} = ?t:start_node('20_rpc_SUITE_call', slave, NodeArgs),
+ ?line Promise1 = rpc:async_call(Node1, ?MODULE, f, []),
+ ?line Promise2 = rpc:async_call(Node2, ?MODULE, f, []),
+ ?line Promise3 = rpc:async_call(Node3, ?MODULE, f, []),
+
+ %% Test fast timeouts.
+ ?line timeout = rpc:nb_yield(Promise2),
+ ?line timeout = rpc:nb_yield(Promise2, 10),
+
+ %% Let Node1 finish its work before yielding.
+ ?t:sleep(?t:seconds(2)),
+ ?line {hej,_,Node1} = rpc:yield(Promise1),
+
+ %% Wait for the Node2 and Node3.
+ ?line {value,{hej,_,Node2}} = rpc:nb_yield(Promise2, infinity),
+ ?line {hej,_,Node3} = rpc:yield(Promise3),
+
+ ?t:timetrap_cancel(Dog),
+ ok.
+
+%%%
+%%% Utility functions.
+%%%
+
+flush(L) ->
+ receive
+ M ->
+ flush([M|L])
+ after 0 ->
+ L
+ end.
+
+t() ->
+ [N | _] = string:tokens(atom_to_list(node()), "_"),
+ 1000*list_to_integer(N).
+
+f() ->
+ timer:sleep(T=t()),
+ spawn(?MODULE, f2, []),
+ {hej,T,node()}.
+
+f2() ->
+ timer:sleep(500),
+ halt().
diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl
new file mode 100644
index 0000000000..f582b94c97
--- /dev/null
+++ b/lib/kernel/test/seq_trace_SUITE.erl
@@ -0,0 +1,760 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(seq_trace_SUITE).
+
+-export([all/1,init_per_testcase/2,fin_per_testcase/2]).
+-export([token_set_get/1, tracer_set_get/1, print/1,
+ send/1, distributed_send/1, recv/1, distributed_recv/1,
+ trace_exit/1, distributed_exit/1, call/1, port/1,
+ match_set_seq_token/1, gc_seq_token/1]).
+
+% internal exports
+-export([simple_tracer/2, one_time_receiver/0, one_time_receiver/1,
+ start_tracer/0, stop_tracer/1,
+ do_match_set_seq_token/1, do_gc_seq_token/1, countdown_start/2]).
+
+%-define(line_trace, 1).
+-include("test_server.hrl").
+
+-define(default_timeout, ?t:minutes(1)).
+
+all(suite) -> [token_set_get, tracer_set_get, print,
+ send, distributed_send, recv, distributed_recv,
+ trace_exit, distributed_exit, call, port,
+ match_set_seq_token, gc_seq_token].
+
+init_per_testcase(_Case, Config) ->
+ ?line Dog = test_server:timetrap(?default_timeout),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Case, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog),
+ ok.
+
+%% Verifies that the set_token and get_token functions work as expected
+
+token_set_get(doc) -> [];
+token_set_get(suite) -> [];
+token_set_get(Config) when is_list(Config) ->
+ ?line Self = self(),
+ ?line seq_trace:reset_trace(),
+ %% Test that initial seq_trace is disabled
+ ?line [] = seq_trace:get_token(),
+ %% Test setting and reading the different fields
+ ?line 0 = seq_trace:set_token(label,17),
+ ?line {label,17} = seq_trace:get_token(label),
+ ?line false = seq_trace:set_token(print,true),
+ ?line {print,true} = seq_trace:get_token(print),
+ ?line false = seq_trace:set_token(send,true),
+ ?line {send,true} = seq_trace:get_token(send),
+ ?line false = seq_trace:set_token('receive',true),
+ ?line {'receive',true} = seq_trace:get_token('receive'),
+ ?line false = seq_trace:set_token(timestamp,true),
+ ?line {timestamp,true} = seq_trace:get_token(timestamp),
+ %% Check the whole token
+ ?line {15,17,0,Self,0} = seq_trace:get_token(), % all flags are set
+ %% Test setting and reading the 'serial' field
+ ?line {0,0} = seq_trace:set_token(serial,{3,5}),
+ ?line {serial,{3,5}} = seq_trace:get_token(serial),
+ %% Check the whole token, test that a whole token can be set and get
+ ?line {15,17,5,Self,3} = seq_trace:get_token(),
+ ?line seq_trace:set_token({15,19,7,Self,5}),
+ ?line {15,19,7,Self,5} = seq_trace:get_token(),
+ %% Check that receive timeout does not reset token
+ ?line receive after 0 -> ok end,
+ ?line {15,19,7,Self,5} = seq_trace:get_token(),
+ %% Check that token can be unset
+ ?line {15,19,7,Self,5} = seq_trace:set_token([]),
+ ?line [] = seq_trace:get_token(),
+ %% Check that Previous serial counter survived unset token
+ ?line 0 = seq_trace:set_token(label, 17),
+ ?line {0,17,0,Self,5} = seq_trace:get_token(),
+ %% Check that reset_trace resets the token and clears
+ %% the Previous serial counter
+ ?line seq_trace:reset_trace(),
+ ?line [] = seq_trace:get_token(),
+ ?line 0 = seq_trace:set_token(label, 19),
+ ?line {0,19,0,Self,0} = seq_trace:get_token(),
+ %% Cleanup
+ ?line seq_trace:reset_trace(),
+ ok.
+
+tracer_set_get(doc) -> [];
+tracer_set_get(suite) -> [];
+tracer_set_get(Config) when is_list(Config) ->
+ ?line Self = self(),
+ ?line seq_trace:set_system_tracer(self()),
+ ?line Self = seq_trace:get_system_tracer(),
+ ?line Self = seq_trace:set_system_tracer(false),
+ ?line false = seq_trace:get_system_tracer(),
+
+ %% Set the system tracer to a port.
+
+ ?line Port = load_tracer(Config),
+ ?line seq_trace:set_system_tracer(Port),
+ ?line Port = seq_trace:get_system_tracer(),
+ ?line Port = seq_trace:set_system_tracer(false),
+ ?line false = seq_trace:get_system_tracer(),
+ ok.
+
+print(doc) -> [];
+print(suite) -> [];
+print(Config) when is_list(Config) ->
+ ?line start_tracer(),
+ ?line seq_trace:set_token(print,true),
+ ?line seq_trace:print(0,print1),
+ ?line seq_trace:print(1,print2),
+ ?line seq_trace:print(print3),
+ ?line seq_trace:reset_trace(),
+ ?line [{0,{print,_,_,[],print1}},
+ {0,{print,_,_,[],print3}}] = stop_tracer(2).
+
+send(doc) -> [];
+send(suite) -> [];
+send(Config) when is_list(Config) ->
+ ?line seq_trace:reset_trace(),
+ ?line start_tracer(),
+ ?line Receiver = spawn(?MODULE,one_time_receiver,[]),
+ ?line seq_trace:set_token(send,true),
+ ?line Receiver ! send,
+ ?line Self = self(),
+ ?line seq_trace:reset_trace(),
+ ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1).
+
+distributed_send(doc) -> [];
+distributed_send(suite) -> [];
+distributed_send(Config) when is_list(Config) ->
+ ?line {ok,Node} = start_node(seq_trace_other,[]),
+ ?line {_,Dir} = code:is_loaded(?MODULE),
+ ?line Mdir = filename:dirname(Dir),
+ ?line true = rpc:call(Node,code,add_patha,[Mdir]),
+ ?line seq_trace:reset_trace(),
+ ?line start_tracer(),
+ ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
+ ?line seq_trace:set_token(send,true),
+ ?line Receiver ! send,
+ ?line Self = self(),
+ ?line seq_trace:reset_trace(),
+ ?line stop_node(Node),
+ ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1).
+
+recv(doc) -> [];
+recv(suite) -> [];
+recv(Config) when is_list(Config) ->
+ ?line seq_trace:reset_trace(),
+ ?line start_tracer(),
+ ?line Receiver = spawn(?MODULE,one_time_receiver,[]),
+ ?line seq_trace:set_token('receive',true),
+ ?line Receiver ! 'receive',
+ %% let the other process receive the message:
+ ?line receive after 1 -> ok end,
+ ?line Self = self(),
+ ?line seq_trace:reset_trace(),
+ ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = stop_tracer(1).
+
+distributed_recv(doc) -> [];
+distributed_recv(suite) -> [];
+distributed_recv(Config) when is_list(Config) ->
+ ?line {ok,Node} = start_node(seq_trace_other,[]),
+ ?line {_,Dir} = code:is_loaded(?MODULE),
+ ?line Mdir = filename:dirname(Dir),
+ ?line true = rpc:call(Node,code,add_patha,[Mdir]),
+ ?line seq_trace:reset_trace(),
+ ?line rpc:call(Node,?MODULE,start_tracer,[]),
+ ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
+ ?line seq_trace:set_token('receive',true),
+ ?line Receiver ! 'receive',
+ %% let the other process receive the message:
+ ?line receive after 1 -> ok end,
+ ?line Self = self(),
+ ?line seq_trace:reset_trace(),
+ ?line Result = rpc:call(Node,?MODULE,stop_tracer,[1]),
+ ?line stop_node(Node),
+ ?line ok = io:format("~p~n",[Result]),
+ ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = Result.
+
+trace_exit(doc) -> [];
+trace_exit(suite) -> [];
+trace_exit(Config) when is_list(Config) ->
+ ?line seq_trace:reset_trace(),
+ ?line start_tracer(),
+ ?line Receiver = spawn_link(?MODULE, one_time_receiver, [exit]),
+ ?line process_flag(trap_exit, true),
+ ?line seq_trace:set_token(send,true),
+ ?line Receiver ! {before, exit},
+ %% let the other process receive the message:
+ ?line receive
+ {'EXIT', Receiver, {exit, {before, exit}}} ->
+ seq_trace:set_token([]);
+ Other ->
+ seq_trace:set_token([]),
+ ?t:fail({received, Other})
+ end,
+ ?line Self = self(),
+ ?line Result = stop_tracer(2),
+ ?line seq_trace:reset_trace(),
+ ?line ok = io:format("~p~n", [Result]),
+ ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}},
+ {0, {send, {1,2}, Receiver, Self,
+ {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result.
+
+distributed_exit(doc) -> [];
+distributed_exit(suite) -> [];
+distributed_exit(Config) when is_list(Config) ->
+ ?line {ok, Node} = start_node(seq_trace_other, []),
+ ?line {_, Dir} = code:is_loaded(?MODULE),
+ ?line Mdir = filename:dirname(Dir),
+ ?line true = rpc:call(Node, code, add_patha, [Mdir]),
+ ?line seq_trace:reset_trace(),
+ ?line rpc:call(Node, ?MODULE, start_tracer,[]),
+ ?line Receiver = spawn_link(Node, ?MODULE, one_time_receiver, [exit]),
+ ?line process_flag(trap_exit, true),
+ ?line seq_trace:set_token(send, true),
+ ?line Receiver ! {before, exit},
+ %% let the other process receive the message:
+ ?line receive
+ {'EXIT', Receiver, {exit, {before, exit}}} ->
+ seq_trace:set_token([]);
+ Other ->
+ seq_trace:set_token([]),
+ ?t:fail({received, Other})
+ end,
+ ?line Self = self(),
+ ?line Result = rpc:call(Node, ?MODULE, stop_tracer, [1]),
+ ?line seq_trace:reset_trace(),
+ ?line stop_node(Node),
+ ?line ok = io:format("~p~n", [Result]),
+ ?line [{0, {send, {1, 2}, Receiver, Self,
+ {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result.
+
+call(doc) ->
+ "Tests special forms {is_seq_trace} and {get_seq_token} "
+ "in trace match specs.";
+call(suite) ->
+ [];
+call(Config) when is_list(Config) ->
+ ?line Self = self(),
+ ?line seq_trace:reset_trace(),
+ ?line TrA = transparent_tracer(),
+ ?line 1 =
+ erlang:trace(Self, true,
+ [call, set_on_spawn, {tracer, TrA(pid)}]),
+ ?line 1 =
+ erlang:trace_pattern({?MODULE, call_tracee_1, 1},
+ [{'_',
+ [],
+ [{message, {{{self}, {get_seq_token}}}}]}],
+ [local]),
+ ?line 1 =
+ erlang:trace_pattern({?MODULE, call_tracee_2, 1},
+ [{'_',
+ [{is_seq_trace}],
+ [{message, {{{self}, {get_seq_token}}}}]}],
+ [local]),
+ ?line RefA = make_ref(),
+ ?line Pid2A = spawn_link(
+ fun() ->
+ receive {_, msg, RefA} -> ok end,
+ RefA = call_tracee_2(RefA),
+ Self ! {self(), msg, RefA}
+ end),
+ ?line Pid1A = spawn_link(
+ fun() ->
+ receive {_, msg, RefA} -> ok end,
+ RefA = call_tracee_1(RefA),
+ Pid2A ! {self(), msg, RefA}
+ end),
+ ?line Pid1A ! {Self, msg, RefA},
+ %% The message is passed Self -> Pid1B -> Pid2B -> Self.
+ %% Traced functions are called in Pid1B and Pid2B.
+ ?line receive {Pid2A, msg, RefA} -> ok end,
+ %% Only call_tracee1 will be traced since the guard for
+ %% call_tracee2 requires a sequential trace. The trace
+ %% token is undefined.
+ ?line Token2A = [],
+ ?line {ok, [{trace, Pid1A, call,
+ {?MODULE, call_tracee_1, [RefA]},
+ {Pid1A, Token2A}}]} =
+ TrA({stop, 1}),
+
+ ?line seq_trace:reset_trace(),
+
+ ?line TrB = transparent_tracer(),
+ ?line 1 =
+ erlang:trace(Self, true,
+ [call, set_on_spawn, {tracer, TrB(pid)}]),
+ ?line Label = 17,
+ ?line seq_trace:set_token(label, Label), % Token enters here!!
+ ?line RefB = make_ref(),
+ ?line Pid2B = spawn_link(
+ fun() ->
+ receive {_, msg, RefB} -> ok end,
+ RefB = call_tracee_2(RefB),
+ Self ! {self(), msg, RefB}
+ end),
+ ?line Pid1B = spawn_link(
+ fun() ->
+ receive {_, msg, RefB} -> ok end,
+ RefB = call_tracee_1(RefB),
+ Pid2B ! {self(), msg, RefB}
+ end),
+ ?line Pid1B ! {Self, msg, RefB},
+ %% The message is passed Self -> Pid1B -> Pid2B -> Self, and the
+ %% seq_trace token follows invisibly. Traced functions are
+ %% called in Pid1B and Pid2B. Seq_trace flags == 0 so no
+ %% seq_trace messages are generated.
+ ?line receive {Pid2B, msg, RefB} -> ok end,
+ %% The values of these counters {.., 1, _, 0}, {.., 2, _, 1}
+ %% depend on that seq_trace has been reset just before this test.
+ ?line Token1B = {0, Label, 1, Self, 0},
+ ?line Token2B = {0, Label, 2, Pid1B, 1},
+ ?line {ok, [{trace, Pid1B, call,
+ {?MODULE, call_tracee_1, [RefB]},
+ {Pid1B, Token1B}},
+ {trace, Pid2B, call,
+ {?MODULE, call_tracee_2, [RefB]},
+ {Pid2B, Token2B}}]} =
+ TrB({stop,2}),
+ ?line seq_trace:reset_trace(),
+ ok.
+
+port(doc) ->
+ "Send trace messages to a port.";
+port(suite) -> [];
+port(Config) when is_list(Config) ->
+ ?line Port = load_tracer(Config),
+ ?line seq_trace:set_system_tracer(Port),
+
+ ?line seq_trace:set_token(print, true),
+ ?line Small = [small,term],
+ ?line seq_trace:print(0, Small),
+ ?line case get_port_message(Port) of
+ {seq_trace,0,{print,_,_,[],Small}} ->
+ ok;
+ Other ->
+ ?line seq_trace:reset_trace(),
+ ?line ?t:fail({unexpected,Other})
+ end,
+ %% OTP-4218 Messages from ports should not affect seq trace token.
+ %%
+ %% Check if trace token still is active on this process after
+ %% the get_port_message/1 above that receives from a port.
+ ?line OtherSmall = [other | Small],
+ ?line seq_trace:print(0, OtherSmall),
+ ?line seq_trace:reset_trace(),
+ ?line case get_port_message(Port) of
+ {seq_trace,0,{print,_,_,[],OtherSmall}} ->
+ ok;
+ Other1 ->
+ ?line ?t:fail({unexpected,Other1})
+ end,
+
+
+ ?line seq_trace:set_token(print, true),
+ ?line Huge = huge_data(),
+ ?line seq_trace:print(0, Huge),
+ ?line seq_trace:reset_trace(),
+ ?line case get_port_message(Port) of
+ {seq_trace,0,{print,_,_,[],Huge}} ->
+ ok;
+ Other2 ->
+ ?line ?t:fail({unexpected,Other2})
+ end,
+ ok.
+
+get_port_message(Port) ->
+ receive
+ {Port,{data,Bin}} when binary(Bin) ->
+ binary_to_term(Bin);
+ Other ->
+ ?t:fail({unexpected,Other})
+ after 5000 ->
+ ?t:fail(timeout)
+ end.
+
+
+
+match_set_seq_token(suite) ->
+ [];
+match_set_seq_token(doc) ->
+ ["Tests that match spec function set_seq_token does not "
+ "corrupt the heap"];
+match_set_seq_token(Config) when is_list(Config) ->
+ ?line Parent = self(),
+ ?line Timetrap = test_server:timetrap(test_server:seconds(20)),
+ %% OTP-4222 Match spec 'set_seq_token' corrupts heap
+ %%
+ %% This test crashes the emulator if the bug in question is present,
+ %% it is therefore done in a slave node.
+ %%
+ %% All the timeout stuff is here to get decent accuracy of the error
+ %% return value, instead of just 'timeout'.
+ %
+ ?line {ok, Sandbox} = start_node(seq_trace_other, []),
+ ?line true = rpc:call(Sandbox, code, add_patha,
+ [filename:dirname(code:which(?MODULE))]),
+ ?line Lbl = 4711,
+ %% Do the possibly crashing test
+ ?line P1 =
+ spawn(
+ fun () ->
+ Parent ! {self(),
+ rpc:call(Sandbox,
+ ?MODULE, do_match_set_seq_token, [Lbl])}
+ end),
+ %% Probe the node with a simple rpc request, to see if it is alive.
+ ?line P2 =
+ spawn(
+ fun () ->
+ receive after 4000 -> ok end,
+ Parent ! {self(), rpc:call(Sandbox, erlang, abs, [-1])}
+ end),
+ %% If the test node hangs completely, this timer expires.
+ ?line R3 = erlang:start_timer(8000, self(), void),
+ %%
+ ?line {ok, Log} =
+ receive
+ {P1, Result} ->
+ exit(P2, done),
+ erlang:cancel_timer(R3),
+ Result;
+ {P2, 1} ->
+ exit(P1, timeout),
+ erlang:cancel_timer(R3),
+ {error, "Test process hung"};
+ {timeout, R3, _} ->
+ exit(P1, timeout),
+ exit(P2, timeout),
+ {error, "Test node hung"}
+ end,
+ ?line ok = check_match_set_seq_token_log(Lbl, Log),
+ %%
+ ?line stop_node(Sandbox),
+ ?line test_server:timetrap_cancel(Timetrap),
+ ok.
+
+%% OTP-4222 Match spec 'set_seq_token' corrupts heap
+%%
+%% The crashing test goes as follows:
+%%
+%% One trigger function calls match spec function {set_seq_token, _, _},
+%% which when faulty corrupts the heap. It is assured that the process
+%% in question has a big heap and recently garbage collected so there
+%% will be room on the heap, which is necessary for the crash to happen.
+%%
+%% Then two processes bounces a few messages between each other, and if
+%% the heap is crashed the emulator crashes, or the triggering process's
+%% loop data gets corrupted so the loop never ends.
+do_match_set_seq_token(Label) ->
+ seq_trace:reset_trace(),
+ Tr = transparent_tracer(),
+ TrPid = Tr(pid),
+ erlang:trace_pattern({?MODULE, '_', '_'},
+ [{'_',
+ [{is_seq_trace}],
+ [{message, {get_seq_token}}]}],
+ [local]),
+ erlang:trace_pattern({?MODULE, countdown, 2},
+ [{'_',
+ [],
+ [{set_seq_token, label, Label},
+ {message, {get_seq_token}}]}],
+ [local]),
+ erlang:trace(new, true, [call, {tracer, TrPid}]),
+ Ref = make_ref(),
+ Bounce = spawn(fun () -> bounce(Ref) end),
+ Mref = erlang:monitor(process, Bounce),
+ _Countdown = erlang:spawn_opt(?MODULE, countdown_start, [Bounce, Ref],
+ [{min_heap_size, 4192}]),
+ receive
+ {'DOWN', Mref, _, _, normal} ->
+ Result = Tr({stop, 0}),
+ seq_trace:reset_trace(),
+ erlang:trace(new, false, [call]),
+ Result;
+ {'DOWN', Mref, _, _, Reason} ->
+ Tr({stop, 0}),
+ seq_trace:reset_trace(),
+ erlang:trace(new, false, [call]),
+ {error, Reason}
+ end.
+
+check_match_set_seq_token_log(
+ Label,
+ [{trace,C,call,{?MODULE,countdown,[B,Ref]}, {0,Label,0,C,0}},
+ {trace,C,call,{?MODULE,countdown,[B,Ref,3]},{0,Label,0,C,0}},
+ {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,2,B,1}},
+ {trace,C,call,{?MODULE,countdown,[B,Ref,2]},{0,Label,2,B,1}},
+ {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,4,B,3}},
+ {trace,C,call,{?MODULE,countdown,[B,Ref,1]},{0,Label,4,B,3}},
+ {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,6,B,5}},
+ {trace,C,call,{?MODULE,countdown,[B,Ref,0]},{0,Label,6,B,5}}
+ ]) ->
+ ok;
+check_match_set_seq_token_log(_Label, Log) ->
+ {error, Log}.
+
+countdown_start(Bounce, Ref) ->
+ %% This gc and the increased heap size of this process ensures that
+ %% the match spec executed for countdown/2 has got heap space for
+ %% the trace token, so the heap gets trashed according to OTP-4222.
+ erlang:garbage_collect(),
+ countdown(Bounce, Ref).
+
+countdown(Bounce, Ref) ->
+ countdown(Bounce, Ref, 3).
+
+countdown(Bounce, Ref, 0) ->
+ Bounce ! Ref;
+countdown(Bounce, Ref, Cnt) ->
+ Tag = make_ref(),
+ Bounce ! {Ref, self(), {Tag, Cnt}},
+ receive {Tag, Cnt} -> countdown(Bounce, Ref, Cnt-1) end.
+
+bounce(Ref) ->
+ receive
+ Ref ->
+ ok;
+ {Ref, Dest, Msg} ->
+ Dest ! Msg,
+ bounce(Ref)
+ end.
+
+
+
+gc_seq_token(suite) ->
+ [];
+gc_seq_token(doc) ->
+ ["Tests that a seq_trace token on a message in the inqueue ",
+ "can be garbage collected."];
+gc_seq_token(Config) when is_list(Config) ->
+ ?line Parent = self(),
+ ?line Timetrap = test_server:timetrap(test_server:seconds(20)),
+ %% OTP-4555 Seq trace token causes free mem read in gc
+ %%
+ %% This test crashes the emulator if the bug in question is present,
+ %% it is therefore done in a slave node.
+ %%
+ %% All the timeout stuff is here to get decent accuracy of the error
+ %% return value, instead of just 'timeout'.
+ %
+ ?line {ok, Sandbox} = start_node(seq_trace_other, []),
+ ?line true = rpc:call(Sandbox, code, add_patha,
+ [filename:dirname(code:which(?MODULE))]),
+ ?line Label = 4711,
+ %% Do the possibly crashing test
+ ?line P1 =
+ spawn(
+ fun () ->
+ Parent ! {self(),
+ rpc:call(Sandbox,
+ ?MODULE, do_gc_seq_token, [Label])}
+ end),
+ %% Probe the node with a simple rpc request, to see if it is alive.
+ ?line P2 =
+ spawn(
+ fun () ->
+ receive after 4000 -> ok end,
+ Parent ! {self(), rpc:call(Sandbox, erlang, abs, [-1])}
+ end),
+ %% If the test node hangs completely, this timer expires.
+ ?line R3 = erlang:start_timer(8000, self(), void),
+ %%
+ ?line ok =
+ receive
+ {P1, Result} ->
+ exit(P2, done),
+ erlang:cancel_timer(R3),
+ Result;
+ {P2, 1} ->
+ exit(P1, timeout),
+ erlang:cancel_timer(R3),
+ {error, "Test process hung"};
+ {timeout, R3, _} ->
+ exit(P1, timeout),
+ exit(P2, timeout),
+ {error, "Test node hung"}
+ end,
+ %%
+ ?line stop_node(Sandbox),
+ ?line test_server:timetrap_cancel(Timetrap),
+ ok.
+
+do_gc_seq_token(Label) ->
+ Parent = self(),
+ Comment =
+ {"OTP-4555 Seq trace token causes free mem read in gc\n"
+ "\n"
+ "The crashing test goes as follows:\n"
+ "\n"
+ "Put a message with seq_trace token in the inqueue,\n"
+ "Grow the process heap big enough to become mmap'ed\n"
+ "and force a garbage collection using large terms\n"
+ "to get a test_heap instruction with a big size value.\n"
+ "Then try to trick the heap into shrinking.\n"
+ "\n"
+ "All this to make the GC move the heap between memory blocks.\n"},
+ seq_trace:reset_trace(),
+ Child = spawn_link(
+ fun() ->
+ receive {Parent, no_seq_trace_token} -> ok end,
+ do_grow(Comment, 256*1024, []),
+ do_shrink(10),
+ receive {Parent, seq_trace_token} -> ok end,
+ Parent ! {self(), {token, seq_trace:get_token(label)}}
+ end),
+ seq_trace:set_token(label, Label),
+ Child ! {Parent, seq_trace_token},
+ seq_trace:set_token([]),
+ Child ! {Parent, no_seq_trace_token},
+ receive
+ {Child, {token, {label, Label}}} ->
+ ok;
+ {Child, {token, Other}} ->
+ {error, Other}
+ end.
+
+do_grow(_, 0, Acc) ->
+ Acc;
+do_grow(E, N, Acc) ->
+ do_grow(E, N-1, [E | Acc]).
+
+do_shrink(0) ->
+ ok;
+do_shrink(N) ->
+ erlang:garbage_collect(),
+ do_shrink(N-1).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Internal help functions
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% Call trace targets
+
+call_tracee_1(X) ->
+ X.
+
+call_tracee_2(X) ->
+ X.
+
+
+transparent_tracer() ->
+ Ref = make_ref(),
+ Loop =
+ fun(Fun, Log, LN) ->
+ receive
+ {stop, MinLN, Ref, From} when LN >= MinLN ->
+ From ! {log, Ref, lists:reverse(Log)};
+ Entry when is_tuple(Entry) == false; element(1, Entry) /= stop ->
+ Fun(Fun, [Entry | Log], LN+1)
+ end
+ end,
+ Self = self(),
+ Pid =
+ spawn(fun() ->
+ seq_trace:set_system_tracer(self()),
+ Self ! {started, Ref},
+ Loop(Loop, [], 0)
+ end),
+ receive {started, Ref} -> ok end,
+ fun(pid) ->
+ Pid;
+ ({stop, N}) when integer(N), N >= 0 ->
+ Mref = erlang:monitor(process, Pid),
+ receive
+ {'DOWN', Mref, _, _, _} ->
+ {error, not_started}
+ after 0 ->
+ DeliverRef = erlang:trace_delivered(all),
+ receive
+ {trace_delivered,_,DeliverRef} -> ok
+ end,
+ Pid ! {stop, N, Ref, self()},
+ receive {'DOWN', Mref, _, _, _} -> ok end,
+ receive {log, Ref, Log} ->
+ {ok, Log}
+ end
+ end
+ end.
+
+
+
+one_time_receiver() ->
+ receive _Term -> ok
+ end.
+
+one_time_receiver(exit) ->
+ receive Term ->
+ exit({exit, Term})
+ end.
+
+simple_tracer(Data, DN) ->
+ receive
+ {seq_trace,Label,Info,Ts} ->
+ simple_tracer([{Label,Info,Ts}|Data], DN+1);
+ {seq_trace,Label,Info} ->
+ simple_tracer([{Label,Info}|Data], DN+1);
+ {stop,N,From} when DN >= N ->
+ From ! {tracerlog,lists:reverse(Data)}
+ end.
+
+stop_tracer(N) when integer(N) ->
+ case catch (seq_trace_SUITE_tracer ! {stop,N,self()}) of
+ {'EXIT', _} ->
+ {error, not_started};
+ _ ->
+ receive
+ {tracerlog,Data} ->
+ Data
+ after 1000 ->
+ {error,timeout}
+ end
+ end.
+
+start_tracer() ->
+ stop_tracer(0),
+ Pid = spawn(?MODULE,simple_tracer,[[], 0]),
+ register(seq_trace_SUITE_tracer,Pid),
+ seq_trace:set_system_tracer(Pid),
+ Pid.
+
+
+
+start_node(Name, Param) ->
+ test_server:start_node(Name, slave, [{args, Param}]).
+
+stop_node(Node) ->
+ test_server:stop_node(Node).
+
+load_tracer(Config) ->
+ Path = ?config(data_dir, Config),
+ ok = erl_ddll:load_driver(Path, echo_drv),
+ open_port({spawn,echo_drv}, [eof,binary]).
+
+huge_data() -> huge_data(16384).
+huge_data(0) -> [];
+huge_data(N) when N rem 2 == 0 ->
+ P = huge_data(N div 2),
+ [P|P];
+huge_data(N) ->
+ P = huge_data(N div 2),
+ [16#1234566,P|P].
diff --git a/lib/kernel/test/seq_trace_SUITE_data/Makefile.src b/lib/kernel/test/seq_trace_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..c1bf142ccf
--- /dev/null
+++ b/lib/kernel/test/seq_trace_SUITE_data/Makefile.src
@@ -0,0 +1,3 @@
+all: echo_drv@dll@
+
+@SHLIB_RULES@
diff --git a/lib/kernel/test/seq_trace_SUITE_data/echo_drv.c b/lib/kernel/test/seq_trace_SUITE_data/echo_drv.c
new file mode 100644
index 0000000000..dcbb3348d8
--- /dev/null
+++ b/lib/kernel/test/seq_trace_SUITE_data/echo_drv.c
@@ -0,0 +1,43 @@
+#include <stdio.h>
+#include "erl_driver.h"
+
+static ErlDrvPort erlang_port;
+static ErlDrvData echo_start(ErlDrvPort, char *);
+static void echo_stop(ErlDrvData), echo_read(ErlDrvData, char*, int);
+
+static ErlDrvEntry echo_driver_entry = {
+ NULL,
+ echo_start,
+ echo_stop,
+ echo_read,
+ NULL,
+ NULL,
+ "echo_drv",
+ NULL
+};
+
+DRIVER_INIT(echo_drv)
+{
+ erlang_port = (ErlDrvPort)-1;
+ return &echo_driver_entry;
+}
+
+static ErlDrvData echo_start(ErlDrvPort port,char *buf)
+{
+ if (erlang_port != (ErlDrvPort)-1) {
+ return ERL_DRV_ERROR_GENERAL;
+ }
+ erlang_port = port;
+ return (ErlDrvData)port;
+}
+
+static void echo_read(ErlDrvData data, char *buf, int count)
+{
+ driver_output(erlang_port, buf, count);
+}
+
+static void echo_stop(ErlDrvData data)
+{
+ erlang_port = (ErlDrvPort)-1;
+}
+
diff --git a/lib/kernel/test/topApp.app b/lib/kernel/test/topApp.app
new file mode 100644
index 0000000000..ed01fa7b58
--- /dev/null
+++ b/lib/kernel/test/topApp.app
@@ -0,0 +1,11 @@
+ {application, topApp,
+ [{description, "Test of start phase"},
+ {id, "CXC 138 38"},
+ {vsn, "2.0"},
+ {applications, [kernel]},
+ {modules, []},
+ {registered, []},
+ {env, [{own_env1, value1}, {own2, val2}]},
+ {included_applications, [appinc1, appinc2]},
+ {start_phases, [{init, [initArgs]}, {go, [goArgs]}]},
+ {mod, {topApp, {topApp, 4, 6}} }]}.
diff --git a/lib/kernel/test/topApp.erl b/lib/kernel/test/topApp.erl
new file mode 100644
index 0000000000..acf98e6da0
--- /dev/null
+++ b/lib/kernel/test/topApp.erl
@@ -0,0 +1,48 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(topApp).
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2, stop/1, start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, {_AppN, Low, High}) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, ch_sup,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) -> ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase, {sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/topApp2.app b/lib/kernel/test/topApp2.app
new file mode 100644
index 0000000000..534c743759
--- /dev/null
+++ b/lib/kernel/test/topApp2.app
@@ -0,0 +1,11 @@
+ {application, topApp2,
+ [{description, "Test of start phase"},
+ {id, "CXC 138 38"},
+ {vsn, "2.0"},
+ {applications, [kernel]},
+ {modules, []},
+ {registered, []},
+ {env, [{own_env1, value1}, {own2, val2}]},
+ {included_applications, [appinc1, appinc2]},
+ {start_phases, [{init, [initArgs]}, {go, [goArgs]}]},
+ {mod, {application_starter, [topApp2, {topApp2, 4, 6}]} }]}.
diff --git a/lib/kernel/test/topApp2.erl b/lib/kernel/test/topApp2.erl
new file mode 100644
index 0000000000..4587910ff3
--- /dev/null
+++ b/lib/kernel/test/topApp2.erl
@@ -0,0 +1,48 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(topApp2).
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2, stop/1, start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, {_AppN, Low, High}) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, ch_sup,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) -> ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/topApp3.app b/lib/kernel/test/topApp3.app
new file mode 100644
index 0000000000..89ecf292c0
--- /dev/null
+++ b/lib/kernel/test/topApp3.app
@@ -0,0 +1,12 @@
+ {application, topApp3,
+ [{description, "Test of start phase"},
+ {id, "CXC 138 38"},
+ {vsn, "2.0"},
+ {applications, [kernel]},
+ {modules, []},
+ {registered, []},
+ {env, [{own_env1, value1}, {own2, val2}]},
+ {included_applications, [appinc1x, appinc2top]},
+ {start_phases, [{top, [topArgs]}, {init, [initArgs]}, {some, [someArgs]},
+ {spec, [specArgs]}, {go, [goArgs]}]},
+ {mod, {application_starter, [topApp3, {topApp3, 4, 6}]} }]}.
diff --git a/lib/kernel/test/topApp3.erl b/lib/kernel/test/topApp3.erl
new file mode 100644
index 0000000000..1bb6f2f31a
--- /dev/null
+++ b/lib/kernel/test/topApp3.erl
@@ -0,0 +1,48 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(topApp3).
+-behaviour(supervisor).
+
+%% External exports
+-export([start/2, stop/1, start_phase/3]).
+
+%% Internal exports
+-export([init/1]).
+
+start(_Type, {_AppN, Low, High}) ->
+ Name = list_to_atom(lists:concat([ch_sup, Low])),
+ {ok, P} = supervisor:start_link({local, Name}, ch_sup,
+ lists:seq(Low, High)),
+ {ok, P, []}.
+
+stop(_) -> ok.
+
+init(Nos) ->
+ SupFlags = {one_for_one, 12, 60},
+ Chs = lists:map(fun(No) ->
+ {list_to_atom(lists:concat([ch,No])),
+ {ch, start_link, [{ch, No}]},
+ permanent, 2000, worker, [ch]}
+ end,
+ Nos),
+ {ok, {SupFlags, Chs}}.
+
+start_phase(Phase, _Type, _Args) ->
+ (catch global:send(start_phase,{sp, Phase})),
+ ok.
diff --git a/lib/kernel/test/wrap_log_reader_SUITE.erl b/lib/kernel/test/wrap_log_reader_SUITE.erl
new file mode 100644
index 0000000000..1d1570fbd9
--- /dev/null
+++ b/lib/kernel/test/wrap_log_reader_SUITE.erl
@@ -0,0 +1,550 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(wrap_log_reader_SUITE).
+
+%-define(debug, true).
+
+-ifdef(debug).
+-define(format(S, A), io:format(S, A)).
+-define(line, put(line, ?LINE), ).
+-define(privdir(_), "./disk_log_SUITE_priv").
+-define(config(X,Y), foo).
+-define(t,test_server).
+-else.
+-include("test_server.hrl").
+-define(format(S, A), ok).
+-define(privdir(Conf), ?config(priv_dir, Conf)).
+-endif.
+
+-export([all/1,
+ no_file/1,
+ one/1, one_empty/1, one_filled/1,
+ two/1, two_filled/1,
+ four/1, four_filled/1,
+ wrap/1, wrap_filled/1,
+ wrapping/1,
+ external/1,
+ error/1]).
+
+-export([init_per_testcase/2, fin_per_testcase/2]).
+
+all(suite) ->
+ [no_file, one, two, four, wrap, wrapping, external, error].
+
+init_per_testcase(Func, Config) when atom(Func), list(Config) ->
+ Dog=?t:timetrap(?t:seconds(60)),
+ [{watchdog, Dog} | Config].
+
+fin_per_testcase(_Func, _Config) ->
+ Dog=?config(watchdog, _Config),
+ ?t:timetrap_cancel(Dog).
+
+no_file(suite) -> [];
+no_file(doc) -> ["No log file exists"];
+no_file(Conf) when list(Conf) ->
+ ?line code:add_path(?config(data_dir,Conf)),
+ Dir = ?privdir(Conf),
+ File = join(Dir, "sune.LOG"),
+ delete_files(File),
+ start(),
+
+ wlt ! {open, self(), File},
+ ?line rec({error, {index_file_not_found, File}}, ?LINE),
+ wlt ! {open, self(), File, 1},
+ ?line rec({error, {index_file_not_found, File}}, ?LINE),
+ wlt ! {open, self(), File, 4},
+ ?line rec({error, {index_file_not_found, File}}, ?LINE),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+one(suite) -> [one_empty, one_filled];
+one(doc) -> ["One index file"].
+
+one_empty(suite) -> [];
+one_empty(doc) -> ["One empty index file"];
+one_empty(Conf) when list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = join(Dir, "sune.LOG"),
+ delete_files(File),
+ start(),
+
+ ?line open(sune, File, ?LINE),
+ %% open
+ ?line do_chunk([{open,File}, eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,1}, eof], wlt, ?LINE),
+ wlt ! {open, self(), File, 2},
+ ?line rec({error, {file_not_found, add_ext(File, 2)}}, ?LINE),
+ ?line close(sune),
+
+ %% closed
+ ?line do_chunk([{open,File}, eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,1}, eof], wlt, ?LINE),
+ wlt ! {open, self(), File, 2},
+ ?line rec({error, {file_not_found, add_ext(File, 2)}}, ?LINE),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+one_filled(suite) -> [];
+one_filled(doc) -> ["One filled index file"];
+one_filled(Conf) when list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = join(Dir, "sune.LOG"),
+ delete_files(File),
+ start(),
+
+ ?line open(sune, File, ?LINE),
+ ?line log_terms(sune, ["first round, one", "first round, two"]),
+ ?line sync(sune),
+ %% open
+ test_one(File),
+ ?line close(sune),
+ %% closed
+ test_one(File),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+test_one(File) ->
+ ?line do_chunk([{open,File},
+ {chunk, ["first round, one", "first round, two"]},
+ eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,1},
+ {chunk, ["first round, one", "first round, two"]},
+ eof], wlt, ?LINE),
+ wlt ! {open, self(), File, 2},
+ ?line rec({error, {file_not_found, add_ext(File, 2)}}, ?LINE),
+ ?line do_chunk([{open,File,1}, {chunk, 1, ["first round, one"]},
+ {chunk, 1, ["first round, two"]}, eof], wlt, ?LINE),
+ ok.
+
+two(suite) -> [two_filled];
+two(doc) -> ["Two index files"].
+
+two_filled(suite) -> [];
+two_filled(doc) -> ["Two filled index files"];
+two_filled(Conf) when list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = list_to_atom(join(Dir, "sune.LOG")),
+ delete_files(File),
+ start(),
+
+ ?line open(sune, File, ?LINE),
+ ?line log_terms(sune, ["first round, 11", "first round, 12"]),
+ ?line log_terms(sune, ["first round, 21", "first round, 22"]),
+ ?line sync(sune),
+ %% open
+ test_two(File),
+ ?line close(sune),
+ %% closed
+ test_two(File),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+test_two(File) ->
+ ?line do_chunk([{open,File},
+ {chunk, infinity, ["first round, 11", "first round, 12"]},
+ {chunk, ["first round, 21", "first round, 22"]},
+ eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,1},
+ {chunk, ["first round, 11", "first round, 12"]},
+ eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,2},
+ {chunk, ["first round, 21", "first round, 22"]},
+ eof], wlt, ?LINE),
+ wlt ! {open, self(), File, 3},
+ ?line rec({error, {file_not_found, add_ext(File, 3)}}, ?LINE),
+ ?line do_chunk([{open,File,1}, {chunk, 1, ["first round, 11"]},
+ {chunk, 2, ["first round, 12"]}, eof], wlt, ?LINE),
+ ok.
+
+four(suite) -> [four_filled];
+four(doc) -> ["Four index files"].
+
+four_filled(suite) -> [];
+four_filled(doc) -> ["Four filled index files"];
+four_filled(Conf) when list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = join(Dir, "sune.LOG"),
+ delete_files(File),
+ start(),
+
+ ?line open(sune, File, ?LINE),
+ ?line init_files(0),
+ ?line sync(sune),
+ %% open
+ test_four(File),
+ ?line close(sune),
+ %% closed
+ test_four(File),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+test_four(File) ->
+ ?line do_chunk([{open,File},
+ {chunk, ["first round, 11", "first round, 12"]},
+ {chunk, ["first round, 21", "first round, 22"]},
+ {chunk, ["first round, 31", "first round, 32"]},
+ {chunk, ["first round, 41", "first round, 42"]},
+ eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,1},
+ {chunk, ["first round, 11", "first round, 12"]},
+ eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,4},
+ {chunk, ["first round, 41", "first round, 42"]},
+ eof], wlt, ?LINE),
+ wlt ! {open, self(), File, 5},
+ ?line rec({error, {file_not_found, add_ext(File, 5)}}, ?LINE),
+ ?line do_chunk([{open,File,1}, {chunk, 1, ["first round, 11"]},
+ {chunk, 2, ["first round, 12"]}, eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,4}, {chunk, 1, ["first round, 41"]},
+ {chunk, 2, ["first round, 42"]}, eof], wlt, ?LINE),
+ ok.
+
+wrap(suite) -> [wrap_filled];
+wrap(doc) -> ["Wrap index file, first wrapping"].
+
+wrap_filled(suite) -> [];
+wrap_filled(doc) -> ["First wrap, open, filled index file"];
+wrap_filled(Conf) when list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = join(Dir, "sune.LOG"),
+ delete_files(File),
+ start(),
+
+ ?line open(sune, File, ?LINE),
+ ?line init_files(0),
+ ?line log_terms(sune, ["second round, 11", "second round, 12"]),
+ ?line sync(sune),
+ %% open
+ test_wrap(File),
+ ?line close(sune),
+ %% closed
+ test_wrap(File),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+test_wrap(File) ->
+ ?line do_chunk([{open,File},
+ {chunk, ["first round, 21", "first round, 22"]},
+ {chunk, ["first round, 31", "first round, 32"]},
+ {chunk, ["first round, 41", "first round, 42"]},
+ {chunk, ["second round, 11", "second round, 12"]},
+ eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,1},
+ {chunk, ["second round, 11", "second round, 12"]},
+ eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,2},
+ {chunk, ["first round, 21", "first round, 22"]},
+ eof], wlt, ?LINE),
+ wlt ! {open, self(), File, 5},
+ ?line rec({error, {file_not_found, add_ext(File, 5)}}, ?LINE),
+ ?line do_chunk([{open,File,1}, {chunk, 1, ["second round, 11"]},
+ {chunk, 2, ["second round, 12"]}, eof], wlt, ?LINE),
+ ?line do_chunk([{open,File,4}, {chunk, 1, ["first round, 41"]},
+ {chunk, 2, ["first round, 42"]}, eof], wlt, ?LINE),
+ ok.
+
+wrapping(suite) -> [];
+wrapping(doc) -> ["Wrapping at the same time as reading"];
+wrapping(Conf) when list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = join(Dir, "sune.LOG"),
+ delete_files(File),
+ start(),
+
+ ?line open(sune, File, ?LINE),
+ ?line init_files(1100),
+ ?line sync(sune),
+ ?line C1 =
+ do_chunk([{open,File}, {chunk, 1, ["first round, 11"]}], wlt, ?LINE),
+ ?line log_terms(sune, ["second round, 11", "second round, 12"]),
+ ?line sync(sune),
+ ?line do_chunk([{chunk, 1, ["first round, 12"]},
+ %% Here two bad bytes are found.
+ {chunk, ["first round, 21", "first round, 22"]},
+ {chunk, ["first round, 31", "first round, 32"]},
+ {chunk, ["first round, 41", "first round, 42"]}, eof],
+ wlt, ?LINE, C1),
+ start(),
+ delete_files(File),
+ ?line open(sune, File, ?LINE),
+ ?line init_files(1100),
+ ?line sync(sune),
+ ?line C2 =
+ do_chunk([{open,File}, {chunk, 1, ["first round, 11"]}], wlt, ?LINE),
+ ?line log_terms(sune, ["second round, 11", "second round, 12"]),
+ ?line close(sune),
+ ?line do_chunk([{chunk, 1, ["first round, 12"]},
+ %% Here two bad bytes are found.
+ {chunk, ["first round, 21", "first round, 22"]},
+ {chunk, ["first round, 31", "first round, 32"]},
+ {chunk, ["first round, 41", "first round, 42"]}, eof],
+ wlt, ?LINE, C2),
+ start(),
+ delete_files(File),
+ ?line open(sune, File, ?LINE),
+ ?line init_files(1100),
+ ?line sync(sune),
+ ?line C3 = do_chunk([{open,File}], wlt, ?LINE),
+ ?line log_terms(sune, ["second round, 11"]),
+ ?line sync(sune),
+ ?line do_chunk([{chunk, 1, ["second round, 11"]},
+ {chunk, 1, ["first round, 21"]},
+ {chunk, 1, ["first round, 22"]},
+ {chunk, ["first round, 31", "first round, 32"]},
+ {chunk, ["first round, 41", "first round, 42"]}, eof],
+ wlt, ?LINE, C3),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+external(suite) -> [];
+external(doc) -> ["External format"];
+external(Conf) when list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = join(Dir, "sune.LOG"),
+ delete_files(File),
+ start(),
+
+ ?line open_ext(sune, File, ?FILE),
+ ?line init_files_ext(0),
+ ?line close(sune),
+ P0 = pps(),
+ wlt ! {open, self(), File},
+ ?line rec({error, {not_a_log_file, add_ext(File, 1)}}, ?LINE),
+ ?line true = (P0 == pps()),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+error(suite) -> [];
+error(doc) -> ["Error situations"];
+error(Conf) when list(Conf) ->
+ Dir = ?privdir(Conf),
+ File = join(Dir, "sune.LOG"),
+ delete_files(File),
+ start(),
+
+ P0 = pps(),
+ wlt ! {open, self(), File, 1},
+ ?line rec({error, {index_file_not_found, File}}, ?LINE),
+ wlt ! {open, self(), File},
+ ?line rec({error, {index_file_not_found, File}}, ?LINE),
+ ?line true = (P0 == pps()),
+
+ ?line open(sune, File, ?LINE),
+ ?line close(sune),
+ P1 = pps(),
+ ?line First = add_ext(File, 1),
+ ?line ok = file:delete(First),
+ wlt ! {open, self(), File},
+ ?line rec({error, {not_a_log_file, First}}, ?LINE),
+ ?line true = (P1 == pps()),
+
+ delete_files(File),
+ ?line open(sune, File, ?LINE),
+ ?line init_files(0),
+ ?line close(sune),
+ P2 = pps(),
+ ?line C = do_chunk([{open,File},
+ {chunk, ["first round, 11", "first round, 12"]}],
+ wlt, ?LINE),
+ ?line Second = add_ext(File, 2),
+ ?line ok = file:delete(Second),
+ wlt ! {chunk, self(), C},
+ ?line rec({error, {file_error, Second, {error, enoent}}}, ?LINE),
+ ?line ok = file:write_file(Second, <<17:(3*8)>>), % three bytes
+ wlt ! {chunk, self(), C},
+ ?line rec({error, {not_a_log_file, Second}}, ?LINE),
+ ?line do_chunk([close], wlt, ?LINE, C),
+ ?line true = (P2 == pps()),
+
+ delete_files(File),
+ ?line open(sune, File, ?LINE),
+ ?line init_files(0),
+ ?line close(sune),
+ P3 = pps(),
+ timer:sleep(1100),
+ Now = calendar:local_time(),
+ ?line ok = file:change_time(First, Now),
+ ?line C2 = do_chunk([{open,File},
+ {chunk, ["first round, 11", "first round, 12"]}],
+ wlt, ?LINE),
+ wlt ! {chunk, self(), C2},
+ ?line rec({error,{is_wrapped,First}}, ?LINE),
+ ?line do_chunk([close], wlt, ?LINE, C2),
+ IndexFile = add_ext(File, idx),
+ ?line ok = file:write_file(IndexFile, <<17:(3*8)>>),
+ wlt ! {open, self(), File, 1},
+ ?line rec({error, {index_file_not_found, File}}, ?LINE),
+ ?line true = (P3 == pps()),
+
+ stop(),
+ delete_files(File),
+ ok.
+
+start() ->
+ ?line ok = wrap_log_test:stop(),
+ dl_wait(),
+ ?line ok = wrap_log_test:init().
+
+stop() ->
+ ?line ok = wrap_log_test:stop(),
+ dl_wait().
+
+%% Give disk logs opened by 'logger' and 'wlt' time to close after
+%% receiving EXIT signals.
+dl_wait() ->
+ case disk_log:accessible_logs() of
+ {[], []} ->
+ ok;
+ _ ->
+ timer:sleep(100),
+ dl_wait()
+ end.
+
+delete_files(File) ->
+ file:delete(add_ext(File, idx)),
+ file:delete(add_ext(File, siz)),
+ file:delete(add_ext(File, 1)),
+ file:delete(add_ext(File, 2)),
+ file:delete(add_ext(File, 3)),
+ file:delete(add_ext(File, 4)),
+ ok.
+
+init_files(Delay) ->
+ ?line log_terms(sune, ["first round, 11", "first round, 12"]),
+ timer:sleep(Delay),
+ ?line log_terms(sune, ["first round, 21", "first round, 22"]),
+ timer:sleep(Delay),
+ ?line log_terms(sune, ["first round, 31", "first round, 32"]),
+ timer:sleep(Delay),
+ ?line log_terms(sune, ["first round, 41", "first round, 42"]),
+ timer:sleep(Delay),
+ ok.
+
+init_files_ext(Delay) ->
+ ?line blog_terms(sune, ["first round, 11", "first round, 12"]),
+ timer:sleep(Delay),
+ ?line blog_terms(sune, ["first round, 21", "first round, 22"]),
+ timer:sleep(Delay),
+ ?line blog_terms(sune, ["first round, 31", "first round, 32"]),
+ timer:sleep(Delay),
+ ?line blog_terms(sune, ["first round, 41", "first round, 42"]),
+ timer:sleep(Delay),
+ ok.
+
+join(A, B) ->
+ filename:nativename(filename:join(A, B)).
+
+do_chunk(Commands, Server, Where) ->
+ do_chunk(Commands, Server, Where, foo).
+
+do_chunk([{open, File, One} | Cs], S, W, _C) ->
+ S ! {open, self(), File, One},
+ ?line NC = rec1(ok, {W,?LINE}),
+ do_chunk(Cs, S, W, NC);
+do_chunk([{open, File} | Cs], S, W, _C) ->
+ S ! {open, self(), File},
+ ?line NC = rec1(ok, {W,?LINE}),
+ do_chunk(Cs, S, W, NC);
+do_chunk([{chunk, Terms} | Cs], S, W, C) ->
+ S ! {chunk, self(), C},
+ ?line NC = rec2(Terms, {W,?LINE}),
+ do_chunk(Cs, S, W, NC);
+do_chunk([{chunk, N, Terms} | Cs], S, W, C) ->
+ S ! {chunk, self(), C, N},
+ ?line NC = rec2(Terms, {W,?LINE}),
+ do_chunk(Cs, S, W, NC);
+do_chunk([eof], S, W, C) ->
+ S ! {chunk, self(), C},
+ ?line C1 = rec2(eof, {W,?LINE}),
+ do_chunk([close], S, W, C1);
+do_chunk([close], S, W, C) ->
+ S ! {close, self(), C},
+ ?line rec(ok, {W,?LINE});
+do_chunk([], _S, _W, C) ->
+ C.
+
+add_ext(Name, Ext) ->
+ lists:concat([Name, ".", Ext]).
+
+%% disk_log.
+open(Log, File, Where) ->
+ logger ! {open, self(), Log, File},
+ rec1(ok, Where).
+
+open_ext(Log, File, Where) ->
+ logger ! {open_ext, self(), Log, File},
+ rec1(ok, Where).
+
+close(Log) ->
+ logger ! {close, self(), Log},
+ rec(ok, ?LINE).
+
+sync(Log) ->
+ logger ! {sync, self(), Log},
+ rec(ok, ?LINE).
+
+log_terms(File, Terms) ->
+ logger ! {log_terms, self(), File, Terms},
+ rec(ok, ?LINE).
+
+blog_terms(File, Terms) ->
+ logger ! {blog_terms, self(), File, Terms},
+ rec(ok, ?LINE).
+
+rec1(M, Where) ->
+ receive
+ {M, C} -> C;
+ Else -> test_server:fail({error, {Where, Else}})
+ after 1000 -> test_server:fail({error, {Where, time_out}})
+ end.
+
+rec2(M, Where) ->
+ receive
+ {C, M} -> C;
+ Else -> test_server:fail({error, {Where, Else}})
+ after 1000 -> test_server:fail({error, {Where, time_out}})
+ end.
+
+rec(M, Where) ->
+ receive
+ M ->
+ ok;
+ Else -> ?t:fail({error, {Where, Else}})
+ after 1000 -> ?t:fail({error, {Where, time_out}})
+ end.
+
+pps() ->
+ {erlang:ports(), lists:filter({erlang, is_process_alive}, processes())}.
diff --git a/lib/kernel/test/wrap_log_reader_SUITE_data/Makefile.src b/lib/kernel/test/wrap_log_reader_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..4098cacfd2
--- /dev/null
+++ b/lib/kernel/test/wrap_log_reader_SUITE_data/Makefile.src
@@ -0,0 +1,7 @@
+EFLAGS=+debug_info
+
+all: wrap_log_test.@EMULATOR@
+
+wrap_log_test.@EMULATOR@: wrap_log_test.erl
+ erlc $(EFLAGS) wrap_log_test.erl
+
diff --git a/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl b/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl
new file mode 100644
index 0000000000..e5ff70fd49
--- /dev/null
+++ b/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl
@@ -0,0 +1,184 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%%----------------------------------------------------------------------
+%%% Purpose : Test wrap_log_reader.erl
+%%%----------------------------------------------------------------------
+
+-module(wrap_log_test).
+
+-export([init/0, stop/0]).
+-define(fsize, 80).
+-define(fno, 4).
+
+%-define(debug, true).
+
+-ifdef(debug).
+-define(format(S, A), io:format(S, A)).
+-else.
+-define(format(S, A), ok).
+-endif.
+
+init() ->
+ spawn(fun() -> start(logger) end),
+ spawn(fun() -> start2(wlt) end),
+ wait_registered(logger),
+ wait_registered(wlt),
+ ok.
+
+wait_registered(Name) ->
+ case whereis(Name) of
+ undefined ->
+ timer:sleep(100),
+ wait_registered(Name);
+ _Pid ->
+ ok
+ end.
+
+stop() ->
+ catch logger ! exit,
+ catch wlt ! exit,
+ wait_unregistered(logger),
+ wait_unregistered(wlt),
+ ok.
+
+wait_unregistered(Name) ->
+ case whereis(Name) of
+ undefined ->
+ ok;
+ _Pid ->
+ timer:sleep(100),
+ wait_unregistered(Name)
+ end.
+
+start(Name) ->
+ ?format("Starting ~p~n", [Name]),
+ register(Name, self()),
+ loop().
+
+start2(Name) ->
+ ?format("Starting ~p~n", [Name]),
+ register(Name, self()),
+ loop2(eof, Name).
+
+loop() ->
+ receive
+ {open, Pid, Name, File} ->
+ R = disk_log:open([{name, Name}, {type, wrap}, {file, File},
+ {size, {?fsize, ?fno}}]),
+ ?format("logger: open ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {open_ext, Pid, Name, File} ->
+ R = disk_log:open([{name, Name}, {type, wrap}, {file, File},
+ {format, external}, {size, {?fsize, ?fno}}]),
+ ?format("logger: open ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {close, Pid, Name} ->
+ R = disk_log:close(Name),
+ ?format("logger: close ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {sync, Pid, Name} ->
+ R = disk_log:sync(Name),
+ ?format("logger: sync ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {log_terms, Pid, Name, Terms} ->
+ R = disk_log:log_terms(Name, Terms),
+ ?format("logger: log_terms ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ {blog_terms, Pid, Name, Terms} ->
+ R = disk_log:blog_terms(Name, Terms),
+ ?format("logger: blog_terms ~p -> ~p~n", [Name, R]),
+ Pid ! R,
+ loop();
+
+ exit ->
+ ?format("Stopping logger~n", []),
+ exit(normal);
+
+ _Else ->
+ ?format("logger: ignored: ~p~n", [_Else]),
+ loop()
+ end.
+
+loop2(C, Wlt) ->
+ receive
+ {open, Pid, Name} ->
+ case wrap_log_reader:open(Name) of
+ {ok, R} ->
+ ?format("~p: open ~p -> ~p~n", [Wlt, Name, {ok, R}]),
+ Pid ! {ok, R},
+ loop2(R, Wlt);
+ E ->
+ ?format("~p: open ~p -> ~p~n", [Wlt, Name, E]),
+ Pid ! E,
+ loop2(C, Wlt)
+ end;
+
+ {open, Pid, Name, No} ->
+ case wrap_log_reader:open(Name, No) of
+ {ok, R} ->
+ ?format("~p: open ~p, file ~p -> ~p~n",
+ [Wlt, Name, No, {ok, R}]),
+ Pid ! {ok, R},
+ loop2(R, Wlt);
+ E ->
+ ?format("~p: open ~p, file ~p -> ~p~n",
+ [Wlt, Name, No, E]),
+ Pid ! E,
+ loop2(C, Wlt)
+ end;
+
+ {close, Pid, WR} ->
+ R = wrap_log_reader:close(WR),
+ ?format("~p: close -> ~p~n", [Wlt, R]),
+ Pid ! R,
+ loop2(eof, Wlt);
+
+ {chunk, Pid, WR} ->
+ did_chunk(wrap_log_reader:chunk(WR), Pid, Wlt);
+
+ {chunk, Pid, WR, N} ->
+ did_chunk(wrap_log_reader:chunk(WR, N), Pid, Wlt);
+
+ exit ->
+ ?format("Stopping ~p~n", [Wlt]),
+ exit(normal);
+
+ _Else ->
+ ?format("~p: ignored: ~p~n", [Wlt, _Else]),
+ loop2(C, Wlt)
+ end.
+
+did_chunk({C1, L}, Pid, Wlt) ->
+ ?format("~p: chunk -> ~p~n", [Wlt, {C1, L}]),
+ Pid ! {C1, L},
+ loop2(C1, Wlt);
+did_chunk({C1, L, _Bad}, Pid, Wlt) ->
+ ?format("~p: chunk -> ~p (bad)~n", [Wlt, {C1, L, _Bad}]),
+ Pid ! {C1, L},
+ loop2(C1, Wlt).
diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl
new file mode 100644
index 0000000000..f20c9a176b
--- /dev/null
+++ b/lib/kernel/test/zlib_SUITE.erl
@@ -0,0 +1,1004 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(zlib_SUITE).
+
+-include("test_server.hrl").
+
+-compile(export_all).
+
+-define(error(Format,Args),
+ put(test_server_loc,{?MODULE,?LINE}),
+ error(Format,Args,?MODULE,?LINE)).
+
+%% Learn erts team how to really write tests ;-)
+-define(m(ExpectedRes,Expr),
+ fun() ->
+ ACtual1 = (catch (Expr)),
+ try case ACtual1 of
+ ExpectedRes -> ACtual1
+ end
+ catch
+ error:{case_clause,ACtuAl} ->
+ ?error("Not Matching Actual result was:~n ~p ~n",
+ [ACtuAl]),
+ ACtuAl
+ end
+ end()).
+
+-define(BARG, {'EXIT',{badarg,[{zlib,_,_}|_]}}).
+-define(DATA_ERROR, {'EXIT',{data_error,[{zlib,_,_}|_]}}).
+
+init_per_testcase(_Func, Config) ->
+ Dog = test_server:timetrap(test_server:seconds(60)),
+ [{watchdog, Dog}|Config].
+fin_per_testcase(_Func, Config) ->
+ Dog = ?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+error(Format, Args, File, Line) ->
+ io:format("~p:~p: ERROR: " ++ Format, [File,Line|Args]),
+ group_leader() ! {failed, File, Line}.
+
+%% Hopefully I don't need this to get it to work with the testserver..
+%% Fail = #'REASON'{file = filename:basename(File),
+%% line = Line,
+%% desc = Args},
+%% case global:whereis_name(mnesia_test_case_sup) of
+%% undefined ->
+%% ignore;
+%% Pid ->
+%% Pid ! Fail
+%% %% global:send(mnesia_test_case_sup, Fail),
+%% end,
+%% log("<>ERROR<>~n" ++ Format, Args, File, Line).
+
+all(suite) ->
+ [api, examples, func, smp, otp_7359].
+
+api(doc) -> "Basic the api tests";
+api(suite) ->
+ [api_open_close,
+ api_deflateInit,
+ api_deflateSetDictionary,
+ api_deflateReset,
+ api_deflateParams,
+ api_deflate,
+ api_deflateEnd,
+ api_inflateInit,
+ api_inflateSetDictionary,
+ api_inflateSync,
+ api_inflateReset,
+ api_inflate,
+ api_inflateEnd,
+ api_setBufsz,
+ api_getBufsz,
+ api_crc32,
+ api_adler32,
+ api_getQSize,
+ api_un_compress,
+ api_un_zip,
+% api_g_un_zip_file,
+ api_g_un_zip].
+
+api_open_close(doc) -> "Test open/0 and close/1";
+api_open_close(suite) -> [];
+api_open_close(Config) when is_list(Config) ->
+ ?line Fd1 = zlib:open(),
+ ?line Fd2 = zlib:open(),
+ ?m(false,Fd1 == Fd2),
+ ?m(ok,zlib:close(Fd1)),
+ ?m(?BARG, zlib:close(Fd1)),
+ ?m(ok,zlib:close(Fd2)),
+
+ %% Make sure that we don't get any EXIT messages if trap_exit is enabled.
+ ?line process_flag(trap_exit, true),
+ ?line Fd3 = zlib:open(),
+ ?m(ok,zlib:close(Fd3)),
+ receive
+ Any -> ?line ?t:fail({unexpected_message,Any})
+ after 10 -> ok
+ end.
+
+api_deflateInit(doc) -> "Test deflateInit/2 and /6";
+api_deflateInit(suite) -> [];
+api_deflateInit(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(?BARG, zlib:deflateInit(gurka, none)),
+ ?m(?BARG, zlib:deflateInit(gurka, gurka)),
+ ?m(?BARG, zlib:deflateInit(Z1, gurka)),
+ Levels = [none, default, best_speed, best_compression] ++ lists:seq(0,9),
+ lists:foreach(fun(Level) ->
+ ?line Z = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z, Level)),
+ ?m(ok,zlib:close(Z))
+ end, Levels),
+ %% /6
+ ?m(?BARG, zlib:deflateInit(Z1,gurka,deflated,-15,8,default)),
+
+ ?m(?BARG, zlib:deflateInit(Z1,default,undefined,-15,8,default)),
+
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,48,8,default)),
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-20,8,default)),
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-7,8,default)),
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,7,8,default)),
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-8,8,default)),
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,8,8,default)),
+
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,0,default)),
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,10,default)),
+
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,8,0)),
+ ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,8,undefined)),
+
+ lists:foreach(fun(Level) ->
+ ?line Z = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z, Level, deflated, -15, 8, default)),
+ ?m(ok,zlib:close(Z))
+ end, Levels),
+
+ lists:foreach(fun(Wbits) ->
+ ?line Z11 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z11,best_compression,deflated,
+ Wbits,8,default)),
+ ?line Z12 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z12,default,deflated,-Wbits,8,default)),
+ ?m(ok,zlib:close(Z11)),
+ ?m(ok,zlib:close(Z12))
+ end, lists:seq(9, 15)),
+
+ lists:foreach(fun(MemLevel) ->
+ ?line Z = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z,default,deflated,-15,
+ MemLevel,default)),
+ ?m(ok,zlib:close(Z))
+ end, lists:seq(1,8)),
+
+ Strategies = [filtered,huffman_only,default],
+ lists:foreach(fun(Strategy) ->
+ ?line Z = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z,best_speed,deflated,-15,8,Strategy)),
+ ?m(ok,zlib:close(Z))
+ end, Strategies),
+ ?m(ok, zlib:deflateInit(Z1,default,deflated,-15,8,default)),
+ ?m({'EXIT',_}, zlib:deflateInit(Z1,none,deflated,-15,8,default)), %% ??
+ ?m(ok, zlib:close(Z1)).
+
+api_deflateSetDictionary(doc) -> "Test deflateSetDictionary";
+api_deflateSetDictionary(suite) -> [];
+api_deflateSetDictionary(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z1, default)),
+ ?m(Id when is_integer(Id), zlib:deflateSetDictionary(Z1, <<1,1,2,3,4,5,1>>)),
+ ?m(Id when is_integer(Id), zlib:deflateSetDictionary(Z1, [1,1,2,3,4,5,1])),
+ ?m(?BARG, zlib:deflateSetDictionary(Z1, gurka)),
+ ?m(?BARG, zlib:deflateSetDictionary(Z1, 128)),
+ ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)),
+ ?m({'EXIT',{stream_error,_}},zlib:deflateSetDictionary(Z1,<<1,1,2,3,4,5,1>>)),
+ ?m(ok, zlib:close(Z1)).
+
+api_deflateReset(doc) -> "Test deflateReset";
+api_deflateReset(suite) -> [];
+api_deflateReset(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z1, default)),
+ ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)),
+ ?m(ok, zlib:deflateReset(Z1)),
+ ?m(ok, zlib:deflateReset(Z1)),
+ %% FIXME how do I make this go wrong??
+ ?m(ok, zlib:close(Z1)).
+
+api_deflateParams(doc) -> "Test deflateParams";
+api_deflateParams(suite) -> [];
+api_deflateParams(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z1, default)),
+ ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)),
+ ?m(ok, zlib:deflateParams(Z1, best_compression, huffman_only)),
+ ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, sync)),
+ ?m({'EXIT',_}, zlib:deflateParams(Z1,best_speed, filtered)),
+ ?m(ok, zlib:close(Z1)).
+
+api_deflate(doc) -> "Test deflate";
+api_deflate(suite) -> [];
+api_deflate(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z1, default)),
+ ?m([B] when is_binary(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, finish)),
+ ?m(ok, zlib:deflateReset(Z1)),
+ ?m([B] when is_binary(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, finish)),
+ ?m(ok, zlib:deflateReset(Z1)),
+ ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>)),
+ ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)),
+ ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, sync)),
+ ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, full)),
+ ?m(B when is_list(B), zlib:deflate(Z1, <<>>, finish)),
+
+ ?m(?BARG, zlib:deflate(gurka, <<1,1,1,1,1,1,1,1,1>>, full)),
+ ?m(?BARG, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, asdj)),
+ ?m(?BARG, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, 198)),
+ %% Causes problems ERROR REPORT
+ ?m(?BARG, zlib:deflate(Z1, [asdj,asd], none)),
+
+ ?m(ok, zlib:close(Z1)).
+
+api_deflateEnd(doc) -> "Test deflateEnd";
+api_deflateEnd(suite) -> [];
+api_deflateEnd(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z1, default)),
+ ?m(ok, zlib:deflateEnd(Z1)),
+ ?m({'EXIT', {einval,_}}, zlib:deflateEnd(Z1)), %% ??
+ ?m(?BARG, zlib:deflateEnd(gurka)),
+ ?m(ok, zlib:deflateInit(Z1, default)),
+ ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>)),
+ ?m({'EXIT', {data_error,_}}, zlib:deflateEnd(Z1)),
+ ?m(ok, zlib:deflateInit(Z1, default)),
+ ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>)),
+ ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>, finish)),
+ ?m(ok, zlib:deflateEnd(Z1)),
+
+ ?m(ok, zlib:close(Z1)).
+
+api_inflateInit(doc) -> "Test inflateInit /1 and /2";
+api_inflateInit(suite) -> [];
+api_inflateInit(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(?BARG, zlib:inflateInit(gurka)),
+ ?m(ok, zlib:inflateInit(Z1)),
+ ?m({'EXIT',{einval,_}}, zlib:inflateInit(Z1, 15)), %% ??
+ lists:foreach(fun(Wbits) ->
+ ?line Z11 = zlib:open(),
+ ?m(ok, zlib:inflateInit(Z11,Wbits)),
+ ?line Z12 = zlib:open(),
+ ?m(ok, zlib:inflateInit(Z12,-Wbits)),
+ ?m(ok,zlib:close(Z11)),
+ ?m(ok,zlib:close(Z12))
+ end, lists:seq(9,15)),
+ ?m(?BARG, zlib:inflateInit(gurka, -15)),
+ ?m(?BARG, zlib:inflateInit(Z1, 7)),
+ ?m(?BARG, zlib:inflateInit(Z1, -7)),
+ ?m(?BARG, zlib:inflateInit(Z1, 48)),
+ ?m(?BARG, zlib:inflateInit(Z1, -16)),
+ ?m(ok, zlib:close(Z1)).
+
+api_inflateSetDictionary(doc) -> "Test inflateSetDictionary";
+api_inflateSetDictionary(suite) -> [];
+api_inflateSetDictionary(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:inflateInit(Z1)),
+ ?m(?BARG, zlib:inflateSetDictionary(gurka,<<1,1,1,1,1>>)),
+ ?m(?BARG, zlib:inflateSetDictionary(Z1,102)),
+ ?m(?BARG, zlib:inflateSetDictionary(Z1,gurka)),
+ Dict = <<1,1,1,1,1>>,
+ ?m({'EXIT',{stream_error,_}}, zlib:inflateSetDictionary(Z1,Dict)),
+ ?m(ok, zlib:close(Z1)).
+
+api_inflateSync(doc) -> "Test inflateSync";
+api_inflateSync(suite) -> [];
+api_inflateSync(Config) when is_list(Config) ->
+ {skip,"inflateSync/1 sucks"}.
+%% ?line Z1 = zlib:open(),
+%% ?m(ok, zlib:deflateInit(Z1)),
+%% ?line B1list0 = zlib:deflate(Z1, "gurkan gurra ger galna tunnor", full),
+%% ?line B2 = zlib:deflate(Z1, "grodan boll", finish),
+%% io:format("~p\n", [B1list0]),
+%% io:format("~p\n", [B2]),
+%% ?m(ok, zlib:deflateEnd(Z1)),
+%% ?line B1 = clobber(14, list_to_binary(B1list0)),
+%% ?line Compressed = list_to_binary([B1,B2]),
+%% ?line io:format("~p\n", [Compressed]),
+
+%% ?m(ok, zlib:inflateInit(Z1)),
+%% ?m(?BARG, zlib:inflateSync(gurka)),
+%% ?m({'EXIT',{data_error,_}}, zlib:inflate(Z1, Compressed)),
+%% ?m(ok, zlib:inflateSync(Z1)),
+%% ?line Ubs = zlib:inflate(Z1, []),
+%% ?line <<"grodan boll">> = list_to_binary(Ubs),
+%% ?m(ok, zlib:close(Z1)).
+
+clobber(N, Bin) when is_binary(Bin) ->
+ T = list_to_tuple(binary_to_list(Bin)),
+ Byte = case element(N, T) of
+ 255 -> 254;
+ B -> B+1
+ end,
+ list_to_binary(tuple_to_list(setelement(N, T, Byte))).
+
+api_inflateReset(doc) -> "Test inflateReset";
+api_inflateReset(suite) -> [];
+api_inflateReset(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:inflateInit(Z1)),
+ ?m(?BARG, zlib:inflateReset(gurka)),
+ ?m(ok, zlib:inflateReset(Z1)),
+ ?m(ok, zlib:close(Z1)).
+
+api_inflate(doc) -> "Test inflate";
+api_inflate(suite) -> [];
+api_inflate(Config) when is_list(Config) ->
+ Data = [<<1,2,2,3,3,3,4,4,4,4>>],
+ ?line Compressed = zlib:compress(Data),
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:inflateInit(Z1)),
+ ?m([], zlib:inflate(Z1, <<>>)),
+ ?m(Data, zlib:inflate(Z1, Compressed)),
+ ?m(ok, zlib:inflateEnd(Z1)),
+ ?m(ok, zlib:inflateInit(Z1)),
+ ?m(Data, zlib:inflate(Z1, Compressed)),
+ ?m(?BARG, zlib:inflate(gurka, Compressed)),
+ ?m(?BARG, zlib:inflate(Z1, 4384)),
+ ?m(?BARG, zlib:inflate(Z1, [atom_list])),
+ ?m(ok, zlib:inflateEnd(Z1)),
+ ?m(ok, zlib:inflateInit(Z1)),
+ ?m({'EXIT',{data_error,_}}, zlib:inflate(Z1, <<2,1,2,1,2>>)),
+ ?m(ok, zlib:close(Z1)).
+
+api_inflateEnd(doc) -> "Test inflateEnd";
+api_inflateEnd(suite) -> [];
+api_inflateEnd(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m({'EXIT',{einval,_}}, zlib:inflateEnd(Z1)),
+ ?m(ok, zlib:inflateInit(Z1)),
+ ?m(?BARG, zlib:inflateEnd(gurka)),
+ ?m({'EXIT',{data_error,_}}, zlib:inflateEnd(Z1)),
+ ?m({'EXIT',{einval,_}}, zlib:inflateEnd(Z1)),
+ ?m(ok, zlib:inflateInit(Z1)),
+ ?m(B when is_list(B), zlib:inflate(Z1, zlib:compress("abc"))),
+ ?m(ok, zlib:inflateEnd(Z1)),
+ ?m(ok, zlib:close(Z1)).
+
+api_getBufsz(doc) -> "Test getBufsz";
+api_getBufsz(suite) -> [];
+api_getBufsz(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(Val when is_integer(Val), zlib:getBufSize(Z1)),
+ ?m(?BARG, zlib:getBufSize(gurka)),
+ ?m(ok, zlib:close(Z1)).
+
+api_setBufsz(doc) -> "Test setBufsz";
+api_setBufsz(suite) -> [];
+api_setBufsz(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(?BARG, zlib:setBufSize(Z1, gurka)),
+ ?m(?BARG, zlib:setBufSize(gurka, 1232330)),
+ Sz = ?m( Val when is_integer(Val), zlib:getBufSize(Z1)),
+ ?m(ok, zlib:setBufSize(Z1, Sz*2)),
+ DSz = Sz*2,
+ ?m(DSz, zlib:getBufSize(Z1)),
+ ?m(ok, zlib:close(Z1)).
+
+%%% Debug function ??
+api_getQSize(doc) -> "Test getQSize";
+api_getQSize(suite) -> [];
+api_getQSize(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ Q = ?m(Val when is_integer(Val), zlib:getQSize(Z1)),
+ io:format("QSize ~p ~n", [Q]),
+ ?m(?BARG, zlib:getQSize(gurka)),
+ ?m(ok, zlib:close(Z1)).
+
+api_crc32(doc) -> "Test crc32";
+api_crc32(suite) -> [];
+api_crc32(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z1,best_speed,deflated,-15,8,default)),
+ Bin = <<1,1,1,1,1,1,1,1,1>>,
+ Compressed1 = ?m(_, zlib:deflate(Z1, Bin, none)),
+ Compressed2 = ?m(_, zlib:deflate(Z1, <<>>, finish)),
+ Compressed = list_to_binary(Compressed1 ++ Compressed2),
+ CRC1 = ?m( CRC1 when is_integer(CRC1), zlib:crc32(Z1)),
+ ?m(CRC1 when is_integer(CRC1), zlib:crc32(Z1,Bin)),
+ ?m(CRC2 when is_integer(CRC2), zlib:crc32(Z1,Compressed)),
+ CRC2 = ?m(CRC2 when is_integer(CRC2), zlib:crc32(Z1,0,Compressed)),
+ ?m(CRC3 when CRC2 /= CRC3, zlib:crc32(Z1,234,Compressed)),
+ ?m(?BARG, zlib:crc32(gurka)),
+ ?m(?BARG, zlib:crc32(Z1, not_a_binary)),
+ ?m(?BARG, zlib:crc32(gurka, <<1,1,2,4,4>>)),
+ ?m(?BARG, zlib:crc32(Z1, 2298929, not_a_binary)),
+ ?m(?BARG, zlib:crc32(Z1, not_an_int, <<123,123,123,35,231>>)),
+ ?m(?BARG, zlib:crc32_combine(Z1, not_an_int, 123123, 123)),
+ ?m(?BARG, zlib:crc32_combine(Z1, noint, 123123, 123)),
+ ?m(?BARG, zlib:crc32_combine(Z1, 123123, noint, 123)),
+ ?m(?BARG, zlib:crc32_combine(Z1, 123123, 123, noint)),
+ ?m(ok, zlib:deflateEnd(Z1)),
+ ?m(ok, zlib:close(Z1)).
+
+api_adler32(doc) -> "Test adler32";
+api_adler32(suite) -> [];
+api_adler32(Config) when is_list(Config) ->
+ ?line Z1 = zlib:open(),
+ ?m(ok, zlib:deflateInit(Z1,best_speed,deflated,-15,8,default)),
+ Bin = <<1,1,1,1,1,1,1,1,1>>,
+ Compressed1 = ?m(_, zlib:deflate(Z1, Bin, none)),
+ Compressed2 = ?m(_, zlib:deflate(Z1, <<>>, finish)),
+ Compressed = list_to_binary(Compressed1 ++ Compressed2),
+ ?m(ADLER1 when is_integer(ADLER1), zlib:adler32(Z1,Bin)),
+ ADLER2 = ?m(ADLER2 when is_integer(ADLER2), zlib:adler32(Z1,Compressed)),
+ ?m(ADLER2 when is_integer(ADLER2), zlib:adler32(Z1,1,Compressed)),
+ ?m(ADLER3 when ADLER2 /= ADLER3, zlib:adler32(Z1,234,Compressed)),
+ ?m(?BARG, zlib:adler32(Z1, not_a_binary)),
+ ?m(?BARG, zlib:adler32(gurka, <<1,1,2,4,4>>)),
+ ?m(?BARG, zlib:adler32(Z1, 2298929, not_a_binary)),
+ ?m(?BARG, zlib:adler32(Z1, not_an_int, <<123,123,123,35,231>>)),
+ ?m(?BARG, zlib:adler32_combine(Z1, noint, 123123, 123)),
+ ?m(?BARG, zlib:adler32_combine(Z1, 123123, noint, 123)),
+ ?m(?BARG, zlib:adler32_combine(Z1, 123123, 123, noint)),
+ ?m(ok, zlib:deflateEnd(Z1)),
+ ?m(ok, zlib:close(Z1)).
+
+api_un_compress(doc) -> "Test compress";
+api_un_compress(suite) -> [];
+api_un_compress(Config) when is_list(Config) ->
+ ?m(?BARG,zlib:compress(not_a_binary)),
+ Bin = <<1,11,1,23,45>>,
+ ?line Comp = zlib:compress(Bin),
+ ?m(?BARG,zlib:uncompress(not_a_binary)),
+ ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<171,171,171,171,171>>)),
+ ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<>>)),
+ ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120>>)),
+ ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156>>)),
+ ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156,3>>)),
+ ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156,3,0>>)),
+ ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<0,156,3,0,0,0,0,1>>)),
+ ?m(Bin, zlib:uncompress(Comp)).
+
+api_un_zip(doc) -> "Test zip";
+api_un_zip(suite) -> [];
+api_un_zip(Config) when is_list(Config) ->
+ ?m(?BARG,zlib:zip(not_a_binary)),
+ Bin = <<1,11,1,23,45>>,
+ ?line Comp = zlib:zip(Bin),
+ ?m(?BARG,zlib:unzip(not_a_binary)),
+ ?m({'EXIT',{data_error,_}}, zlib:unzip(<<171,171,171,171,171>>)),
+ ?m({'EXIT',{data_error,_}}, zlib:unzip(<<>>)),
+ ?m(Bin, zlib:unzip(Comp)),
+
+ %% OTP-6396
+ B = <<131,104,19,100,0,13,99,95,99,105,100,95,99,115,103,115,110,95,50,97,1,107,0,4,208,161,246,29,107,0,3,237,166,224,107,0,6,66,240,153,0,2,10,1,0,8,97,116,116,97,99,104,101,100,104,2,100,0,22,117,112,100,97,116,101,95,112,100,112,95,99,111,110,116,101,120,116,95,114,101,113,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,197,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,5,0,33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,1,114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4,103,112,114,115,8,0,104,2,104,2,100,0,8,97,99,116,105,118,97,116,101,104,23,100,0,11,112,100,112,95,99,111,110,116,1,120,116,100,0,7,112,114,105,109,97,114,121,97,1,100,0,9,117,110,100,101,102,105,110,101,100,97,1,97,4,97,4,97,7,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,10100,100,0,9,117,110,100,101,102,105,110,101,100,100,0,5,102,97,108,115,101,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,1,101,100,97,0,100,0,9,117,110,100,101,102,105,110,101,100,107,0,4,16,0,1,144,107,0,4,61,139,186,181,107,0,4,10,8,201,49,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,0,101,100,100,0,9,117,110,100,101,102,105,110,101,100,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,21,106,108,0,0,0,3,104,2,97,1,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,167,20,104,2,97,4,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,21,104,2,97,10,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,26,106,100,0,5,118,101,114,57,57,100,0,9,117,110,0,101,102,105,110,101,100,107,0,2,0,244,107,0,4,10,6,102,195,107,0,4,10,6,102,195,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,107,0,125,248,143,0,203,25115,157,116,65,185,65,172,55,87,164,88,225,50,203,251,115,157,116,65,185,65,172,55,87,164,88,225,50,0,0,82,153,50,0,200,98,87,148,237,193,185,65,149,167,69,144,14,16,153,50,3,81,70,94,13,109,193,1,120,5,181,113,198,118,50,3,81,70,94,13,109,193,185,120,5,181,113,198,118,153,3,81,70,94,13,109,193,185,120,5,181,113,198,118,153,50,16,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,113,92,2,119,128,0,0,108,0,0,1,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,11,97,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,0,33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,101,114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4,103,112,114,115,8,0,106>>,
+ Z = zlib:zip(B),
+ ?m(B, zlib:unzip(Z)).
+
+%% api_g_un_zip_file(doc) -> "Test gunzip_file";
+%% api_g_un_zip_file(suite) -> [];
+%% api_g_un_zip_file(Config) when is_list(Config) ->
+%% ?line Out = conf(data_dir,Config),
+%% io:format("Using OutDir ~p ~n", [Out]),
+%% F = filename:join(Out,"testing1"),
+%% Data = <<1,1,255,255,255,1,1>>,
+%% ?m(ok, file:write_file(F,Data)),
+%% ?line Compressed = zlib:gzip_file(F),
+%% ?m(ok, file:write_file(F++".gz",Compressed)),
+%% ?m(Data, zlib:gunzip_file(F++".gz")),
+%% ?m({error,enoent}, zlib:gunzip_file(gurka)),
+%% ?m({error,enoent}, zlib:gzip_file(gurka)),
+%% ?m({error,what}, zlib:gunzip_file(F)),
+%% ?line ok.
+
+api_g_un_zip(doc) -> "Test gunzip";
+api_g_un_zip(suite) -> [];
+api_g_un_zip(Config) when is_list(Config) ->
+ ?m(?BARG,zlib:gzip(not_a_binary)),
+ Bin = <<1,11,1,23,45>>,
+ ?line Comp = zlib:gzip(Bin),
+ ?m(?BARG, zlib:gunzip(not_a_binary)),
+ ?m(?DATA_ERROR, zlib:gunzip(<<171,171,171,171,171>>)),
+ ?m(?DATA_ERROR, zlib:gunzip(<<>>)),
+ ?m(Bin, zlib:gunzip(Comp)),
+
+ %% Bad CRC; bad length.
+ BadCrc = bad_crc_data(),
+ ?line ?m({'EXIT',{data_error,_}},(catch zlib:gunzip(BadCrc))),
+ BadLen = bad_len_data(),
+ ?line ?m({'EXIT',{data_error,_}},(catch zlib:gunzip(BadLen))),
+ ok.
+
+bad_crc_data() ->
+ %% zlib:zip(<<42>>), one byte changed.
+ <<31,139,8,0,0,0,0,0,0,3,211,2,0,91,39,185,9,1,0,0,0>>.
+
+bad_len_data() ->
+ %% zlib:zip(<<42>>), one byte changed.
+ <<31,139,8,0,0,0,0,0,0,3,211,2,0,91,38,185,9,2,0,0,0>>.
+
+examples(doc) -> "Test the doc examples";
+examples(suite) ->
+ [
+ intro
+ ].
+
+intro(suite) -> [];
+intro(doc) -> "";
+intro(Config) when is_list(Config) ->
+ D = <<"This is a binary">>,
+ [put({ex, N}, <<"This is a binary">>) || N <- [0,1,2,3,4]],
+ put({ex, 5}, end_of_data),
+ put(ex,0),
+ ?line Read = fun() ->
+ N = get(ex),
+ put(ex,N+1),
+ get({ex,N})
+ end,
+
+ ?line Z = zlib:open(),
+ ?line ok = zlib:deflateInit(Z,default),
+
+ ?line Compress = fun(end_of_data, _Cont) -> [];
+ (Data, Cont) ->
+ [zlib:deflate(Z, Data)|Cont(Read(),Cont)]
+ end,
+ ?line Compressed = Compress(Read(),Compress),
+ ?line Last = zlib:deflate(Z, [], finish),
+ ?line ok = zlib:deflateEnd(Z),
+ ?line zlib:close(Z),
+ ?line Res = list_to_binary([Compressed|Last]),
+ Orig = list_to_binary(lists:duplicate(5, D)),
+ ?m(Orig, zlib:uncompress(Res)).
+
+func(doc) -> "Test the functionality";
+func(suite) ->
+ [zip_usage, gz_usage, gz_usage2, compress_usage,
+ dictionary_usage,
+ large_deflate,
+ %% inflateSync,
+ crc,
+ adler
+ ].
+
+large_deflate(doc) -> "Test deflate large file, which had a bug reported on erlang-bugs";
+large_deflate(suite) -> [];
+large_deflate(Config) when is_list(Config) ->
+ large_deflate().
+large_deflate() ->
+ ?line Z = zlib:open(),
+ ?line Plain = rand_bytes(zlib:getBufSize(Z)*5),
+ ?line ok = zlib:deflateInit(Z),
+ ?line _ZlibHeader = zlib:deflate(Z, [], full),
+ ?line Deflated = zlib:deflate(Z, Plain, full),
+ ?m(ok, zlib:close(Z)),
+ ?m(Plain, zlib:unzip(list_to_binary([Deflated, 3, 0]))).
+
+rand_bytes(Sz) ->
+ L = <<8,2,3,6,1,2,3,2,3,4,8,7,3,7,2,3,4,7,5,8,9,3>>,
+ rand_bytes(erlang:md5(L),Sz).
+
+rand_bytes(Bin, Sz) when byte_size(Bin) >= Sz ->
+ <<Res:Sz/binary, _/binary>> = Bin,
+ Res;
+rand_bytes(Bin, Sz) ->
+ rand_bytes(<<(erlang:md5(Bin))/binary, Bin/binary>>, Sz).
+
+
+zip_usage(doc) -> "Test a standard compressed zip file";
+zip_usage(suite) -> [];
+zip_usage(Config) when is_list(Config) ->
+ zip_usage(zip_usage({get_arg,Config}));
+zip_usage({get_arg,Config}) ->
+ ?line Out = conf(data_dir,Config),
+ ?line {ok,ZIP} = file:read_file(filename:join(Out,"zipdoc.zip")),
+ ?line {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")),
+ {run,ZIP,ORIG};
+zip_usage({run,ZIP,ORIG}) ->
+ ?line <<_:14/binary, CRC:32/little,
+ CompSz:32/little, UnCompSz:32/little,_:31/binary,
+ Compressed:CompSz/binary, _/binary>> = ZIP,
+
+ %%io:format("CRC ~p CSz ~p UnCSz ~p ~n", [CRC,CompSz,UnCompSz]),
+ ?line Split = split_bin(Compressed,[]),
+ ?line Z = zlib:open(),
+
+ ?m(ok, zlib:inflateInit(Z, -15)),
+ Bs = [zlib:inflate(Z, Part) || Part <- Split],
+ UC0 = list_to_binary(Bs),
+ ?m(UnCompSz, byte_size(UC0)),
+ ?m(CRC, zlib:crc32(Z)),
+ ?m(true, zlib:crc32(Z,UC0) == zlib:crc32(Z,ORIG)),
+ ?m(ok, zlib:inflateEnd(Z)),
+
+ ?line UC1 = zlib:unzip(Compressed),
+ ?m(UnCompSz, byte_size(UC1)),
+ ?m(true, zlib:crc32(Z,UC1) == zlib:crc32(Z,ORIG)),
+
+ ?m(ok, zlib:inflateInit(Z, -15)),
+ ?line UC2 = zlib:inflate(Z, Compressed),
+ ?m(UnCompSz, byte_size(list_to_binary(UC2))),
+ ?m(CRC, zlib:crc32(Z)),
+ ?m(true, zlib:crc32(Z,UC2) == zlib:crc32(Z,ORIG)),
+ ?m(ok, zlib:inflateEnd(Z)),
+
+ ?m(ok, zlib:inflateInit(Z, -15)),
+ ?line UC3 = zlib:inflate(Z, Split), % Test multivec.
+ ?m(UnCompSz, byte_size(list_to_binary(UC3))),
+ ?m(true, zlib:crc32(Z,UC3) == zlib:crc32(Z,ORIG)),
+ ?m(CRC, zlib:crc32(Z)),
+ ?m(ok, zlib:inflateEnd(Z)),
+
+ ?m(ok, zlib:inflateInit(Z, -15)),
+ ?m(ok, zlib:setBufSize(Z, UnCompSz *2)),
+ ?line UC4 = zlib:inflate(Z, Compressed),
+ ?m(UnCompSz, byte_size(list_to_binary(UC4))),
+ ?m(CRC, zlib:crc32(Z)),
+ ?m(CRC, zlib:crc32(Z,UC4)),
+ ?m(true, zlib:crc32(Z,UC4) == zlib:crc32(Z,ORIG)),
+ ?m(ok, zlib:inflateEnd(Z)),
+
+ ?line C1 = zlib:zip(ORIG),
+ ?line UC5 = zlib:unzip(C1),
+ ?m(CRC, zlib:crc32(Z,UC5)),
+ ?m(true,zlib:crc32(Z,UC5) == zlib:crc32(Z,ORIG)),
+
+ ?m(ok, zlib:deflateInit(Z, default, deflated, -15, 8, default)),
+ ?line C2 = zlib:deflate(Z, ORIG, finish),
+ ?m(true, C1 == list_to_binary(C2)),
+ ?m(ok, zlib:deflateEnd(Z)),
+
+ ?m(ok, zlib:deflateInit(Z, none, deflated, -15, 8, filtered)),
+ ?m(ok, zlib:deflateParams(Z, default, default)),
+ ?line C3 = zlib:deflate(Z, ORIG, finish),
+ ?m(true, C1 == list_to_binary(C3)),
+ ?m(ok, zlib:deflateEnd(Z)),
+
+ ?line ok = zlib:close(Z),
+ ?line ok.
+
+gz_usage(doc) -> "Test a standard compressed gzipped file";
+gz_usage(suite) -> [];
+gz_usage(Config) when is_list(Config) ->
+ gz_usage(gz_usage({get_arg,Config}));
+gz_usage({get_arg,Config}) ->
+ ?line Out = conf(data_dir,Config),
+ ?line {ok,GZIP} = file:read_file(filename:join(Out,"zipdoc.1.gz")),
+ ?line {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")),
+ ?line {ok,GZIP2} = file:read_file(filename:join(Out,"zipdoc.txt.gz")),
+ {run,GZIP,ORIG,GZIP2};
+gz_usage({run,GZIP,ORIG,GZIP2}) ->
+ ?line Z = zlib:open(),
+ ?line UC1 = zlib:gunzip(GZIP),
+ ?m(true,zlib:crc32(Z,UC1) == zlib:crc32(Z,ORIG)),
+ ?line UC3 = zlib:gunzip(GZIP2),
+ ?m(true,zlib:crc32(Z,UC3) == zlib:crc32(Z,ORIG)),
+ ?line Compressed = zlib:gzip(ORIG),
+ ?line UC5 = zlib:gunzip(Compressed),
+ ?m(true,zlib:crc32(Z,UC5) == zlib:crc32(Z,ORIG)),
+ ?line ok = zlib:close(Z).
+
+gz_usage2(doc) -> "Test more of a standard compressed gzipped file";
+gz_usage2(suite) -> [];
+gz_usage2(Config) ->
+ case os:find_executable("gzip") of
+ Name when is_list(Name) ->
+ ?line Z = zlib:open(),
+ ?line Out = conf(data_dir,Config),
+ ?line {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")),
+ ?line Compressed = zlib:gzip(ORIG),
+ GzOutFile = filename:join(Out,"out.gz"),
+ OutFile = filename:join(Out,"out.txt"),
+ ?m(ok, file:write_file(GzOutFile,Compressed)),
+ ?line os:cmd("gzip -c -d " ++ GzOutFile ++ " > " ++ OutFile),
+ case file:read_file(OutFile) of
+ {ok,ExtDecompressed} ->
+ ?m(true,
+ zlib:crc32(Z,ExtDecompressed) == zlib:crc32(Z,ORIG));
+ Error ->
+ io:format("Couldn't test external decompressor ~p\n",
+ [Error])
+ end,
+ ?line ok = zlib:close(Z),
+ ok;
+ false ->
+ {skipped,"No gzip in path"}
+ end.
+
+
+
+compress_usage(doc) ->
+ "Test that (de)compress funcs work with"
+ " standard tools, for example a chunk from a png file";
+compress_usage(suite) -> [];
+compress_usage(Config) when is_list(Config) ->
+ compress_usage(compress_usage({get_arg,Config}));
+compress_usage({get_arg,Config}) ->
+ ?line Out = conf(data_dir,Config),
+ ?line {ok,C1} = file:read_file(filename:join(Out,"png-compressed.zlib")),
+ {run,C1};
+compress_usage({run,C1}) ->
+ ?line Z = zlib:open(),
+ %% See that we can uncompress a file generated with external prog.
+ ?line UC1 = zlib:uncompress(C1),
+ %% Check that the crc are correct.
+ ?m(4125865008,zlib:crc32(Z,UC1)),
+ ?line C2 = zlib:compress(UC1),
+ ?line UC2 = zlib:uncompress(C2),
+ %% Check that the crc are correct.
+ ?m(4125865008,zlib:crc32(Z,UC2)),
+
+ ?line ok = zlib:close(Z),
+
+ D = [<<"We tests some partial">>,
+ <<"data, sent over">>,
+ <<"the stream">>,
+ <<"we check that we can unpack">>,
+ <<"every message we get">>],
+
+ ?line ZC = zlib:open(),
+ ?line ZU = zlib:open(),
+ Test = fun(finish, {_,Tot}) ->
+ ?line Compressed = zlib:deflate(ZC, <<>>, finish),
+ Data = zlib:inflate(ZU, Compressed),
+ [Tot|Data];
+ (Data, {Op,Tot}) ->
+ ?line Compressed = zlib:deflate(ZC, Data, Op),
+ Res1 = ?m([Data],zlib:inflate(ZU, Compressed)),
+ {Op, [Tot|Res1]}
+ end,
+ ?line zlib:deflateInit(ZC),
+ ?line zlib:inflateInit(ZU),
+ ?line T1 = lists:foldl(Test,{sync,[]},D++[finish]),
+ ?m(true, list_to_binary(D) == list_to_binary(T1)),
+ ?line zlib:deflateEnd(ZC),
+ ?line zlib:inflateEnd(ZU),
+
+ ?line zlib:deflateInit(ZC),
+ ?line zlib:inflateInit(ZU),
+ ?line T2 = lists:foldl(Test,{full,[]},D++[finish]),
+ ?m(true, list_to_binary(D) == list_to_binary(T2)),
+ ?line zlib:deflateEnd(ZC),
+ ?line zlib:inflateEnd(ZU),
+
+ ?line ok = zlib:close(ZC),
+ ?line ok = zlib:close(ZU).
+
+
+crc(doc) -> "Check that crc works as expected";
+crc(suite) -> [];
+crc(Config) when is_list(Config) ->
+ crc(crc({get_arg,Config}));
+crc({get_arg,Config}) ->
+ ?line Out = conf(data_dir,Config),
+ ?line {ok,C1} = file:read_file(filename:join(Out,"zipdoc")),
+ {run,C1};
+crc({run,C1}) ->
+ ?line Z = zlib:open(),
+ ?line Crc = zlib:crc32(Z, C1),
+ Bins = split_bin(C1,[]),
+ %%io:format("Length ~p ~p ~n", [length(Bins), [size(Bin) || Bin <- Bins]]),
+ Last = lists:last(Bins),
+ SCrc = lists:foldl(fun(Bin,Crc0) ->
+ Crc1 = zlib:crc32(Z, Crc0, Bin),
+ ?m(false, Crc == Crc1 andalso Bin /= Last),
+ Crc1
+ end, 0, Bins),
+ ?m(Crc,SCrc),
+ ?line [First|Rest] = Bins,
+ Combine = fun(Bin, CS1) ->
+ CS2 = zlib:crc32(Z, Bin),
+ S2 = byte_size(Bin),
+ zlib:crc32_combine(Z,CS1,CS2,S2)
+ end,
+ ?line Comb = lists:foldl(Combine, zlib:crc32(Z, First), Rest),
+ ?m(Crc,Comb),
+ ?line ok = zlib:close(Z).
+
+adler(doc) -> "Check that adler works as expected";
+adler(suite) -> [];
+adler(Config) when is_list(Config) ->
+ adler(adler({get_arg,Config}));
+adler({get_arg,Config}) ->
+ ?line Out = conf(data_dir,Config),
+ File1 = filename:join(Out,"zipdoc"),
+ ?line {ok,C1} = file:read_file(File1),
+ {run,C1};
+adler({run,C1}) ->
+ ?line Z = zlib:open(),
+ ?m(1, zlib:adler32(Z,<<>>)),
+ ?line Crc = zlib:adler32(Z, C1),
+ Bins = split_bin(C1,[]),
+ Last = lists:last(Bins),
+ SCrc = lists:foldl(fun(Bin,Crc0) ->
+ Crc1 = zlib:adler32(Z, Crc0, Bin),
+ ?m(false, Crc == Crc1 andalso Bin /= Last),
+ Crc1
+ end, zlib:adler32(Z,<<>>), Bins),
+ ?m(Crc,SCrc),
+ ?line [First|Rest] = Bins,
+ Combine = fun(Bin, CS1) ->
+ CS2 = zlib:adler32(Z, Bin),
+ S2 = byte_size(Bin),
+ zlib:adler32_combine(Z,CS1,CS2,S2)
+ end,
+ ?line Comb = lists:foldl(Combine, zlib:adler32(Z, First), Rest),
+ ?m(Crc,Comb),
+ ?line ok = zlib:close(Z).
+
+dictionary_usage(doc) -> "Test dictionary usage";
+dictionary_usage(suite) -> [];
+dictionary_usage(Config) when is_list(Config) ->
+ dictionary_usage(dictionary_usage({get_arg,Config}));
+dictionary_usage({get_arg,_Config}) ->
+ {run}; % no args
+dictionary_usage({run}) ->
+ ?line Z1 = zlib:open(),
+ Dict = <<"Anka">>,
+ Data = <<"Kalle Anka">>,
+ ?m(ok, zlib:deflateInit(Z1)),
+ ?line DictID = zlib:deflateSetDictionary(Z1, Dict),
+ %% ?line io:format("DictID = ~p\n", [DictID]),
+ ?line B1 = zlib:deflate(Z1, Data),
+ ?line B2 = zlib:deflate(Z1, <<>>, finish),
+ ?m(ok, zlib:deflateEnd(Z1)),
+ ?m(ok, zlib:close(Z1)),
+ Compressed = list_to_binary([B1,B2]),
+ %% io:format("~p\n", [Compressed]),
+
+ %% Now uncompress.
+ ?line Z2 = zlib:open(),
+ ?m(ok, zlib:inflateInit(Z2)),
+ ?line {'EXIT',{{need_dictionary,DictID},_}} = (catch zlib:inflate(Z2, Compressed)),
+ ?m(ok, zlib:inflateSetDictionary(Z2, Dict)),
+ ?line Uncompressed = ?m(B when is_list(B), zlib:inflate(Z2, [])),
+ ?m(ok, zlib:inflateEnd(Z2)),
+ ?m(ok, zlib:close(Z2)),
+ ?m(Data, list_to_binary(Uncompressed)).
+
+split_bin(<<Part:1997/binary,Rest/binary>>, Acc) ->
+ split_bin(Rest, [Part|Acc]);
+split_bin(Last,Acc) ->
+ lists:reverse([Last|Acc]).
+
+
+smp(doc) -> "Check concurrent access to zlib driver";
+smp(suite) -> [];
+smp(Config) ->
+ case erlang:system_info(smp_support) of
+ true ->
+ NumOfProcs = lists:min([8,erlang:system_info(schedulers)]),
+ io:format("smp starting ~p workers\n",[NumOfProcs]),
+
+ %% Tests to run in parallel.
+ Funcs = [zip_usage, gz_usage, compress_usage, dictionary_usage,
+ crc, adler],
+
+ %% We get all function arguments here to avoid repeated parallel
+ %% file read access.
+ FnAList = lists:map(fun(F) -> {F,?MODULE:F({get_arg,Config})}
+ end, Funcs),
+
+ Pids = [spawn_link(?MODULE, worker, [random:uniform(9999),
+ list_to_tuple(FnAList),
+ self()])
+ || _ <- lists:seq(1,NumOfProcs)],
+ wait_pids(Pids);
+
+ false ->
+ {skipped,"No smp support"}
+ end.
+
+
+worker(Seed, FnATpl, Parent) ->
+ io:format("smp worker ~p, seed=~p~n",[self(),Seed]),
+ random:seed(Seed,Seed,Seed),
+ worker_loop(100, FnATpl),
+ Parent ! self().
+
+worker_loop(0, _FnATpl) ->
+ large_deflate(), % the time consuming one as finale
+ ok;
+worker_loop(N, FnATpl) ->
+ {F,A} = element(random:uniform(size(FnATpl)),FnATpl),
+ ?MODULE:F(A),
+ worker_loop(N-1, FnATpl).
+
+wait_pids([]) ->
+ ok;
+wait_pids(Pids) ->
+ receive
+ Pid ->
+ ?line true = lists:member(Pid,Pids),
+ Others = lists:delete(Pid,Pids),
+ io:format("wait_pid got ~p, still waiting for ~p\n",[Pid,Others]),
+ wait_pids(Others)
+ end.
+
+
+otp_7359(doc) -> "Deflate/inflate data with size close to multiple of internal buffer size";
+otp_7359(suite) -> [];
+otp_7359(_Config) ->
+ %% Find compressed size
+ ZTry = zlib:open(),
+ ok = zlib:deflateInit(ZTry),
+ ISize = zlib:getBufSize(ZTry),
+ IData = list_to_binary([Byte band 255 || Byte <- lists:seq(1,ISize)]),
+ ?line ISize = byte_size(IData),
+
+ ?line DSize = iolist_size(zlib:deflate(ZTry, IData, sync)),
+ zlib:close(ZTry),
+
+ io:format("Deflated try ~p -> ~p bytes~n", [ISize, DSize]),
+
+ %% Try deflate and inflate with different internal buffer sizes
+ ISpan = 1,
+ DSpan = 10, % use larger span around deflated size as it may vary depending on buf size
+
+ Cases = [{DS,IS} || DMul<-[1,2],
+ DS <- lists:seq((DSize div DMul)-DSpan,
+ (DSize div DMul)+DSpan),
+ IMul<-[1,2],
+ IS <- lists:seq((ISize div IMul)-ISpan,
+ (ISize div IMul)+ISpan)],
+
+ lists:foreach(fun(Case) -> otp_7359_def_inf(IData,Case) end,
+ Cases).
+
+
+otp_7359_def_inf(Data,{DefSize,InfSize}) ->
+ %%io:format("Try: DefSize=~p InfSize=~p~n", [DefSize,InfSize]),
+ ?line ZDef = zlib:open(),
+ ?line ok = zlib:deflateInit(ZDef),
+ ?line ok = zlib:setBufSize(ZDef,DefSize),
+ ?line DefData = iolist_to_binary(zlib:deflate(ZDef, Data, sync)),
+ %%io:format("Deflated ~p(~p) -> ~p(~p) bytes~n",
+ %% [byte_size(Data), InfSize, byte_size(DefData), DefSize]),
+ ?line ok = zlib:close(ZDef),
+
+ ?line ZInf = zlib:open(),
+ ?line ok = zlib:inflateInit(ZInf),
+ ?line ok = zlib:setBufSize(ZInf,InfSize),
+ ?line Data = iolist_to_binary(zlib:inflate(ZInf, DefData)),
+ ?line ok = zlib:close(ZInf),
+ ok.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%% Helps with testing directly %%%%%%%%%%%%%
+
+conf(What,Config) ->
+ try ?config(What,Config) of
+ undefined ->
+ "./zlib_SUITE_data";
+ Dir ->
+ Dir
+ catch
+ _:_ -> "./zlib_SUITE_data"
+ end.
+
+t() -> t([all]).
+
+t(What) when not is_list(What) ->
+ t([What]);
+t(What) ->
+ lists:foreach(fun(T) ->
+ try ?MODULE:T([])
+ catch _E:_R ->
+ Line = get(test_server_loc),
+ io:format("Failed ~p:~p ~p ~p ~p~n",
+ [T,Line,_E,_R, erlang:get_stacktrace()])
+ end
+ end, expand(What)).
+
+expand(All) ->
+ lists:reverse(expand(All,[])).
+expand([H|T], Acc) ->
+ case ?MODULE:H(suite) of
+ [] -> expand(T,[H|Acc]);
+ Cs ->
+ R = expand(Cs, Acc),
+ expand(T, R)
+ end;
+expand([], Acc) -> Acc.
+
diff --git a/lib/kernel/test/zlib_SUITE_data/png-compressed.zlib b/lib/kernel/test/zlib_SUITE_data/png-compressed.zlib
new file mode 100644
index 0000000000..5ce70684e3
--- /dev/null
+++ b/lib/kernel/test/zlib_SUITE_data/png-compressed.zlib
Binary files differ
diff --git a/lib/kernel/test/zlib_SUITE_data/zipdoc b/lib/kernel/test/zlib_SUITE_data/zipdoc
new file mode 100644
index 0000000000..e63952e3ef
--- /dev/null
+++ b/lib/kernel/test/zlib_SUITE_data/zipdoc
@@ -0,0 +1,1924 @@
+[Info-ZIP note, 981119: this file is based on PKWARE's appnote.txt of
+ 15 February 1996, taking into account PKWARE's revised appnote.txt version
+ of 01 September 1998. It has been unofficially corrected and extended by
+ Info-ZIP without explicit permission by PKWARE. Although Info-ZIP
+ believes the information to be accurate and complete, it is provided
+ under a disclaimer similar to the PKWARE disclaimer below, differing
+ only in the substitution of "Info-ZIP" for "PKWARE". In other words,
+ use this information at your own risk, but we think it's correct.
+
+ Specification info from PKWARE that was obviously wrong has been corrected
+ silently (e.g. missing structure fields, wrong numbers
+ As of PKZIPW 2.50, two new incompatibilities have been introduced by PKWARE;
+ they are noted below. Note that the "NTFS tag" conflict is currently not
+ real; PKZIPW 2.50 actually tags NTFS files as having come from a FAT
+ file system, too.]
+
+
+Disclaimer
+----------
+
+Although PKWARE will attempt to supply current and accurate
+information relating to its file formats, algorithms, and the
+subject programs, the possibility of error can not be eliminated.
+PKWARE therefore expressly disclaims any warranty that the
+information contained in the associated materials relating to the
+subject programs and/or the format of the files created or
+accessed by the subject programs and/or the algorithms used by
+the subject programs, or any other matter, is current, correct or
+accurate as delivered. Any risk of damage due to any possible
+inaccurate information is assumed by the user of the information.
+Furthermore, the information relating to the subject programs
+and/or the file formats created or accessed by the subject
+programs and/or the algorithms used by the subject programs is
+subject to change without notice.
+
+
+General Format of a ZIP file
+----------------------------
+
+ Files stored in arbitrary order. Large zipfiles can span multiple
+ diskette media.
+
+ Overall zipfile format:
+
+ [local file header + file data + data_descriptor] . . .
+ [central directory] end of central directory record
+
+
+ A. Local file header:
+
+ local file header signature 4 bytes (0x04034b50)
+ version needed to extract 2 bytes
+ general purpose bit flag 2 bytes
+ compression method 2 bytes
+ last mod file time 2 bytes
+ last mod file date 2 bytes
+ crc-32 4 bytes
+ compressed size 4 bytes
+ uncompressed size 4 bytes
+ filename length 2 bytes
+ extra field length 2 bytes
+
+ filename (variable size)
+ extra field (variable size)
+
+
+ B. Data descriptor:
+
+ data descriptor signature 4 bytes (0x08074b50)
+ crc-32 4 bytes
+ compressed size 4 bytes
+ uncompressed size 4 bytes
+
+ This descriptor exists only if bit 3 of the general
+ purpose bit flag is set (see below). It is byte aligned
+ and immediately follows the last byte of compressed data.
+ This descriptor is used only when it was not possible to
+ seek in the output zip file, e.g., when the output zip file
+ was standard output or a non seekable device.
+
+ C. Central directory structure:
+
+ [file header] . . . end of central dir record
+
+ File header:
+
+ central file header signature 4 bytes (0x02014b50)
+ version made by 2 bytes
+ version needed to extract 2 bytes
+ general purpose bit flag 2 bytes
+ compression method 2 bytes
+ last mod file time 2 bytes
+ last mod file date 2 bytes
+ crc-32 4 bytes
+ compressed size 4 bytes
+ uncompressed size 4 bytes
+ filename length 2 bytes
+ extra field length 2 bytes
+ file comment length 2 bytes
+ disk number start 2 bytes
+ internal file attributes 2 bytes
+ external file attributes 4 bytes
+ relative offset of local header 4 bytes
+
+ filename (variable size)
+ extra field (variable size)
+ file comment (variable size)
+
+ End of central dir record:
+
+ end of central dir signature 4 bytes (0x06054b50)
+ number of this disk 2 bytes
+ number of the disk with the
+ start of the central directory 2 bytes
+ total number of entries in
+ the central dir on this disk 2 bytes
+ total number of entries in
+ the central dir 2 bytes
+ size of the central directory 4 bytes
+ offset of start of central
+ directory with respect to
+ the starting disk number 4 bytes
+ zipfile comment length 2 bytes
+ zipfile comment (variable size)
+
+
+ D. Explanation of fields:
+
+ version made by (2 bytes)
+
+ The upper byte indicates the host system (OS) for the
+ file. Software can use this information to determine
+ the line record format for text files etc. The current
+ mappings are:
+
+ 0 - FAT file system (DOS, OS/2, NT) + PKZIPW 2.50 VFAT, NTFS
+ 1 - Amiga
+ 2 - VMS (VAX or Alpha AXP)
+ 3 - Unix
+ 4 - VM/CMS
+ 5 - Atari
+ 6 - HPFS file system (OS/2, NT 3.x)
+ 7 - Macintosh
+ 8 - Z-System
+ 9 - CP/M
+ 10 - TOPS-20 [supposedly PKZIPW 2.50 NTFS]
+ 11 - NTFS file system (NT) [used by Info-ZIP, only]
+ 12 - SMS/QDOS
+ 13 - Acorn RISC OS
+ 14 - VFAT file system (Win95, NT) [Info-ZIP reservation, unused]
+ 15 - MVS
+ 16 - BeOS (BeBox or PowerMac)
+ 17 - Tandem
+ 18 thru 255 - unused
+
+ The lower byte indicates the version number of the
+ software used to encode the file. The value/10
+ indicates the major version number, and the value
+ mod 10 is the minor version number.
+
+ version needed to extract (2 bytes)
+
+ The minimum software version needed to extract the
+ file, mapped as above.
+
+ general purpose bit flag: (2 bytes)
+
+ Bit 0: If set, indicates that the file is encrypted.
+
+ (For Method 6 - Imploding)
+ Bit 1: If the compression method used was type 6,
+ Imploding, then this bit, if set, indicates
+ an 8K sliding dictionary was used. If clear,
+ then a 4K sliding dictionary was used.
+ Bit 2: If the compression method used was type 6,
+ Imploding, then this bit, if set, indicates
+ an 3 Shannon-Fano trees were used to encode the
+ sliding dictionary output. If clear, then 2
+ Shannon-Fano trees were used.
+
+ (For Method 8 - Deflating)
+ Bit 2 Bit 1
+ 0 0 Normal (-en) compression option was used.
+ 0 1 Maximum (-ex) compression option was used.
+ 1 0 Fast (-ef) compression option was used.
+ 1 1 Super Fast (-es) compression option was used.
+
+ Note: Bits 1 and 2 are undefined if the compression
+ method is any other.
+
+ Bit 3: If this bit is set, the fields crc-32, compressed size
+ and uncompressed size are set to zero in the local
+ header. The correct values are put in the data descriptor
+ immediately following the compressed data. (Note: PKZIP
+ version 2.04g for DOS only recognizes this bit for method 8
+ compression, newer versions of PKZIP recognize this bit
+ for any compression method.)
+ [Info-ZIP note: This bit was introduced by PKZIP 2.04 for
+ DOS. In general, this feature can only be reliably used
+ together with compression methods that allow intrinsic
+ detection of the "end-of-compressed-data" condition. From
+ the set of compression methods described in this Zip archive
+ specification, only "deflate" meets this requirement.
+ Especially, the method STORED does not work!
+ The Info-ZIP tools recognize this bit regardless of the
+ compression method; but, they rely on correctly set
+ "compressed size" information in the central directory entry.]
+
+ Bit 5: If this bit is set, this indicates that the file is compressed
+ patched data. (Note: Requires PKZIP version 2.70 or greater)
+
+ The upper three bits are reserved and used internally
+ by the software when processing the zipfile. The
+ remaining bits are unused.
+
+ compression method: (2 bytes)
+
+ (see accompanying documentation for algorithm
+ descriptions)
+
+ 0 - The file is stored (no compression)
+ 1 - The file is Shrunk
+ 2 - The file is Reduced with compression factor 1
+ 3 - The file is Reduced with compression factor 2
+ 4 - The file is Reduced with compression factor 3
+ 5 - The file is Reduced with compression factor 4
+ 6 - The file is Imploded
+ 7 - Reserved for Tokenizing compression algorithm
+ 8 - The file is Deflated
+ 9 - Reserved for enhanced Deflating
+ 10 - PKWARE Data Compression Library Imploding
+
+ date and time fields: (2 bytes each)
+
+ The date and time are encoded in standard MS-DOS format.
+ If input came from standard input, the date and time are
+ those at which compression was started for this data.
+
+ CRC-32: (4 bytes)
+
+ The CRC-32 algorithm was generously contributed by
+ David Schwaderer and can be found in his excellent
+ book "C Programmers Guide to NetBIOS" published by
+ Howard W. Sams & Co. Inc. The 'magic number' for
+ the CRC is 0xdebb20e3. The proper CRC pre and post
+ conditioning is used, meaning that the CRC register
+ is pre-conditioned with all ones (a starting value
+ of 0xffffffff) and the value is post-conditioned by
+ taking the one's complement of the CRC residual.
+ If bit 3 of the general purpose flag is set, this
+ field is set to zero in the local header and the correct
+ value is put in the data descriptor and in the central
+ directory.
+
+ compressed size: (4 bytes)
+ uncompressed size: (4 bytes)
+
+ The size of the file compressed and uncompressed,
+ respectively. If bit 3 of the general purpose bit flag
+ is set, these fields are set to zero in the local header
+ and the correct values are put in the data descriptor and
+ in the central directory.
+
+ filename length: (2 bytes)
+ extra field length: (2 bytes)
+ file comment length: (2 bytes)
+
+ The length of the filename, extra field, and comment
+ fields respectively. The combined length of any
+ directory record and these three fields should not
+ generally exceed 65,535 bytes. If input came from standard
+ input, the filename length is set to zero.
+
+ [Info-ZIP note:
+ This feature is not yet supported by any PKWARE version of ZIP
+ (at least not in PKZIP for DOS and PKZIP for Windows/WinNT).
+ The Info-ZIP programs handle standard input differently:
+ If input came from standard input, the filename is set to "-"
+ (length one).]
+
+
+ disk number start: (2 bytes)
+
+ The number of the disk on which this file begins.
+
+ internal file attributes: (2 bytes)
+
+ The lowest bit of this field indicates, if set, that
+ the file is apparently an ASCII or text file. If not
+ set, that the file apparently contains binary data.
+ The remaining bits are unused in version 1.0.
+
+ external file attributes: (4 bytes)
+
+ The mapping of the external attributes is
+ host-system dependent (see 'version made by'). For
+ MS-DOS, the low order byte is the MS-DOS directory
+ attribute byte. If input came from standard input, this
+ field is set to zero.
+
+ relative offset of local header: (4 bytes)
+
+ This is the offset from the start of the first disk on
+ which this file appears, to where the local header should
+ be found.
+
+ filename: (Variable)
+
+ The name of the file, with optional relative path.
+ The path stored should not contain a drive or
+ device letter, or a leading slash. All slashes
+ should be forward slashes '/' as opposed to
+ backwards slashes '\' for compatibility with Amiga
+ and Unix file systems etc. If input came from standard
+ input, there is no filename field.
+ [Info-ZIP discrepancy:
+ If input came from standard input, the file name is set
+ to "-" (without the quotes).
+ As far as we know, the PKWARE specification for "input from
+ stdin" is not supported by PKZIP/PKUNZIP for DOS, OS/2, Windows
+ Windows NT.]
+
+ extra field: (Variable)
+
+ This is for future expansion. If additional information
+ needs to be stored in the future, it should be stored
+ here. Earlier versions of the software can then safely
+ skip this file, and find the next file or header. This
+ field will be 0 length in version 1.0.
+
+ In order to allow different programs and different types
+ of information to be stored in the 'extra' field in .ZIP
+ files, the following structure should be used for all
+ programs storing data in this field:
+
+ header1+data1 + header2+data2 . . .
+
+ Each header should consist of:
+
+ Header ID - 2 bytes
+ Data Size - 2 bytes
+
+ Note: all fields stored in Intel low-byte/high-byte order.
+
+ The Header ID field indicates the type of data that is in
+ the following data block.
+
+ Header ID's of 0 thru 31 are reserved for use by PKWARE.
+ The remaining ID's can be used by third party vendors for
+ proprietary usage.
+
+ The current Header ID mappings defined by PKWARE are:
+
+ 0x0007 AV Info
+ 0x0009 OS/2 extended attributes (also Info-ZIP)
+ 0x000a PKWARE Win95/WinNT FileTimes [undocumented!]
+ 0x000c PKWARE VAX/VMS (also Info-ZIP)
+ 0x000d PKWARE Unix
+ 0x000f Patch Descriptor
+
+ The Header ID mappings defined by Info-ZIP and third parties are:
+
+ 0x07c8 Info-ZIP Macintosh (old, J. Lee)
+ 0x2605 ZipIt Macintosh (first version)
+ 0x2705 ZipIt Macintosh v 1.3.5 and newer (w/o full filename)
+ 0x334d Info-ZIP Macintosh (new, D. Haase's 'Mac3' field )
+ 0x4341 Acorn/SparkFS (David Pilling)
+ 0x4453 Windows NT security descriptor (binary ACL)
+ 0x4704 VM/CMS
+ 0x470f MVS
+ 0x4b46 FWKCS MD5 (third party, see below)
+ 0x4c41 OS/2 access control list (text ACL)
+ 0x4d49 Info-ZIP VMS (VAX or Alpha)
+ 0x5356 AOS/VS (binary ACL)
+ 0x5455 extended timestamp
+ 0x5855 Info-ZIP Unix (original; also OS/2, NT, etc.)
+ 0x6542 BeOS (BeBox, PowerMac, etc.)
+ 0x756e ASi Unix
+ 0x7855 Info-ZIP Unix (new)
+ 0xfb4a SMS/QDOS
+
+ The Data Size field indicates the size of the following
+ data block. Programs can use this value to skip to the
+ next header block, passing over any data blocks that are
+ not of interest.
+
+ Note: As stated above, the size of the entire .ZIP file
+ header, including the filename, comment, and extra
+ field should not exceed 64K in size.
+
+ In case two different programs should appropriate the same
+ Header ID value, it is strongly recommended that each
+ program place a unique signature of at least two bytes in
+ size (and preferably 4 bytes or bigger) at the start of
+ each data area. Every program should verify that its
+ unique signature is present, in addition to the Header ID
+ value being correct, before assuming that it is a block of
+ known type.
+
+ In the following descriptions, note that "Short" means two bytes,
+ "Long" means four bytes, and "Long-Long" means eight bytes,
+ regardless of their native sizes. Unless specifically noted, all
+ integer fields should be interpreted as unsigned (non-negative)
+ numbers.
+
+
+ -OS/2 Extended Attributes Extra Field:
+ ====================================
+
+ The following is the layout of the OS/2 extended attributes "extra"
+ block. (Last Revision 19960922)
+
+ Note: all fields stored in Intel low-byte/high-byte order.
+
+ Local-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (OS/2) 0x0009 Short tag for this extra block type
+ TSize Short total data size for this block
+ BSize Long uncompressed EA data size
+ CType Short compression type
+ EACRC Long CRC value for uncompressed EA data
+ (var.) variable compressed EA data
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (OS/2) 0x0009 Short tag for this extra block type
+ TSize Short total data size for this block
+ BSize Long size of uncompressed local EA data
+
+ The value of CType is interpreted according to the "compression
+ method" section above; i.e., 0 for stored, 8 for deflated, etc.
+
+ The OS/2 extended attribute structure (FEA2LIST) is compressed and
+ then stored in its entirety within this structure. There will only
+ ever be one block of data in the variable-length field.
+
+
+ -OS/2 Access Control List Extra Field:
+ ====================================
+
+ The following is the layout of the OS/2 ACL extra block.
+ (Last Revision 19960922)
+
+ Local-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (ACL) 0x4c41 Short tag for this extra block type
+ TSize Short total data size for this block
+ BSize Long uncompressed ACL data size
+ CType Short compression type
+ EACRC Long CRC value for uncompressed ACL data
+ (var.) variable compressed ACL data
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (ACL) 0x4c41 Short tag for this extra block type
+ TSize Short total data size for this block
+ BSize Long size of uncompressed local ACL data
+
+ The value of CType is interpreted according to the "compression
+ method" section above; i.e., 0 for stored, 8 for deflated, etc.
+
+ The uncompressed ACL data consist of a text header of the form
+ "ACL1:%hX,%hd\n", where the first field is the OS/2 ACCINFO acc_attr
+ member and the second is acc_count, followed by acc_count strings
+ of the form "%s,%hx\n", where the first field is acl_ugname (user
+ group name) and the second acl_access. This block type will be
+ extended for other operating systems as needed.
+
+
+ -Windows NT Security Descriptor Extra Field:
+ ==========================================
+
+ The following is the layout of the NT Security Descriptor (another
+ type of ACL) extra block. (Last Revision 19960922)
+
+ Local-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (SD) 0x4453 Short tag for this extra block type
+ TSize Short total data size for this block
+ BSize Long uncompressed SD data size
+ Version Byte version of uncompressed SD data format
+ CType Short compression type
+ EACRC Long CRC value for uncompressed SD data
+ (var.) variable compressed SD data
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (SD) 0x4453 Short tag for this extra block type
+ TSize Short total data size for this block
+ BSize Long size of uncompressed local SD data
+
+ The value of CType is interpreted according to the "compression
+ method" section above; i.e., 0 for stored, 8 for deflated, etc.
+ Version specifies how the compressed data are to be interpreted
+ and allows for future expansion of this extra field type. Currently
+ only version 0 is defined.
+
+ For version 0, the compressed data are to be interpreted as a single
+ valid Windows NT SECURITY_DESCRIPTOR data structure, in self-relative
+ format.
+
+
+ -PKWARE Win95/WinNT Extra Field:
+ ==============================
+
+ The following description covers PKWARE's undocumented
+ Windows 95 & Windows NT extra field, introduced with the
+ release of PKZIP for Windows 2.50. (Last Revision 19980425)
+
+ This field has a fixed data size of 32 bytes and is only stored
+ as local extra field.
+
+ Value Size Description
+ ----- ---- -----------
+ (WinNT) 0x000a Short Tag for this "extra" block type
+ TSize Short Total Data Size for this block
+ Unknwn1 Long ???? (all 0 ?)
+ Unknwn2 Long ????
+ ModTime Long-Long 64-bit NTFS last-modified filetime
+ AccTime Long-Long 64-bit NTFS last-access filetime
+ CreTime Long-Long 64-bit NTFS creation filetime
+
+ The NTFS filetimes are 64-bit unsigned integers, stored in Intel
+ (least significant byte first) byte order. They determine the
+ number of 1.0E-07 seconds (1/10th microseconds!) past WinNT "epoch",
+ which is "01-Jan-1601 00:00:00 UTC".
+
+
+ -PKWARE VAX/VMS Extra Field:
+ ==========================
+
+ The following is the layout of PKWARE's VAX/VMS attributes "extra"
+ block. (Last Revision 12/17/91)
+
+ Note: all fields stored in Intel low-byte/high-byte order.
+
+ Value Size Description
+ ----- ---- -----------
+ (VMS) 0x000c Short Tag for this "extra" block type
+ TSize Short Total Data Size for this block
+ CRC Long 32-bit CRC for remainder of the block
+ Tag1 Short VMS attribute tag value #1
+ Size1 Short Size of attribute #1, in bytes
+ (var.) Size1 Attribute #1 data
+ .
+ .
+ .
+ TagN Short VMS attribute tage value #N
+ SizeN Short Size of attribute #N, in bytes
+ (var.) SizeN Attribute #N data
+
+ Rules:
+
+ 1. There will be one or more of attributes present, which will
+ each be preceded by the above TagX & SizeX values. These
+ values are identical to the ATR$C_XXXX and ATR$S_XXXX constants
+ which are defined in ATR.H under VMS C. Neither of these values
+ will ever be zero.
+
+ 2. No word alignment or padding is performed.
+
+ 3. A well-behaved PKZIP/VMS program should never produce more than
+ one sub-block with the same TagX value. Also, there will never
+ be more than one "extra" block of type 0x000c in a particular
+ directory record.
+
+
+ -Info-ZIP VMS Extra Field:
+ ========================
+
+ The following is the layout of Info-ZIP's VMS attributes extra
+ block for VAX or Alpha AXP. The local-header and central-header
+ versions are identical. (Last Revision 19960922)
+
+ Value Size Description
+ ----- ---- -----------
+ (VMS2) 0x4d49 Short tag for this extra block type
+ TSize Short total data size for this block
+ ID Long block ID
+ Flags Short info bytes
+ BSize Short uncompressed block size
+ Reserved Long (reserved)
+ (var.) variable compressed VMS file-attributes block
+
+ The block ID is one of the following unterminated strings:
+
+ "VFAB" struct FAB
+ "VALL" struct XABALL
+ "VFHC" struct XABFHC
+ "VDAT" struct XABDAT
+ "VRDT" struct XABRDT
+ "VPRO" struct XABPRO
+ "VKEY" struct XABKEY
+ "VMSV" version (e.g., "V6.1"; truncated at hyphen)
+ "VNAM" reserved
+
+ The lower three bits of Flags indicate the compression method. The
+ currently defined methods are:
+
+ 0 stored (not compressed)
+ 1 simple "RLE"
+ 2 deflated
+
+ The "RLE" method simply replaces zero-valued bytes with zero-valued
+ bits and non-zero-valued bytes with a "1" bit followed by the byte
+ value.
+
+ The variable-length compressed data contains only the data corre-
+ sponding to the indicated structure or string. Typically multiple
+ VMS2 extra fields are present (each with a unique block type).
+
+
+ -Info-ZIP Macintosh Extra Field:
+ ==============================
+
+ The following is the layout of the (old) Info-ZIP resource-fork extra
+ block for Macintosh. The local-header and central-header versions
+ are identical. (Last Revision 19960922)
+
+ Value Size Description
+ ----- ---- -----------
+ (Mac) 0x07c8 Short tag for this extra block type
+ TSize Short total data size for this block
+ "JLEE" beLong extra-field signature
+ FInfo 16 bytes Macintosh FInfo structure
+ CrDat beLong HParamBlockRec fileParam.ioFlCrDat
+ MdDat beLong HParamBlockRec fileParam.ioFlMdDat
+ Flags beLong info bits
+ DirID beLong HParamBlockRec fileParam.ioDirID
+ VolName 28 bytes volume name (optional)
+
+ All fields but the first two are in native Macintosh format
+ (big-endian Motorola order, not little-endian Intel). The least
+ significant bit of Flags is 1 if the file is a data fork, 0 other-
+ wise. In addition, if this extra field is present, the filename
+ has an extra 'd' or 'r' appended to indicate data fork or resource
+ fork. The 28-byte VolName field may be omitted.
+
+
+ -ZipIt Macintosh Extra Field (long):
+ ==================================
+
+ The following is the layout of the ZipIt extra block for Macintosh.
+ The local-header and central-header versions are identical.
+ (Last Revision 19970130)
+
+ Value Size Description
+ ----- ---- -----------
+ (Mac2) 0x2605 Short tag for this extra block type
+ TSize Short total data size for this block
+ "ZPIT" beLong extra-field signature
+ FnLen Byte length of FileName
+ FileName variable full Macintosh filename
+ FileType Byte[4] four-byte Mac file type string
+ Creator Byte[4] four-byte Mac creator string
+
+
+ -ZipIt Macintosh Extra Field (short):
+ ===================================
+
+ The following is the layout of a shortened variant of the
+ ZipIt extra block for Macintosh (without "full name" entry).
+ This variant is used by ZipIt 1.3.5 and newer for entries that
+ do not need a "full Mac filename" record.
+ The local-header and central-header versions are identical.
+ (Last Revision 19980903)
+
+ Value Size Description
+ ----- ---- -----------
+ (Mac2b) 0x2705 Short tag for this extra block type
+ TSize Short total data size for this block
+ "ZPIT" beLong extra-field signature
+ FileType Byte[4] four-byte Mac file type string
+ Creator Byte[4] four-byte Mac creator string
+
+
+ -Info-ZIP Macintosh Extra Field (new):
+ ====================================
+
+ The following is the layout of the (new) Info-ZIP extra
+ block for Macintosh, designed by Dirk Haase.
+ All values are in little-endian.
+ (Last Revision 19981005)
+
+ Local-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (Mac3) 0x334d Short tag for this extra block type ("M3")
+ TSize Short total data size for this block
+ BSize Long uncompressed finder attribute data size
+ Flags Short info bits
+ fdType Byte[4] Type of the File (4-byte string)
+ fdCreator Byte[4] Creator of the File (4-byte string)
+ (CType) Short compression type
+ (CRC) Long CRC value for uncompressed MacOS data
+ Attribs variable finder attribute data (see below)
+
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (Mac3) 0x334d Short tag for this extra block type ("M3")
+ TSize Short total data size for this block
+ BSize Long uncompressed finder attribute data size
+ Flags Short info bits
+ fdType Byte[4] Type of the File (4-byte string)
+ fdCreator Byte[4] Creator of the File (4-byte string)
+
+ The third bit of Flags in both headers indicates whether
+ the LOCAL extra field is uncompressed (and therefore whether CType
+ and CRC are omitted):
+
+ Bits of the Flags:
+ bit 0 if set, file is a data fork; otherwise unset
+ bit 1 if set, filename will be not changed
+ bit 2 if set, Attribs is uncompressed (no CType, CRC)
+ bit 3 if set, date and times are in 64 bit
+ if zero date and times are in 32 bit.
+ bit 4 if set, timezone offsets fields for the native
+ Mac times are omitted (UTC support deactivated)
+ bits 5-15 reserved;
+
+
+ Attributes:
+
+ Attribs is a Mac-specific block of data in little-endian format with
+ the following structure (if compressed, uncompress it first):
+
+ Value Size Description
+ ----- ---- -----------
+ fdFlags Short Finder Flags
+ fdLocation.v Short Finder Icon Location
+ fdLocation.h Short Finder Icon Location
+ fdFldr Short Folder containing file
+
+ FXInfo 16 bytes Macintosh FXInfo structure
+ FXInfo-Structure:
+ fdIconID Short
+ fdUnused[3] Short unused but reserved 6 bytes
+ fdScript Byte Script flag and number
+ fdXFlags Byte More flag bits
+ fdComment Short Comment ID
+ fdPutAway Long Home Dir ID
+
+ FVersNum Byte file version number
+ may be not used by MacOS
+ ACUser Byte directory access rights
+
+ FlCrDat ULong date and time of creation
+ FlMdDat ULong date and time of last modification
+ FlBkDat ULong date and time of last backup
+ These time numbers are original Mac FileTime values (local time!).
+ Currently, date-time width is 32-bit, but future version may
+ support be 64-bit times (see flags)
+
+ CrGMTOffs Long(signed!) difference "local Creat. time - UTC"
+ MdGMTOffs Long(signed!) difference "local Modif. time - UTC"
+ BkGMTOffs Long(signed!) difference "local Backup time - UTC"
+ These "local time - UTC" differences (stored in seconds) may be
+ used to support timestamp adjustment after inter-timezone transfer.
+ These fields are optional; bit 4 of the flags word controls their
+ presence.
+
+ Charset Short TextEncodingBase (Charset)
+ valid for the following two fields
+
+ FullPath variable Path of the current file.
+ Zero terminated string (C-String)
+ Currently coded in the native Charset.
+
+ Comment variable Finder Comment of the current file.
+ Zero terminated string (C-String)
+ Currently coded in the native Charset.
+
+
+ -Acorn SparkFS Extra Field:
+ =========================
+
+ The following is the layout of David Pilling's SparkFS extra block
+ for Acorn RISC OS. The local-header and central-header versions are
+ identical. (Last Revision 19960922)
+
+ Value Size Description
+ ----- ---- -----------
+ (Acorn) 0x4341 Short tag for this extra block type
+ TSize Short total data size for this block
+ "ARC0" Long extra-field signature
+ LoadAddr Long load address or file type
+ ExecAddr Long exec address
+ Attr Long file permissions
+ Zero Long reserved; always zero
+
+ The following bits of Attr are associated with the given file
+ permissions:
+
+ bit 0 user-writable ('W')
+ bit 1 user-readable ('R')
+ bit 2 reserved
+ bit 3 locked ('L')
+ bit 4 publicly writable ('w')
+ bit 5 publicly readable ('r')
+ bit 6 reserved
+ bit 7 reserved
+
+
+ -VM/CMS Extra Field:
+ ==================
+
+ The following is the layout of the file-attributes extra block for
+ VM/CMS. The local-header and central-header versions are
+ identical. (Last Revision 19960922)
+
+ Value Size Description
+ ----- ---- -----------
+ (VM/CMS) 0x4704 Short tag for this extra block type
+ TSize Short total data size for this block
+ flData variable file attributes data
+
+ flData is an uncompressed fldata_t struct.
+
+
+ -MVS Extra Field:
+ ===============
+
+ The following is the layout of the file-attributes extra block for
+ MVS. The local-header and central-header versions are identical.
+ (Last Revision 19960922)
+
+ Value Size Description
+ ----- ---- -----------
+ (MVS) 0x470f Short tag for this extra block type
+ TSize Short total data size for this block
+ flData variable file attributes data
+
+ flData is an uncompressed fldata_t struct.
+
+
+ -PKWARE Unix Extra Field:
+ ========================
+
+ The following is the layout of PKWARE's Unix "extra" block.
+ It was introduced with the release of PKZIP for Unix 2.50.
+ Note: all fields are stored in Intel low-byte/high-byte order.
+ (Last Revision 19980901)
+
+ This field has a minimum data size of 12 bytes and is only stored
+ as local extra field.
+
+ Value Size Description
+ ----- ---- -----------
+ (Unix0) 0x000d Short Tag for this "extra" block type
+ TSize Short Total Data Size for this block
+ AcTime Long time of last access (UTC/GMT)
+ ModTime Long time of last modification (UTC/GMT)
+ UID Short Unix user ID
+ GID Short Unix group ID
+ (var) variable Variable length data field
+
+ The variable length data field will contain file type
+ specific data. Currently the only values allowed are
+ the original "linked to" file names for hard or symbolic links.
+
+ The fixed part of this field has the same layout as Info-ZIP's
+ abandoned "Unix1 timestamps & owner ID info" extra field;
+ only the two tag bytes are different.
+
+
+ -PATCH Descriptor Extra Field:
+ ============================
+
+ The following is the layout of the Patch Descriptor "extra"
+ block.
+
+ Note: all fields stored in Intel low-byte/high-byte order.
+
+ Value Size Description
+ ----- ---- -----------
+ (Patch) 0x000f Short Tag for this "extra" block type
+ TSize Short Size of the total "extra" block
+ Version Short Version of the descriptor
+ Flags Long Actions and reactions (see below)
+ OldSize Long Size of the file about to be patched
+ OldCRC Long 32-bit CRC of the file about to be patched
+ NewSize Long Size of the resulting file
+ NewCRC Long 32-bit CRC of the resulting file
+
+
+ Actions and reactions
+
+ Bits Description
+ ---- ----------------
+ 0 Use for autodetection
+ 1 Treat as selfpatch
+ 2-3 RESERVED
+ 4-5 Action (see below)
+ 6-7 RESERVED
+ 8-9 Reaction (see below) to absent file
+ 10-11 Reaction (see below) to newer file
+ 12-13 Reaction (see below) to unknown file
+ 14-15 RESERVED
+ 16-31 RESERVED
+
+ Actions
+
+ Action Value
+ ------ -----
+ none 0
+ add 1
+ delete 2
+ patch 3
+
+ Reactions
+
+ Reaction Value
+ -------- -----
+ ask 0
+ skip 1
+ ignore 2
+ fail 3
+
+
+ -Extended Timestamp Extra Field:
+ ==============================
+
+ The following is the layout of the extended-timestamp extra block.
+ (Last Revision 19970118)
+
+ Local-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (time) 0x5455 Short tag for this extra block type
+ TSize Short total data size for this block
+ Flags Byte info bits
+ (ModTime) Long time of last modification (UTC/GMT)
+ (AcTime) Long time of last access (UTC/GMT)
+ (CrTime) Long time of original creation (UTC/GMT)
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (time) 0x5455 Short tag for this extra block type
+ TSize Short total data size for this block
+ Flags Byte info bits (refers to local header!)
+ (ModTime) Long time of last modification (UTC/GMT)
+
+ The central-header extra field contains the modification time only,
+ or no timestamp at all. TSize is used to flag its presence or
+ absence. But note:
+
+ If "Flags" indicates that Modtime is present in the local header
+ field, it MUST be present in the central header field, too!
+ This correspondence is required because the modification time
+ value may be used to support trans-timezone freshening and
+ updating operations with zip archives.
+
+ The time values are in standard Unix signed-long format, indicating
+ the number of seconds since 1 January 1970 00:00:00. The times
+ are relative to Coordinated Universal Time (UTC), also sometimes
+ referred to as Greenwich Mean Time (GMT). To convert to local time,
+ the software must know the local timezone offset from UTC/GMT.
+
+ The lower three bits of Flags in both headers indicate which time-
+ stamps are present in the LOCAL extra field:
+
+ bit 0 if set, modification time is present
+ bit 1 if set, access time is present
+ bit 2 if set, creation time is present
+ bits 3-7 reserved for additional timestamps; not set
+
+ Those times that are present will appear in the order indicated, but
+ any combination of times may be omitted. (Creation time may be
+ present without access time, for example.) TSize should equal
+ (1 + 4*(number of set bits in Flags)), as the block is currently
+ defined. Other timestamps may be added in the future.
+
+
+ -Info-ZIP Unix Extra Field (type 1):
+ ==================================
+
+ The following is the layout of the old Info-ZIP extra block for
+ Unix. It has been replaced by the extended-timestamp extra block
+ (0x5455) and the Unix type 2 extra block (0x7855).
+ (Last Revision 19970118)
+
+ Local-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (Unix1) 0x5855 Short tag for this extra block type
+ TSize Short total data size for this block
+ AcTime Long time of last access (UTC/GMT)
+ ModTime Long time of last modification (UTC/GMT)
+ UID Short Unix user ID
+ GID Short Unix group ID
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (Unix1) 0x5855 Short tag for this extra block type
+ TSize Short total data size for this block
+ AcTime Long time of last access (GMT/UTC)
+ ModTime Long time of last modification (GMT/UTC)
+
+ The file access and modification times are in standard Unix signed-
+ long format, indicating the number of seconds since 1 January 1970
+ 00:00:00. The times are relative to Coordinated Universal Time
+ (UTC), also sometimes referred to as Greenwich Mean Time (GMT). To
+ convert to local time, the software must know the local timezone
+ offset from UTC/GMT. The modification time may be used by non-Unix
+ systems to support inter-timezone freshening and updating of zip
+ archives.
+
+ The local-header extra block may optionally contain UID and GID
+ info for the file. The local-header TSize value is the only
+ indication of this. Note that Unix UIDs and GIDs are usually
+ specific to a particular machine, and they generally require root
+ access to restore.
+
+ This extra field type is obsolete, but it has been in use since
+ mid-1994. Therefore future archiving software should continue to
+ support it. Some guidelines:
+
+ An archive member should either contain the old "Unix1"
+ extra field block or the new extra field types "time" and/or
+ "Unix2".
+
+ If both the old "Unix1" block type and one or both of the new
+ block types "time" and "Unix2" are found, the "Unix1" block
+ should be considered invalid and ignored.
+
+ Unarchiving software should recognize both old and new extra
+ field block types, but the info from new types overrides the
+ old "Unix1" field.
+
+ Archiving software should recognize "Unix1" extra fields for
+ timestamp comparison but never create it for updated, freshened
+ or new archive members. When copying existing members to a new
+ archive, any "Unix1" extra field blocks should be converted to
+ the new "time" and/or "Unix2" types.
+
+
+ -Info-ZIP Unix Extra Field (type 2):
+ ==================================
+
+ The following is the layout of the new Info-ZIP extra block for
+ Unix. (Last Revision 19960922)
+
+ Local-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (Unix2) 0x7855 Short tag for this extra block type
+ TSize Short total data size for this block
+ UID Short Unix user ID
+ GID Short Unix group ID
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (Unix2) 0x7855 Short tag for this extra block type
+ TSize Short total data size for this block
+
+ The data size of the central-header version is zero; it is used
+ solely as a flag that UID/GID info is present in the local-header
+ extra field. If additional fields are ever added to the local
+ version, the central version may be extended to indicate this.
+
+ Note that Unix UIDs and GIDs are usually specific to a particular
+ machine, and they generally require root access to restore.
+
+
+ -ASi Unix Extra Field:
+ ====================
+
+ The following is the layout of the ASi extra block for Unix. The
+ local-header and central-header versions are identical.
+ (Last Revision 19960916)
+
+ Value Size Description
+ ----- ---- -----------
+ (Unix3) 0x756e Short tag for this extra block type
+ TSize Short total data size for this block
+ CRC Long CRC-32 of the remaining data
+ Mode Short file permissions
+ SizDev Long symlink'd size OR major/minor dev num
+ UID Short user ID
+ GID Short group ID
+ (var.) variable symbolic link filename
+
+ Mode is the standard Unix st_mode field from struct stat, containing
+ user/group/other permissions, setuid/setgid and symlink info, etc.
+
+ If Mode indicates that this file is a symbolic link, SizDev is the
+ size of the file to which the link points. Otherwise, if the file
+ is a device, SizDev contains the standard Unix st_rdev field from
+ struct stat (includes the major and minor numbers of the device).
+ SizDev is undefined in other cases.
+
+ If Mode indicates that the file is a symbolic link, the final field
+ will be the name of the file to which the link points. The file-
+ name length can be inferred from TSize.
+
+ [Note that TSize may incorrectly refer to the data size not counting
+ the CRC; i.e., it may be four bytes too small.]
+
+
+ -BeOS Extra Field:
+ ================
+
+ The following is the layout of the file-attributes extra block for
+ BeOS. (Last Revision 19970531)
+
+ Local-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (BeOS) 0x6542 Short tag for this extra block type
+ TSize Short total data size for this block
+ BSize Long uncompressed file attribute data size
+ Flags Byte info bits
+ (CType) Short compression type
+ (CRC) Long CRC value for uncompressed file attribs
+ Attribs variable file attribute data
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (BeOS) 0x6542 Short tag for this extra block type
+ TSize Short total data size for this block
+ BSize Long size of uncompressed local EF block data
+ Flags Byte info bits
+
+ The least significant bit of Flags in both headers indicates whether
+ the LOCAL extra field is uncompressed (and therefore whether CType
+ and CRC are omitted):
+
+ bit 0 if set, Attribs is uncompressed (no CType, CRC)
+ bits 1-7 reserved; if set, assume error or unknown data
+
+ Currently the only supported compression types are deflated (type 8)
+ and stored (type 0); the latter is not used by Info-ZIP's Zip but is
+ supported by UnZip.
+
+ Attribs is a BeOS-specific block of data in big-endian format with
+ the following structure (if compressed, uncompress it first):
+
+ Value Size Description
+ ----- ---- -----------
+ Name variable attribute name (null-terminated string)
+ Type Long attribute type (32-bit unsigned integer)
+ Size Long Long data size for this sub-block (64 bits)
+ Data variable attribute data
+
+ The attribute structure is repeated for every attribute. The Data
+ field may contain anything--text, flags, bitmaps, etc.
+
+
+ -SMS/QDOS Extra Field:
+ ====================
+
+ The following is the layout of the file-attributes extra block for
+ SMS/QDOS. The local-header and central-header versions are identical.
+ (Last Revision 19960929)
+
+ Value Size Description
+ ----- ---- -----------
+ (QDOS) 0xfb4a Short tag for this extra block type
+ TSize Short total data size for this block
+ LongID Long extra-field signature
+ (ExtraID) Long additional signature/flag bytes
+ QDirect 64 bytes qdirect structure
+
+ LongID may be "QZHD" or "QDOS". In the latter case, ExtraID will
+ be present. Its first three bytes are "02\0"; the last byte is
+ currently undefined.
+
+ QDirect contains the file's uncompressed directory info (qdirect
+ struct). Its elements are in native (big-endian) format:
+
+ d_length beLong file length
+ d_access byte file access type
+ d_type byte file type
+ d_datalen beLong data length
+ d_reserved beLong unused
+ d_szname beShort size of filename
+ d_name 36 bytes filename
+ d_update beLong time of last update
+ d_refdate beLong file version number
+ d_backup beLong time of last backup (archive date)
+
+
+ -AOS/VS Extra Field:
+ ==================
+
+ The following is the layout of the extra block for Data General
+ AOS/VS. The local-header and central-header versions are identical.
+ (Last Revision 19961125)
+
+ Value Size Description
+ ----- ---- -----------
+ (AOSVS) 0x5356 Short tag for this extra block type
+ TSize Short total data size for this block
+ "FCI\0" Long extra-field signature
+ Version Byte version of AOS/VS extra block (10 = 1.0)
+ Fstat variable fstat packet
+ AclBuf variable raw ACL data ($MXACL bytes)
+
+ Fstat contains the file's uncompressed fstat packet, which is one of
+ the following:
+
+ normal fstat packet (P_FSTAT struct)
+ DIR/CPD fstat packet (P_FSTAT_DIR struct)
+ unit (device) fstat packet (P_FSTAT_UNIT struct)
+ IPC file fstat packet (P_FSTAT_IPC struct)
+
+ AclBuf contains the raw ACL data; its length is $MXACL.
+
+
+ -FWKCS MD5 Extra Field:
+ =====================
+
+ The following is the layout of the optional extra block used by the
+ FWKCS utility. There is no local-header version; the following
+ applies only to the central header. (Last Revision 19961207)
+
+ Central-header version:
+
+ Value Size Description
+ ----- ---- -----------
+ (MD5) 0x4b46 Short tag for this extra block type
+ TSize Short total data size for this block (19)
+ "MD5" 3 bytes extra-field signature
+ MD5hash 16 bytes 128-bit MD5 hash of uncompressed data
+
+ The MD5 hash in this extra block is used to automatically identify
+ files independent of their filenames; it is an an enhanced contents-
+ signature.
+
+ FWKCS provides an option to strip this extra field, if
+ present, from a zipfile central directory. In adding
+ this extra field, FWKCS preserves Zipfile Authenticity
+ Verification; if stripping this extra field, FWKCS
+ preserves all versions of AV through PKZIP version 2.04g.
+
+ ``The MD5 algorithm is being placed in the public domain for review
+ and possible adoption as a standard.'' (Ron Rivest, MIT Laboratory
+ for Computer Science and RSA Data Security, Inc., April 1992, RFC
+ 1321, 11.76-77). FWKCS, and FWKCS Contents_Signature System, are
+ trademarks of Frederick W. Kantor.
+
+
+
+ file comment: (Variable)
+
+ The comment for this file.
+
+ number of this disk: (2 bytes)
+
+ The number of this disk, which contains central
+ directory end record.
+
+ number of the disk with the start of the central directory: (2 bytes)
+
+ The number of the disk on which the central
+ directory starts.
+
+ total number of entries in the central dir on this disk: (2 bytes)
+
+ The number of central directory entries on this disk.
+
+ total number of entries in the central dir: (2 bytes)
+
+ The total number of files in the zipfile.
+
+
+ size of the central directory: (4 bytes)
+
+ The size (in bytes) of the entire central directory.
+
+ offset of start of central directory with respect to
+ the starting disk number: (4 bytes)
+
+ Offset of the start of the central directory on the
+ disk on which the central directory starts.
+
+ zipfile comment length: (2 bytes)
+
+ The length of the comment for this zipfile.
+
+ zipfile comment: (Variable)
+
+ The comment for this zipfile.
+
+
+ D. General notes:
+
+ 1) All fields unless otherwise noted are unsigned and stored
+ in Intel low-byte:high-byte, low-word:high-word order.
+
+ 2) String fields are not null terminated, since the
+ length is given explicitly.
+
+ 3) Local headers should not span disk boundaries. Also, even
+ though the central directory can span disk boundaries, no
+ single record in the central directory should be split
+ across disks.
+
+ 4) The entries in the central directory may not necessarily
+ be in the same order that files appear in the zipfile.
+
+UnShrinking - Method 1
+----------------------
+
+Shrinking is a Dynamic Ziv-Lempel-Welch compression algorithm
+with partial clearing. The initial code size is 9 bits, and
+the maximum code size is 13 bits. Shrinking differs from
+conventional Dynamic Ziv-Lempel-Welch implementations in several
+respects:
+
+1) The code size is controlled by the compressor, and is not
+ automatically increased when codes larger than the current
+ code size are created (but not necessarily used). When
+ the decompressor encounters the code sequence 256
+ (decimal) followed by 1, it should increase the code size
+ read from the input stream to the next bit size. No
+ blocking of the codes is performed, so the next code at
+ the increased size should be read from the input stream
+ immediately after where the previous code at the smaller
+ bit size was read. Again, the decompressor should not
+ increase the code size used until the sequence 256,1 is
+ encountered.
+
+2) When the table becomes full, total clearing is not
+ performed. Rather, when the compressor emits the code
+ sequence 256,2 (decimal), the decompressor should clear
+ all leaf nodes from the Ziv-Lempel tree, and continue to
+ use the current code size. The nodes that are cleared
+ from the Ziv-Lempel tree are then re-used, with the lowest
+ code value re-used first, and the highest code value
+ re-used last. The compressor can emit the sequence 256,2
+ at any time.
+
+
+
+Expanding - Methods 2-5
+-----------------------
+
+The Reducing algorithm is actually a combination of two
+distinct algorithms. The first algorithm compresses repeated
+byte sequences, and the second algorithm takes the compressed
+stream from the first algorithm and applies a probabilistic
+compression method.
+
+The probabilistic compression stores an array of 'follower
+sets' S(j), for j=0 to 255, corresponding to each possible
+ASCII character. Each set contains between 0 and 32
+characters, to be denoted as S(j)[0],...,S(j)[m], where m<32.
+The sets are stored at the beginning of the data area for a
+Reduced file, in reverse order, with S(255) first, and S(0)
+last.
+
+The sets are encoded as { N(j), S(j)[0],...,S(j)[N(j)-1] },
+where N(j) is the size of set S(j). N(j) can be 0, in which
+case the follower set for S(j) is empty. Each N(j) value is
+encoded in 6 bits, followed by N(j) eight bit character values
+corresponding to S(j)[0] to S(j)[N(j)-1] respectively. If
+N(j) is 0, then no values for S(j) are stored, and the value
+for N(j-1) immediately follows.
+
+Immediately after the follower sets, is the compressed data
+stream. The compressed data stream can be interpreted for the
+probabilistic decompression as follows:
+
+
+let Last-Character <- 0.
+loop until done
+ if the follower set S(Last-Character) is empty then
+ read 8 bits from the input stream, and copy this
+ value to the output stream.
+ otherwise if the follower set S(Last-Character) is non-empty then
+ read 1 bit from the input stream.
+ if this bit is not zero then
+ read 8 bits from the input stream, and copy this
+ value to the output stream.
+ otherwise if this bit is zero then
+ read B(N(Last-Character)) bits from the input
+ stream, and assign this value to I.
+ Copy the value of S(Last-Character)[I] to the
+ output stream.
+
+ assign the last value placed on the output stream to
+ Last-Character.
+end loop
+
+
+B(N(j)) is defined as the minimal number of bits required to
+encode the value N(j)-1.
+
+
+The decompressed stream from above can then be expanded to
+re-create the original file as follows:
+
+
+let State <- 0.
+
+loop until done
+ read 8 bits from the input stream into C.
+ case State of
+ 0: if C is not equal to DLE (144 decimal) then
+ copy C to the output stream.
+ otherwise if C is equal to DLE then
+ let State <- 1.
+
+ 1: if C is non-zero then
+ let V <- C.
+ let Len <- L(V)
+ let State <- F(Len).
+ otherwise if C is zero then
+ copy the value 144 (decimal) to the output stream.
+ let State <- 0
+
+ 2: let Len <- Len + C
+ let State <- 3.
+
+ 3: move backwards D(V,C) bytes in the output stream
+ (if this position is before the start of the output
+ stream, then assume that all the data before the
+ start of the output stream is filled with zeros).
+ copy Len+3 bytes from this position to the output stream.
+ let State <- 0.
+ end case
+end loop
+
+
+The functions F,L, and D are dependent on the 'compression
+factor', 1 through 4, and are defined as follows:
+
+For compression factor 1:
+ L(X) equals the lower 7 bits of X.
+ F(X) equals 2 if X equals 127 otherwise F(X) equals 3.
+ D(X,Y) equals the (upper 1 bit of X) * 256 + Y + 1.
+For compression factor 2:
+ L(X) equals the lower 6 bits of X.
+ F(X) equals 2 if X equals 63 otherwise F(X) equals 3.
+ D(X,Y) equals the (upper 2 bits of X) * 256 + Y + 1.
+For compression factor 3:
+ L(X) equals the lower 5 bits of X.
+ F(X) equals 2 if X equals 31 otherwise F(X) equals 3.
+ D(X,Y) equals the (upper 3 bits of X) * 256 + Y + 1.
+For compression factor 4:
+ L(X) equals the lower 4 bits of X.
+ F(X) equals 2 if X equals 15 otherwise F(X) equals 3.
+ D(X,Y) equals the (upper 4 bits of X) * 256 + Y + 1.
+
+
+Imploding - Method 6
+--------------------
+
+The Imploding algorithm is actually a combination of two distinct
+algorithms. The first algorithm compresses repeated byte
+sequences using a sliding dictionary. The second algorithm is
+used to compress the encoding of the sliding dictionary output,
+using multiple Shannon-Fano trees.
+
+The Imploding algorithm can use a 4K or 8K sliding dictionary
+size. The dictionary size used can be determined by bit 1 in the
+general purpose flag word; a 0 bit indicates a 4K dictionary
+while a 1 bit indicates an 8K dictionary.
+
+The Shannon-Fano trees are stored at the start of the compressed
+file. The number of trees stored is defined by bit 2 in the
+general purpose flag word; a 0 bit indicates two trees stored, a
+1 bit indicates three trees are stored. If 3 trees are stored,
+the first Shannon-Fano tree represents the encoding of the
+Literal characters, the second tree represents the encoding of
+the Length information, the third represents the encoding of the
+Distance information. When 2 Shannon-Fano trees are stored, the
+Length tree is stored first, followed by the Distance tree.
+
+The Literal Shannon-Fano tree, if present is used to represent
+the entire ASCII character set, and contains 256 values. This
+tree is used to compress any data not compressed by the sliding
+dictionary algorithm. When this tree is present, the Minimum
+Match Length for the sliding dictionary is 3. If this tree is
+not present, the Minimum Match Length is 2.
+
+The Length Shannon-Fano tree is used to compress the Length part
+of the (length,distance) pairs from the sliding dictionary
+output. The Length tree contains 64 values, ranging from the
+Minimum Match Length, to 63 plus the Minimum Match Length.
+
+The Distance Shannon-Fano tree is used to compress the Distance
+part of the (length,distance) pairs from the sliding dictionary
+output. The Distance tree contains 64 values, ranging from 0 to
+63, representing the upper 6 bits of the distance value. The
+distance values themselves will be between 0 and the sliding
+dictionary size, either 4K or 8K.
+
+The Shannon-Fano trees themselves are stored in a compressed
+format. The first byte of the tree data represents the number of
+bytes of data representing the (compressed) Shannon-Fano tree
+minus 1. The remaining bytes represent the Shannon-Fano tree
+data encoded as:
+
+ High 4 bits: Number of values at this bit length + 1. (1 - 16)
+ Low 4 bits: Bit Length needed to represent value + 1. (1 - 16)
+
+The Shannon-Fano codes can be constructed from the bit lengths
+using the following algorithm:
+
+1) Sort the Bit Lengths in ascending order, while retaining the
+ order of the original lengths stored in the file.
+
+2) Generate the Shannon-Fano trees:
+
+ Code <- 0
+ CodeIncrement <- 0
+ LastBitLength <- 0
+ i <- number of Shannon-Fano codes - 1 (either 255 or 63)
+
+ loop while i >= 0
+ Code = Code + CodeIncrement
+ if BitLength(i) <> LastBitLength then
+ LastBitLength=BitLength(i)
+ CodeIncrement = 1 shifted left (16 - LastBitLength)
+ ShannonCode(i) = Code
+ i <- i - 1
+ end loop
+
+
+3) Reverse the order of all the bits in the above ShannonCode()
+ vector, so that the most significant bit becomes the least
+ significant bit. For example, the value 0x1234 (hex) would
+ become 0x2C48 (hex).
+
+4) Restore the order of Shannon-Fano codes as originally stored
+ within the file.
+
+Example:
+
+ This example will show the encoding of a Shannon-Fano tree
+ of size 8. Notice that the actual Shannon-Fano trees used
+ for Imploding are either 64 or 256 entries in size.
+
+Example: 0x02, 0x42, 0x01, 0x13
+
+ The first byte indicates 3 values in this table. Decoding the
+ bytes:
+ 0x42 = 5 codes of 3 bits long
+ 0x01 = 1 code of 2 bits long
+ 0x13 = 2 codes of 4 bits long
+
+ This would generate the original bit length array of:
+ (3, 3, 3, 3, 3, 2, 4, 4)
+
+ There are 8 codes in this table for the values 0 thru 7. Using the
+ algorithm to obtain the Shannon-Fano codes produces:
+
+ Reversed Order Original
+Val Sorted Constructed Code Value Restored Length
+--- ------ ----------------- -------- -------- ------
+0: 2 1100000000000000 11 101 3
+1: 3 1010000000000000 101 001 3
+2: 3 1000000000000000 001 110 3
+3: 3 0110000000000000 110 010 3
+4: 3 0100000000000000 010 100 3
+5: 3 0010000000000000 100 11 2
+6: 4 0001000000000000 1000 1000 4
+7: 4 0000000000000000 0000 0000 4
+
+
+The values in the Val, Order Restored and Original Length columns
+now represent the Shannon-Fano encoding tree that can be used for
+decoding the Shannon-Fano encoded data. How to parse the
+variable length Shannon-Fano values from the data stream is beyond the
+scope of this document. (See the references listed at the end of
+this document for more information.) However, traditional decoding
+schemes used for Huffman variable length decoding, such as the
+Greenlaw algorithm, can be successfully applied.
+
+The compressed data stream begins immediately after the
+compressed Shannon-Fano data. The compressed data stream can be
+interpreted as follows:
+
+loop until done
+ read 1 bit from input stream.
+
+ if this bit is non-zero then (encoded data is literal data)
+ if Literal Shannon-Fano tree is present
+ read and decode character using Literal Shannon-Fano tree.
+ otherwise
+ read 8 bits from input stream.
+ copy character to the output stream.
+ otherwise (encoded data is sliding dictionary match)
+ if 8K dictionary size
+ read 7 bits for offset Distance (lower 7 bits of offset).
+ otherwise
+ read 6 bits for offset Distance (lower 6 bits of offset).
+
+ using the Distance Shannon-Fano tree, read and decode the
+ upper 6 bits of the Distance value.
+
+ using the Length Shannon-Fano tree, read and decode
+ the Length value.
+
+ Length <- Length + Minimum Match Length
+
+ if Length = 63 + Minimum Match Length
+ read 8 bits from the input stream,
+ add this value to Length.
+
+ move backwards Distance+1 bytes in the output stream, and
+ copy Length characters from this position to the output
+ stream. (if this position is before the start of the output
+ stream, then assume that all the data before the start of
+ the output stream is filled with zeros).
+end loop
+
+Tokenizing - Method 7
+--------------------
+
+This method is not used by PKZIP.
+
+Deflating - Method 8
+-----------------
+
+The Deflate algorithm is similar to the Implode algorithm using
+a sliding dictionary of up to 32K with secondary compression
+from Huffman/Shannon-Fano codes.
+
+The compressed data is stored in blocks with a header describing
+the block and the Huffman codes used in the data block. The header
+format is as follows:
+
+ Bit 0: Last Block bit This bit is set to 1 if this is the last
+ compressed block in the data.
+ Bits 1-2: Block type
+ 00 (0) - Block is stored - All stored data is byte aligned.
+ Skip bits until next byte, then next word = block length,
+ followed by the ones compliment of the block length word.
+ Remaining data in block is the stored data.
+
+ 01 (1) - Use fixed Huffman codes for literal and distance codes.
+ Lit Code Bits Dist Code Bits
+ --------- ---- --------- ----
+ 0 - 143 8 0 - 31 5
+ 144 - 255 9
+ 256 - 279 7
+ 280 - 287 8
+
+ Literal codes 286-287 and distance codes 30-31 are never
+ used but participate in the huffman construction.
+
+ 10 (2) - Dynamic Huffman codes. (See expanding Huffman codes)
+
+ 11 (3) - Reserved - Flag a "Error in compressed data" if seen.
+
+Expanding Huffman Codes
+-----------------------
+If the data block is stored with dynamic Huffman codes, the Huffman
+codes are sent in the following compressed format:
+
+ 5 Bits: # of Literal codes sent - 257 (257 - 286)
+ All other codes are never sent.
+ 5 Bits: # of Dist codes - 1 (1 - 32)
+ 4 Bits: # of Bit Length codes - 4 (4 - 19)
+
+The Huffman codes are sent as bit lengths and the codes are built as
+described in the implode algorithm. The bit lengths themselves are
+compressed with Huffman codes. There are 19 bit length codes:
+
+ 0 - 15: Represent bit lengths of 0 - 15
+ 16: Copy the previous bit length 3 - 6 times.
+ The next 2 bits indicate repeat length (0 = 3, ... ,3 = 6)
+ Example: Codes 8, 16 (+2 bits 11), 16 (+2 bits 10) will
+ expand to 12 bit lengths of 8 (1 + 6 + 5)
+ 17: Repeat a bit length of 0 for 3 - 10 times. (3 bits of length)
+ 18: Repeat a bit length of 0 for 11 - 138 times (7 bits of length)
+
+The lengths of the bit length codes are sent packed 3 bits per value
+(0 - 7) in the following order:
+
+ 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15
+
+The Huffman codes should be built as described in the Implode algorithm
+except codes are assigned starting at the shortest bit length, i.e. the
+shortest code should be all 0's rather than all 1's. Also, codes with
+a bit length of zero do not participate in the tree construction. The
+codes are then used to decode the bit lengths for the literal and distance
+tables.
+
+The bit lengths for the literal tables are sent first with the number
+of entries sent described by the 5 bits sent earlier. There are up
+to 286 literal characters; the first 256 represent the respective 8
+bit character, code 256 represents the End-Of-Block code, the remaining
+29 codes represent copy lengths of 3 thru 258. There are up to 30
+distance codes representing distances from 1 thru 32k as described
+below.
+
+ Length Codes
+ ------------
+ Extra Extra Extra Extra
+ Code Bits Length Code Bits Lengths Code Bits Lengths Code Bits Length(s)
+ ---- ---- ------ ---- ---- ------- ---- ---- ------- ---- ---- ---------
+ 257 0 3 265 1 11,12 273 3 35-42 281 5 131-162
+ 258 0 4 266 1 13,14 274 3 43-50 282 5 163-194
+ 259 0 5 267 1 15,16 275 3 51-58 283 5 195-226
+ 260 0 6 268 1 17,18 276 3 59-66 284 5 227-257
+ 261 0 7 269 2 19-22 277 4 67-82 285 0 258
+ 262 0 8 270 2 23-26 278 4 83-98
+ 263 0 9 271 2 27-30 279 4 99-114
+ 264 0 10 272 2 31-34 280 4 115-130
+
+ Distance Codes
+ --------------
+ Extra Extra Extra Extra
+ Code Bits Dist Code Bits Dist Code Bits Distance Code Bits Distance
+ ---- ---- ---- ---- ---- ------ ---- ---- -------- ---- ---- --------
+ 0 0 1 8 3 17-24 16 7 257-384 24 11 4097-6144
+ 1 0 2 9 3 25-32 17 7 385-512 25 11 6145-8192
+ 2 0 3 10 4 33-48 18 8 513-768 26 12 8193-12288
+ 3 0 4 11 4 49-64 19 8 769-1024 27 12 12289-16384
+ 4 1 5,6 12 5 65-96 20 9 1025-1536 28 13 16385-24576
+ 5 1 7,8 13 5 97-128 21 9 1537-2048 29 13 24577-32768
+ 6 2 9-12 14 6 129-192 22 10 2049-3072
+ 7 2 13-16 15 6 193-256 23 10 3073-4096
+
+The compressed data stream begins immediately after the
+compressed header data. The compressed data stream can be
+interpreted as follows:
+
+do
+ read header from input stream.
+
+ if stored block
+ skip bits until byte aligned
+ read count and 1's compliment of count
+ copy count bytes data block
+ otherwise
+ loop until end of block code sent
+ decode literal character from input stream
+ if literal < 256
+ copy character to the output stream
+ otherwise
+ if literal = end of block
+ break from loop
+ otherwise
+ decode distance from input stream
+
+ move backwards distance bytes in the output stream, and
+ copy length characters from this position to the output
+ stream.
+ end loop
+while not last block
+
+if data descriptor exists
+ skip bits until byte aligned
+ check data descriptor signature
+ read crc and sizes
+endif
+
+Decryption
+----------
+
+The encryption used in PKZIP was generously supplied by Roger
+Schlafly. PKWARE is grateful to Mr. Schlafly for his expert
+help and advice in the field of data encryption.
+
+PKZIP encrypts the compressed data stream. Encrypted files must
+be decrypted before they can be extracted.
+
+Each encrypted file has an extra 12 bytes stored at the start of
+the data area defining the encryption header for that file. The
+encryption header is originally set to random values, and then
+itself encrypted, using three, 32-bit keys. The key values are
+initialized using the supplied encryption password. After each byte
+is encrypted, the keys are then updated using pseudo-random number
+generation techniques in combination with the same CRC-32 algorithm
+used in PKZIP and described elsewhere in this document.
+
+The following is the basic steps required to decrypt a file:
+
+1) Initialize the three 32-bit keys with the password.
+2) Read and decrypt the 12-byte encryption header, further
+ initializing the encryption keys.
+3) Read and decrypt the compressed data stream using the
+ encryption keys.
+
+
+Step 1 - Initializing the encryption keys
+-----------------------------------------
+
+Key(0) <- 305419896
+Key(1) <- 591751049
+Key(2) <- 878082192
+
+loop for i <- 0 to length(password)-1
+ update_keys(password(i))
+end loop
+
+
+Where update_keys() is defined as:
+
+
+update_keys(char):
+ Key(0) <- crc32(key(0),char)
+ Key(1) <- Key(1) + (Key(0) & 000000ffH)
+ Key(1) <- Key(1) * 134775813 + 1
+ Key(2) <- crc32(key(2),key(1) >> 24)
+end update_keys
+
+
+Where crc32(old_crc,char) is a routine that given a CRC value and a
+character, returns an updated CRC value after applying the CRC-32
+algorithm described elsewhere in this document.
+
+
+Step 2 - Decrypting the encryption header
+-----------------------------------------
+
+The purpose of this step is to further initialize the encryption
+keys, based on random data, to render a plaintext attack on the
+data ineffective.
+
+
+Read the 12-byte encryption header into Buffer, in locations
+Buffer(0) thru Buffer(11).
+
+loop for i <- 0 to 11
+ C <- buffer(i) ^ decrypt_byte()
+ update_keys(C)
+ buffer(i) <- C
+end loop
+
+
+Where decrypt_byte() is defined as:
+
+
+unsigned char decrypt_byte()
+ local unsigned short temp
+ temp <- Key(2) | 2
+ decrypt_byte <- (temp * (temp ^ 1)) >> 8
+end decrypt_byte
+
+
+After the header is decrypted, the last 1 or 2 bytes in Buffer
+should be the high-order word/byte of the CRC for the file being
+decrypted, stored in Intel low-byte/high-byte order, or the high-order
+byte of the file time if bit 3 of the general purpose bit flag is set.
+Versions of PKZIP prior to 2.0 used a 2 byte CRC check; a 1 byte CRC check is
+used on versions after 2.0. This can be used to test if the password
+supplied is correct or not.
+
+
+Step 3 - Decrypting the compressed data stream
+----------------------------------------------
+
+The compressed data stream can be decrypted as follows:
+
+
+loop until done
+ read a character into C
+ Temp <- C ^ decrypt_byte()
+ update_keys(temp)
+ output Temp
+end loop
+
+
+In addition to the above mentioned contributors to PKZIP and PKUNZIP,
+I would like to extend special thanks to Robert Mahoney for suggesting
+the extension .ZIP for this software.
+
+
+References:
+
+ Fiala, Edward R., and Greene, Daniel H., "Data compression with
+ finite windows", Communications of the ACM, Volume 32, Number 4,
+ April 1989, pages 490-505.
+
+ Held, Gilbert, "Data Compression, Techniques and Applications,
+ Hardware and Software Considerations",
+ John Wiley & Sons, 1987.
+
+ Huffman, D.A., "A method for the construction of minimum-redundancy
+ codes", Proceedings of the IRE, Volume 40, Number 9, September 1952,
+ pages 1098-1101.
+
+ Nelson, Mark, "LZW Data Compression", Dr. Dobbs Journal, Volume 14,
+ Number 10, October 1989, pages 29-37.
+
+ Nelson, Mark, "The Data Compression Book", M&T Books, 1991.
+
+ Storer, James A., "Data Compression, Methods and Theory",
+ Computer Science Press, 1988
+
+ Welch, Terry, "A Technique for High-Performance Data Compression",
+ IEEE Computer, Volume 17, Number 6, June 1984, pages 8-19.
+
+ Ziv, J. and Lempel, A., "A universal algorithm for sequential data
+ compression", Communications of the ACM, Volume 30, Number 6,
+ June 1987, pages 520-540.
+
+ Ziv, J. and Lempel, A., "Compression of individual sequences via
+ variable-rate coding", IEEE Transactions on Information Theory,
+ Volume 24, Number 5, September 1978, pages 530-536.
diff --git a/lib/kernel/test/zlib_SUITE_data/zipdoc.1.gz b/lib/kernel/test/zlib_SUITE_data/zipdoc.1.gz
new file mode 100644
index 0000000000..eb72160328
--- /dev/null
+++ b/lib/kernel/test/zlib_SUITE_data/zipdoc.1.gz
Binary files differ
diff --git a/lib/kernel/test/zlib_SUITE_data/zipdoc.txt.gz b/lib/kernel/test/zlib_SUITE_data/zipdoc.txt.gz
new file mode 100644
index 0000000000..23d2280be5
--- /dev/null
+++ b/lib/kernel/test/zlib_SUITE_data/zipdoc.txt.gz
Binary files differ
diff --git a/lib/kernel/test/zlib_SUITE_data/zipdoc.zip b/lib/kernel/test/zlib_SUITE_data/zipdoc.zip
new file mode 100644
index 0000000000..c471b311dd
--- /dev/null
+++ b/lib/kernel/test/zlib_SUITE_data/zipdoc.zip
Binary files differ
diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk
new file mode 100644
index 0000000000..f93ad09b44
--- /dev/null
+++ b/lib/kernel/vsn.mk
@@ -0,0 +1 @@
+KERNEL_VSN = 2.13.4