diff options
Diffstat (limited to 'lib/kernel')
102 files changed, 12226 insertions, 5079 deletions
diff --git a/lib/kernel/Makefile b/lib/kernel/Makefile index 534b564c2c..7586a4c981 100644 --- a/lib/kernel/Makefile +++ b/lib/kernel/Makefile @@ -35,7 +35,7 @@ SPECIAL_TARGETS = # ---------------------------------------------------- include $(ERL_TOP)/make/otp_subdir.mk -DIA_PLT_APPS=crypto +DIA_PLT_APPS=crypto compiler TEST_NEEDS_RELEASE=true include $(ERL_TOP)/make/app_targets.mk diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile index fa2e635324..a9fd26904a 100644 --- a/lib/kernel/doc/src/Makefile +++ b/lib/kernel/doc/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2021. All Rights Reserved. +# Copyright Ericsson AB 1997-2023. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -68,7 +68,6 @@ XML_REF3_FILES = application.xml \ seq_trace.xml \ socket.xml \ wrap_log_reader.xml \ - user.xml \ zlib_stub.xml \ $(XML_REF3_ESOCK_EFILES) diff --git a/lib/kernel/doc/src/application.xml b/lib/kernel/doc/src/application.xml index 2a807e62bb..a1f585f5cd 100644 --- a/lib/kernel/doc/src/application.xml +++ b/lib/kernel/doc/src/application.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2021</year> + <year>1996</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -69,12 +69,21 @@ <func> <name name="ensure_all_started" arity="1" since="OTP R16B02"/> <name name="ensure_all_started" arity="2" since="OTP R16B02"/> - <fsummary>Load and start an application and its dependencies, recursively.</fsummary> + <name name="ensure_all_started" arity="3" since="OTP @OTP-18451@"/> + <fsummary>Loads and starts all applications and their dependencies, recursively.</fsummary> <desc> - <p>Equivalent to calling + <p><c><anno>Applications</anno></c> is either an an <c>atom()</c> or a list + of <c>atom()</c> representing multiple applications.</p> + <p>This function is equivalent to calling <seemfa marker="#start/1"><c>start/1,2</c></seemfa> - repeatedly on all dependencies that are not yet started for an application. + repeatedly on all dependencies that are not yet started of each application. Optional dependencies will also be loaded and started if they are available.</p> + <p>The <c><anno>Mode</anno></c> argument controls if the applications should + be started in <c>serial</c> mode (one at a time) or <c>concurrent</c> mode. + In concurrent mode, a dependency graph is built and the leaves of the graph + are started concurrently and recursively. In both modes, no assertion can be + made about the order the applications are started. If not supplied, it defaults + to <c>serial</c>.</p> <p>Returns <c>{ok, AppNames}</c> for a successful start or for an already started application (which is, however, omitted from the <c>AppNames</c> list).</p> <p>The function reports <c>{error, {AppName,Reason}}</c> for errors, where @@ -181,6 +190,16 @@ </desc> </func> <func> + <name name="get_supervisor" arity="1" since="OTP @OTP-18444@"/> + <fsummary>Get the supervisor of an application.</fsummary> + <desc> + <p>Returns the <c><anno>Pid</anno></c> of the supervisor running + at the root of <c><anno>Application</anno></c>.</p> + <p>If the specified application does not exist or does not + define a callback module, the function returns <c>undefined</c>.</p> + </desc> + </func> + <func> <name name="load" arity="1" since=""/> <name name="load" arity="2" since=""/> <fsummary>Load an application.</fsummary> diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index f551fd1ebe..ffa77641de 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -101,6 +101,18 @@ <code> /usr/local/jungerl:/home/some_user/my_erlang_lib</code> <p>On Windows, use semi-colon as separator.</p> + <p>The code paths specified by <c>$OTP_ROOT</c>, <c>ERL_LIBS</c>, + and boot scripts have their listings cached by default (except for ".") + since OTP @OTP-18466@. + The code server will lookup the contents in their directories once + and avoid future file system traversals. Therefore modules added + to such directories after the Erlang VM boots won't be picked up. + You can disable this behaviour by setting <c>-cache_boot_paths false</c> + or by calling <c>code:set_path(code:get_path())</c>.</p> + <p>The functions in this module and the command line options <c>-pa</c> + and <c>-pz</c> are not cached by default. However, many of the functions + that manipulate the code path accept the <c>cache</c> atom as an optional + argument, which will enable caching on selected paths.</p> </section> <section> @@ -309,6 +321,12 @@ zip:create("mnesia-4.4.7.ez", </section> <datatypes> <datatype> + <name name="add_path_ret"/> + </datatype> + <datatype> + <name name="cache"/> + </datatype> + <datatype> <name name="load_ret"/> </datatype> <datatype> @@ -321,14 +339,24 @@ zip:create("mnesia-4.4.7.ez", <name name="prepared_code"/> <desc><p>An opaque term holding prepared code.</p></desc> </datatype> + <datatype> + <name name="replace_path_ret"/> + </datatype> + <datatype> + <name name="set_path_ret"/> + </datatype> </datatypes> <funcs> <func> <name name="set_path" arity="1" since=""/> + <name name="set_path" arity="2" since="OTP @OTP-18466@"/> <fsummary>Set the code server search path.</fsummary> <desc> <p>Sets the code path to the list of directories <c><anno>Path</anno></c>.</p> + <p>An optional second argument may be set to the atom <c>cache</c> to + control if the contents of the directory must be cached on first traversal. + Defaults to <c>nocache</c>.</p> <p>Returns:</p> <taglist> <tag><c>true</c></tag> @@ -347,13 +375,18 @@ zip:create("mnesia-4.4.7.ez", </func> <func> <name name="add_path" arity="1" since=""/> + <name name="add_path" arity="2" since="OTP @OTP-18466@"/> <name name="add_pathz" arity="1" since=""/> + <name name="add_pathz" arity="2" since="OTP @OTP-18466@"/> <fsummary>Add a directory to the end of the code path.</fsummary> <type name="add_path_ret"/> <desc> <p>Adds <c><anno>Dir</anno></c> to the code path. The directory is added as the last directory in the new path. If <c><anno>Dir</anno></c> already exists in the path, it is not added.</p> + <p>An optional second argument may be set to the atom <c>cache</c> to + control if the contents of the directory must be cached on first traversal. + Defaults to <c>nocache</c>.</p> <p>Returns <c>true</c> if successful, or <c>{error, bad_directory}</c> if <c><anno>Dir</anno></c> is not the name of a directory.</p> @@ -361,12 +394,16 @@ zip:create("mnesia-4.4.7.ez", </func> <func> <name name="add_patha" arity="1" since=""/> + <name name="add_patha" arity="2" since="OTP @OTP-18466@"/> <fsummary>Add a directory to the beginning of the code path.</fsummary> <type name="add_path_ret"/> <desc> <p>Adds <c><anno>Dir</anno></c> to the beginning of the code path. If <c><anno>Dir</anno></c> exists, it is removed from the old position in the code path.</p> + <p>An optional second argument may be set to the atom <c>cache</c> to + control if the contents of the directory must be cached on first traversal. + Defaults to <c>nocache</c>.</p> <p>Returns <c>true</c> if successful, or <c>{error, bad_directory}</c> if <c><anno>Dir</anno></c> is not the name of a directory.</p> @@ -374,17 +411,23 @@ zip:create("mnesia-4.4.7.ez", </func> <func> <name name="add_paths" arity="1" since=""/> + <name name="add_paths" arity="2" since="OTP @OTP-18466@"/> <name name="add_pathsz" arity="1" since=""/> + <name name="add_pathsz" arity="2" since="OTP @OTP-18466@"/> <fsummary>Add directories to the end of the code path.</fsummary> <desc> <p>Adds the directories in <c><anno>Dirs</anno></c> to the end of the code path. If a <c><anno>Dir</anno></c> exists, it is not added.</p> + <p>An optional second argument may be set to the atom <c>cache</c> to + control if the contents of the directory must be cached on first traversal. + Defaults to <c>nocache</c>.</p> <p>Always returns <c>ok</c>, regardless of the validity of each individual <c><anno>Dir</anno></c>.</p> </desc> </func> <func> <name name="add_pathsa" arity="1" since=""/> + <name name="add_pathsa" arity="2" since="OTP @OTP-18466@"/> <fsummary>Add directories to the beginning of the code path.</fsummary> <desc> <p>Traverses <c><anno>Dirs</anno></c> and adds @@ -395,6 +438,9 @@ zip:create("mnesia-4.4.7.ez", be <c>[Dir2,Dir1|OldCodePath]</c>.</p> <p>If a <c><anno>Dir</anno></c> already exists in the code path, it is removed from the old position.</p> + <p>An optional second argument may be set to the atom <c>cache</c> to + control if the contents of the directory must be cached on first traversal. + Defaults to <c>nocache</c>.</p> <p>Always returns <c>ok</c>, regardless of the validity of each individual <c><anno>Dir</anno></c>.</p> </desc> @@ -420,7 +466,35 @@ zip:create("mnesia-4.4.7.ez", </desc> </func> <func> + <name name="del_paths" arity="1" since="OTP @OTP-18466@"/> + <fsummary>Deletes directories from the code path.</fsummary> + <desc> + <p>Deletes directories from the code path. The argument is a list of either + atoms or complete directory names. If an atom <c><anno>Name</anno></c>, + the directory with the name <c>.../<anno>Name</anno>[-Vsn][/ebin]</c> is + deleted from the code path.</p> + <p>Always returns <c>ok</c>, regardless of the validity + of each individual <c><anno>NamesOrDirs</anno></c>.</p> + </desc> + </func> + <func> + <name name="clear_cache" arity="0" since="OTP @OTP-18466@"/> + <fsummary>Clears the code path cache.</fsummary> + <desc> + <p>Clear the code path cache. If a directory is cached, its cache is + cleared once and then it will be recalculated and cached once more + in a future traversal.</p> + <p>If you want to clear the cache for a single path, you might re-add it + to the code path (with <c>add_path/2</c>) or + replace it (with <c>replace_path/3</c>). + If you want to disable all cache, you can reset the code path + with <c>code:set_path(code:get_path())</c>.</p> + <p>Always returns <c>ok</c>.</p> + </desc> + </func> + <func> <name name="replace_path" arity="2" since=""/> + <name name="replace_path" arity="3" since="OTP @OTP-18466@"/> <fsummary>Replace a directory with another in the code path.</fsummary> <desc> <p>Replaces an old occurrence of a directory @@ -430,6 +504,9 @@ zip:create("mnesia-4.4.7.ez", directory must also be named <c>.../<anno>Name</anno>[-Vsn][/ebin]</c>. This function is to be used if a new version of the directory (library) is added to a running system.</p> + <p>An optional third argument may be set to the atom <c>cache</c> to + control if the contents of the directory must be cached on first traversal. + Defaults to <c>nocache</c>.</p> <p>Returns:</p> <taglist> <tag><c>true</c></tag> @@ -981,17 +1058,6 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]), </desc> </func> <func> - <name name="is_module_native" arity="1" since=""/> - <fsummary>Test if a module has native code.</fsummary> - <desc> - <p>Returns <c>false</c> if the given <c><anno>Module</anno></c> is - loaded, and <c>undefined</c> if it is not.</p> - <warning><p>This function is deprecated and will be removed in a future - release.</p></warning> - </desc> - </func> - - <func> <name name="get_mode" arity="0" since="OTP R16B"/> <fsummary>The mode of the code server.</fsummary> <desc> diff --git a/lib/kernel/doc/src/disk_log.xml b/lib/kernel/doc/src/disk_log.xml index 46ed711906..dc6f9ba5bf 100644 --- a/lib/kernel/doc/src/disk_log.xml +++ b/lib/kernel/doc/src/disk_log.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1997</year> - <year>2021</year> + <year>2023</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -39,7 +39,7 @@ <description> <p><c>disk_log</c> is a disk-based term logger that enables efficient logging of items on files.</p> - <p>Two types of logs are supported:</p> + <p>Three types of logs are supported:</p> <taglist> <tag>halt logs</tag> <item><p>Appends items to a single file, which size can @@ -49,6 +49,17 @@ wrap log file is filled up, further items are logged on to the next file in the sequence, starting all over with the first file when the last file is filled up.</p></item> + <tag>rotate logs</tag> + <item><p>Uses a sequence of rotate log files of limited size. As a + log file is filled up, it is rotated and then compressed. There is one active + log file and upto the configured number of compressed log files. Only externally + formatted logs are supported. It follows the same naming convention as the handler + logger_std_h for Logger. For more details about the naming convention check the file + parameter for + <seemfa marker="#open/1"><c>open/1</c></seemfa>.</p> + <p>It follows the same naming convention as that for the compressed files for Linux's + logrotate and BSD's newsyslog.</p> + </item> </taglist> <p>For efficiency reasons, items are always written to files as binaries.</p> @@ -73,7 +84,7 @@ A process that opens a disk log can 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 an owner can close the disk log - either explicitly (by calling <c>close/1</c> or <c>lclose/1,2</c>) + either explicitly (by calling <c>close/1</c>) or by terminating.</p> <p>Owners can subscribe to <em>notifications</em>, messages of the form <c>{disk_log, Node, Log, Info}</c>, which are sent @@ -197,6 +208,9 @@ <datatype> <name name="file_error"/> </datatype> + <datatype> + <name name="next_file_error_rsn"/> + </datatype> </datatypes> <funcs> <func> @@ -207,20 +221,7 @@ </p> </desc> </func> - <func> - <name name="accessible_logs" arity="0" since=""/> - <fsummary>Return the accessible disk logs on the current node.</fsummary> - <desc> - <p>Returns the names of the disk logs accessible on the current node. - The first list contains the logs. The second list is always empty - (before Erlang/OTP 24.0 it used to contain so called distributed - disk logs). - </p> - <note><p>This function is deprecated. - Use <seemfa marker="#all/0"><c>all/0</c></seemfa> instead. - </p></note> - </desc> - </func> + <func> <name name="alog" arity="2" since=""/> <name name="balog" arity="2" since=""/> @@ -326,10 +327,10 @@ but it cannot be decreased to something less than the current file size. </p> - <p>For a wrap log, both the size and the number of files can always - be increased, as long as the number of files does not - exceed 65000. If the maximum number of files is decreased, the - change is not valid until the current file is full and the + <p>For a wrap or rotate log, both the size and the number of files can + always be increased, as long as the number of files does not + exceed 65000. For wrap logs, if the maximum number of files is decreased, + the change is not valid until the current file is full and the log wraps to the next file. The redundant files are removed the next time the log wraps around, that is, starts to log to file number 1. @@ -346,13 +347,16 @@ file (that is, files 7 and 8) are removed the next time file 6 is full. </p> + <p>For rotate logs, if the maximum number of files is decreased, + the redundant files are deleted instantly. + </p> <p>If the size of the files is decreased, the change immediately affects the current log. It does not change the size of log files already full until the next time they are used. </p> <p>If the log size is decreased, for example, to save space, function - <seemfa marker="#inc_wrap_file/1"><c>inc_wrap_file/1</c></seemfa> + <seemfa marker="#next_file/1"><c>next_file/1</c></seemfa>, can be used to force the log to wrap. </p> </desc> @@ -644,27 +648,7 @@ </p> </desc> </func> - <func> - <name name="lclose" arity="1" since=""/> - <name name="lclose" arity="2" since=""/> - <fsummary>Close a disk log on one node.</fsummary> - <type name="lclose_error_rsn"/> - <desc> - <p><c>lclose/1</c> closes a disk log on the current node.</p> - <p><c>lclose/2</c> closes a disk log on the - current node if <anno>Node</anno> is the current node.</p> - <p><c>lclose(<anno>Log</anno>)</c> is equivalent to - <c>lclose(<anno>Log</anno>, node())</c>. - See also <seeerl marker="#close_1"><c>close/1</c></seeerl>. - </p> - <p>If no log with the specified name exist on the current node, - <c>no_such_log</c> is returned. - </p> - <note><p>These functions are deprecated. Use - <seemfa marker="#close/1"><c>close/1</c></seemfa> - instead.</p></note> - </desc> - </func> + <func> <name name="log" arity="2" since=""/> <name name="blog" arity="2" since=""/> @@ -729,6 +713,26 @@ </desc> </func> <func> + <name name="next_file" arity="1" since="OTP @OTP-18331@"/> + <fsummary>Change to the next log file of a disk log.</fsummary> + <type name="next_file_error_rsn"/> + <type name="invalid_header"/> + <desc> + <p>For wrap logs, it forces the disk log to start logging to the + next log file. It can be used, for example, with + <c>change_size/2</c> to reduce the amount of disk space allocated + by the disk log. + </p> + <p>Owners subscribing to notifications normally receive a + <c>wrap</c> message, but if an error occurs with a reason tag + of <c>invalid_header</c> or <c>file_error</c>, an <c>error_status</c> + message is sent.</p> + <p>For rotate logs, it forces rotation of the currently active log + file, compresses it and opens a new active file for logging. + </p> + </desc> + </func> + <func> <name name="open" arity="1" since=""/> <fsummary>Open a disk log file.</fsummary> <type name="dlog_options"/> @@ -757,9 +761,16 @@ the filename defaults to <c>lists:concat([<anno>Log</anno>, ".LOG"])</c> for halt logs.</p> <p>For wrap logs, this is the base name of the files. Each file in - a wrap log is called <c><![CDATA[<base_name>.N]]></c>, where <c>N</c> + a wrap log is called <c><![CDATA[<FileName>.N]]></c>, where <c>N</c> is an integer. Each wrap log also has two files called - <c><![CDATA[<base_name>.idx]]></c> and <c><![CDATA[<base_name>.siz]]></c>. + <c><![CDATA[<FileName>.idx]]></c> and <c><![CDATA[<FileName>.siz]]></c>. + </p> + <p>For rotate logs, this is the name of the active log file. The compressed + files are named as <c><![CDATA[<FileName>.N.gz]]></c>, where <c>N</c> is + an integer and <c><![CDATA[<FileName>.0.gz]]></c> is the latest compressed + log file. All the compressed files are renamed at each rotation so that the + latest files have the smallest index. The maximum value for N is the value of + <c><![CDATA[MaxNoFiles]]></c> minus 1. </p> </item> <tag><c>{linkto, <anno>LinkTo</anno>}</c><marker id="linkto"></marker></tag> @@ -803,10 +814,10 @@ log more items are rejected. Defaults to <c>infinity</c>, which for halt implies that there is no maximum size.</p> - <p>For wrap logs, parameter <c><anno>Size</anno></c> + <p>For wrap and rotate logs, parameter <c><anno>Size</anno></c> can be a pair - <c>{<anno>MaxNoBytes</anno>, <anno>MaxNoFiles</anno>}</c> or - <c>infinity</c>. + <c>{<anno>MaxNoBytes</anno>, <anno>MaxNoFiles</anno>}</c>. For wrap logs + it can also be <c>infinity</c>. In the latter case, if the files of an existing wrap log with the same name can be found, the size is read from the existing wrap log, otherwise an error is returned.</p> @@ -837,6 +848,12 @@ opening an existing wrap log for the first time, that is, when creating the disk log process.</p> </note> + <p>Rotate logs write at most <c><anno>MaxNoBytes</anno></c> + bytes on the active log file and keep the latest <c><anno>MaxNoFiles</anno></c> + compressed files. Regardless of <c><anno>MaxNoBytes</anno></c>, + at least the header (if there is one) and one + item are written on each rotate log file before rotation. + </p> <p>When opening an already open halt log, option <c>size</c> is ignored.</p> </item> @@ -910,7 +927,7 @@ <tag><c>{head, <anno>Head</anno>}</c></tag> <item> <p>Specifies a header to be - written first on the log file. If the log is a wrap + written first on the log file. If the log is a wrap or rotate log, the item <c><anno>Head</anno></c> is written first in each new file. <c><anno>Head</anno></c> is to be a term if the format is <c>internal</c>, otherwise an <c>iodata()</c>. @@ -1015,12 +1032,12 @@ <desc> <p>Renames the log file to <c><anno>File</anno></c> and then recreates a new log file. - If a wrap log exists, <c><anno>File</anno></c> is used as the base name + If a wrap/rotate log exists, <c><anno>File</anno></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 argument <c><anno>Head</anno></c> or <c><anno>BHead</anno></c> is specified, this item is used instead. - The header argument is used only once. Next time a wrap log file + The header argument is used only once. Next time a wrap/rotate log file is opened, the header given to <c>open/1</c> is used. </p> <p><c>reopen/2,3</c> are used for internally formatted @@ -1060,7 +1077,7 @@ If argument <c><anno>Head</anno></c> or <c><anno>BHead</anno></c> is specified, 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 used only once. Next time a wrap log file + The header argument is used only once. Next time a wrap/rotate log file is opened, the header given to <c>open/1</c> is used. </p> <p><c>truncate/1</c> is used for both internally and externally diff --git a/lib/kernel/doc/src/erpc.xml b/lib/kernel/doc/src/erpc.xml index 876a8a66b6..1c5ac214b0 100644 --- a/lib/kernel/doc/src/erpc.xml +++ b/lib/kernel/doc/src/erpc.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2020</year><year>2022</year> + <year>2020</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -57,6 +57,14 @@ Note that it is up to the user to ensure that correct code to execute via <c>erpc</c> is available on the involved nodes. </p> + <note><p> + For some important information about distributed signals, see the + <seeguide marker="system/reference_manual:processes#blocking-signaling-over-distribution"> + Blocking Signaling Over Distribution</seeguide> section in the + <i>Processes</i> chapter of the <i>Erlang Reference Manual</i>. + Blocking signaling can, for example, cause timeouts in <c>erpc</c> + to be significantly delayed. + </p></note> </description> <datatypes> diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 131eba8284..a24dcadcb7 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2022</year> + <year>1996</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1214,6 +1214,9 @@ f.txt: {person, "kalle", 25}. <name name="pid2name" arity="1" since=""/> <fsummary>Return the name of the file handled by a pid.</fsummary> <desc> + <change> + <p>This function is deprecated and will be removed in Erlang/OTP 27.</p> + </change> <p>If <c><anno>Pid</anno></c> is an I/O device, that is, a pid returned from <c>open/2</c>, this function returns the filename, or rather:</p> <taglist> diff --git a/lib/kernel/doc/src/global.xml b/lib/kernel/doc/src/global.xml index 407ca52a8b..9d2442c84a 100644 --- a/lib/kernel/doc/src/global.xml +++ b/lib/kernel/doc/src/global.xml @@ -452,4 +452,3 @@ <seeerl marker="net_kernel"><c>net_kernel(3)</c></seeerl></p> </section> </erlref> - diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 0dac35f9a9..5524000f3d 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2022</year> + <year>1997</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1092,6 +1092,22 @@ get_tcpi_sacked(Sock) -> <seemfa marker="gen_tcp#shutdown/2"><c>gen_tcp:shutdown/2</c></seemfa> to shut down the write side.</p> </item> + <tag><c>{exclusiveaddruse, Boolean}</c> + <marker id="option-exclusiveaddruse"/></tag> + <item> + <p> + Enables/disables exclusive address/port usage on Windows. That + is, by enabling this option you can prevent other sockets from + binding to the same address/port. By default this option is + disabled. That is, other sockets may use the same address/port + by setting <seeerl marker="#option-reuseaddr"><c>{reuseaddr, + true}</c></seeerl> in combination with + <seeerl marker="#option-reuseport"><c>{reuseport, + true}</c></seeerl> unless <c>{exclusiveaddruse, true}</c> + has been set on <c><anno>Socket</anno></c>. On non-Windows + systems this option is silently ignored. + </p> + </item> <tag><c>{header, Size}</c></tag> <item> <p>This option is only meaningful if option <c>binary</c> @@ -1566,18 +1582,109 @@ setcap cap_sys_admin,cap_sys_ptrace,cap_dac_read_search+epi beam.smp</code> option. </p> </item> - <tag><c>{reuseaddr, Boolean}</c></tag> + <tag><c>{reuseaddr, Boolean}</c><marker id="option-reuseaddr"/></tag> + <item> + <p> + Allows or disallows reuse of local address. By default, reuse + is disallowed. + </p> + <note> + <p> + On windows <c>{reuseaddr, true}</c> will have no effect unless + also <seeerl marker="#option-reuseport"><c>{reuseport, + true}</c></seeerl> is set. If both are set, the + <c>SO_REUSEADDR</c> Windows socket option will be enabled. + This since setting <c>SO_REUSEADDR</c> on Windows more or less + has the same behavior as setting both <c>SO_REUSEADDR</c> and + <c>SO_REUSEPORT</c> on BSD. This behavior was introduced as + of OTP @OTP-18344@. + </p> + <change> + <p> + Previous behavior on Windows: + </p> + <list> + <item> + Prior to OTP 25.0, the <c>{reuseaddr, true}</c> option was + silently ignored. + </item> + <item> + Between OTP 25.0 and up to the predecessor of OTP 25.2, + the underlying <c>SO_REUSEADDR</c> socket option was set + if <c>{reuseaddr, true}</c> was set. + </item> + <item> + Between OTP 25.2 and up to the predecessor of OTP @OTP-18344@, + the underlying <c>SO_REUSEADDR</c> socket option was only + set on UDP sockets if <c>{reuseaddr, true}</c> was set, and + silently ignored on other sockets. + </item> + </list> + </change> + <p> + See also the + <seeerl marker="#option-exclusiveaddruse"><c>exclusiveaddruse</c></seeerl> + option. + </p> + </note> + </item> + <tag><c>{reuseport, Boolean}</c><marker id="option-reuseport"/></tag> + <item> + <p> + Allows or disallows reuse of local port which <i>may or may not</i> + have load balancing depending on the underlying OS. By default, + reuse is disallowed. See also + <seeerl marker="#option-reuseport_lb"><c>reuseport_lb</c></seeerl>. + </p> + <note> + <p> + On windows <c>{reuseport, true}</c> will have no effect unless + also <seeerl marker="#option-reuseaddr"><c>{reuseaddr, + true}</c></seeerl> is set. If both are set, the + <c>SO_REUSEADDR</c> Windows socket option will be enabled. + This since setting <c>SO_REUSEADDR</c> on Windows more or less + has the same behavior as setting both <c>SO_REUSEADDR</c> and + <c>SO_REUSEPORT</c> on BSD. The <c>reuseport</c> option was + introduced as of OTP @OTP-18344@. + </p> + <p> + See also the + <seeerl marker="#option-exclusiveaddruse"><c>exclusiveaddruse</c></seeerl> + option. + </p> + </note> + <note> + <p> + <c>reuseport</c> <i>may or may not</i> be the same underlying + option as + <seeerl marker="#option-reuseport_lb"><c>reuseport_lb</c></seeerl> + depending on the underlying OS. They, for example, are on Linux. + When they are the same underlying option, operating on both may + cause them to interact in surprising ways. For example, + by enabling <c>reuseport</c> and then disabling + <c>reuseport_lb</c> both will end up being disabled. + </p> + </note> + </item> + <tag><c>{reuseport_lb, Boolean}</c><marker id="option-reuseport_lb"/></tag> <item> <p> - Allows or disallows local reuse of address. By - default, reuse is disallowed. + Allows or disallows reuse of local port <i>with</i> load balancing. + By default, reuse is disallowed. See also + <seeerl marker="#option-reuseport"><c>reuseport</c></seeerl>. </p> - <note><p> - On Windows this option will be ignored unless - <c><anno>Socket</anno></c> is an UDP socket. This since the - behavior of <c>reuseaddr</c> is very different on Windows - compared to other system. - </p></note> + <note> + <p> + <c>reuseport_lb</c> <i>may or may not</i> be the same underlying + option as + <seeerl marker="#option-reuseport"><c>reuseport</c></seeerl> + depending on the underlying OS. They, for example, are on Linux. + When they are the same underlying option, operating on both may + cause them to interact in surprising ways. For example, + by enabling <c>reuseport_lb</c> and then disabling + <c>reuseport</c> both will end up being disabled. + </p> + </note> </item> <tag><c>{send_timeout, Integer}</c></tag> <item> diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml index 326b53a873..17edb81002 100644 --- a/lib/kernel/doc/src/kernel_app.xml +++ b/lib/kernel/doc/src/kernel_app.xml @@ -669,7 +669,6 @@ erl -kernel logger '[{handler,default,logger_std_h,#{formatter=>{logger_formatte <seeerl marker="pg"><c>pg(3)</c></seeerl>, <seeerl marker="rpc"><c>rpc(3)</c></seeerl>, <seeerl marker="seq_trace"><c>seq_trace(3)</c></seeerl>, - <seeerl marker="user"><c>user(3)</c></seeerl>, <seeerl marker="stdlib:timer"><c>timer(3)</c></seeerl></p> </section> </appref> diff --git a/lib/kernel/doc/src/os.xml b/lib/kernel/doc/src/os.xml index 9ac0583d0a..11bc1d4b43 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2021</year> + <year>1997</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -115,8 +115,8 @@ <fsummary>Execute a command in a shell of the target OS.</fsummary> <desc> <p>Executes <c><anno>Command</anno></c> in a command shell of the - target OS, captures the standard output of the command, - and returns this result as a string.</p> + target OS, captures the standard output and standard error of the + command, and returns this result as a string.</p> <p><em>Examples:</em></p> <code type="none"> LsOut = os:cmd("ls"), % on unix platform diff --git a/lib/kernel/doc/src/ref_man.xml b/lib/kernel/doc/src/ref_man.xml index 7864764685..39973158d6 100644 --- a/lib/kernel/doc/src/ref_man.xml +++ b/lib/kernel/doc/src/ref_man.xml @@ -4,7 +4,7 @@ <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2021</year> + <year>1996</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -69,7 +69,6 @@ <xi:include href="rpc.xml"/> <xi:include href="seq_trace.xml"/> <xi:include href="socket.xml"/> - <xi:include href="user.xml"/> <xi:include href="wrap_log_reader.xml"/> <xi:include href="zlib_stub.xml"/> </application> diff --git a/lib/kernel/doc/src/rpc.xml b/lib/kernel/doc/src/rpc.xml index 6b471d0d42..c5b110f2e5 100644 --- a/lib/kernel/doc/src/rpc.xml +++ b/lib/kernel/doc/src/rpc.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2022</year> + <year>1996</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -53,6 +53,14 @@ <c>erpc</c>, so the <c>rpc</c> module won't not suffer scalability wise and performance wise compared to <c>erpc</c>. </p></note> + <note><p> + For some important information about distributed signals, see the + <seeguide marker="system/reference_manual:processes#blocking-signaling-over-distribution"> + Blocking Signaling Over Distribution</seeguide> section in the + <i>Processes</i> chapter of the <i>Erlang Reference Manual</i>. + Blocking signaling can, for example, cause timeouts in <c>rpc</c> + to be significantly delayed. + </p></note> </description> <datatypes> diff --git a/lib/kernel/doc/src/socket.xml b/lib/kernel/doc/src/socket.xml index 753517bee4..2861108da6 100644 --- a/lib/kernel/doc/src/socket.xml +++ b/lib/kernel/doc/src/socket.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2018</year><year>2022</year> + <year>2018</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -40,48 +40,97 @@ the functions, e.g. <seemfa marker="#recv/3"><c>recv/3</c></seemfa>, have a time-out argument. </p> + <marker id="asynchronous-call"/> <note> <p> - Some functions allow for an <i>asynchronous</i> call. - This is achieved by setting the <c>Timeout</c> argument to - <c>nowait</c>. For instance, if calling the + Some functions allow for an <i>asynchronous</i> call. + This is achieved by setting the <c>Timeout</c> argument to + <c>nowait</c> or to a + (<seetype marker="socket#select_handle">select</seetype> + or + <seetype marker="socket#completion_handle">completion</seetype>) + <i>handle</i>. + </p> + <p> + For instance, if calling the <seeerl marker="#recv-nowait"><c>recv/3</c></seeerl> function with Timeout set to <c>nowait</c> (<c>recv(Sock, 0, nowait)</c>) - when there is actually nothing to read, it will return with - <c>{select, </c> - <seetype marker="#select_info"><c>SelectInfo</c></seetype><c>}</c> - (<c>SelectInfo</c> contains the - <seetype marker="socket#select_handle">SelectHandle</seetype>). - When data eventually arrives a 'select' message - will be sent to the caller: + when there is actually nothing to read, it will return with either + one of: </p> <taglist> <!-- NOTE THAT THE EMPTY TAG IS INTENTIONAL --> <tag></tag> - <item><c>{'$socket', socket(), select, SelectHandle}</c></item> + <item><c>{completion, </c> + <seetype marker="#completion_info"><c>CompletionInfo</c></seetype><c>}</c></item> + <tag></tag> + <item><c>{select, </c> + <seetype marker="#select_info"><c>SelectInfo</c></seetype><c>}</c></item> </taglist> <p> - The caller can now call the <c>recv</c> function again - and probably expect data - (it is really up to the OS network protocol implementation). + <c>CompletionInfo</c> contains the + <seetype marker="socket#completion_handle">CompletionHandle</seetype> + and + <c>SelectInfo</c> contains the + <seetype marker="socket#select_handle">SelectHandle</seetype>. </p> <p> - Note that all other users are <em>locked out</em> until the - 'current user' has called the function (<c>recv</c> in this case) - and its return value shows that the operation has completed. - An operation can also be cancelled with + We have two different implementations. + One on <i>Unix</i> (<c>select</c>, based directly on the synchronous + standard socket interface) + and one on <i>Windows</i> (<c>completion</c>, based on the + asynchronous I/O Completion Ports). + </p> + <p> + These two implementations have a slightly different behaviour + and message interface. + </p> + <p> + The difference will only manifest for the user, if calls are made + with the timeout argument set to 'nowait' (see above). + </p> + + <p> + When an completion message is received (<em>with</em> the result of the + operation), that means that the operation (connect, send, recv, ...) + has been <em>completed</em> (successfully or otherwise). + When a select message is received, that only means that the operation + <em>can now be completed</em>, via a call to, for instance, + <seemfa marker="#connect/1"><c>connect/1</c></seemfa>. + </p> + + <p>The completion message has the format:</p> + <taglist> + <!-- NOTE THAT THE EMPTY TAG IS INTENTIONAL --> + <tag></tag> + <item><c>{'$socket', socket(), completion, {CompletionHandle, CompletionStatus}}</c></item> + </taglist> + <p>The select message has the format: </p> + <taglist> + <!-- NOTE THAT THE EMPTY TAG IS INTENTIONAL --> + <tag></tag> + <item><c>{'$socket', socket(), select, SelectHandle}</c></item> + </taglist> + <p> + Note that, on select "system", all other users are <em>locked out</em> + until the 'current user' has called the function (<c>recv</c> + for instance) and its return value shows that the operation has + completed. + Such an operation can also be cancelled with <seemfa marker="#cancel/2"><c>cancel/2</c></seemfa>. </p> <p> - Instead of <c>Timeout = nowait</c> it is equivalent to create a - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype>) + Instead of <c>Timeout = nowait</c> it is equivalent to create a + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> + or + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype> with <seemfa marker="erts:erlang#make_ref/0"><c>make_ref()</c></seemfa> and give as <c>Timeout</c>. - This will then be the <c>SelectHandle</c> in the 'select' message, - which enables a compiler optimization for receiving + This will then be the <c>Handle</c> in the 'completion' or 'select' + message, which enables a compiler optimization for receiving a message containing a newly created <c>reference()</c> (ignore the part of the message queue that had arrived before the the <c>reference()</c> was created). @@ -98,9 +147,11 @@ If, for instance, the socket has been closed (by another process), <c>Info</c> will be <c>{SelectHandle, closed}</c>. </p> </note> + <note> - <p>There is currently <em>no</em> support for Windows. </p> - <p>Support for IPv6 has been implemented but <em>not</em> tested. </p> + <p>The Windows support has currently <em>pre-release</em> status. </p> + <p>Support for IPv6 has been implemented but not <em>fully</em> + tested. </p> <p>SCTP has only been partly implemented (and not tested). </p> </note> </description> @@ -206,6 +257,41 @@ </p> </desc> </datatype> + + <datatype> + <name name="completion_tag"/> + <desc> + <p> + A tag that describes the ongoing (completion) operation, + contained in the returned + <seetype marker="#completion_info"><c>completion_info()</c></seetype>. + </p> + </desc> + </datatype> + <datatype> + <name name="completion_handle"/> + <desc> + <p> + A <c>reference()</c> that uniquely identifies + the (completion) operation, contained in the returned + <seetype marker="#completion_info"><c>completion_info()</c></seetype>. + </p> + </desc> + </datatype> + <datatype> + <name name="completion_info"/> + <desc> + <p> + Returned by an operation that requires the caller to wait + for a + <seeerl marker="#asynchronous-call">completion message</seeerl> + containing the + <seetype marker="#completion_handle"><c>CompletionHandle</c></seetype> + <em>and</em> the result of the operation; the <c>CompletionStatus</c>. + </p> + </desc> + </datatype> + <datatype> <name name="info"/> <desc> @@ -1399,36 +1485,73 @@ </p> <p> When there is no pending connection to return, - the function will return - <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype>, - and the caller will later receive a select message, - <c>{'$socket', Socket, select, SelectHandle}</c> ( - with the - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> - contained in the - <seetype marker="#select_info"> - <c><anno>SelectInfo</anno></c> - </seetype> - ) when a client connects. - A subsequent call to <c>accept/1,2</c> - will then return the socket. + the function will return (on <i>Unix</i>) + <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype> + or (on <i>Windows</i>) + <seetype marker="#completion_info"><c>{completion, <anno>CompletionInfo</anno>}</c></seetype>, + and the caller will later receive either one of these messages + (depending on the platform) when the client connects: </p> + <taglist> + <tag><c>select</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, select, SelectHandle}</c> + (with the + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> + contained in the + <seetype marker="#select_info"><c><anno>SelectInfo</anno></c></seetype>). + </p> + <p> + A subsequent call to <c>accept/1,2</c> will then return the + socket. + </p> + </item> + <tag><c>completion</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, completion, {CompletionHandle, CompletionStatus}}</c> + (with the + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype> + contained in the + <seetype marker="#completion_info"><c><anno>CompletionInfo</anno></c></seetype>). + </p> + <p> + The <em>result</em> of the accept will be in the + <c>CompletionStatus</c>. + </p> + </item> + </taglist> <p> - If the time-out argument is <c>SelectHandle</c>, + If the time-out argument is a <c>Handle</c>, that term will be contained in a returned - <c><anno>SelectInfo</anno></c> - and the corresponding select message. - The <c>SelectHandle</c> is presumed to be + <c><anno>SelectInfo</anno></c> or <c><anno>CompletionInfo</anno></c> + and the corresponding select or completion message. + The <c>Handle</c> is presumed to be unique to this call. </p> <p> - If the time-out argument is <c>nowait</c>, and a - <c><anno>SelectInfo</anno></c> is returned, - it will contain a - <seetype marker="socket#select_handle"> - <c>select_handle()</c> - </seetype> generated by the call. - </p> + If the time-out argument is <c>nowait</c>:</p> + <taglist> + <tag>On <i>Unix</i></tag> + <item> + <p> + And a <c><anno>SelectInfo</anno></c> is returned, + it will contain a + <seetype marker="socket#select_handle"><c>select_handle()</c></seetype> + generated by the call. + </p> + </item> + <tag>On <i>Windows</i></tag> + <item> + <p> + And a <c><anno>CompletionInfo</anno></c> is returned, + it will contain a + <seetype marker="socket#completion_handle"><c>completion_handle()</c></seetype> + generated by the call. + </p> + </item> + </taglist> <p> If the caller doesn't want to wait for a connection, it must immediately call @@ -1467,10 +1590,10 @@ </func> <func> - <name name="cancel" arity="2" since="OTP 22.1"/> + <name name="cancel" arity="2" clause_i="1" since="OTP 22.1"/> <fsummary>Cancel an asynchronous request.</fsummary> <desc> - <p>Cancel an asynchronous request.</p> + <p>Cancel an asynchronous (select) request.</p> <p> Call this function in order to cancel a previous asynchronous call to, e.g. @@ -1490,7 +1613,7 @@ has been completed. </p> <p> - If <c><anno>SelectInfo</anno></c> does not match an + If <c><anno>SelectInfo</anno></c> does not match an operation in progress for the calling process, this function returns <c>{error, {invalid, SelectInfo}}</c>. @@ -1499,6 +1622,74 @@ </func> <func> + <name name="cancel" arity="2" clause_i="2" since="OTP 26.0"/> + <fsummary>Cancel an asynchronous request.</fsummary> + <desc> + <p>Cancel an asynchronous (completion) request.</p> + <p> + Call this function in order to cancel a previous + asynchronous call to, e.g. + <seemfa marker="#recv/3"><c>recv/3</c></seemfa>. + </p> + <p> + An ongoing asynchronous operation blocks the socket + until the operation has been finished in good order, + or until it has been cancelled by this function. + </p> + <p> + Any other process that tries an operation + of the same basic type (accept / send / recv) will be + enqueued and notified with the regular <c>select</c> + mechanism for asynchronous operations + when the current operation and all enqueued before it + has been completed. + </p> + <p> + If <c><anno>CompletionInfo</anno></c> does not match an + operation in progress for the calling process, + this function returns + <c>{error, {invalid, CompletionInfo}}</c>. + </p> + </desc> + </func> + + <!-- + <func> + <name name="cancel" arity="2" clause_i="1" since="OTP 22.1"/> + <name name="cancel" arity="2" clause_i="2" since="OTP 26.0"/> + <fsummary>Cancel an asynchronous request.</fsummary> + <desc> + <p>Cancel an asynchronous request.</p> + <p> + Call this function in order to cancel a previous + asynchronous call to, e.g. + <seemfa marker="#recv/3"><c>recv/3</c></seemfa>. + </p> + <p> + An ongoing asynchronous operation blocks the socket + until the operation has been finished in good order, + or until it has been cancelled by this function. + </p> + <p> + Any other process that tries an operation + of the same basic type (accept / send / recv) will be + enqueued and notified with the regular <c>select</c> + mechanism for asynchronous operations + when the current operation and all enqueued before it + has been completed. + </p> + <p> + If <c><anno>SelectInfo</anno></c> or + <c><anno>CompletionInfo</anno></c> does not match an + operation in progress for the calling process, + this function returns + <c>{error, {invalid, SelectInfo | CompletionInfo}}</c>. + </p> + </desc> + </func> + --> + + <func> <name name="close" arity="1" since="OTP 22.0"/> <fsummary>Close a socket.</fsummary> <desc> @@ -1533,6 +1724,11 @@ If a connection attempt is already in progress (by another process), <c>{error, already}</c> is returned. </p> + <note> + <p> + On <i>Windows</i> the socket has to be <em>bound</em>. + </p> + </note> </desc> </func> @@ -1550,6 +1746,9 @@ </p> <note> <p> + On <i>Windows</i> the socket has to be <em>bound</em>. + </p> + <p> Note that when this call has returned <c>{error, timeout}</c> the connection state of the socket is uncertain since the platform's network stack @@ -1620,6 +1819,9 @@ <seemfa marker="#cancel/2"><c>cancel/2</c></seemfa> to cancel the operation. </p> + <note> + <p>On <i>Windows</i> the socket has to be <em>bound</em>.</p> + </note> </desc> </func> @@ -1646,6 +1848,11 @@ but that incurs more overhead since the connect address and time-out are processed in vain. </p> + <note> + <p> + <em>Not</em> used on <i>Windows</i>. + </p> + </note> </desc> </func> @@ -2151,6 +2358,9 @@ <fsummary>Listen for connections on a socket.</fsummary> <desc> <p>Listen for connections on a socket.</p> + <note> + <p>On <i>Windows</i> the socket has to be <em>bound</em>.</p> + </note> </desc> </func> @@ -2466,7 +2676,8 @@ <desc> <p> Receives data from a socket, - but returns a select continuation if the data + but returns a <c>select</c> or <c>completion</c> continuation + if the data could not be returned immediately. </p> <p> @@ -2474,44 +2685,72 @@ <seeerl marker="#recv-infinity"> infinite time-out <c>recv/1,2,3,4</c> </seeerl> - but if the data cannot be delivered immediately, - the function returns - <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype>, - and the caller will then receive a select message, - <c>{'$socket', Socket, select, SelectHandle}</c> - ( with the - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> - contained in the - <seetype marker="#select_info"> - <c><anno>SelectInfo</anno></c> - </seetype> - ) when data has arrived. - A subsequent call to <c>recv/1,2,3,4</c> - will then return the data. + but if the data can be delivered immediately, + the function returns (on <i>Unix</i>) + <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype> + or (on <i>Windows</i>) + <seetype marker="#completion_info"><c>{completion, <anno>CompletionInfo</anno>}</c></seetype>, + and the caller will then receive one of these messages: </p> + + <taglist> + <tag><c>select</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, select, SelectHandle}</c> + (with the + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> + that was contained in the + <seetype marker="#select_info"><c><anno>SelectInfo</anno></c></seetype>) + when data has arrived. + </p> + <p> + A subsequent call to <c>recv/1,2,3,4</c> + will then return the data. + </p> + </item> + <tag><c>completion</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, completion, {CompletionHandle, CompletionStatus}}</c> + (with the + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype> + contained in the + <seetype marker="#completion_info"><c><anno>CompletionInfo</anno></c></seetype>). + </p> + <p> + The <em>result</em> of the receive will be in the + <c>CompletionStatus</c>. + </p> + </item> + </taglist> + <p> - If the time-out argument is <c>SelectHandle</c>, + If <c>Handle</c> is a + <seetype marker="#select_handle"><c>select_handle()</c></seetype> or + <seetype marker="#completion_handle"><c>completion_handle()</c></seetype>, that term will be contained in a returned - <c><anno>SelectInfo</anno></c> - and the corresponding select message. - The <c>SelectHandle</c> is presumed to be - unique to this call. + <c><anno>SelectInfo</anno></c> or <c><anno>CompletionInfo</anno></c> + and the corresponding (select or completion) message. + The <c>Handle</c> is presumed to be unique to this call. </p> <p> If the time-out argument is <c>nowait</c>, and a - <c><anno>SelectInfo</anno></c> is returned, + <c><anno>SelectInfo</anno></c> or + <c><anno>CompletionInfo</anno></c> is returned, it will contain a - <seetype marker="socket#select_handle"> - <c>select_handle()</c> - </seetype> generated by the call. + <seetype marker="socket#select_handle"><c>select_handle()</c></seetype> + or + <seetype marker="socket#completion_handle"><c>completion_handle()</c></seetype> + generated by the call. </p> <p> - Note that for a socket of type <c>stream</c>, + Note that for a socket of type <c>stream</c> (on <i>Unix</i>), if <c><anno>Length</anno> > 0</c> and only part of that amount of data is available, the function will return <seetype marker="#select_info"> - <c>{ok, {<anno>Data</anno>, <anno>SelectInfo</anno></c> + <c>{ok, {<anno>Data</anno>, <anno>SelectInfo</anno>}}</c> </seetype> with partial data. If the caller doesn't want to wait for more data, it must immediately call @@ -2605,7 +2844,7 @@ <desc> <p> Receives a message from a socket, - but returns a select continuation if no message + but returns a select continuation or a completion term if no message could be returned immediately. </p> <p> @@ -2613,36 +2852,63 @@ <seeerl marker="#recvfrom-infinity"> infinite time-out <c>recvfrom/1,2,3,4</c> </seeerl> - but if no message cannot delivered immediately, - the function returns - <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype>, - and the caller will then receive a select message, - <c>{'$socket', Socket, select, SelectHandle}</c> - ( with the - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> - contained in the - <seetype marker="#select_info"> - <c><anno>SelectInfo</anno></c> - </seetype> - ) when data has arrived. - A subsequent call to <c>recvfrom/1,2,3,4</c> - will then return the message. + but if no message can be delivered immediately, + the function returns (on <i>/Unix</i>) + <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype> + or (on <i>Windows</i>) <seetype marker="#completion_info"><c>{completion, <anno>CompletionInfo</anno>}</c></seetype>, + and the caller will then receive one of these messages: </p> + + <taglist> + <tag><c>select</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, select, SelectHandle}</c> + (with the + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> + that was contained in the + <seetype marker="#select_info"><c><anno>SelectInfo</anno></c></seetype>) + when data has arrived. + </p> + <p> + A subsequent call to <c>recvfrom/1,2,3,4</c> + will then return the message. + </p> + </item> + <tag><c>completion</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, completion, {CompletionHandle, CompletionStatus}}</c> + (with the + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype> + contained in the + <seetype marker="#completion_info"><c><anno>CompletionInfo</anno></c></seetype>). + </p> + <p> + The <em>result</em> of the receive will be in the + <c>CompletionStatus</c>. + </p> + </item> + </taglist> + <p> - If the time-out argument is <c>SelectHandle</c>, + If the <c>Handle</c> is a + <seetype marker="#select_handle"><c>select_handle()</c></seetype> or + <seetype marker="#completion_handle"><c>completion_handle()</c></seetype>, that term will be contained in a returned - <c><anno>SelectInfo</anno></c> - and the corresponding select message. - The <c>SelectHandle</c> is presumed to be - unique to this call. + <c><anno>SelectInfo</anno></c> or <c><anno>CompletionInfo</anno></c> + and the corresponding (select or completion) message. + The <c>Handle</c> is presumed to be unique to this call. </p> <p> If the time-out argument is <c>nowait</c>, and a - <c><anno>SelectInfo</anno></c> is returned, + <c><anno>SelectInfo</anno></c> or + <c><anno>CompletionInfo</anno></c> is returned, it will contain a - <seetype marker="socket#select_handle"> - <c>select_handle()</c> - </seetype> generated by the call. + <seetype marker="socket#select_handle"><c>select_handle()</c></seetype> + or + <seetype marker="socket#completion_handle"><c>completion_handle()</c></seetype> + generated by the call. </p> <p> If the caller doesn't want to wait for the data, @@ -2745,44 +3011,70 @@ <desc> <p> Receives a message from a socket, - but returns a select continuation if no message + but returns a select continuation or a completion term if no message could be returned immediately. </p> <p> The same as - <seeerl marker="#recvfrom-infinity"> - infinite time-out <c>recvfrom/1,2,3,4</c> + <seeerl marker="#recvmsg-infinity"> + infinite time-out <c>recvmsg/1,2,3,4</c> </seeerl> - but if no message cannot delivered immediately, - the function returns - <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype>, - and the caller will then receive a select message, - <c>{'$socket', Socket, select, SelectHandle}</c> - ( with the - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> - contained in the - <seetype marker="#select_info"> - <c><anno>SelectInfo</anno></c> - </seetype> - ) when data has arrived. - A subsequent call to <c>recvmsg/1,2,3,4,5</c> - will then return the data. + but if no message can delivered immediately, + the function returns (on <i>Unix</i>) + <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype> + or (on <i>Windows</i>) <seetype marker="#completion_info"><c>{completion, <anno>CompletionInfo</anno>}</c></seetype>, + and the caller will then receive one of these messages: </p> + + <taglist> + <tag><c>select</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, select, SelectHandle}</c> + (with the + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> + that was contained in the + <seetype marker="#select_info"><c><anno>SelectInfo</anno></c></seetype>) + when data has arrived. + </p> + <p> + A subsequent call to <c>recvmsg/1,2,3,4,5</c> + will then return the data. + </p> + </item> + <tag><c>completion</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, completion, {CompletionHandle, CompletionStatus}}</c> + (with the + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype> + contained in the + <seetype marker="#completion_info"><c><anno>CompletionInfo</anno></c></seetype>). + </p> + <p> + The <em>result</em> of the receive will be in the + <c>CompletionStatus</c>. + </p> + </item> + </taglist> <p> - If the time-out argument is <c>SelectHandle</c>, + If the <c>Handle</c> is a + <seetype marker="#select_handle"><c>select_handle()</c></seetype> or + <seetype marker="#completion_handle"><c>completion_handle()</c></seetype>, that term will be contained in a returned - <c><anno>SelectInfo</anno></c> - and the corresponding select message. - The <c>SelectHandle</c> is presumed to be - unique to this call. + <c><anno>SelectInfo</anno></c> or <c><anno>CompletionInfo</anno></c> + and the corresponding (select or completion) message. + The <c>Handle</c> is presumed to be unique to this call. </p> <p> If the time-out argument is <c>nowait</c>, and a - <c><anno>SelectInfo</anno></c> is returned, + <c><anno>SelectInfo</anno></c> or + <c><anno>CompletionInfo</anno></c> is returned, it will contain a - <seetype marker="socket#select_handle"> - <c>select_handle()</c> - </seetype> generated by the call. + <seetype marker="socket#select_handle"><c>select_handle()</c></seetype> + or + <seetype marker="socket#completion_handle"><c>completion_handle()</c></seetype> + generated by the call. </p> <p> If the caller doesn't want to wait for the data, @@ -2932,7 +3224,7 @@ <desc> <p> Sends data on a connected socket, - but returns a select continuation if the data + but returns completion <em>or</em> a select continuation if the data could not be sent immediately. </p> <p> @@ -2942,34 +3234,58 @@ </seeerl> but if the data is not immediately accepted by the platform network layer, the function returns - <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype>, - and the caller will then receive a select message, - <c>{'$socket', Socket, select, SelectHandle}</c> ( - with the - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> - that was contained in the - <seetype marker="#select_info"> - <c><anno>SelectInfo</anno></c> - </seetype> - ) when there is room for more data. - A subsequent call to <c>send/2-4</c> will then send the data. - </p> + (on <i>Unix</i>) <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype> or (on <i>Windows</i>) <seetype marker="#completion_info"><c>{completion, <anno>CompletionInfo</anno>}</c></seetype>, + and the caller will then receive one of these messages: </p> + + <taglist> + <tag><c>select</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, select, SelectHandle}</c> ( + with the + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> + that was contained in the + <seetype marker="#select_info"> + <c><anno>SelectInfo</anno></c> + </seetype> + ) when there is room for more data. </p> + <p>A subsequent call to <c>send/2-4</c> will then send the data. + </p> + </item> + <tag><c>completion</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, completion, {CompletionHandle, CompletionStatus}}</c> + (with the + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype> + contained in the + <seetype marker="#completion_info"><c><anno>CompletionInfo</anno></c></seetype>). + </p> + <p> + The <em>result</em> of the send will be in the + <c>CompletionStatus</c>. + </p> + </item> + </taglist> <p> - If <c>SelectHandle</c> is a - <seetype marker="#select_handle"><c>select_handle()</c></seetype>, + If <c>Handle</c> is a + <seetype marker="#select_handle"><c>select_handle()</c></seetype> or + <seetype marker="#completion_handle"><c>completion_handle()</c></seetype>, that term will be contained in a returned - <c><anno>SelectInfo</anno></c> - and the corresponding select message. - The <c>SelectHandle</c> is presumed to be + <c><anno>SelectInfo</anno></c> or <c><anno>CompletionInfo</anno></c> + and the corresponding select or completion message. + The <c>Handle</c> is presumed to be unique to this call. </p> <p> - If <c>SelectHandle</c> is <c>nowait</c>, and a - <c><anno>SelectInfo</anno></c> is returned, + If <c>Handle</c> is <c>nowait</c>, and a + <c><anno>SelectInfo</anno></c> or + <c><anno>CompletionInfo</anno></c> is returned, it will contain a - <seetype marker="socket#select_handle"> - <c>select_handle()</c> - </seetype> generated by the call. + <seetype marker="socket#select_handle"><c>select_handle()</c></seetype> + or + <seetype marker="socket#completion_handle"><c>completion_handle()</c></seetype> + generated by the call. </p> <p> If some of the data was sent, the function will return @@ -2978,7 +3294,7 @@ {ok, {<anno>RestData</anno>, <anno>SelectInfo</anno>}, </c> </seetype> - which can only happen for a socket of + which can only happen (on <i>Unix</i>) for a socket of <seetype marker="#type">type <c>stream</c></seetype>. If the caller does not want to wait to send the rest of the data, it should immediately cancel the operation with @@ -3091,7 +3407,13 @@ The return value indicates the result from the platform's network layer. See <seeerl marker="#send-infinity"><c>send/2,3,4</c></seeerl>. - </p> + </p> + <note> + <p> + On Windows, this function can only be used with + datagram and raw sockets. + </p> + </note> </desc> </func> @@ -3116,6 +3438,12 @@ if no data or only some of it was accepted by the platform's network layer. </p> + <note> + <p> + On Windows, this function can only be used with + datagram and raw sockets. + </p> + </note> </desc> </func> @@ -3129,7 +3457,7 @@ <desc> <p> Sends a message on a socket, - but returns a select continuation if the data + but returns completion <em>or</em> a select continuation if the data could not be sent immediately. </p> <p> @@ -3138,35 +3466,60 @@ infinity time-out <c>sendmsg/2,3</c> </seeerl> but if the data is not immediately accepted by - the platform network layer, the function returns - <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype>, - and the caller will then receive a select message, - <c>{'$socket', Socket, select, SelectHandle}</c> ( - with the - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> - that was contained in the - <seetype marker="#select_info"> - <c><anno>SelectInfo</anno></c> - </seetype> - ) when there is room for more data. - A subsequent call to <c>sendmsg/2-4</c> will then send the data. + the platform network layer, + the function returns + (on <i>Unix</i>) <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype> or (on <i>Windows</i>) <seetype marker="#completion_info"><c>{completion, <anno>CompletionInfo</anno>}</c></seetype>, + and the caller will then receive one of these messages: </p> + + <taglist> + <tag><c>select</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, select, SelectHandle}</c> ( + with the + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> + that was contained in the + <seetype marker="#select_info"> + <c><anno>SelectInfo</anno></c> + </seetype> + ) when there is room for more data. + A subsequent call to <c>sendmsg/2-4</c> will then send the data. + </p> + </item> + <tag><c>completion</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, completion, {CompletionHandle, CompletionStatus}}</c> + (with the + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype> + contained in the + <seetype marker="#completion_info"><c><anno>CompletionInfo</anno></c></seetype>). + </p> + <p> + The <em>result</em> of the send will be in the + <c>CompletionStatus</c>. + </p> + </item> + </taglist> <p> - If <c>SelectHandle</c>, is a - <seetype marker="#select_handle"><c>select_handle()</c></seetype>, + If <c>Handle</c>, is a + <seetype marker="#select_handle"><c>select_handle()</c></seetype> or + <seetype marker="#completion_handle"><c>completion_handle()</c></seetype>, that term will be contained in a returned - <c><anno>SelectInfo</anno></c> - and the corresponding select message. - The <c>SelectHandle</c> is presumed to be + <c><anno>SelectInfo</anno></c> or <c><anno>CompletionInfo</anno></c> + and the corresponding select or completion message. + The <c>Handle</c> is presumed to be unique to this call. </p> <p> - If <c>SelectHandle</c> is <c>nowait</c>, and a - <c><anno>SelectInfo</anno></c> is returned, + If <c>Timeout</c> is <c>nowait</c>, and a + <c><anno>SelectInfo</anno></c> or + <c><anno>CompletionInfo</anno></c> is returned, it will contain a - <seetype marker="socket#select_handle"> - <c>select_handle()</c> - </seetype> generated by the call. + <seetype marker="socket#select_handle"><c>select_handle()</c></seetype> or + <seetype marker="socket#completion_handle"><c>completion_handle()</c></seetype> + generated by the call. </p> <p> If some of the data was sent, the function will return @@ -3181,6 +3534,12 @@ it should immediately cancel the operation with <seemfa marker="#cancel/2"><c>cancel/2</c></seemfa>. </p> + <note> + <p> + On Windows, this function can only be used with + datagram and raw sockets. + </p> + </note> </desc> </func> @@ -3296,7 +3655,7 @@ <desc> <p> Sends data on a socket, - but returns a select continuation if the data + but returns completion <em>or</em> a select continuation if the data could not be sent immediately. </p> <p> @@ -3307,34 +3666,58 @@ but if the data is not immediately accepted by the platform network layer, the function returns - <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype>, - and the caller will then receive a select message, - <c>{'$socket', Socket, select, SelectHandle}</c> ( - with the - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> - that was contained in the - <seetype marker="#select_info"> - <c><anno>SelectInfo</anno></c> - </seetype> - ) when there is room for more data. - A subsequent call to <c>sendto/3-5</c> will then send the data. - </p> + (on <i>Unix</i>) <seetype marker="#select_info"><c>{select, <anno>SelectInfo</anno>}</c></seetype> or (on <i>Windows</i>) <seetype marker="#completion_info"><c>{completion, <anno>CompletionInfo</anno>}</c></seetype>, + and the caller will then receive one of these messages: </p> + + <taglist> + <tag><c>select</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, select, SelectHandle}</c> ( + with the + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype> + that was contained in the + <seetype marker="#select_info"> + <c><anno>SelectInfo</anno></c> + </seetype> + ) when there is room for more data. </p> + <p>A subsequent call to <c>send/2-4</c> will then send the data. + </p> + </item> + <tag><c>completion</c> message</tag> + <item> + <p> + <c>{'$socket', Socket, completion, {CompletionHandle, CompletionStatus}}</c> + (with the + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype> + contained in the + <seetype marker="#completion_info"><c><anno>CompletionInfo</anno></c></seetype>). + </p> + <p> + The <em>result</em> of the send will be in the + <c>CompletionStatus</c>. + </p> + </item> + </taglist> <p> - If <c>SelectHandle</c> is a - <seetype marker="#select_handle"><c>select_handle()</c></seetype>, + If <c>Handle</c> is a + <seetype marker="#select_handle"><c>select_handle()</c></seetype> or + <seetype marker="#completion_handle"><c>completion_handle()</c></seetype>, that term will be contained in a returned - <c><anno>SelectInfo</anno></c> - and the corresponding select message. - The <c>SelectHandle</c> is presumed to be + <c><anno>SelectInfo</anno></c> or <c><anno>CompletionInfo</anno></c> + and the corresponding select or completion message. + The <c>Handle</c> is presumed to be unique to this call. </p> <p> - If <c>SelectHandle</c> is <c>nowait</c>, and a - <c><anno>SelectInfo</anno></c> is returned, + If <c>Handle</c> is <c>nowait</c>, and a + <c><anno>SelectInfo</anno></c> or + <c><anno>CompletionInfo</anno></c> is returned, it will contain a - <seetype marker="socket#select_handle"> - <c>select_handle()</c> - </seetype> generated by the call. + <seetype marker="socket#select_handle"><c>select_handle()</c></seetype> + or + <seetype marker="socket#completion_handle"><c>completion_handle()</c></seetype> + generated by the call. </p> <p> If some of the data was sent, the function will return @@ -3343,7 +3726,7 @@ {ok, {<anno>RestData</anno>, <anno>SelectInfo</anno>}, </c> </seetype> - which can only happen for a socket of + which can only happen (on <i>Unix</i>) for a socket of <seetype marker="#type">type <c>stream</c></seetype>. If the caller does not want to wait to send the rest of the data, it should immediately cancel the operation with diff --git a/lib/kernel/doc/src/socket_usage.xml b/lib/kernel/doc/src/socket_usage.xml index 39d9ded99e..dfa551426d 100644 --- a/lib/kernel/doc/src/socket_usage.xml +++ b/lib/kernel/doc/src/socket_usage.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2018</year><year>2021</year> + <year>2018</year><year>2023</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -41,38 +41,79 @@ option used. </p> <section> <title>Asynchronous calls</title> - <p>Some functions allow for an <i>asynchronous</i> call - (<seeerl marker="socket#accept-nowait"><c>accept/2</c></seeerl>, - <seeerl marker="socket#connect-nowait"><c>connect/3</c></seeerl>, - <seeerl marker="socket#recv-nowait"><c>recv/3,4</c></seeerl>, - <seeerl marker="socket#recvfrom-nowait"><c>recvfrom/3,4</c></seeerl>, - <seeerl marker="socket#recvmsg-nowait"><c>recvmsg/2,3,5</c></seeerl>, - <seeerl marker="socket#send-nowait"><c>send/3,4</c></seeerl>, - <seeerl marker="socket#sendmsg-nowait"><c>sendmsg/3,4</c></seeerl> and - <seeerl marker="socket#sendto-nowait"><c>sendto/4,5</c></seeerl>). - This is achieved by setting the <c>Timeout</c> argument to - <c>nowait</c>. For instance, if calling the - <seeerl marker="socket#recv-nowait"><c>recv/3</c></seeerl> - function with Timeout set to <c>nowait</c> (i.e. - <c>recv(Sock, 0, nowait)</c>) - when there is actually nothing to read, it will return with - <c>{select, </c> - <seetype marker="socket#select_info"><c>SelectInfo</c></seetype><c>}</c> - (<c>SelectInfo</c> contains the - <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype>). - When data eventually arrives a 'select message' + <p> + Some functions allow for an <i>asynchronous</i> call + (<seeerl marker="socket#accept-nowait"><c>accept/2</c></seeerl>, + <seeerl marker="socket#connect-nowait"><c>connect/3</c></seeerl>, + <seeerl marker="socket#recv-nowait"><c>recv/3,4</c></seeerl>, + <seeerl marker="socket#recvfrom-nowait"><c>recvfrom/3,4</c></seeerl>, + <seeerl marker="socket#recvmsg-nowait"><c>recvmsg/2,3,5</c></seeerl>, + <seeerl marker="socket#send-nowait"><c>send/3,4</c></seeerl>, + <seeerl marker="socket#sendmsg-nowait"><c>sendmsg/3,4</c></seeerl> and + <seeerl marker="socket#sendto-nowait"><c>sendto/4,5</c></seeerl>). + This is achieved by setting the <c>Timeout</c> argument to + <c>nowait</c>. For instance, if calling the + <seeerl marker="socket#recv-nowait"><c>recv/3</c></seeerl> + function with Timeout set to <c>nowait</c> (i.e. + <c>recv(Sock, 0, nowait)</c>) + when there is actually nothing to read, it will return with: + </p> + <taglist> + <tag>On Unix</tag> + <item> + <p> + <c>{select, </c> + <seetype marker="socket#select_info"><c>SelectInfo</c></seetype><c>}</c> + </p> + <p> + <c>SelectInfo</c> contains the + <seetype marker="socket#select_handle"><c>SelectHandle</c></seetype>. + </p> + </item> + + <tag>On Windows</tag> + <item> + <p> + <c>{completion, </c> + <seetype marker="socket#completion_info"><c>CompletionInfo</c></seetype><c>}</c> + </p> + <p> + <c>CompletionInfo</c> contains the + <seetype marker="socket#completion_handle"><c>CompletionHandle</c></seetype>. + </p> + </item> + </taglist> + <p>When data eventually arrives a 'select' or 'completion' message will be sent to the caller:</p> <taglist> - <!-- NOTE THAT THE EMPTY TAG IS INTENTIONAL --> - <tag></tag> - <item><c>{'$socket', socket(), select, SelectHandle}</c></item> + <tag>On Unix</tag> + <item> + <p> + <c>{'$socket', socket(), select, SelectHandle}</c> + </p> + <p> + The caller can then make another + call to the recv function and now expect data. + </p> + <p> + Note that all other users are <em>locked out</em> until the + 'current user' has called the function (recv in this case). + So either immediately call the function or + <seemfa marker="socket#cancel/2"><c>cancel</c></seemfa>. + </p> + </item> + + <tag>On Windows</tag> + <item> + <p> + <c>{'$socket', socket(), completion, {CompletionHandle, CompletionStatus}}</c> + </p> + <p> + The <c>CompletionStatus</c> contains the result of the + operation (read). + </p> + </item> </taglist> - <p>The caller can then make another - call to the recv function and now expect data.</p> - <p>Note that all other users are <em>locked out</em> until the - 'current user' has called the function (recv in this case). So either - immediately call the function or - <seemfa marker="socket#cancel/2"><c>cancel</c></seemfa>. </p> <p>The user must also be prepared to receive an abort message: </p> <taglist> <!-- NOTE THAT THE EMPTY TAG IS INTENTIONAL --> @@ -101,6 +142,10 @@ <cell>select_handle()</cell> </row> <row> + <cell>completion</cell> + <cell>{completion_handle(), CompletionStatus}</cell> + </row> + <row> <cell>abort</cell> <cell>{select_handle(), Reason :: term()}</cell> </row> @@ -108,6 +153,8 @@ </table> <p>The <c>select_handle()</c> is the same as was returned in the <seetype marker="socket#select_info"><c>SelectInfo</c></seetype>. </p> + <p>The <c>completion_handle()</c> is the same as was returned in the + <seetype marker="socket#completion_info"><c>CompletionInfo</c></seetype>. </p> </section> </section> @@ -191,8 +238,11 @@ <cell>default | pos_integer() | {pos_integer(), pos_ineteger()}</cell> <cell>yes</cell> <cell>yes</cell> - <cell>'default' only valid for set. - The tuple form is only valid for type 'stream' and protocol 'tcp'.</cell> + <cell> + The tuple format is <em>not</em> allowed on Windows. + 'default' only valid for set. + The tuple form is only valid for type 'stream' and protocol 'tcp'. + </cell> </row> <row> <cell>rcvctrlbuf</cell> diff --git a/lib/kernel/doc/src/specs.xml b/lib/kernel/doc/src/specs.xml index e856351ce4..fd3877d9a8 100644 --- a/lib/kernel/doc/src/specs.xml +++ b/lib/kernel/doc/src/specs.xml @@ -35,7 +35,6 @@ <xi:include href="../specs/specs_rpc.xml"/> <xi:include href="../specs/specs_seq_trace.xml"/> <xi:include href="../specs/specs_socket.xml"/> - <xi:include href="../specs/specs_user.xml"/> <xi:include href="../specs/specs_wrap_log_reader.xml"/> <xi:include href="../specs/specs_zlib_stub.xml"/> </specs> diff --git a/lib/kernel/doc/src/user.xml b/lib/kernel/doc/src/user.xml deleted file mode 100644 index 38eac1c221..0000000000 --- a/lib/kernel/doc/src/user.xml +++ /dev/null @@ -1,41 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>1996</year> - <year>2016</year> - <holder>Ericsson AB, All Rights Reserved</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - The Initial Developer of the Original Code is Ericsson AB. - </legalnotice> - - <title>user</title> - <prepared>Robert Virding</prepared> - <docno>1</docno> - <date>1996-10-10</date> - <rev>A</rev> - </header> - <module>user</module> - <modulesummary>Standard I/O server.</modulesummary> - <description> - <p><c>user</c> is a server that responds to all 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/include/dist.hrl b/lib/kernel/include/dist.hrl index 16320b64e9..4eef2bb3fc 100644 --- a/lib/kernel/include/dist.hrl +++ b/lib/kernel/include/dist.hrl @@ -72,6 +72,14 @@ ?DFLAG_BIG_CREATION bor ?DFLAG_HANDSHAKE_23)). +%% New mandatory flags in OTP 26 +-define(MANDATORY_DFLAGS_26, (?DFLAG_V4_NC bor + ?DFLAG_UNLINK_ID)). + +%% All mandatory flags +-define(DFLAGS_MANDATORY, (?MANDATORY_DFLAGS_25 bor + ?MANDATORY_DFLAGS_26)). + %% Also update dflag2str() in ../src/dist_util.erl %% when adding flags... diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 2149e89776..f67044f5e7 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -100,6 +100,8 @@ MODULES = \ inet_config \ inet_db \ inet_dns \ + inet_epmd_dist \ + inet_epmd_socket \ inet_gethost_native \ inet_hosts \ inet_parse \ @@ -138,9 +140,9 @@ MODULES = \ seq_trace \ socket \ standard_error \ - user \ user_drv \ user_sup \ + prim_tty \ raw_file_io \ raw_file_io_compressed \ raw_file_io_inflate \ diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index 3eb87d73c7..b3e6eea64f 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2021. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,7 +19,8 @@ %% -module(application). --export([ensure_all_started/1, ensure_all_started/2, start/1, start/2, +-export([ensure_all_started/1, ensure_all_started/2, ensure_all_started/3, + 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, @@ -28,7 +29,7 @@ -export([set_env/1, set_env/2, set_env/3, set_env/4, unset_env/2, unset_env/3]). -export([get_env/1, get_env/2, get_env/3, get_all_env/0, get_all_env/1]). -export([get_key/1, get_key/2, get_all_key/0, get_all_key/1]). --export([get_application/0, get_application/1, info/0]). +-export([get_application/0, get_application/1, get_supervisor/1, info/0]). -export([start_type/0]). -export_type([start_type/0]). @@ -117,28 +118,50 @@ unload(Application) -> application_controller:unload_application(Application). --spec ensure_all_started(Application) -> {'ok', Started} | {'error', Reason} when - Application :: atom(), +-spec ensure_all_started(Applications) -> {'ok', Started} | {'error', Reason} when + Applications :: atom() | [atom()], Started :: [atom()], Reason :: term(). ensure_all_started(Application) -> - ensure_all_started(Application, temporary). + ensure_all_started(Application, temporary, serial). --spec ensure_all_started(Application, Type) -> {'ok', Started} | {'error', Reason} when - Application :: atom(), +-spec ensure_all_started(Applications, Type) -> {'ok', Started} | {'error', AppReason} when + Applications :: atom() | [atom()], Type :: restart_type(), Started :: [atom()], - Reason :: term(). + AppReason :: {atom(), term()}. ensure_all_started(Application, Type) -> - case ensure_all_started([Application], [], Type, []) of - {ok, Started} -> - {ok, lists:reverse(Started)}; - {error, Reason, Started} -> - _ = [stop(App) || App <- Started], - {error, Reason} + ensure_all_started(Application, Type, serial). + +-spec ensure_all_started(Applications, Type, Mode) -> {'ok', Started} | {'error', AppReason} when + Applications :: atom() | [atom()], + Type :: restart_type(), + Mode :: serial | concurrent, + Started :: [atom()], + AppReason :: {atom(), term()}. +ensure_all_started(Application, Type, Mode) when is_atom(Application) -> + ensure_all_started([Application], Type, Mode); +ensure_all_started(Applications, Type, Mode) when is_list(Applications) -> + Opts = #{type => Type, mode => Mode}, + + case enqueue_or_start(Applications, [], #{}, [], [], Opts) of + {ok, DAG, _Pending, Started} when Mode =:= concurrent -> + ReqIDs = gen_server:reqids_new(), + concurrent_dag_start(maps:to_list(DAG), ReqIDs, [], Started, Type); + {ok, DAG, _Pending, Started} when Mode =:= serial -> + 0 = map_size(DAG), + {ok, lists:reverse(Started)}; + {error, AppReason, Started} -> + _ = [stop(Name) || Name <- Started], + {error, AppReason} end. -ensure_all_started([App | Apps], OptionalApps, Type, Started) -> +enqueue_or_start([App | Apps], Optional, DAG, Pending, Started, Opts) + when is_map_key(App, DAG) -> + %% We already traversed the application, so only add it as pending + enqueue_or_start(Apps, Optional, DAG, [App | Pending], Started, Opts); + +enqueue_or_start([App | Apps], Optional, DAG, Pending, Started, Opts) when is_atom(App) -> %% In case the app is already running, we just skip it instead %% of attempting to start all of its children - which would %% have already been loaded and started anyway. @@ -146,16 +169,16 @@ ensure_all_started([App | Apps], OptionalApps, Type, Started) -> false -> case ensure_loaded(App) of {ok, Name} -> - case ensure_started(Name, App, Type, Started) of - {ok, NewStarted} -> - ensure_all_started(Apps, OptionalApps, Type, NewStarted); - Error -> - Error + case enqueue_or_start_app(Name, App, DAG, Pending, Started, Opts) of + {ok, NewDAG, NewPending, NewStarted} -> + enqueue_or_start(Apps, Optional, NewDAG, NewPending, NewStarted, Opts); + ErrorAppReasonStarted -> + ErrorAppReasonStarted end; {error, {"no such file or directory", _} = Reason} -> - case lists:member(App, OptionalApps) of + case lists:member(App, Optional) of true -> - ensure_all_started(Apps, OptionalApps, Type, Started); + enqueue_or_start(Apps, Optional, DAG, Pending, Started, Opts); false -> {error, {App, Reason}, Started} end; @@ -163,27 +186,91 @@ ensure_all_started([App | Apps], OptionalApps, Type, Started) -> {error, {App, Reason}, Started} end; true -> - ensure_all_started(Apps, OptionalApps, Type, Started) + enqueue_or_start(Apps, Optional, DAG, Pending, Started, Opts) end; -ensure_all_started([], _OptionalApps, _Type, Started) -> - {ok, Started}. +enqueue_or_start([], _Optional, DAG, Pending, Started, _Opts) -> + {ok, DAG, Pending, Started}. -ensure_started(Name, App, Type, Started) -> +enqueue_or_start_app(Name, App, DAG, Pending, Started, Opts) -> + #{type := Type, mode := Mode} = Opts, {ok, ChildApps} = get_key(Name, applications), {ok, OptionalApps} = get_key(Name, optional_applications), + {ok, Mod} = get_key(Name, mod), + + %% If the application has no dependencies and we are either + %% on serial mode or the app does not have a module callback, + %% we start it immediately. At the end of serial mode, the DAG + %% is always empty. + case enqueue_or_start(ChildApps, OptionalApps, DAG, [], Started, Opts) of + {ok, NewDAG, NewPending, NewStarted} + when NewPending =:= [], (Mode =:= serial) or (Mod =:= []) -> + case application_controller:start_application(App, Type) of + ok -> + {ok, NewDAG, Pending, [App | NewStarted]}; + {error, {already_started, App}} -> + {ok, NewDAG, Pending, NewStarted}; + {error, Reason} -> + {error, {App, Reason}, NewStarted} + end; + {ok, NewDAG, NewPending, NewStarted} -> + {ok, NewDAG#{App => NewPending}, [App | Pending], NewStarted}; + ErrorAppReasonStarted -> + ErrorAppReasonStarted + end. - case ensure_all_started(ChildApps, OptionalApps, Type, Started) of - {ok, NewStarted} -> - case application_controller:start_application(Name, Type) of - ok -> - {ok, [App | NewStarted]}; - {error, {already_started, App}} -> - {ok, NewStarted}; - {error, Reason} -> - {error, {App, Reason}, NewStarted} - end; - Error -> - Error +concurrent_dag_start([], ReqIDs, _Done, Started, _Type) -> + wait_all_enqueued(ReqIDs, Started, false); +concurrent_dag_start(Pending0, ReqIDs0, Done, Started0, Type) -> + {Pending1, ReqIDs1} = enqueue_dag_leaves(Pending0, ReqIDs0, [], Done, Type), + + case wait_one_enqueued(ReqIDs1, Started0) of + {ok, App, ReqIDs2, Started1} -> + concurrent_dag_start(Pending1, ReqIDs2, [App], Started1, Type); + {error, AppReason, ReqIDs2} -> + wait_all_enqueued(ReqIDs2, Started0, AppReason) + end. + +enqueue_dag_leaves([{App, Children} | Rest], ReqIDs, Acc, Done, Type) -> + case Children -- Done of + [] -> + Req = application_controller:start_application_request(App, Type), + NewReqIDs = gen_server:reqids_add(Req, App, ReqIDs), + enqueue_dag_leaves(Rest, NewReqIDs, Acc, Done, Type); + NewChildren -> + NewAcc = [{App, NewChildren} | Acc], + enqueue_dag_leaves(Rest, ReqIDs, NewAcc, Done, Type) + end; +enqueue_dag_leaves([], ReqIDs, Acc, _Done, _Type) -> + {Acc, ReqIDs}. + +wait_one_enqueued(ReqIDs0, Started) -> + case gen_server:wait_response(ReqIDs0, infinity, true) of + {{reply, ok}, App, ReqIDs1} -> + {ok, App, ReqIDs1, [App | Started]}; + {{reply, {error, {already_started, App}}}, App, ReqIDs1} -> + {ok, App, ReqIDs1, Started}; + {{reply, {error, Reason}}, App, ReqIDs1} -> + {error, {App, Reason}, ReqIDs1}; + {{error, {Reason, _Ref}}, _App, _ReqIDs1} -> + exit(Reason); + no_request -> + exit(deadlock) + end. + +wait_all_enqueued(ReqIDs0, Started0, LastAppReason) -> + case gen_server:reqids_size(ReqIDs0) of + 0 when LastAppReason =:= false -> + {ok, lists:reverse(Started0)}; + 0 -> + _ = [stop(App) || App <- Started0], + {error, LastAppReason}; + _ -> + case wait_one_enqueued(ReqIDs0, Started0) of + {ok, _App, ReqIDs1, Started1} -> + wait_all_enqueued(ReqIDs1, Started1, LastAppReason); + {error, NewAppReason, ReqIDs1} -> + wait_all_enqueued(ReqIDs1, Started0, NewAppReason) + end end. -spec start(Application) -> 'ok' | {'error', Reason} when @@ -397,13 +484,8 @@ get_env(Application, Key) -> Def :: term(), Val :: term(). -get_env(Application, Key, Def) -> - case get_env(Application, Key) of - {ok, Val} -> - Val; - undefined -> - Def - end. +get_env(Application, Key, Default) -> + application_controller:get_env(Application, Key, Default). -spec get_all_env() -> Env when Env :: [{Par :: atom(), Val :: term()}]. @@ -466,6 +548,20 @@ get_application(Pid) when is_pid(Pid) -> get_application(Module) when is_atom(Module) -> application_controller:get_application_module(Module). +-spec get_supervisor(Application) -> 'undefined' | {'ok', Pid} when + Pid :: pid(), + Application :: atom(). + +get_supervisor(Application) when is_atom(Application) -> + case application_controller:get_master(Application) of + undefined -> undefined; + Master -> + case application_master:get_child(Master) of + {Root, _App} -> {ok, Root}; + error -> undefined + end + end. + -spec start_type() -> StartType | 'undefined' | 'local' when StartType :: start_type(). diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 1f428c560b..60080c155e 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2021. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,12 +22,13 @@ %% External exports -export([start/1, load_application/1, unload_application/1, - start_application/2, start_boot_application/2, stop_application/1, + start_application/2, start_application_request/2, + start_boot_application/2, stop_application/1, control_application/1, is_running/1, change_application_data/2, prep_config_change/0, config_change/1, which_applications/0, which_applications/1, loaded_applications/0, info/0, set_env/2, - get_pid_env/2, get_env/2, get_pid_all_env/1, get_all_env/1, + get_pid_env/2, get_env/2, get_env/3, 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, @@ -237,6 +238,9 @@ unload_application(AppName) -> start_application(AppName, RestartType) -> gen_server:call(?AC, {start_application, AppName, RestartType}, infinity). +start_application_request(AppName, RestartType) -> + gen_server:send_request(?AC, {start_application, AppName, RestartType}). + %%----------------------------------------------------------------- %% Func: is_running/1 %% Args: Application = atom() @@ -343,11 +347,15 @@ get_pid_env(Master, Key) -> end. get_env(AppName, Key) -> - case ets:lookup(ac_tab, {env, AppName, Key}) of - [{_, Val}] -> {ok, Val}; - _ -> undefined + NotFound = make_ref(), + case ets:lookup_element(ac_tab, {env, AppName, Key}, 2, NotFound) of + NotFound -> undefined; + Val -> {ok, Val} end. +get_env(AppName, Key, Default) -> + ets:lookup_element(ac_tab, {env, AppName, Key}, 2, Default). + get_pid_all_env(Master) -> case ets:match(ac_tab, {{application_master, '$1'}, Master}) of [[AppName]] -> get_all_env(AppName); @@ -442,10 +450,7 @@ start_type(Master) -> get_master(AppName) -> - case ets:lookup(ac_tab, {application_master, AppName}) of - [{_, Pid}] -> Pid; - _ -> undefined - end. + ets:lookup_element(ac_tab, {application_master, AppName}, 2, undefined). get_application(Master) -> case ets:match(ac_tab, {{application_master, '$1'}, Master}) of @@ -1541,6 +1546,11 @@ make_appl_i({application, Name, Opts}) when is_atom(Name), is_list(Opts) -> end, Phases = get_opt(start_phases, Opts, undefined), Env = get_opt(env, Opts, []), + case check_para(Env, Name) of + ok -> ok; + {error, Reason} -> + throw({error, {invalid_options, Reason}}) + end, MaxP = get_opt(maxP, Opts, infinity), MaxT = get_opt(maxT, Opts, infinity), IncApps = get_opt(included_applications, Opts, []), diff --git a/lib/kernel/src/application_master.erl b/lib/kernel/src/application_master.erl index 35c9db170e..fa8fed6d28 100644 --- a/lib/kernel/src/application_master.erl +++ b/lib/kernel/src/application_master.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2021. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -75,7 +75,7 @@ call(AppMaster, Req) -> AppMaster ! {Req, Tag, self()}, receive {'DOWN', Ref, process, _, _Info} -> - ok; + error; {Tag, Res} -> erlang:demonitor(Ref, [flush]), Res diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 001f3ac981..13fed657d1 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,17 +26,15 @@ %% some implementation details. See also related modules: code_*.erl %% in this directory. --export([objfile_extension/0, - set_path/1, - get_path/0, +-export([objfile_extension/0, + set_path/1, set_path/2, + get_path/0, load_file/1, ensure_loaded/1, ensure_modules_loaded/1, load_abs/1, load_abs/2, load_binary/3, - load_native_partial/2, - load_native_sticky/3, atomic_load/1, prepare_loading/1, finish_loading/1, @@ -59,18 +57,20 @@ 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, + add_paths/1, add_paths/2, + add_path/1, add_path/2, + add_pathsa/1, add_pathsa/2, + add_pathsz/1, add_pathsz/2, + add_patha/1, add_patha/2, + add_pathz/1, add_pathz/2, del_path/1, - replace_path/2, - rehash/0, + del_paths/1, + clear_cache/0, + replace_path/2,replace_path/3, start_link/0, which/1, get_doc/1, + get_doc/2, where_is_file/1, where_is_file/2, set_primary_archive/4, @@ -80,8 +80,8 @@ modified_modules/0, get_mode/0]). --deprecated({rehash,0,"the code path cache feature has been removed"}). --deprecated({is_module_native,1,"HiPE has been removed"}). +-removed({rehash,0,"the code path cache feature has been removed"}). +-removed({is_module_native,1,"HiPE has been removed"}). -export_type([load_error_rsn/0, load_ret/0]). -export_type([prepared_code/0]). @@ -93,6 +93,8 @@ %% Some types for basic exported functions of this module %%---------------------------------------------------------------------------- +-define(is_cache(T), T =:= cache orelse T =:= nocache). +-type cache() :: cache | nocache. -type load_error_rsn() :: 'badfile' | 'nofile' | 'not_purged' @@ -110,7 +112,7 @@ %%% BIFs --export([get_chunk/2, is_module_native/1, module_md5/1]). +-export([get_chunk/2, module_md5/1]). -spec get_chunk(Bin, Chunk) -> binary() | undefined when @@ -134,16 +136,6 @@ get_chunk_1(Beam, Chunk) -> erlang:raise(error, Reason, [{Mod,get_chunk,L,Loc}|Rest]) end. --spec is_module_native(Module) -> true | false | undefined when - Module :: module(). -is_module_native(Module) when is_atom(Module) -> - case is_loaded(Module) of - {file, _} -> false; - false -> undefined - end; -is_module_native(Module) -> - erlang:error(badarg, [Module]). - -spec module_md5(binary()) -> binary() | undefined. module_md5(<<"FOR1", _/bits>>=Beam) -> @@ -183,7 +175,10 @@ objfile_extension() -> -spec load_file(Module) -> load_ret() when Module :: module(). load_file(Mod) when is_atom(Mod) -> - call({load_file,Mod}). + case get_object_code(Mod) of + error -> {error,nofile}; + {Mod,Binary,File} -> load_module(Mod, File, Binary, false, false) + end. -spec ensure_loaded(Module) -> {module, Module} | {error, What} when Module :: module(), @@ -191,20 +186,36 @@ load_file(Mod) when is_atom(Mod) -> ensure_loaded(Mod) when is_atom(Mod) -> case erlang:module_loaded(Mod) of true -> {module, Mod}; - false -> call({ensure_loaded,Mod}) + false -> + case get_object_code(Mod) of + error -> call({sync_ensure_on_load, Mod}); + {Mod,Binary,File} -> + load_module(Mod, File, Binary, false, true) + end end. %% XXX File as an atom is allowed only for backwards compatibility. -spec load_abs(Filename) -> load_ret() when Filename :: file:filename(). load_abs(File) when is_list(File); is_atom(File) -> - Mod = list_to_atom(filename:basename(File)), - call({load_abs,File,Mod}). + load_abs(File, list_to_atom(filename:basename(File))). %% XXX Filename is also an atom(), e.g. 'cover_compiled' -spec load_abs(Filename :: loaded_filename(), Module :: module()) -> load_ret(). load_abs(File, M) when (is_list(File) orelse is_atom(File)), is_atom(M) -> - call({load_abs,File,M}). + case modp(File) of + true -> + FileName0 = lists:concat([File, objfile_extension()]), + FileName = code_server:absname(FileName0), + case erl_prim_loader:get_file(FileName) of + {ok,Bin,_} -> + load_module(M, FileName, Bin, false, false); + error -> + {error, nofile} + end; + false -> + {error,badarg} + end. %% XXX Filename is also an atom(), e.g. 'cover_compiled' -spec load_binary(Module, Filename, Binary) -> @@ -215,17 +226,26 @@ load_abs(File, M) when (is_list(File) orelse is_atom(File)), is_atom(M) -> What :: badarg | load_error_rsn(). 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}). + case modp(File) of + true -> load_module(Mod, File, Bin, true, false); + false -> {error,badarg} + end. + +load_module(Mod, File, Bin, Purge, EnsureLoaded) -> + case erlang:prepare_loading(Mod, Bin) of + {error,_}=Error -> + Error; + Prepared -> + call({load_module, Prepared, Mod, File, Purge, EnsureLoaded}) + end. --spec load_native_partial(Module :: module(), Binary :: binary()) -> load_ret(). -load_native_partial(Mod, Bin) when is_atom(Mod), is_binary(Bin) -> - call({load_native_partial,Mod,Bin}). +modp(Atom) when is_atom(Atom) -> true; +modp(List) when is_list(List) -> int_list(List); +modp(_) -> false. --spec load_native_sticky(Module :: module(), 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}). +int_list([H|T]) when is_integer(H) -> int_list(T); +int_list([_|_]) -> false; +int_list([]) -> true. -spec delete(Module) -> boolean() when Module :: module(). @@ -242,7 +262,8 @@ soft_purge(Mod) when is_atom(Mod) -> call({soft_purge,Mod}). -spec is_loaded(Module) -> {'file', Loaded} | false when Module :: module(), Loaded :: loaded_filename(). -is_loaded(Mod) when is_atom(Mod) -> call({is_loaded,Mod}). +is_loaded(Mod) when is_atom(Mod) -> + code_server:is_loaded(Mod). -spec get_object_code(Module) -> {Module, Binary, Filename} | error when Module :: module(), @@ -345,12 +366,18 @@ unstick_mod(Mod) when is_atom(Mod) -> call({unstick_mod,Mod}). -spec is_sticky(Module) -> boolean() when Module :: module(). -is_sticky(Mod) when is_atom(Mod) -> call({is_sticky,Mod}). +is_sticky(Mod) when is_atom(Mod) -> + code_server:is_sticky(Mod). --spec set_path(Path) -> 'true' | {'error', What} when - Path :: [Dir :: file:filename()], - What :: 'bad_directory'. -set_path(PathList) when is_list(PathList) -> call({set_path,PathList}). +-type set_path_ret() :: 'true' | {'error', 'bad_directory'}. +-spec set_path(Path) -> set_path_ret() when + Path :: [Dir :: file:filename()]. +set_path(PathList) -> set_path(PathList, nocache). + +-spec set_path(Path, cache()) -> set_path_ret() when + Path :: [Dir :: file:filename()]. +set_path(PathList, Cache) when is_list(PathList), ?is_cache(Cache) -> + call({set_path,PathList,Cache}). -spec get_path() -> Path when Path :: [Dir :: file:filename()]. @@ -359,27 +386,51 @@ get_path() -> call(get_path). -type add_path_ret() :: 'true' | {'error', 'bad_directory'}. -spec add_path(Dir) -> add_path_ret() when Dir :: file:filename(). -add_path(Dir) when is_list(Dir) -> call({add_path,last,Dir}). +add_path(Dir) -> add_path(Dir, nocache). + +-spec add_path(Dir, cache()) -> add_path_ret() when + Dir :: file:filename(). +add_path(Dir, Cache) when is_list(Dir), ?is_cache(Cache) -> call({add_path,last,Dir,Cache}). -spec add_pathz(Dir) -> add_path_ret() when Dir :: file:filename(). -add_pathz(Dir) when is_list(Dir) -> call({add_path,last,Dir}). +add_pathz(Dir) -> add_pathz(Dir, nocache). + +-spec add_pathz(Dir, cache()) -> add_path_ret() when + Dir :: file:filename(). +add_pathz(Dir, Cache) when is_list(Dir), ?is_cache(Cache) -> call({add_path,last,Dir,Cache}). -spec add_patha(Dir) -> add_path_ret() when Dir :: file:filename(). -add_patha(Dir) when is_list(Dir) -> call({add_path,first,Dir}). +add_patha(Dir) -> add_patha(Dir, nocache). + +-spec add_patha(Dir, cache()) -> add_path_ret() when + Dir :: file:filename(). +add_patha(Dir, Cache) when is_list(Dir), ?is_cache(Cache) -> call({add_path,first,Dir,Cache}). -spec add_paths(Dirs) -> 'ok' when Dirs :: [Dir :: file:filename()]. -add_paths(Dirs) when is_list(Dirs) -> call({add_paths,last,Dirs}). +add_paths(Dirs) -> add_paths(Dirs, nocache). + +-spec add_paths(Dirs, cache()) -> 'ok' when + Dirs :: [Dir :: file:filename()]. +add_paths(Dirs, Cache) when is_list(Dirs), ?is_cache(Cache) -> call({add_paths,last,Dirs,Cache}). -spec add_pathsz(Dirs) -> 'ok' when Dirs :: [Dir :: file:filename()]. -add_pathsz(Dirs) when is_list(Dirs) -> call({add_paths,last,Dirs}). +add_pathsz(Dirs) -> add_pathsz(Dirs, nocache). + +-spec add_pathsz(Dirs, cache()) -> 'ok' when + Dirs :: [Dir :: file:filename()]. +add_pathsz(Dirs, Cache) when is_list(Dirs), ?is_cache(Cache) -> call({add_paths,last,Dirs,Cache}). -spec add_pathsa(Dirs) -> 'ok' when Dirs :: [Dir :: file:filename()]. -add_pathsa(Dirs) when is_list(Dirs) -> call({add_paths,first,Dirs}). +add_pathsa(Dirs) -> add_pathsa(Dirs, nocache). + +-spec add_pathsa(Dirs, cache()) -> 'ok' when + Dirs :: [Dir :: file:filename()]. +add_pathsa(Dirs, Cache) when is_list(Dirs), ?is_cache(Cache) -> call({add_paths,first,Dirs,Cache}). -spec del_path(NameOrDir) -> boolean() | {'error', What} when NameOrDir :: Name | Dir, @@ -388,22 +439,33 @@ add_pathsa(Dirs) when is_list(Dirs) -> call({add_paths,first,Dirs}). What :: 'bad_name'. del_path(Name) when is_list(Name) ; is_atom(Name) -> call({del_path,Name}). --spec replace_path(Name, Dir) -> 'true' | {'error', What} when +-spec del_paths(NamesOrDirs) -> 'ok' when + NamesOrDirs :: [Name | Dir], + Name :: atom(), + Dir :: file:filename(). +del_paths(Dirs) when is_list(Dirs) -> call({del_paths,Dirs}). + +-type replace_path_ret() :: 'true' | + {'error', 'bad_directory' | 'bad_name' | {'badarg',_}}. +-spec replace_path(Name, Dir) -> replace_path_ret() when Name:: atom(), - Dir :: file:filename(), - What :: 'bad_directory' | 'bad_name' | {'badarg',_}. -replace_path(Name, Dir) when (is_atom(Name) orelse is_list(Name)), - (is_atom(Dir) orelse is_list(Dir)) -> - call({replace_path,Name,Dir}). - --spec rehash() -> 'ok'. -rehash() -> - cache_warning(), - ok. + Dir :: file:filename(). +replace_path(Name, Dir) -> + replace_path(Name, Dir, nocache). + +-spec replace_path(Name, Dir, cache()) -> replace_path_ret() when + Name:: atom(), + Dir :: file:filename(). +replace_path(Name, Dir, Cache) when (is_atom(Name) orelse is_list(Name)), + (is_atom(Dir) orelse is_list(Dir)), ?is_cache(Cache) -> + call({replace_path,Name,Dir,Cache}). -spec get_mode() -> 'embedded' | 'interactive'. get_mode() -> call(get_mode). +-spec clear_cache() -> ok. +clear_cache() -> call(clear_cache). + %%% %%% Loading of several modules in parallel. %%% @@ -431,8 +493,8 @@ ensure_modules_loaded_1(Ms0) -> end, ensure_modules_loaded_2(OnLoad, Error1). -ensure_modules_loaded_2([{M,_}|Ms], Errors) -> - case ensure_loaded(M) of +ensure_modules_loaded_2([{M,{Prepared,File}}|Ms], Errors) -> + case call({load_module, Prepared, M, File, false, true}) of {module,M} -> ensure_modules_loaded_2(Ms, Errors); {error,Err} -> @@ -578,12 +640,12 @@ prepare_check_uniq_1([], [_|_]=Errors) -> {error,Errors}. partition_on_load(Prep) -> - P = fun({_,{PC,_,_}}) -> + P = fun({_,{PC,_}}) -> erlang:has_prepared_code_on_load(PC) end, lists:partition(P, Prep). -verify_prepared([{M,{Prep,Name,_Native}}|T]) +verify_prepared([{M,{Prep,Name}}|T]) when is_atom(M), is_list(Name) -> try erlang:has_prepared_code_on_load(Prep) of false -> @@ -599,62 +661,35 @@ verify_prepared([]) -> verify_prepared(_) -> error. -finish_loading(Prepared0, EnsureLoaded) -> - Prepared = [{M,{Bin,File}} || {M,{Bin,File,_}} <- Prepared0], - Native0 = [{M,Code} || {M,{_,_,Code}} <- Prepared0, - Code =/= undefined], - case call({finish_loading,Prepared,EnsureLoaded}) of - ok -> - finish_loading_native(Native0); - {error,Errors}=E when EnsureLoaded -> - S0 = sofs:relation(Errors), - S1 = sofs:domain(S0), - R0 = sofs:relation(Native0), - R1 = sofs:drestriction(R0, S1), - Native = sofs:to_external(R1), - finish_loading_native(Native), - E; - {error,_}=E -> - E - end. - -finish_loading_native([{Mod,Code}|Ms]) -> - _ = load_native_partial(Mod, Code), - finish_loading_native(Ms); -finish_loading_native([]) -> - ok. +finish_loading(Prepared, EnsureLoaded) -> + call({finish_loading,Prepared,EnsureLoaded}). load_mods([]) -> {[],[]}; load_mods(Mods) -> - Path = get_path(), - F = prepare_loading_fun(), - {ok,{Succ,Error0}} = erl_prim_loader:get_modules(Mods, F, Path), - Error = [case E of - badfile -> {M,E}; - _ -> {M,nofile} - end || {M,E} <- Error0], - {Succ,Error}. + F = fun(Mod) -> + case get_object_code(Mod) of + {Mod, Beam, File} -> prepare_loading(Mod, File, Beam); + error -> {error, nofile} + end + end, + do_par(F, Mods). load_bins([]) -> {[],[]}; load_bins(BinItems) -> - F = prepare_loading_fun(), + F = fun({Mod, File, Beam}) -> prepare_loading(Mod, File, Beam) end, do_par(F, BinItems). --type prep_fun_type() :: fun((module(), file:filename(), binary()) -> - {ok,_} | {error,_}). +-spec prepare_loading(module(), file:filename(), binary()) -> + {ok,_} | {error,_}. --spec prepare_loading_fun() -> prep_fun_type(). - -prepare_loading_fun() -> - fun(Mod, FullName, Beam) -> - case erlang:prepare_loading(Mod, Beam) of - {error,_}=Error -> - Error; - Prepared -> - {ok,{Prepared,FullName,undefined}} - end +prepare_loading(Mod, FullName, Beam) -> + case erlang:prepare_loading(Mod, Beam) of + {error,_}=Error -> + Error; + Prepared -> + {ok,{Prepared,FullName}} end. do_par(Fun, L) -> @@ -664,31 +699,36 @@ do_par(Fun, L) -> Res end. --spec do_par_fun(prep_fun_type(), list()) -> fun(() -> no_return()). +-type par_fun_type() :: fun((module() | {module(), file:filename(), binary()}) -> + {ok,_} | {error,_}). + +-spec do_par_fun(par_fun_type(), list()) -> fun(() -> no_return()). do_par_fun(Fun, L) -> fun() -> - _ = [spawn_monitor(do_par_fun_2(Fun, Item)) || - Item <- L], - exit(do_par_recv(length(L), [], [])) + _ = [spawn_monitor(do_par_fun_each(Fun, Item)) || Item <- L], + exit(do_par_recv(length(L), [], [])) end. --spec do_par_fun_2(prep_fun_type(), - {module(),file:filename(),binary()}) -> +-spec do_par_fun_each(par_fun_type(), term()) -> fun(() -> no_return()). -do_par_fun_2(Fun, Item) -> +do_par_fun_each(Fun, Mod) when is_atom(Mod) -> + do_par_fun_each(Fun, Mod, Mod); +do_par_fun_each(Fun, {Mod, _, _} = Item) -> + do_par_fun_each(Fun, Mod, Item). + +do_par_fun_each(Fun, Mod, Item) -> fun() -> - {Mod,Filename,Bin} = Item, - try Fun(Mod, Filename, Bin) of - {ok,Res} -> - exit({good,{Mod,Res}}); - {error,Error} -> - exit({bad,{Mod,Error}}) - catch - _:Error -> - exit({bad,{Mod,Error}}) - end + try Fun(Item) of + {ok,Res} -> + exit({good,{Mod,Res}}); + {error,Error} -> + exit({bad,{Mod,Error}}) + catch + _:Error -> + exit({bad,{Mod,Error}}) + end end. do_par_recv(0, Good, Bad) -> @@ -860,34 +900,52 @@ where_is_file(Tail, File, Path, Files) -> Res :: #docs_v1{}, Reason :: non_existing | missing | file:posix(). get_doc(Mod) when is_atom(Mod) -> + get_doc(Mod, #{sources => [eep48, debug_info]}). + +get_doc(Mod, #{sources:=[Source|Sources]}=Options) -> + GetDoc = fun(Fn) -> R = case Source of + debug_info -> get_doc_chunk_from_ast(Fn); + eep48 -> get_doc_chunk(Fn, Mod) + end, + case R of + {error, missing} -> get_doc(Mod, Options#{sources=>Sources}); + _ -> R + end + end, case which(Mod) of preloaded -> - Fn = filename:join([code:lib_dir(erts),"ebin",atom_to_list(Mod) ++ ".beam"]), - get_doc_chunk(Fn, Mod); + ErtsDir = code:lib_dir(erts), + ErtsEbinDir = + case filelib:is_dir(filename:join([ErtsDir,"ebin"])) of + true -> filename:join([ErtsDir,"ebin"]); + false -> filename:join([ErtsDir,"preloaded","ebin"]) + end, + Fn = filename:join([ErtsEbinDir, atom_to_list(Mod) ++ ".beam"]), + GetDoc(Fn); Error when is_atom(Error) -> {error, Error}; Fn -> - get_doc_chunk(Fn, Mod) - end. + GetDoc(Fn) + end; +get_doc(_, #{sources:=[]}) -> + {error, missing}. get_doc_chunk(Filename, Mod) when is_atom(Mod) -> case beam_lib:chunks(Filename, ["Docs"]) of {error,beam_lib,{missing_chunk,_,_}} -> - case get_doc_chunk(Filename, atom_to_list(Mod)) of - {error,missing} -> - get_doc_chunk_from_ast(Filename); - Error -> - Error - end; + get_doc_chunk(Filename, atom_to_list(Mod)); {error,beam_lib,{file_error,_Filename,_Err}} -> get_doc_chunk(Filename, atom_to_list(Mod)); {ok, {Mod, [{"Docs",Bin}]}} -> {ok,binary_to_term(Bin)} end; get_doc_chunk(Filename, Mod) -> + RootDir = code:root_dir(), case filename:dirname(Filename) of Filename -> {error,missing}; + RootDir -> + {error,missing}; Dir -> ChunkFile = filename:join([Dir,"doc","chunks",Mod ++ ".chunk"]), case file:read_file(ChunkFile) of @@ -904,24 +962,36 @@ get_doc_chunk_from_ast(Filename) -> case beam_lib:chunks(Filename, [abstract_code]) of {error,beam_lib,{missing_chunk,_,_}} -> {error,missing}; + {error,beam_lib,{file_error,_,_}} -> + {error, missing}; {ok, {_Mod, [{abstract_code, {raw_abstract_v1, AST}}]}} -> Docs = get_function_docs_from_ast(AST), + Types = get_type_docs_from_ast(AST), {ok, #docs_v1{ anno = 0, beam_language = erlang, module_doc = none, - metadata = #{ generated => true, otp_doc_vsn => ?CURR_DOC_VERSION }, - docs = Docs }}; + metadata = #{ generated => true, otp_doc_vsn => ?CURR_DOC_VERSION}, + docs = Docs++Types }}; {ok, {_Mod, [{abstract_code,no_abstract_code}]}} -> {error,missing}; Error -> Error end. +get_type_docs_from_ast(AST) -> + lists:flatmap(fun(E) -> get_type_docs_from_ast(E, AST) end, AST). +get_type_docs_from_ast({attribute, Anno, type, {TypeName, _, Ps}}=Meta, _) -> + Arity = length(Ps), + Signature = io_lib:format("~p/~p",[TypeName,Arity]), + [{{type, TypeName, Arity},Anno,[unicode:characters_to_binary(Signature)],none,#{signature => [Meta]}}]; +get_type_docs_from_ast(_, _) -> + []. + get_function_docs_from_ast(AST) -> lists:flatmap(fun(E) -> get_function_docs_from_ast(E, AST) end, AST). get_function_docs_from_ast({function,Anno,Name,Arity,_Code}, AST) -> Signature = io_lib:format("~p/~p",[Name,Arity]), - Specs = lists:filter( + Specs = lists:filter( fun({attribute,_Ln,spec,{FA,_}}) -> case FA of {F,A} -> diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index af8531271f..f420337eb7 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2022. All Rights Reserved. +%% Copyright Ericsson AB 1998-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,7 +22,8 @@ %% This file holds the server part of the code_server. -export([start_link/1, - call/1, + call/1, absname/1, + is_loaded/1, is_sticky/1, system_code_change/4, error_msg/2, info_msg/2 ]). @@ -31,6 +32,7 @@ -include_lib("stdlib/include/ms_transform.hrl"). -import(lists, [foreach/2]). +-define(moddb, code_server). -type on_load_action() :: fun((term(), state()) -> {'reply',term(),state()} | @@ -41,7 +43,7 @@ -record(state, {supervisor :: pid(), root :: file:name_all(), - path :: [file:name_all()], + path :: [{file:name_all(), cache | nocache}], moddb :: ets:table(), namedb :: ets:table(), mode = interactive :: 'interactive' | 'embedded', @@ -58,6 +60,14 @@ start_link(Args) -> {Ref,Res} -> Res end. +is_loaded(Mod) -> + case ets:lookup(?moddb, Mod) of + [{Mod,File}] -> {file,File}; + [] -> false + end. + +is_sticky(Mod) -> + is_sticky(Mod, ?moddb). %% ----------------------------------------------------------- %% Init the code_server process. @@ -67,7 +77,7 @@ init(Ref, Parent, [Root,Mode]) -> register(?MODULE, self()), process_flag(trap_exit, true), - Db = ets:new(code, [private]), + Db = ets:new(?moddb, [named_table, protected]), foreach(fun (M) -> %% Pre-loaded modules are always sticky. ets:insert(Db, [{M,preloaded},{{sticky,M},true}]) @@ -251,22 +261,19 @@ handle_call({dir,Dir}, _From, S) -> Resp = do_dir(Root,Dir,S#state.namedb), {reply,Resp,S}; -handle_call({load_file,Mod}, From, St) when is_atom(Mod) -> - load_file(Mod, From, St); - -handle_call({add_path,Where,Dir0}, _From, +handle_call({add_path,Where,Dir0,Cache}, _From, #state{namedb=Namedb,path=Path0}=S) -> - {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), + {Resp,Path} = add_path(Where, Dir0, Path0, Cache, Namedb), {reply,Resp,S#state{path=Path}}; -handle_call({add_paths,Where,Dirs0}, _From, +handle_call({add_paths,Where,Dirs0,Cache}, _From, #state{namedb=Namedb,path=Path0}=S) -> - {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), + {Resp,Path} = add_paths(Where, Dirs0, Path0, Cache, Namedb), {reply,Resp,S#state{path=Path}}; -handle_call({set_path,PathList}, _From, +handle_call({set_path,PathList,Cache}, _From, #state{root=Root,path=Path0,namedb=Namedb}=S) -> - {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb, Root), + {Resp,Path,NewDb} = set_path(PathList, Path0, Cache, Namedb, Root), {reply,Resp,S#state{path=Path,namedb=NewDb}}; handle_call({del_path,Name}, _From, @@ -274,35 +281,31 @@ handle_call({del_path,Name}, _From, {Resp,Path} = del_path(Name, Path0, Namedb), {reply,Resp,S#state{path=Path}}; -handle_call({replace_path,Name,Dir}, _From, +handle_call({del_paths,Names}, _From, + #state{path=Path0,namedb=Namedb}=S) -> + {Resp,Path} = del_paths(Names, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; + +handle_call({replace_path,Name,Dir,Cache}, _From, #state{path=Path0,namedb=Namedb}=S) -> - {Resp,Path} = replace_path(Name, Dir, Path0, Namedb), + {Resp,Path} = replace_path(Name, Dir, Path0, Cache, Namedb), {reply,Resp,S#state{path=Path}}; handle_call(get_path, _From, S) -> - {reply,S#state.path,S}; - -%% Messages to load, delete and purge modules/files. -handle_call({load_abs,File,Mod}, From, S) when is_atom(Mod) -> - case modp(File) of - false -> - {reply,{error,badarg},S}; - true -> - load_abs(File, Mod, From, S) - end; - -handle_call({load_binary,Mod,File,Bin}, From, S) when is_atom(Mod) -> - do_load_binary(Mod, File, Bin, From, S); - -handle_call({ensure_loaded,Mod}, From, St) when is_atom(Mod) -> - case erlang:module_loaded(Mod) of - true -> - {reply,{module,Mod},St}; - false when St#state.mode =:= interactive -> - ensure_loaded(Mod, From, St); - false -> - {reply,{error,embedded},St} - end; + {reply,[P || {P, _Cache} <- S#state.path],S}; + +handle_call(clear_cache, _From, S) -> + Path = [{P, if is_atom(Cache) -> Cache; true -> cache end} || + {P, Cache} <- S#state.path], + {reply,ok,S#state{path=Path}}; + +handle_call({load_module,PC,Mod,File,Purge,EnsureLoaded}, From, S) + when is_atom(Mod) -> + case Purge andalso erlang:module_loaded(Mod) of + true -> do_purge(Mod); + false -> ok + end, + try_finish_module(File, Mod, PC, EnsureLoaded, From, S); handle_call({delete,Mod}, _From, St) when is_atom(Mod) -> case catch erlang:delete_module(Mod) of @@ -319,23 +322,16 @@ handle_call({purge,Mod}, _From, St) when is_atom(Mod) -> handle_call({soft_purge,Mod}, _From, St) when is_atom(Mod) -> {reply,do_soft_purge(Mod),St}; -handle_call({is_loaded,Mod}, _From, St) when is_atom(Mod) -> - {reply,is_loaded(Mod, St#state.moddb),St}; - handle_call(all_loaded, _From, S) -> Db = S#state.moddb, {reply,all_loaded(Db),S}; -handle_call({get_object_code,Mod}, _From, St) when is_atom(Mod) -> - case get_object_code(St, Mod) of - {_,Bin,FName} -> {reply,{Mod,Bin,FName},St}; - Error -> {reply,Error,St} +handle_call({get_object_code,Mod}, _From, St0) when is_atom(Mod) -> + case get_object_code(St0, Mod) of + {Bin,FName,St1} -> {reply,{Mod,Bin,FName},St1}; + {error,St1} -> {reply,error,St1} end; -handle_call({is_sticky, Mod}, _From, S) -> - Db = S#state.moddb, - {reply, is_sticky(Mod,Db), S}; - handle_call(stop,_From, S) -> {stop,normal,stopped,S}; @@ -355,6 +351,20 @@ handle_call(get_mode, _From, S=#state{mode=Mode}) -> handle_call({finish_loading,Prepared,EnsureLoaded}, _From, S) -> {reply,finish_loading(Prepared, EnsureLoaded, S),S}; +%% Handles pending on_load events when we cannot find any +%% object code in code:ensure_loaded/1. It's possible that +%% the user has loaded a binary that has an on_load +%% function, and in that case we need to suspend them until +%% the on_load function finishes. +handle_call({sync_ensure_on_load, Mod}, From, S) -> + handle_pending_on_load( + fun(_, St) -> + case erlang:module_loaded(Mod) of + true -> {reply, {module, Mod}, St}; + false -> {reply, {error, nofile}, St} + end + end, Mod, From, S); + handle_call(Other,_From, S) -> error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]), {noreply,S}. @@ -494,26 +504,42 @@ try_ebin_dirs([]) -> %% %% Add the erl_prim_loader path. -%% %% add_loader_path(IPath0,Mode) -> {ok,PrimP0} = erl_prim_loader:get_path(), + + %% All boot paths except for "." are cached by default but this can be disabled. + %% -pa and -pz are never cached by default. case Mode of embedded -> - strip_path(PrimP0, Mode); % i.e. only normalize + cache_path(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), + PrimP = patch_path(PrimP0), + IPath = patch_path(IPath0), + + Path0 = exclude_pa_pz(PrimP,Pa,Pz), + Path1 = strip_path(Path0, Mode), + Path2 = merge_path(Path1, IPath, []), + Path3 = cache_path(Path2), + add_pa_pz(Path3,Pa,Pz) + end. + +cache_path(Path) -> + Default = cache_boot_paths(), + [{P, do_cache_path(P, Default)} || P <- Path]. + +do_cache_path(".", _) -> nocache; +do_cache_path(_, Default) -> Default. - P = exclude_pa_pz(PrimP,Pa,Pz), - Path0 = strip_path(P, Mode), - Path = add(Path0, IPath, []), - add_pa_pz(Path,Pa,Pz) +cache_boot_paths() -> + case init:get_argument(cache_boot_paths) of + {ok,[["false"]]} -> nocache; + _ -> cache end. patch_path(Path) -> @@ -524,15 +550,10 @@ patch_path(Path) -> %% As the erl_prim_loader path includes the -pa and -pz %% directories they have to be removed first !! +exclude_pa_pz(P0,Pa,[]) -> + P0 -- Pa; 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)). + lists:reverse(lists:reverse(P0 -- Pa) -- Pz). %% %% Keep only 'valid' paths in code server. @@ -559,27 +580,32 @@ strip_path(_, _) -> %% 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), +merge_path(Path,["."|IPath],Acc) -> + RPath = merge_path1(Path,IPath,Acc), ["."|lists:delete(".",RPath)]; -add(Path,IPath,Acc) -> - add1(Path,IPath,Acc). +merge_path(Path,IPath,Acc) -> + merge_path1(Path,IPath,Acc). -add1([P|Path],IPath,Acc) -> +merge_path1([P|Path],IPath,Acc) -> case lists:member(P,Acc) of true -> - add1(Path,IPath,Acc); % Already added + merge_path1(Path,IPath,Acc); % Already added false -> IPath1 = exclude(P,IPath), - add1(Path,IPath1,[P|Acc]) + merge_path1(Path,IPath1,[P|Acc]) end; -add1(_,IPath,Acc) -> +merge_path1(_,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). + {_,Path1} = add_paths(first,Patha,Path0,nocache,false), + case Pathz of + [] -> + Path1; + _ -> + {_,Path2} = add_paths(first,Pathz,lists:reverse(Path1),nocache,false), + lists:reverse(Path2) + end. get_arg(Arg) -> case init:get_argument(Arg) of @@ -693,22 +719,22 @@ do_check_path([Dir | Tail], PathChoice, ArchiveExt, Acc) -> %% %% 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) -> +add_path(Where,Dir,Path,Cache,NameDb) when is_atom(Dir) -> + add_path(Where,atom_to_list(Dir),Path,Cache,NameDb); +add_path(Where,Dir0,Path,Cache,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)}; + {true, do_add(Where,NewDir,Path,Cache,NameDb)}; Error -> {Error, Path} end; false -> {{error, bad_directory}, Path} end; -add_path(_,_,Path,_) -> +add_path(_,_,Path,_,_) -> {{error, bad_directory}, Path}. @@ -718,16 +744,16 @@ add_path(_,_,Path,_) -> %% 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) -> +do_add(first,Dir,Path,Cache,NameDb) -> update(Dir, NameDb), - [Dir|lists:delete(Dir,Path)]; -do_add(last,Dir,Path,NameDb) -> - case lists:member(Dir,Path) of + [{Dir, Cache}|lists:keydelete(Dir,1,Path)]; +do_add(last,Dir,Path,Cache,NameDb) -> + case lists:keymember(Dir,1,Path) of true -> - Path; + lists:keyreplace(Dir,1,Path,{Dir,Cache}); false -> maybe_update(Dir, NameDb), - Path ++ [Dir] + Path ++ [{Dir,Cache}] end. %% Do not update if the same name already exists ! @@ -742,13 +768,14 @@ update(Dir, NameDb) -> %% %% Set a completely new path. %% -set_path(NewPath0, OldPath, NameDb, Root) -> +set_path(NewPath0, OldPath, Cache, NameDb, Root) -> NewPath = normalize(NewPath0), case check_path(NewPath) of {ok, NewPath2} -> ets:delete(NameDb), - NewDb = create_namedb(NewPath2, Root), - {true, NewPath2, NewDb}; + NewPath3 = [{P, Cache} || P <- NewPath2], + NewDb = create_namedb(NewPath3, Root), + {true, NewPath3, NewDb}; Error -> {Error, OldPath, NameDb} end. @@ -796,7 +823,7 @@ create_namedb(Path, Root) -> end, Db. -init_namedb([P|Path], Db) -> +init_namedb([{P, _Cache}|Path], Db) -> insert_dir(P, Db), init_namedb(Path, Db); init_namedb([], _) -> @@ -874,7 +901,7 @@ del_path(Name0,Path,NameDb) -> end end. -del_path1(Name,[P|Path],NameDb) -> +del_path1(Name,[{P, Cache}|Path],NameDb) -> case get_name(P) of Name -> delete_name(Name, NameDb), @@ -887,12 +914,12 @@ del_path1(Name,[P|Path],NameDb) -> end, Path; _ -> - [P|del_path1(Name,Path,NameDb)] + [{P, Cache}|del_path1(Name,Path,NameDb)] end; del_path1(_,[],_) -> []. -insert_old_shadowed(Name, [P|Path], NameDb) -> +insert_old_shadowed(Name, [{P, _Cache}|Path], NameDb) -> case get_name(P) of Name -> insert_name(Name, P, NameDb); _ -> insert_old_shadowed(Name, Path, NameDb) @@ -904,27 +931,27 @@ insert_old_shadowed(_, [], _) -> %% 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) -> +replace_path(Name,Dir,Path,Cache,NameDb) -> case catch check_pars(Name,Dir) of {ok,N,D} -> - {true,replace_path1(N,D,Path,NameDb)}; + {true,replace_path1(N,D,Path,Cache,NameDb)}; {'EXIT',_} -> {{error,{badarg,[Name,Dir]}},Path}; Error -> {Error,Path} end. -replace_path1(Name,Dir,[P|Path],NameDb) -> +replace_path1(Name,Dir,[{P, _}=Pair|Path],Cache,NameDb) -> case get_name(P) of Name -> insert_name(Name, Dir, NameDb), - [Dir|Path]; + [{Dir, Cache}|Path]; _ -> - [P|replace_path1(Name,Dir,Path,NameDb)] + [Pair|replace_path1(Name,Dir,Path,Cache,NameDb)] end; -replace_path1(Name, Dir, [], NameDb) -> +replace_path1(Name, Dir, [], Cache, NameDb) -> insert_name(Name, Dir, NameDb), - [Dir]. + [{Dir, Cache}]. check_pars(Name,Dir) -> N = to_list(Name), @@ -1076,55 +1103,46 @@ get_mods([], _) -> []. is_sticky(Mod, Db) -> erlang:module_loaded(Mod) andalso (ets:lookup(Db, {sticky, Mod}) =/= []). -add_paths(Where,[Dir|Tail],Path,NameDb) -> - {_,NPath} = add_path(Where,Dir,Path,NameDb), - add_paths(Where,Tail,NPath,NameDb); -add_paths(_,_,Path,_) -> +add_paths(Where,[Dir|Tail],Path,Cache,NameDb) -> + {_,NPath} = add_path(Where,Dir,Path,Cache,NameDb), + add_paths(Where,Tail,NPath,Cache,NameDb); +add_paths(_,_,Path,_,_) -> {ok,Path}. -do_load_binary(Module, File, Binary, From, St) -> - case modp(File) andalso is_binary(Binary) of - true -> - case erlang:module_loaded(Module) of - true -> do_purge(Module); - false -> ok - end, - try_load_module(File, Module, Binary, From, 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, Mod, From, St) -> - Ext = objfile_extension(), - FileName0 = lists:concat([File, Ext]), - FileName = absname(FileName0), - case erl_prim_loader:get_file(FileName) of - {ok,Bin,_} -> - try_load_module(FileName, Mod, Bin, From, St); - error -> - {reply,{error,nofile},St} - end. +del_paths([Name | Names],Path,NameDb) -> + {_,NPath} = del_path(Name, Path, NameDb), + del_paths(Names,NPath,NameDb); +del_paths(_,Path,_) -> + {ok,Path}. -try_load_module(File, Mod, Bin, From, St) -> +try_finish_module(File, Mod, PC, true, From, St) -> Action = fun(_, S) -> - try_load_module_1(File, Mod, Bin, From, S) + case erlang:module_loaded(Mod) of + true -> + {reply,{module,Mod},S}; + false when S#state.mode =:= interactive -> + try_finish_module_1(File, Mod, PC, From, S); + false -> + {reply,{error,embedded},S} + end + end, + handle_pending_on_load(Action, Mod, From, St); +try_finish_module(File, Mod, PC, false, From, St) -> + Action = fun(_, S) -> + try_finish_module_1(File, Mod, PC, From, S) end, handle_pending_on_load(Action, Mod, From, St). -try_load_module_1(File, Mod, Bin, From, #state{moddb=Db}=St) -> +try_finish_module_1(File, Mod, PC, From, #state{moddb=Db}=St) -> case is_sticky(Mod, Db) of true -> %% Sticky file reject the load error_msg("Can't load module '~w' that resides in sticky dir\n",[Mod]), {reply,{error,sticky_directory},St}; false -> - try_load_module_2(File, Mod, Bin, From, undefined, St) + try_finish_module_2(File, Mod, PC, From, St) end. -try_load_module_2(File, Mod, Bin, From, _Architecture, St0) -> +try_finish_module_2(File, Mod, PC, From, St0) -> Action = fun({module,_}=Module, #state{moddb=Db}=S) -> ets:insert(Db, {Mod,File}), {reply,Module,S}; @@ -1134,69 +1152,73 @@ try_load_module_2(File, Mod, Bin, From, _Architecture, St0) -> error_msg("Loading of ~ts failed: ~p\n", [File, What]), {reply,Error,S} end, - Res = erlang:load_module(Mod, Bin), + Res = case erlang:finish_loading([PC]) of + ok -> + {module,Mod}; + {Error,[Mod]} -> + {error,Error} + end, handle_on_load(Res, Action, Mod, From, St0). int_list([H|T]) when is_integer(H) -> int_list(T); int_list([_|_]) -> false; int_list([]) -> true. -ensure_loaded(Mod, From, St0) -> - Action = fun(_, S) -> - case erlang:module_loaded(Mod) of - true -> - {reply,{module,Mod},S}; - false -> - load_file_1(Mod, From, S) - end - end, - handle_pending_on_load(Action, Mod, From, St0). - -load_file(Mod, From, St0) -> - Action = fun(_, S) -> - load_file_1(Mod, From, S) - end, - handle_pending_on_load(Action, Mod, From, St0). - -load_file_1(Mod, From, St) -> - case get_object_code(St, Mod) of - error -> - {reply,{error,nofile},St}; - {Mod,Binary,File} -> - try_load_module_1(File, Mod, Binary, From, St) - end. - -get_object_code(#state{path=Path}, Mod) when is_atom(Mod) -> +get_object_code(#state{path=Path} = St, Mod) when is_atom(Mod) -> ModStr = atom_to_list(Mod), case erl_prim_loader:is_basename(ModStr) of true -> - mod_to_bin(Path, Mod, ModStr ++ objfile_extension()); + case mod_to_bin(Path, ModStr ++ objfile_extension(), []) of + {Binary, File, NewPath} -> + {Binary, File, St#state{path=NewPath}}; + + {error, NewPath} -> + {error, St#state{path=NewPath}} + end; + false -> - error + {error, St} end. -mod_to_bin([Dir|Tail], Mod, ModFile) -> - File = filename:append(Dir, ModFile), - case erl_prim_loader:get_file(File) of - error -> - mod_to_bin(Tail, Mod, ModFile); - {ok,Bin,_} -> - case filename:pathtype(File) of - absolute -> - {Mod,Bin,File}; - _ -> - {Mod,Bin,absname(File)} - end +mod_to_bin([{Dir, Cache0}|Tail], ModFile, Acc) -> + case with_cache(Cache0, Dir, ModFile) of + {true, Cache1} -> + File = filename:append(Dir, ModFile), + + case erl_prim_loader:get_file(File) of + error -> + mod_to_bin(Tail, ModFile, [{Dir, Cache1} | Acc]); + + {ok,Bin,_} -> + Path = lists:reverse(Acc, [{Dir, Cache1} | Tail]), + + case filename:pathtype(File) of + absolute -> {Bin, File, Path}; + _ -> {Bin, absname(File), Path} + end + end; + {false, Cache1} -> + mod_to_bin(Tail, ModFile, [{Dir, Cache1} | Acc]) end; -mod_to_bin([], Mod, ModFile) -> +mod_to_bin([], ModFile, Acc) -> %% At last, try also erl_prim_loader's own method case erl_prim_loader:get_file(ModFile) of - error -> - error; % No more alternatives ! - {ok,Bin,FName} -> - {Mod,Bin,absname(FName)} + error -> + {error, lists:reverse(Acc)}; % No more alternatives ! + {ok,Bin,FName} -> + {Bin, absname(FName), lists:reverse(Acc)} end. +with_cache(nocache, _Dir, _ModFile) -> + {true, nocache}; +with_cache(cache, Dir, ModFile) -> + case erl_prim_loader:list_dir(Dir) of + {ok, Entries} -> with_cache(maps:from_keys(Entries, []), Dir, ModFile); + error -> {false, cache} + end; +with_cache(Cache, _Dir, ModFile) when is_map(Cache) -> + {is_map_key(ModFile, Cache), Cache}. + absname(File) -> case erl_prim_loader:get_cwd() of {ok,Cwd} -> absname(File, Cwd); @@ -1232,13 +1254,6 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> end, absname(filename:join(Name), Dcwd). - -is_loaded(M, Db) -> - case ets:lookup(Db, M) of - [{M,File}] -> {file,File}; - [] -> false - end. - do_purge(Mod) -> {_WasOld, DidKill} = erts_code_purger:purge(Mod), DidKill. @@ -1445,4 +1460,4 @@ 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_list(X) when is_atom(X) -> atom_to_list(X).
\ No newline at end of file diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 19225c9be5..c6d8922e8f 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2021. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -24,13 +24,13 @@ -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, + close/1, 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, all/0]). + all/0, next_file/1]). %% Internal exports -export([init/2, internal_open/2, @@ -47,9 +47,11 @@ -export_type([continuation/0]). --deprecated([{accessible_logs, 0, "use disk_log:all/0 instead"}, - {lclose, 1, "use disk_log:close/1 instead"}, - {lclose, 2, "use disk_log:close/1 instead"}]). +-deprecated([{inc_wrap_file, 1, "use disk_log:next_file/1 instead"}]). + +-removed([{accessible_logs, 0, "use disk_log:all/0 instead"}, + {lclose, 1, "use disk_log:close/1 instead"}, + {lclose, 2, "use disk_log:close/1 instead"}]). -type dlog_state_error() :: 'ok' | {'error', term()}. @@ -185,22 +187,6 @@ balog_terms(Log, Bytess) -> close(Log) -> req(Log, close). --type lclose_error_rsn() :: 'no_such_log' - | {'file_error', file:filename(), file_error()}. - --spec lclose(Log) -> 'ok' | {'error', lclose_error_rsn()} when - Log :: log(). -lclose(Log) -> - lclose(Log, node()). - --spec lclose(Log, Node) -> 'ok' | {'error', lclose_error_rsn()} when - Log :: log(), - Node :: node(). -lclose(Log, Node) when node() =:= Node -> - req(Log, close); -lclose(_Log, _Node) -> - {error, no_such_log}. - -type trunc_error_rsn() :: 'no_such_log' | 'nonode' | {'read_only_mode', log()} | {'blocked_log', log()} @@ -253,12 +239,20 @@ reopen(Log, NewFile, NewHead) -> breopen(Log, NewFile, NewHead) -> req(Log, {reopen, NewFile, {ok, ensure_binary(NewHead)}, breopen, 3}). --type inc_wrap_error_rsn() :: 'no_such_log' | 'nonode' +-type next_file_error_rsn() :: 'no_such_log' | 'nonode' | {'read_only_mode', log()} | {'blocked_log', log()} | {'halt_log', log()} + | {'rotate_log', log()} | {'invalid_header', invalid_header()} | {'file_error', file:filename(), file_error()}. +-spec next_file(Log) -> 'ok' | {'error', next_file_error_rsn()} when + Log :: log(). +next_file(Log) -> + req(Log, next_file). + +-type inc_wrap_error_rsn() :: next_file_error_rsn(). + -spec inc_wrap_file(Log) -> 'ok' | {'error', inc_wrap_error_rsn()} when Log :: log(). inc_wrap_file(Log) -> @@ -528,11 +522,6 @@ chunk_info(More = #continuation{}) -> chunk_info(BadCont) -> {error, {no_continuation, BadCont}}. --spec accessible_logs() -> {[Log], []} when - Log :: log(). -accessible_logs() -> - {disk_log_server:all(), []}. - -spec all() -> [Log] when Log :: log(). all() -> @@ -592,6 +581,8 @@ check_arg([], Res) -> {OldSize, Version} = disk_log_1:read_size_file_version(Res#arg.file), check_wrap_arg(Ret, OldSize, Version); + Res#arg.type =:= rotate -> + {ok, Res#arg{format = external}}; true -> Ret end; @@ -620,6 +611,8 @@ check_arg([{size, {MaxB,MaxF}}|Tail], Res) when is_integer(MaxB), MaxB > 0, MaxB =< ?MAX_BYTES, MaxF > 0, MaxF < ?MAX_FILES -> check_arg(Tail, Res#arg{size = {MaxB, MaxF}}); +check_arg([{type, rotate}|Tail], Res) -> + check_arg(Tail, Res#arg{type = rotate}); check_arg([{type, wrap}|Tail], Res) -> check_arg(Tail, Res#arg{type = wrap}); check_arg([{type, halt}|Tail], Res) -> @@ -879,18 +872,49 @@ handle({From, inc_wrap_file}=Message, S) -> reply(From, {error, {read_only_mode, L#log.name}}, S); #log{type = halt}=L -> reply(From, {error, {halt_log, L#log.name}}, S); + #log{type = rotate}=L -> + reply(From, {error, {rotate_log, L#log.name}}, S); #log{status = ok} when S#state.cache_error =/= ok -> loop(cache_error(S, [From])); #log{status = ok}=L -> case catch do_inc_wrap_file(L) of {ok, L2, Lost} -> put(log, L2), - notify_owners({wrap, Lost}), + notify_owners({L#log.type, 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; + #log{status = {blocked, false}}=L -> + reply(From, {error, {blocked_log, L#log.name}}, S); + #log{blocked_by = From}=L -> + reply(From, {error, {blocked_log, L#log.name}}, S); + _ -> + enqueue(Message, S) + end; +handle({From, next_file}=Message, S) -> + case get(log) of + #log{mode = read_only}=L -> + reply(From, {error, {read_only_mode, L#log.name}}, S); + #log{type = halt}=L -> + reply(From, {error, {halt_log, L#log.name}}, S); + #log{status = ok} when S#state.cache_error =/= ok -> + loop(cache_error(S, [From])); + #log{status = ok, type = wrap}=L -> + case catch do_inc_wrap_file(L) of + {ok, L2, Lost} -> + put(log, L2), + notify_owners({L#log.type, 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; + #log{status = ok, type = rotate}=L -> + {ok, L2} = do_inc_rotate_file(L), + put(log, L2), + reply(From, ok, S); #log{status = {blocked, false}}=L -> reply(From, {error, {blocked_log, L#log.name}}, S); #log{blocked_by = From}=L -> @@ -910,7 +934,7 @@ handle({From, {reopen, NewFile, Head, F, A}}, S) -> case catch close_disk_log2(L) of closed -> File = L#log.filename, - case catch rename_file(File, NewFile, L#log.type) of + case catch rename_file(File, NewFile, L) of ok -> H = merge_head(Head, L#log.head), case do_open((S#state.args)#arg{name = L#log.name, @@ -1233,15 +1257,19 @@ is_owner(Pid, L) -> end. %% ok | throw(Error) -rename_file(File, NewFile, halt) -> +rename_file(File, NewFile, #log{type = halt}) -> case file:rename(File, NewFile) of ok -> ok; Else -> file_error(NewFile, Else) end; -rename_file(File, NewFile, wrap) -> - rename_file(wrap_file_extensions(File), File, NewFile, ok). +rename_file(File, NewFile, #log{type = wrap}) -> + rename_file(wrap_file_extensions(File), File, NewFile, ok); +rename_file(File, NewFile, #log{type = rotate, extra = Handle}) -> + {_MaxB, MaxF} = disk_log_1:get_rotate_size(Handle), + disk_log_1:rotate_files(Handle#rotate_handle.file, MaxF), + rename_file(rotate_file_extensions(File, MaxF), File, NewFile, ok). rename_file([Ext|Exts], File, NewFile0, Res) -> NewFile = add_ext(NewFile0, Ext), @@ -1299,6 +1327,20 @@ compare_arg(_Attr, _Val, _A) -> ok. %% -> {ok, Res, log(), Cnt} | Error +do_open(#arg{type = rotate} = A) -> + #arg{name = Name, size = Size, mode = Mode, head = Head0, + format = Format, type = Type, file = FName} = A, + Head = mk_head(Head0, Format), + case disk_log_1:open_rotate_log_file(FName, Size, Head) of + {ok, RotHandle} -> + L = #log{name = Name, type = Type, format = Format, + filename = FName, size = Size, mode = Mode, + extra = RotHandle, format_type = rotate_ext, + head = Head}, + {ok, {ok, Name}, L, 0}; + Error -> + Error + end; do_open(A) -> #arg{type = Type, format = Format, name = Name, head = Head0, file = FName, repair = Repair, size = Size, mode = Mode, @@ -1368,6 +1410,11 @@ do_change_size(#log{type = wrap}=L, NewSize) -> {ok, Handle} = disk_log_1:change_size_wrap(Extra, NewSize, Version), erase(is_full), put(log, L#log{extra = Handle}), + ok; +do_change_size(#log{type =rotate, extra = Extra} = L, NewSize) -> + {ok, Handle} = disk_log_1:change_size_rotate(Extra, NewSize), + erase(is_full), + put(log, L#log{extra = Handle}), ok. %% -> {ok, Head} | Error; Head = none | {head, H} | {M,F,A} @@ -1389,14 +1436,15 @@ check_head({head, Term}, internal) -> 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(Type, {NewMaxB,NewMaxF}) when + (Type =:= wrap orelse Type =:= rotate) andalso + is_integer(NewMaxB), is_integer(NewMaxF), + NewMaxB > 0, NewMaxB =< ?MAX_BYTES, NewMaxF > 0, NewMaxF < ?MAX_FILES -> + ok; check_size(_, _) -> not_ok. @@ -1423,6 +1471,13 @@ do_inc_wrap_file(L) -> end end. +%%----------------------------------------------------------------- +%% Force log rotation. +%%----------------------------------------------------------------- +%% -> {ok, log()} +do_inc_rotate_file(#log{extra = Handle, head = Head} = L) -> + Handle2 = disk_log_1:do_rotate(Handle, Head), + {ok, L#log{extra = Handle2}}. %%----------------------------------------------------------------- %% Open a log file. @@ -1495,7 +1550,9 @@ close_disk_log2(L) -> #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) + disk_log_1:mf_ext_close(Handle, Mode); + #log{type = rotate, extra = Handle} -> + disk_log_1:rotate_ext_close(Handle) end, closed. @@ -1591,6 +1648,8 @@ do_info(L, Cnt) -> Size = case Type of wrap -> disk_log_1:get_wrap_size(Extra); + rotate -> + disk_log_1:get_rotate_size(Extra); halt -> Extra#halt.size end, @@ -1609,6 +1668,11 @@ do_info(L, Cnt) -> {current_file, CurF}, {no_overflows, {NewAccFull, NoFull}} ]; + rotate when Mode =:= read_write -> + #rotate_handle{curB = CurB} = Extra, + [{no_current_bytes, CurB}, + {no_items, Cnt} + ]; halt when Mode =:= read_write -> IsFull = case get(is_full) of undefined -> false; @@ -1713,7 +1777,11 @@ do_log(#log{format_type = wrap_ext}=L, B, _BSz) -> {error, Error, Handle, Logged, Lost} -> put(log, L#log{extra = Handle}), {error, Error, Logged - Lost} - end. + end; +do_log(#log{type = rotate}=L, B, _BSz) -> + {ok, Handle, Logged} = disk_log_1:rotate_ext_log(L#log.extra, B, L#log.head), %%error case here + put(log, L#log{extra = Handle}), + Logged. logl(B, external, undefined) -> {B, iolist_size(B)}; @@ -1763,6 +1831,10 @@ do_write_cache(#log{filename = FName, type = halt, extra = Halt} = Log) -> 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; +do_write_cache(#log{type = rotate, extra = Handle} = Log) -> + {Reply, NewHandle} = disk_log_1:rotate_write_cache(Handle), + put(log, Log#log{extra = NewHandle}), Reply. %% -> ok | Error @@ -1770,7 +1842,7 @@ 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) -> +do_sync(#log{type = Type, extra = Handle} = Log) when Type == wrap orelse Type == rotate-> {Reply, NewHandle} = disk_log_1:mf_sync(Handle), put(log, Log#log{extra = NewHandle}), Reply. @@ -1815,7 +1887,12 @@ do_trunc(#log{type = wrap}=L, Head) -> NewLog2 = trunc_wrap(NewLog), NewHandle = (NewLog2#log.extra)#handle{noFull = 0, accFull = 0}, do_change_size(NewLog2#log{extra = NewHandle, head = OldHead}, - {MaxB, MaxF}). + {MaxB, MaxF}); +do_trunc(#log{type = rotate, head = Head, extra = Handle}=L, none) -> + Handle1 = disk_log_1:do_rotate(Handle, Head), + disk_log_1:remove_files(rotate, Handle1#rotate_handle.file, 0, Handle1#rotate_handle.maxF), + put(log, L#log{extra = Handle1}), + ok. trunc_wrap(L) -> case do_inc_wrap_file(L) of @@ -1900,7 +1977,7 @@ merge_head(Head, _) -> Head. %% -> List of extensions of existing files (no dot included) | throw(FileError) -wrap_file_extensions(File) -> +wrap_file_extensions(File) -> {_CurF, _CurFSz, _TotSz, NoOfFiles} = disk_log_1:read_index_file(File), Fs = if @@ -1919,6 +1996,18 @@ wrap_file_extensions(File) -> end, lists:filter(Fun, ["idx", "siz" | Fs]). +rotate_file_extensions(File, MaxF) -> + rotate_file_extensions(File, MaxF, 0, []). + +rotate_file_extensions(_File, MaxF, MaxF, Res) -> + Res; +rotate_file_extensions(File, MaxF, N, Res) -> + Ext = integer_to_list(N) ++ ".gz", + case file:read_file_info(add_ext(File, Ext)) of + {ok, _} -> rotate_file_extensions(File, MaxF, N+1, [Ext|Res]); + _ -> rotate_file_extensions(File, MaxF, N+1, Res) + end. + add_ext(File, Ext) -> lists:concat([File, ".", Ext]). diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl index 6cb2c13f02..41844c03d2 100644 --- a/lib/kernel/src/disk_log.hrl +++ b/lib/kernel/src/disk_log.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2021. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -56,7 +56,8 @@ %%------------------------------------------------------------------------ -type dlog_format() :: 'external' | 'internal'. --type dlog_format_type() :: 'halt_ext' | 'halt_int' | 'wrap_ext' | 'wrap_int'. +-type dlog_format_type() :: 'halt_ext' | 'halt_int' | 'wrap_ext' | 'wrap_int' + | 'rotate_ext'. -type dlog_head() :: 'none' | {'ok', binary()} | mfa(). -type dlog_head_opt() :: none | term() | iodata(). -type log() :: term(). % XXX: refine @@ -83,7 +84,7 @@ | {MaxNoBytes :: pos_integer(), MaxNoFiles :: pos_integer()}. -type dlog_status() :: 'ok' | {'blocked', 'false' | [_]}. %QueueLogRecords --type dlog_type() :: 'halt' | 'wrap'. +-type dlog_type() :: 'halt' | 'wrap' | 'rotate'. %%------------------------------------------------------------------------ %% Records @@ -129,7 +130,7 @@ %% 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. + 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, @@ -146,6 +147,18 @@ %% overflows since the log was opened. ). +-record(rotate_handle, + {file :: file:filename(), + cur_fdc :: #cache{}, + inode, + file_check, + maxB :: pos_integer(), + maxF :: pos_integer() | {pos_integer(),pos_integer()}, + curB = 0 :: non_neg_integer(), + firstPos :: non_neg_integer(), + compress_on_rotate = true} + ). + -record(log, {status = ok :: dlog_status(), name :: dlog_name(), %% the key leading to this structure @@ -160,8 +173,8 @@ %% 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 + extra :: #halt{} | #handle{} | #rotate_handle{}, %% type of the log + version :: integer() | undefined} %% if wrap log file, undefined for halt and rotate ). -record(continuation, %% Chunk continuation. diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index a488a44dcc..5f585a4c39 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2021. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,10 +23,14 @@ -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, +-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([open_rotate_log_file/3, do_rotate/2, + rotate_ext_log/3, rotate_write_cache/1, rotate_ext_close/1, + change_size_rotate/2, get_rotate_size/1, + rotate_files/2]). -export([print_index_file/1]). -export([read_index_file/1]). @@ -38,6 +42,7 @@ -export([is_head/1]). -export([position/3, truncate_at/3, fwrite/4, fclose/2]). -export([set_quiet/1, is_quiet/0]). +-export([remove_files/4]). -compile({inline,[{scan_f2,7}]}). @@ -455,7 +460,7 @@ new_ext_file(FName, Head) -> %% -> {FdC, {NoItemsWritten, NoBytesWritten}} | throw(Error) ext_log_head(Fd, Head) -> case lh(Head, external) of - {ok, BinHead} -> + {ok, BinHead} -> Size = byte_size(BinHead), {ok, FdC} = fwrite_header(Fd, BinHead, Size), {FdC, {1, Size}}; @@ -678,7 +683,7 @@ mf_int_open(FName, MaxB, MaxF, Repair, Mode, Head, Version) -> end. %% -> {ok, handle(), Lost} | {error, Error, handle()} -mf_int_inc(Handle, Head) -> +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, @@ -732,7 +737,7 @@ mf_int_log(Handle, Bins, Head, No0, Wraps) -> noFull = NoFull + 1}, case catch close(CurFdC, FileName, read_write) of ok -> - mf_int_log(Handle1, Bins, Head, No0 + Nh, + mf_int_log(Handle1, Bins, Head, No0 + Nh, [Lost | Wraps]); Error -> Lost1 = Lost + sum(Wraps), @@ -845,7 +850,10 @@ mf_write_cache(#handle{filename = FName, cur_fdc = FdC} = Handle) -> %% -> {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}}. + {Reply, Handle#handle{cur_fdc = NewFdC}}; +mf_sync(#rotate_handle{file = FName, cur_fdc = FdC} = Handle) -> + {Reply, NewFdC} = fsync(FdC, FName), + {Reply, Handle#rotate_handle{cur_fdc = NewFdC}}. %% -> ok | throw(FileError) mf_int_close(#handle{filename = FName, curF = CurF, cur_name = FileName, @@ -855,7 +863,7 @@ mf_int_close(#handle{filename = FName, curF = CurF, cur_name = FileName, ok. %% -> {ok, handle(), Cnt} | throw(FileError) -mf_ext_open(FName, MaxB, MaxF, Repair, Mode, Head, Version) -> +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 @@ -865,37 +873,37 @@ mf_ext_open(FName, MaxB, MaxF, Repair, Mode, Head, Version) -> MaxF end, {ok, FdC, FileName, Lost, {NoItems, NoBytes}, CurB} = - ext_file_open(FName, First, 0, 0, Head, Repair, Mode), + 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}, + 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, +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} + {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} @@ -968,18 +976,201 @@ mf_ext_close(#handle{filename = FName, curF = CurF, Res. %% -> {ok, handle()} | throw(FileError) -change_size_wrap(Handle, {NewMaxB, NewMaxF}, Version) -> - FName = Handle#handle.filename, +change_size_wrap(#handle{filename = FName} = Handle, {NewMaxB, NewMaxF}, Version) -> {_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}} + NewMaxF > MaxF -> + remove_files(wrap, 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. + +change_size_rotate(#rotate_handle{maxB = MaxB, maxF = MaxF, file = FName} = Handle, {NewMaxB, NewMaxF}) -> + {MaxB, MaxF1} = get_size(MaxB, MaxF), + if + NewMaxF > MaxF1 -> + remove_files(rotate, FName, MaxF1, NewMaxF), + {ok, Handle#rotate_handle{maxB = NewMaxB, maxF = NewMaxF}}; + NewMaxF < MaxF1 -> + remove_files(rotate, FName, NewMaxF, MaxF1), + {ok, Handle#rotate_handle{maxB = NewMaxB, maxF = NewMaxF}}; + true -> + {ok, Handle#rotate_handle{maxB = NewMaxB, maxF = NewMaxF}} + end. + +open_rotate_log_file(FileName, Size, Head) -> + try + case filelib:ensure_dir(FileName) of + ok -> + case file:open(FileName, [raw, binary, read, append]) of + {ok, Fd} -> + {FdC1, _HeadSize} = ext_log_head(Fd, Head), + {FdC, FileSize} = position_close(FdC1, FileName, cur), + {ok,#file_info{inode=INode}} = + file:read_file_info(FileName,[raw]), + {MaxB, MaxF} = Size, + RotHandle = #rotate_handle{file = FileName, + cur_fdc = FdC, + maxB = MaxB, + maxF = MaxF, + curB = FileSize, + firstPos = FileSize, + inode = INode}, + update_rotation(RotHandle), + {ok, RotHandle}; + Error -> + Error + end; + Error -> + Error + end + catch + _:Reason -> {error,Reason} + end. + +update_rotation(#rotate_handle{file = FName, maxF = MaxF}) -> + maybe_remove_archives(MaxF, FName), + maybe_update_compress(0, MaxF,FName). + +maybe_remove_archives(Count, FName) -> + Archive = rotate_file_name(FName, Count), + case file:read_file_info(Archive,[raw]) of + {error,enoent} -> + ok; + _ -> + _ = file:delete(Archive), + maybe_remove_archives(Count+1, FName) + end. + +maybe_update_compress(MaxF, MaxF, _FName) -> + ok; +maybe_update_compress(N, MaxF, FName) -> + FileName = add_ext(FName, N), + case file:read_file_info(FileName,[raw]) of + {ok,_} -> + compress_file(FileName); + _ -> + ok + end, + maybe_update_compress(N+1, MaxF, FName). + +do_rotate(#rotate_handle{file = FName, maxF = MaxF, cur_fdc = FdC} = RotHandle, Head) -> + #cache{fd = Fd, c = C} = FdC, + {_, _C1} = write_cache(Fd, FName, C), + _ = delayed_write_close(Fd), + rotate_files(FName, MaxF), + {ok, NewFdC, FileSize} = ensure_open(FName, Head), + {ok,#file_info{inode=INode}} = file:read_file_info(FName,[raw]), + RotHandle#rotate_handle{cur_fdc = NewFdC, inode = INode, curB = FileSize, firstPos = FileSize}. + +rotate_files(FileName,0) -> + _ = file:delete(FileName), + ok; +rotate_files(FileName, 1) -> + FileName0 = FileName ++".0", + Rename = file:rename(FileName, FileName0), + %% Rename may fail if file has been deleted. If it has, then + %% we do not need to compress it... + if Rename =:= ok -> compress_file(FileName0); + true -> ok + end, + ok; +rotate_files(FileName, Count) -> + _ = file:rename(rotate_file_name(FileName, Count-2), rotate_file_name(FileName, Count-1)), + rotate_files(FileName, Count-1). + +rotate_file_name(FileName, Count) -> + concat([FileName, ".", Count, ".gz"]). + +compress_file(FileName) -> + {ok,In} = file:open(FileName,[read,binary]), + {ok,Out} = file:open(FileName++".gz",[write]), + Z = zlib:open(), + zlib:deflateInit(Z, default, deflated, 31, 8, default), + compress_data(Z,In,Out), + zlib:deflateEnd(Z), + zlib:close(Z), + _ = file:close(In), + _ = file:close(Out), + _ = file:delete(FileName), + ok. + +compress_data(Z,In,Out) -> + case file:read(In,100000) of + {ok,Data} -> + Compressed = zlib:deflate(Z, Data), + _ = file:write(Out,Compressed), + compress_data(Z,In,Out); + eof -> + Compressed = zlib:deflate(Z, <<>>, finish), + _ = file:write(Out,Compressed), + ok + end. + +rotate_ext_log(Handle, Bin, Head) -> + rotate_ext_log(Handle, Bin, Head, 0). + +rotate_ext_log(Handle, [], _Head, N) -> + {ok, Handle, N}; +rotate_ext_log(Handle, Bins, Head, N0) -> + #rotate_handle{file = FileName, maxB = MaxB, cur_fdc = CurFdC, + curB = CurB, firstPos = FirstPos} = Handle, + {FirstBins, LastBins, NoBytes, N} = + ext_split_bins(CurB, MaxB, FirstPos, Bins), + case FirstBins of + [] -> + Handle1 = do_rotate(Handle, Head), + rotate_ext_log(Handle1, Bins, Head, N0); + _ -> + case fwrite(CurFdC, FileName, FirstBins, NoBytes) of + {ok, NewCurFdC} -> + Handle1 = Handle#rotate_handle{cur_fdc = NewCurFdC, + curB = CurB + NoBytes}, + rotate_ext_log(Handle1, LastBins, Head, N0 + N); + {Error, NewCurFdC} -> + Handle1 = Handle#rotate_handle{cur_fdc = NewCurFdC}, + {error, Error, Handle1} + end + end. + +%% -> {Reply, handle()}; Reply = ok | Error +rotate_write_cache(#rotate_handle{file = 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#rotate_handle{cur_fdc = NewFdC}}. + +rotate_ext_close(#rotate_handle{file = FName, cur_fdc = CurFdC}) -> + (catch fclose(CurFdC, FName)). + +ensure_open(Filename, Head) -> + case filelib:ensure_dir(Filename) of + ok -> + case open_update(Filename) of + {ok, Fd} -> + {FdC1, _HeadSize} = ext_log_head(Fd, Head), + {FdC, FileSize} = position_close(FdC1, Filename, cur), + {ok, FdC, FileSize}; + Error -> + exit({could_not_reopen_file,Error}) + end; + Error -> + exit({could_not_create_dir_for_file,Error}) + end. + +%% A special close that closes the FD properly when the delayed write close failed +delayed_write_close(Fd) -> + case file:close(Fd) of + %% We got an error while closing, could be a delayed write failing + %% So we close again in order to make sure the file is closed. + {error, _} -> + file:close(Fd); + Res -> + Res end. %%----------------------------------------------------------------- @@ -1037,7 +1228,7 @@ ext_file_open(FName, NewFile, OldFile, OldCnt, Head, Repair, Mode) -> -define(index_file_name(F), add_ext(F, "idx")). read_index_file(truncate, FName, MaxF) -> - remove_files(FName, 2, MaxF), + remove_files(wrap, FName, 2, MaxF), _ = file:delete(?index_file_name(FName)), {1, 0, 0, 0}; read_index_file(_, FName, _MaxF) -> @@ -1139,7 +1330,7 @@ write_index_file(read_write, FName, NewFile, OldFile, OldCnt) -> _ = file:close(Fd), case R of {ok, <<Lost:SzSz/unit:8>>} -> Lost; - {ok, _} -> + {ok, _} -> throw({error, {invalid_index_file, FileName}}); eof -> 0; Error2 -> file_error(FileName, Error2) @@ -1342,7 +1533,7 @@ inc_wrap(FName, CurF, MaxF) -> if CurF >= NewMaxF -> %% We are at or above the new number of files - remove_files(FName, CurF + 1, OldMaxF), + remove_files(wrap, FName, CurF + 1, OldMaxF), if CurF > NewMaxF -> %% The change was done while the current file was @@ -1389,24 +1580,34 @@ file_size(Fname) -> %% -> 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(Type, FName, N, Max) -> + remove_files(Type, FName, N, Max, ok). -remove_files(_FName, N, Max, ok) when N > Max -> +remove_files(_Type, _FName, N, Max, ok) when N > Max -> ok; -remove_files(_FName, N, Max, {FileName, Error}) when N > Max -> +remove_files(_Type, _FName, N, Max, {FileName, Error}) when N > Max -> file_error(FileName, Error); -remove_files(FName, N, Max, Reply) -> - FileName = add_ext(FName, N), +remove_files(Type, FName, N, Max, Reply) -> + FileName = + case Type of + wrap -> add_ext(FName, N); + rotate -> rotate_file_name(FName, N) + end, NewReply = case file:delete(FileName) of ok -> Reply; {error, enoent} -> Reply; Error -> {FileName, Error} end, - remove_files(FName, N + 1, Max, NewReply). + remove_files(Type, FName, N + 1, Max, NewReply). %% -> {MaxBytes, MaxFiles} get_wrap_size(#handle{maxB = MaxB, maxF = MaxF}) -> + get_size(MaxB, MaxF). + +get_rotate_size(#rotate_handle{maxB = MaxB, maxF = MaxF}) -> + get_size(MaxB, MaxF). + +get_size(MaxB, MaxF) -> case MaxF of {NewMaxF,_} -> {MaxB, NewMaxF}; MaxF -> {MaxB, MaxF} @@ -1586,6 +1787,7 @@ write_cache_close(Fd, FileName, C) -> -spec file_error(file:filename(), {'error', file:posix()}) -> no_return(). + file_error(FileName, {error, Error}) -> throw({error, {file_error, FileName, Error}}). diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index a1b7c22c21..ab3e8d7478 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2023. All Rights Reserved. +%% Copyright Ericsson AB 1999-2022. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -45,15 +45,6 @@ -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]). @@ -421,7 +412,7 @@ shutdown(_Module, _Line, _Data, Reason) -> exit(Reason). %% Use this line to debug connection. %% Set net_kernel verbose = 1 as well. -%% exit({Reason, ?MODULE, _Line, _Data, erlang:timestamp()}). +%% exit({Reason, {?MODULE, _Line, _Data, erlang:timestamp()}}). handshake_we_started(#hs_data{request_type=ReqType, this_node=MyNode, @@ -524,11 +515,13 @@ connection(#hs_data{other_node = Node, f_setopts = HSData#hs_data.mf_setopts, f_getopts = HSData#hs_data.mf_getopts}, #tick{}); - _ -> - ?shutdown2(Node, connection_setup_failed) + Error1 -> + ?shutdown2( + {Node, Socket}, + {f_setopts_post_nodeup_failed, Error1}) end; - _ -> - ?shutdown(Node) + Error2 -> + ?shutdown2({Node, Socket}, {f_setopts_pre_nodeup_failed, Error2}) end. %% Generate a message digest from Challenge number and Cookie @@ -581,7 +574,7 @@ do_setnode(#hs_data{other_node = Node, socket = Socket, error_msg("** Distribution system limit reached, " "no table space left for node ~w ** ~n", [Node]), - ?shutdown(Node); + ?shutdown({Node, Socket}); error:Other:Stacktrace -> exit({Other, Stacktrace}) end; @@ -589,7 +582,7 @@ do_setnode(#hs_data{other_node = Node, socket = Socket, error_msg("** Distribution connection error, " "could not get low level port for node ~w ** ~n", [Node]), - ?shutdown(Node) + ?shutdown({Node, Socket}) end. mark_nodeup(#hs_data{kernel_pid = Kernel, @@ -626,9 +619,9 @@ con_loop(#state{kernel = Kernel, node = Node, Tick) -> receive {tcp_closed, Socket} -> - ?shutdown2(Node, connection_closed); + ?shutdown2({Node, Socket}, tcp_closed); {Kernel, disconnect} -> - ?shutdown2(Node, disconnected); + ?shutdown2({Node, Socket}, disconnected); {Kernel, aux_tick} -> case getstat(DHandle, Socket, MFGetstat) of {ok, _, _, PendWrite} -> @@ -645,17 +638,17 @@ con_loop(#state{kernel = Kernel, node = Node, error_msg("** Node ~p not responding **~n" "** Removing (timedout) connection **~n", [Node]), - ?shutdown2(Node, net_tick_timeout); - _Other -> - ?shutdown2(Node, send_net_tick_failed) + ?shutdown2({Node, Socket}, net_tick_timeout); + Error1 -> + ?shutdown2({Node, Socket}, {send_net_tick_failed, Error1}) end; {From, get_status} -> case getstat(DHandle, Socket, MFGetstat) of {ok, Read, Write, _} -> From ! {self(), get_status, {ok, Read, Write}}, con_loop(ConData, Tick); - _ -> - ?shutdown2(Node, get_status_failed) + Error2 -> + ?shutdown2({Node, Socket}, {get_status_failed, Error2}) end; {From, Ref, {setopts, Opts}} -> Ret = case MFSetOpts of @@ -689,9 +682,8 @@ send_name(#hs_data{socket = Socket, this_node = Node, NameLen = byte_size(NameBin), ?trace("send_name: 'N' node=~p creation=~w\n", [Node, Creation]), - _ = ?to_port(FSend, Socket, - [<<$N, Flags:64, Creation:32, NameLen:16>>, NameBin]), - ok. + to_port(FSend, Socket, + [<<$N, Flags:64, Creation:32, NameLen:16>>, NameBin]). to_binary(Atom) when is_atom(Atom) -> atom_to_binary(Atom, latin1); @@ -708,23 +700,20 @@ send_challenge(#hs_data{socket = Socket, this_node = Node, NameLen = byte_size(NodeName), ?trace("send: 'N' challenge=~w creation=~w\n", [Challenge,Creation]), - _ = ?to_port(FSend, Socket, [<<$N, - ThisFlags:64, - Challenge:32, - Creation:32, - NameLen:16>>, NodeName]), - ok. + to_port(FSend, Socket, + [<<$N,ThisFlags:64, Challenge:32, Creation:32, NameLen:16>>, + NodeName]). 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]). + 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]). + to_port(FSend, Socket, [$a,Digest]). %% @@ -737,8 +726,8 @@ recv_name(#hs_data{socket = Socket, f_recv = Recv} = HSData) -> recv_name_old(HSData, Data); {ok, [$N | _] = Data} -> recv_name_new(HSData, Data); - _ -> - ?shutdown(no_node) + Other -> + ?shutdown2({no_node, Socket}, {recv_name_failed, Other}) end. %% OTP 25.3: @@ -783,7 +772,7 @@ recv_name_new(HSData, end, {Flags, NodeOrHost, Creation}; false -> - ?shutdown(Data) + ?shutdown({name, Data}) end. is_node_name(NodeName) -> @@ -919,7 +908,7 @@ recv_challenge(#hs_data{socket=Socket, f_recv=Recv}=HSData) -> {ok,[$N | _]=Msg} -> recv_challenge_new(HSData, Msg); Other -> - ?shutdown2(no_node, {recv_challenge_failed, Other}) + ?shutdown2({no_node, Socket}, {recv_challenge_failed, Other}) end. recv_challenge_new(#hs_data{other_node=Node}, @@ -997,7 +986,8 @@ recv_challenge_reply(#hs_data{socket = Socket, ?shutdown2(NodeB, {recv_challenge_reply_failed, bad_cookie}) end; Other -> - ?shutdown2(no_node, {recv_challenge_reply_failed, Other}) + ?shutdown2({no_node, Socket}, + {recv_challenge_reply_failed, Other}) end. recv_challenge_ack(#hs_data{socket = Socket, f_recv = FRecv, @@ -1014,15 +1004,21 @@ recv_challenge_ack(#hs_data{socket = Socket, f_recv = FRecv, _ -> error_msg("** Connection attempt to node ~w cancelled." " Invalid challenge ack. **~n", [NodeB]), - ?shutdown2(NodeB, {recv_challenge_ack_failed, bad_cookie}) + ?shutdown2( + {NodeB, Socket}, {recv_challenge_ack_failed, bad_cookie}) end; Other -> - ?shutdown2(NodeB, {recv_challenge_ack_failed, Other}) + ?shutdown2( + {NodeB, Socket}, {recv_challenge_ack_failed, Other}) end. -recv_status(#hs_data{kernel_pid = Kernel, socket = Socket, - this_flags = MyFlgs, - other_node = Node, f_recv = Recv} = HSData) -> +recv_status( + #hs_data{ + kernel_pid = Kernel, + socket = Socket, + this_flags = MyFlgs, + other_node = Node, + f_recv = Recv} = HSData) -> case Recv(Socket, 0, infinity) of {ok, "snamed:"++Rest} -> <<NameLen:16, @@ -1039,9 +1035,11 @@ recv_status(#hs_data{kernel_pid = Kernel, socket = Socket, ?debug({dist_util,self(),recv_status, Node, Stat}), case {Stat, name_type(MyFlgs)} of {"not_allowed", _} -> - ?shutdown2(Node, {recv_status_failed, not_allowed}); + ?shutdown2( + {Node, Socket}, {recv_status_failed, not_allowed}); {_, dynamic} -> - ?shutdown2(Node, {recv_status_failed, unexpected, Stat}); + ?shutdown2( + {Node, Socket}, {recv_status_failed, unexpected, Stat}); _ -> continue end, @@ -1056,20 +1054,20 @@ recv_status(#hs_data{kernel_pid = Kernel, socket = Socket, ?debug({is_pending,self(),Reply}), send_status(HSData, Reply), if not Reply -> - ?shutdown(Node); + ?shutdown({Node, Socket}); Reply -> HSData end; "ok" -> HSData; "ok_simultaneous" -> HSData; Other -> - ?shutdown2(Node, {recv_status_failed, unknown, Other}) + ?shutdown2( + {Node, Socket}, {recv_status_failed, unknown, Other}) end; Error -> - ?debug({dist_util,self(),recv_status_error, - Node, Error}), - ?shutdown2(Node, {recv_status_failed, Error}) + ?debug({dist_util, self(), recv_status_error, Node, Error}), + ?shutdown2({Node, Socket}, {recv_status_failed, Error}) end. @@ -1083,13 +1081,14 @@ recv_status_reply(#hs_data{socket = Socket, "true" -> true; "false" -> false; Other -> - ?shutdown2(Node, {recv_status_failed, unexpected, Other}) + ?shutdown2( + {Node, Socket}, {recv_status_failed, unexpected, Other}) end; Error -> ?debug({dist_util,self(),recv_status_error, Node, Error}), - ?shutdown2(Node, {recv_status_failed, Error}) + ?shutdown2({Node, Socket}, {recv_status_failed, Error}) end. @@ -1104,22 +1103,32 @@ send_status(#hs_data{socket = Socket, case FSend(Socket, [$s, "named:", <<NameLen:16, NameBin/binary>>, <<Creation:32>>]) of - {error, _} -> - ?shutdown(Node); + {error, _} = Error-> + ?shutdown2({Node, Socket}, {send_status_failed, Error}); _ -> - true + ok 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 + {error, _} = Error -> + ?shutdown2({Node, Socket}, {send_status_failed, Error}); + _ -> + ok end. - - + +to_port(FSend, Socket, Data) -> + case FSend(Socket, Data) of + {error, closed} -> + self() ! {tcp_closed, Socket}, + ok; + {error, _} = Error -> + ?shutdown2(Socket, {f_send_failed, Error}); + ok -> + ok + end. + %% %% Send a TICK to the other side. @@ -1214,7 +1223,7 @@ setup_timer(Pid, Timeout) -> setup_timer(Pid, Timeout) after Timeout -> ?trace("Timer expires ~p, ~p~n",[Pid, Timeout]), - ?shutdown2(timer, setup_timer_timeout) + ?shutdown2({timer, Pid}, setup_timer_timeout) end. reset_timer(Timer) -> @@ -1223,7 +1232,7 @@ reset_timer(Timer) -> cancel_timer(Timer) -> unlink(Timer), - exit(Timer, shutdown). + exit(Timer, cancel_setup_timer). net_ticker_spawn_options() -> Opts = application:get_env(kernel, net_ticker_spawn_options, []), diff --git a/lib/kernel/src/erl_compile_server.erl b/lib/kernel/src/erl_compile_server.erl index f4b719068e..3910d32cac 100644 --- a/lib/kernel/src/erl_compile_server.erl +++ b/lib/kernel/src/erl_compile_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2019. All Rights Reserved. +%% Copyright Ericsson AB 2019-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,8 +51,7 @@ start_link() -> init([]) -> %% We don't want the current directory in the code path. %% Remove it. - Path = [D || D <- code:get_path(), D =/= "."], - true = code:set_path(Path), + _ = code:del_path("."), Config = init_config(), {ok, #st{config=Config}, ?IDLE_TIMEOUT}. @@ -68,7 +67,7 @@ handle_call({compile, Parameters}, From, #st{jobs=Jobs}=St0) -> case verify_context(PathArgs, Parameters, St0) of {ok, St1} -> #{cwd := Cwd, encoding := Enc} = Parameters, - PidRef = spawn_monitor(fun() -> exit(do_compile(ErlcArgs, Cwd, Enc)) end), + PidRef = spawn_monitor(fun() -> exit(do_compile(ErlcArgs, unicode:characters_to_list(Cwd, Enc), Enc)) end), St = St1#st{jobs=Jobs#{PidRef => From}}, {noreply, St#st{timeout=?IDLE_TIMEOUT}}; wrong_config -> @@ -145,8 +144,9 @@ do_compile(ErlcArgs, Cwd, Enc) -> {error, StdOutput, StdErrorOutput} end. -parse_command_line(#{command_line := CmdLine, cwd := Cwd}) -> - parse_command_line_1(CmdLine, Cwd, [], []). +parse_command_line(#{command_line := CmdLine0, cwd := Cwd, encoding := Enc}) -> + CmdLine = lists:map(fun(A) -> unicode:characters_to_list(A, Enc) end, CmdLine0), + parse_command_line_1(CmdLine, unicode:characters_to_list(Cwd, Enc), [], []). parse_command_line_1(["-pa", Pa|T], Cwd, PaAcc, PzAcc) -> parse_command_line_1(T, Cwd, [Pa|PaAcc], PzAcc); diff --git a/lib/kernel/src/erl_erts_errors.erl b/lib/kernel/src/erl_erts_errors.erl index 4d23112b83..d21dc8267b 100644 --- a/lib/kernel/src/erl_erts_errors.erl +++ b/lib/kernel/src/erl_erts_errors.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2020-2022. All Rights Reserved. +%% Copyright Ericsson AB 2020-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -352,8 +352,19 @@ format_erlang_error(demonitor, [_], _) -> format_erlang_error(demonitor, [Ref,Options], _) -> Arg1 = must_be_ref(Ref), [Arg1,maybe_option_list_error(Options, Arg1)]; -format_erlang_error(display_string, [_], _) -> +format_erlang_error(display_string, [_], none) -> [not_string]; +format_erlang_error(display_string, [_], Cause) -> + maybe_posix_message(Cause, false); +format_erlang_error(display_string, [Device, _], none) -> + case lists:member(Device,[stdin,stdout,stderr]) of + true -> + [[],not_string]; + false -> + [not_device,[]] + end; +format_erlang_error(display_string, [_, _], Cause) -> + maybe_posix_message(Cause, true); format_erlang_error(element, [Index, Tuple], _) -> [if not is_integer(Index) -> @@ -1430,8 +1441,23 @@ is_flat_char_list([H|T]) -> is_flat_char_list([]) -> true; is_flat_char_list(_) -> false. +maybe_posix_message(Cause, HasDevice) -> + case erl_posix_msg:message(Cause) of + "unknown POSIX error" ++ _ -> + unknown; + PosixStr when HasDevice -> + [unicode:characters_to_binary( + io_lib:format("~ts (~tp)",[PosixStr, Cause]))]; + PosixStr when not HasDevice -> + [{general, + unicode:characters_to_binary( + io_lib:format("~ts (~tp)",[PosixStr, Cause]))}] + end. + format_error_map([""|Es], ArgNum, Map) -> format_error_map(Es, ArgNum + 1, Map); +format_error_map([{general, E}|Es], ArgNum, Map) -> + format_error_map(Es, ArgNum, Map#{ general => expand_error(E)}); format_error_map([E|Es], ArgNum, Map) -> format_error_map(Es, ArgNum + 1, Map#{ArgNum => expand_error(E)}); format_error_map([], _, Map) -> @@ -1519,6 +1545,8 @@ expand_error(not_ref) -> <<"not a reference">>; expand_error(not_string) -> <<"not a list of characters">>; +expand_error(not_device) -> + <<"not a valid device type">>; expand_error(not_tuple) -> <<"not a tuple">>; expand_error(range) -> diff --git a/lib/kernel/src/erl_kernel_errors.erl b/lib/kernel/src/erl_kernel_errors.erl index 80660d46c8..ee5b77ad25 100644 --- a/lib/kernel/src/erl_kernel_errors.erl +++ b/lib/kernel/src/erl_kernel_errors.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2020-2022. All Rights Reserved. +%% Copyright Ericsson AB 2020-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -75,7 +75,7 @@ format_os_error(_, _, _) -> maybe_posix_message(Reason) -> case erl_posix_msg:message(Reason) of - "unknown POSIX error" -> + "unknown POSIX error" ++ _ -> io_lib:format("open_port failed with reason: ~tp",[Reason]); PosixStr -> io_lib:format("~ts (~tp)",[PosixStr, Reason]) diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index 74dc524988..829f28f00d 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2021. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -578,11 +578,9 @@ limit_term(Term) -> -spec get_format_depth() -> 'unlimited' | pos_integer(). get_format_depth() -> - case application:get_env(kernel, error_logger_format_depth) of - {ok, Depth} when is_integer(Depth) -> + case application:get_env(kernel, error_logger_format_depth, unlimited) of + Depth when is_integer(Depth) -> max(10, Depth); - {ok, unlimited} -> - unlimited; - undefined -> - unlimited + unlimited -> + unlimited end. diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index ae688ee717..6cf3e211e8 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2021. All Rights Reserved. +%% Copyright Ericsson AB 1999-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -447,7 +447,7 @@ lc_graph_to_dot(OutFile, InFile) -> {ok, [LL0]} = file:consult(InFile), [{"NO LOCK",0} | LL] = LL0, - Map = maps:from_list([{Id, Name} || {Name, Id, _, _} <- LL]), + Map = #{Id => Name || {Name, Id, _, _} <- LL}, case file:open(OutFile, [exclusive]) of {ok, Out} -> diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 49ad387a3a..3d4422dc2a 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -18,6 +18,7 @@ %% %CopyrightEnd% %% -module(file). +-deprecated([{pid2name,1,"this functionality is no longer supported"}]). %% Interface module for the file server and the file io servers. @@ -172,16 +173,9 @@ format_error(ErrorId) -> Pid :: pid(). 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 + case file_request(Pid, pid2name) of + {ok, _} = Ok -> Ok; + _ -> undefined end. %%%----------------------------------------------------------------- diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index 723325bdfb..e257857e5a 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2022. All Rights Reserved. +%% Copyright Ericsson AB 2000-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -26,7 +26,7 @@ -export([count_and_find/3]). --record(state, {handle,owner,mref,buf,read_mode,unic}). +-record(state, {handle,owner,mref,name,buf,read_mode,unic}). -include("file_int.hrl"). @@ -80,8 +80,9 @@ do_start(Spawn, Owner, FileName, ModeList) -> Self ! {Ref, ok}, server_loop( #state{handle = Handle, - owner = Owner, - mref = M, + owner = Owner, + mref = M, + name = FileName, buf = <<>>, read_mode = ReadMode, unic = UnicodeMode}) @@ -322,7 +323,10 @@ file_request({read_handle_info, Opts}, Reply -> {reply,Reply,State} end; -file_request(Unknown, +file_request(pid2name, + #state{name=Name}=State) -> + {reply,{ok,Name},State}; +file_request(Unknown, #state{}=State) -> Reason = {request, Unknown}, {error,{error,Reason},State}. diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 29eaa23375..c5450c3fd0 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2018. All Rights Reserved. +%% Copyright Ericsson AB 2000-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -37,8 +37,6 @@ -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 @@ -56,7 +54,7 @@ format_error(ErrorId) -> start() -> do_start(start). start_link() -> do_start(start_link). -stop() -> +stop() -> gen_server:call(?FILE_SERVER, stop, infinity). %%%---------------------------------------------------------------------- @@ -77,7 +75,6 @@ stop() -> init([]) -> process_flag(trap_exit, true), - ?FILE_IO_SERVER_TABLE = ets:new(?FILE_IO_SERVER_TABLE, [named_table]), {ok, undefined}. %%---------------------------------------------------------------------- @@ -97,14 +94,7 @@ init([]) -> handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, State) 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, State}; + {reply, ?FILE_IO_SERVER:start_link(Pid, Name, ModeList), State}; handle_call({open, _Name, _Mode}, _From, State) -> {reply, {error, einval}, State}; @@ -228,7 +218,6 @@ handle_cast(Msg, State) -> {'noreply', state()}. handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) -> - ets:delete(?FILE_IO_SERVER_TABLE, Pid), {noreply, State}; handle_info(Info, State) -> diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index f53a9dca3e..d02b9a2379 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -58,6 +58,7 @@ {buffer, non_neg_integer()} | {debug, boolean()} | {dontroute, boolean()} | + {exclusiveaddruse, boolean()} | {high_msgq_watermark, pos_integer()} | {linger, {boolean(), non_neg_integer()}} | {low_msgq_watermark, pos_integer()} | @@ -65,6 +66,8 @@ {priority, non_neg_integer()} | {recbuf, non_neg_integer()} | {reuseaddr, boolean()} | + {reuseport, boolean()} | + {reuseport_lb, boolean()} | {ipv6_v6only, boolean()} | {sndbuf, non_neg_integer()} | {sctp_autoclose, non_neg_integer()} | @@ -84,6 +87,7 @@ buffer | debug | dontroute | + exclusiveaddruse | high_msgq_watermark | linger | low_msgq_watermark | @@ -91,6 +95,8 @@ priority | recbuf | reuseaddr | + reuseport | + reuseport_lb | ipv6_v6only | sctp_autoclose | sctp_disable_fragments | diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 1cba7fa624..e56f9eff1d 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2022. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,6 +43,7 @@ {deliver, port | term} | {dontroute, boolean()} | {exit_on_close, boolean()} | + {exclusiveaddruse, boolean()} | {header, non_neg_integer()} | {high_msgq_watermark, pos_integer()} | {high_watermark, non_neg_integer()} | @@ -63,6 +64,8 @@ ValueBin :: binary()} | {recbuf, non_neg_integer()} | {reuseaddr, boolean()} | + {reuseport, boolean()} | + {reuseport_lb, boolean()} | {send_timeout, non_neg_integer() | infinity} | {send_timeout_close, boolean()} | {show_econnreset, boolean()} | @@ -84,6 +87,7 @@ deliver | dontroute | exit_on_close | + exclusiveaddruse | header | high_msgq_watermark | high_watermark | @@ -103,6 +107,8 @@ (ValueBin :: binary())} | recbuf | reuseaddr | + reuseport | + reuseport_lb | send_timeout | send_timeout_close | show_econnreset | diff --git a/lib/kernel/src/gen_tcp_socket.erl b/lib/kernel/src/gen_tcp_socket.erl index 7f37e8414d..fb0f807cc1 100644 --- a/lib/kernel/src/gen_tcp_socket.erl +++ b/lib/kernel/src/gen_tcp_socket.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2019-2022. All Rights Reserved. +%% Copyright Ericsson AB 2019-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -43,6 +43,7 @@ %% Undocumented or unsupported -export([unrecv/2]). -export([fdopen/2]). +-export([socket_setopts/2]). %% gen_statem callbacks @@ -728,8 +729,10 @@ socket_close(Socket) -> -compile({inline, [socket_cancel/2]}). socket_cancel(Socket, SelectInfo) -> case socket:cancel(Socket, SelectInfo) of - ok -> ok; - {error, closed} -> ok + ok -> ok; + {error, closed} -> ok; + {error, _} = ERROR -> ERROR + end. %%% ======================================================================== @@ -1009,6 +1012,7 @@ ignore_optname(Tag) -> high_msgq_watermark -> true; high_watermark -> true; low_msgq_watermark -> true; + low_watermark -> true; nopush -> true; _ -> false end. @@ -1029,7 +1033,6 @@ socket_opts() -> dontroute => {socket, dontroute}, keepalive => {socket, keepalive}, linger => {socket, linger}, - low_watermark => {socket, rcvlowat}, priority => {socket, priority}, recbuf => {socket, rcvbuf}, reuseaddr => {socket, reuseaddr}, @@ -1574,7 +1577,7 @@ handle_event( info = SelectInfo, from = From, listen_socket = ListenSocket}, {P, D}) -> - socket_cancel(ListenSocket, SelectInfo), + _ = socket_cancel(ListenSocket, SelectInfo), {next_state, 'closed', {P, D}, [{reply, From, {error, timeout}}]}; handle_event(Type, Content, #accept{} = State, P_D) -> @@ -1660,7 +1663,7 @@ handle_event( {timeout, connect}, connect, #connect{info = SelectInfo, from = From}, {#params{socket = Socket} = _P, _D} = P_D) -> - socket_cancel(Socket, SelectInfo), + _ = socket_cancel(Socket, SelectInfo), _ = socket_close(Socket), {next_state, 'closed', P_D, [{reply, From, {error, timeout}}]}; @@ -2267,11 +2270,11 @@ cleanup_close_read(P, D, State, Reason) -> case State of #accept{ info = SelectInfo, from = From, listen_socket = ListenSocket} -> - socket_cancel(ListenSocket, SelectInfo), + _ = socket_cancel(ListenSocket, SelectInfo), {D, [{reply, From, {error, Reason}}]}; #connect{info = SelectInfo, from = From} -> - socket_cancel(P#params.socket, SelectInfo), + _ = socket_cancel(P#params.socket, SelectInfo), {D, [{reply, From, {error, Reason}}]}; _ -> @@ -2282,7 +2285,7 @@ cleanup_recv(P, D, State, Reason) -> %% ?DBG({P#params.socket, State, Reason}), case State of #recv{info = SelectInfo} -> - socket_cancel(P#params.socket, SelectInfo), + _ = socket_cancel(P#params.socket, SelectInfo), cleanup_recv_reply(P, D, [], Reason); _ -> cleanup_recv_reply(P, D, [], Reason) @@ -2498,6 +2501,32 @@ tag(Packet) -> tcp end. + +%% ------- +%% Exported socket option translation +%% +socket_setopts(Socket, Opts) -> + socket_setopts( + Socket, + [Opt || + Opt <- internalize_setopts(Opts), + element(1, Opt) =/= tcp_module], + socket_opts()). +%% +socket_setopts(_Socket, [], _SocketOpts) -> + ok; +socket_setopts(Socket, [{Tag,Val} | Opts], SocketOpts) -> + case SocketOpts of + #{ Tag := Name } -> + %% Ignore all errors as an approximation for + %% inet_drv ignoring most errors + _ = socket_setopt(Socket, Name, Val), + socket_setopts(Socket, Opts, SocketOpts); + #{} -> % Ignore + socket_setopts(Socket, Opts, SocketOpts) + end. + + %% ------- %% setopts in server %% diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index c652a7663f..9debede39b 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -38,6 +38,7 @@ {deliver, port | term} | {dontroute, boolean()} | {drop_membership, membership()} | + {exclusiveaddruse, boolean()} | {header, non_neg_integer()} | {high_msgq_watermark, pos_integer()} | {low_msgq_watermark, pos_integer()} | @@ -53,6 +54,8 @@ {read_packets, non_neg_integer()} | {recbuf, non_neg_integer()} | {reuseaddr, boolean()} | + {reuseport, boolean()} | + {reuseport_lb, boolean()} | {sndbuf, non_neg_integer()} | {tos, non_neg_integer()} | {tclass, non_neg_integer()} | @@ -68,6 +71,7 @@ debug | deliver | dontroute | + exclusiveaddruse | header | high_msgq_watermark | low_msgq_watermark | @@ -84,6 +88,8 @@ read_packets | recbuf | reuseaddr | + reuseport | + reuseport_lb | sndbuf | tos | tclass | diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 4854ed2900..28bd01d228 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -497,6 +497,7 @@ disconnect() -> -spec init([]) -> {'ok', state()}. init([]) -> + _ = process_flag(async_dist, true), process_flag(trap_exit, true), %% Monitor all 'nodeup'/'nodedown' messages of visible nodes. @@ -2760,19 +2761,10 @@ inform_connection_loss(_Node, #state{}) -> %% Volatile send (does not bring up connections and does not %% preserve signal order) of Msg to global name server at Node... %% + gns_volatile_send(Node, Msg) -> - To = {global_name_server, Node}, - case erlang:send(To, Msg, [nosuspend, noconnect]) of - ok -> - ok; - noconnect -> - ok; - nosuspend -> - _ = spawn(fun () -> - _ = erlang:send(To, Msg, [noconnect]) - end), - ok - end. + _ = erlang:send({global_name_server, Node}, Msg, [noconnect]), + ok. %% %% Volatile multicast of Msg to all global name servers on known nodes @@ -2784,14 +2776,17 @@ gns_volatile_multicast(Msg, IgnoreNode, MinVer, maps:foreach(fun (Node, Ver) when is_atom(Node), Node =/= IgnoreNode, Ver >= MinVer -> - gns_volatile_send(Node, Msg); + _ = erlang:send({global_name_server, Node}, Msg, + [noconnect]); ({pending, Node}, Ver) when AlsoPend == true, Node =/= IgnoreNode, Ver >= MinVer -> - gns_volatile_send(Node, Msg); + _ = erlang:send({global_name_server, Node}, Msg, + [noconnect]); (_, _) -> ok - end, Known). + end, Known), + ok. is_node_potentially_known(Node, #state{known = Known}) -> maps:is_key(Node, Known) orelse maps:is_key({pending, Node}, Known). diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl index 9117a54b61..0fa1854e9e 100644 --- a/lib/kernel/src/global_group.erl +++ b/lib/kernel/src/global_group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2022. All Rights Reserved. +%% Copyright Ericsson AB 1998-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -260,6 +260,7 @@ start_link() -> gen_server:start_link({local, global_group}, global_group,[],[]) stop() -> gen_server:call(global_group, stop, infinity). init([]) -> + _ = process_flag(async_dist, true), process_flag(priority, max), ok = net_kernel:monitor_nodes(true, #{connection_id => true}), put(registered_names, [undefined]), @@ -1374,9 +1375,7 @@ make_group_conf(NodeName, KernParamValue) -> GMap = if OwnNodes == [] -> all; true -> - maps:from_list(lists:map(fun (Node) -> - {Node, ok} - end, OwnNodes)) + #{Node => ok || Node <- OwnNodes} end, #gconf{parameter_value = KernParamValue, node_name = NodeName, diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index 8410c1a4b5..665b326ea0 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2019. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,51 +21,45 @@ %% A group leader process for user io. --export([start/2, start/3, server/3]). --export([interfaces/1]). +-export([start/2, start/3, whereis_shell/0, server/4]). start(Drv, Shell) -> start(Drv, Shell, []). start(Drv, Shell, Options) -> - spawn_link(group, server, [Drv, Shell, Options]). + Ancestors = [self() | case get('$ancestors') of + undefined -> []; + Anc -> Anc + end], + spawn_link(group, server, [Ancestors, Drv, Shell, Options]). -server(Drv, Shell, Options) -> +server(Ancestors, Drv, Shell, Options) -> process_flag(trap_exit, true), + _ = [put('$ancestors', Ancestors) || Shell =/= {}], edlin:init(), put(line_buffer, proplists:get_value(line_buffer, Options, group_history:load())), put(read_mode, list), put(user_drv, Drv), - put(expand_fun, - proplists:get_value(expand_fun, Options, - fun(B) -> edlin_expand:expand(B) end)), + ExpandFun = normalize_expand_fun(Options, fun edlin_expand:expand/2), + put(expand_fun, ExpandFun), 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); - _ -> - [] + put(expand_below, proplists:get_value(expand_below, Options, true)), + + server_loop(Drv, start_shell(Shell), []). + +whereis_shell() -> + case node(group_leader()) of + Node when Node =:= node() -> + case user_drv:whereis_group() of + undefined -> undefined; + GroupPid -> + {dictionary, Dict} = erlang:process_info(GroupPid, dictionary), + proplists:get_value(shell, Dict) + end; + OtherNode -> + erpc:call(OtherNode, group, whereis_shell, []) 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. @@ -81,7 +75,8 @@ start_shell(Shell) when is_function(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); + put(shell, Shell), + Shell; start_shell(_Shell) -> ok. @@ -92,9 +87,11 @@ start_shell1(M, F, Args) -> Shell when is_pid(Shell) -> group_leader(G, self()), link(Shell), % we're linked to it. - put(shell, Shell); + put(shell, Shell), + Shell; Error -> % start failure exit(Error) % let the group process crash + end. start_shell1(Fun) -> @@ -104,19 +101,20 @@ start_shell1(Fun) -> Shell when is_pid(Shell) -> group_leader(G, self()), link(Shell), % we're linked to it. - put(shell, Shell); + put(shell, 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) -> + {io_request,From,ReplyAs,Req} when is_pid(From) -> %% This io_request may cause a transition to a couple of %% selective receive loops elsewhere in this module. Buf = io_request(Req, From, ReplyAs, Drv, Shell, Buf0), server_loop(Drv, Shell, Buf); - {reply,{{From,ReplyAs},Reply}} -> + {reply,{From,ReplyAs},Reply} -> io_reply(From, ReplyAs, Reply), server_loop(Drv, Shell, Buf0); {driver_id,ReplyTo} -> @@ -152,30 +150,40 @@ exit_shell(Reason) -> get_tty_geometry(Drv) -> Drv ! {self(),tty_geometry}, receive - {Drv,tty_geometry,Geometry} -> - Geometry + {Drv,tty_geometry,Geometry} -> + Geometry after 2000 -> - timeout + 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} + {Drv,get_unicode_state,UniState} -> + UniState; + {Drv,get_unicode_state,error} -> + {error, internal} after 2000 -> - {error,timeout} + {error,timeout} end. set_unicode_state(Drv,Bool) -> Drv ! {self(),set_unicode_state,Bool}, receive - {Drv,set_unicode_state,_OldUniState} -> - ok + {Drv,set_unicode_state,_OldUniState} -> + ok after 2000 -> - timeout + timeout + end. + +get_terminal_state(Drv) -> + Drv ! {self(),get_terminal_state}, + receive + {Drv,get_terminal_state,UniState} -> + UniState; + {Drv,get_terminal_state,error} -> + {error, internal} + after 2000 -> + {error,timeout} end. - io_request(Req, From, ReplyAs, Drv, Shell, Buf0) -> case io_request(Req, Drv, Shell, {From,ReplyAs}, Buf0) of @@ -197,12 +205,12 @@ io_request(Req, From, ReplyAs, Drv, Shell, Buf0) -> end. -%% Put_chars, unicode is the normal message, characters are always in +%% 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 +%% 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) -> +%% io_request({put_chars,unicode,Binary}, Drv, Buf) when is_binary(Binary) -> %% send_drv(Drv, {put_chars,Binary}), %% {ok,ok,Buf}; %% @@ -211,7 +219,7 @@ io_request(Req, From, ReplyAs, Drv, Shell, Buf0) -> io_request({put_chars,unicode,Chars}, Drv, _Shell, From, Buf) -> case catch unicode:characters_to_binary(Chars,utf8) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + send_drv(Drv, {put_chars_sync, unicode, Binary, From}), {noreply,Buf}; _ -> {error,{error,{put_chars, unicode,Chars}},Buf} @@ -219,12 +227,12 @@ io_request({put_chars,unicode,Chars}, Drv, _Shell, From, Buf) -> io_request({put_chars,unicode,M,F,As}, Drv, _Shell, From, Buf) -> case catch apply(M, F, As) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + send_drv(Drv, {put_chars_sync, unicode, Binary, From}), {noreply,Buf}; Chars -> case catch unicode:characters_to_binary(Chars,utf8) of B when is_binary(B) -> - send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}), + send_drv(Drv, {put_chars_sync, unicode, B, From}), {noreply,Buf}; _ -> {error,{error,F},Buf} @@ -233,12 +241,12 @@ io_request({put_chars,unicode,M,F,As}, Drv, _Shell, From, Buf) -> io_request({put_chars,latin1,Binary}, Drv, _Shell, From, Buf) when is_binary(Binary) -> send_drv(Drv, {put_chars_sync, unicode, unicode:characters_to_binary(Binary,latin1), - {From,ok}}), + From}), {noreply,Buf}; io_request({put_chars,latin1,Chars}, Drv, _Shell, From, Buf) -> case catch unicode:characters_to_binary(Chars,latin1) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + send_drv(Drv, {put_chars_sync, unicode, Binary, From}), {noreply,Buf}; _ -> {error,{error,{put_chars,latin1,Chars}},Buf} @@ -248,12 +256,12 @@ io_request({put_chars,latin1,M,F,As}, Drv, _Shell, From, Buf) -> Binary when is_binary(Binary) -> send_drv(Drv, {put_chars_sync, unicode, unicode:characters_to_binary(Binary,latin1), - {From,ok}}), + From}), {noreply,Buf}; Chars -> case catch unicode:characters_to_binary(Chars,latin1) of B when is_binary(B) -> - send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}), + send_drv(Drv, {put_chars_sync, unicode, B, From}), {noreply,Buf}; _ -> {error,{error,F},Buf} @@ -384,7 +392,7 @@ check_valid_opts(_) -> false. do_setopts(Opts, Drv, Buf) -> - put(expand_fun, proplists:get_value(expand_fun, Opts, get(expand_fun))), + put(expand_fun, normalize_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 -> @@ -408,6 +416,12 @@ do_setopts(Opts, Drv, Buf) -> {ok,ok,Buf} end. +normalize_expand_fun(Options, Default) -> + case proplists:get_value(expand_fun, Options, Default) of + Fun when is_function(Fun, 1) -> fun(X,_) -> Fun(X) end; + Fun -> Fun + end. + getopts(Drv,Buf) -> Exp = {expand_fun, case get(expand_fun) of Func when is_function(Func) -> @@ -431,8 +445,8 @@ getopts(Drv,Buf) -> true -> unicode; _ -> latin1 end}, - {ok,[Exp,Echo,Bin,Uni],Buf}. - + Tty = {terminal, get_terminal_state(Drv)}, + {ok,[Exp,Echo,Bin,Uni,Tty],Buf}. %% get_chars_*(Prompt, Module, Function, XtraArgument, Drv, Buffer) %% Gets characters from the input Drv until as the applied function @@ -485,18 +499,29 @@ get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf0, State, Encoding) -> get_chars_apply(Pbs, M, F, Xa, Drv, Shell, Buf, State0, Line, Encoding) -> case catch M:F(State0, cast(Line,get(read_mode), Encoding), Encoding, Xa) of + {stop,Result,eof} -> + {ok,Result,eof}; {stop,Result,Rest} -> - {ok,Result,append(Rest, Buf, Encoding)}; + case {M,F} of + {io_lib, get_until} -> + save_line_buffer(Line, get_lines(new_stack(get(line_buffer)))), + {ok,Result,append(Rest, Buf, Encoding)}; + _ -> + {ok,Result,append(Rest, Buf, Encoding)} + end; {'EXIT',_} -> {error,{error,err_func(M, F, Xa)},[]}; State1 -> + save_line_buffer(Line, get_lines(new_stack(get(line_buffer)))), get_chars_loop(Pbs, M, F, Xa, Drv, Shell, Buf, State1, Encoding) end. get_chars_n_loop(Pbs, M, F, Xa, Drv, Shell, Buf0, State, Encoding) -> try M:F(State, cast(Buf0, get(read_mode), Encoding), Encoding, Xa) of + {stop,Result,eof} -> + {ok,Result,eof}; {stop,Result,Rest} -> - {ok, Result, Rest}; + {ok,Result,append(Rest, [], Encoding)}; State1 -> case get_chars_echo_off(Pbs, Drv, Shell) of interrupted -> @@ -529,10 +554,21 @@ get_line(Chars, Pbs, Drv, Shell, Encoding) -> get_line1(edlin:edit_line(Chars, Cont), Drv, Shell, new_stack(get(line_buffer)), Encoding). -get_line1({done,Line,Rest,Rs}, Drv, _Shell, Ls, _Encoding) -> +get_line1({done,Line,Rest,Rs}, Drv, _Shell, _Ls, _Encoding) -> send_drv_reqs(Drv, Rs), - save_line_buffer(Line, get_lines(Ls)), {done,Line,Rest}; +get_line1({undefined,{_A, Mode, Char}, _Cs, Cont, Rs}, Drv, Shell, Ls0, Encoding) + when ((Mode =:= none) and (Char =:= $\^O)) -> + send_drv_reqs(Drv, Rs), + Buffer = edlin:current_chars(Cont), + send_drv(Drv, {open_editor, Buffer}), + receive + {Drv, {editor_data, Cs}} -> + send_drv_reqs(Drv, edlin:erase_line(Cont)), + {more_chars,NewCont,NewRs} = edlin:start(edlin:prompt(Cont)), + send_drv_reqs(Drv, NewRs), + get_line1(edlin:edit_line(Cs, NewCont), Drv, Shell, Ls0, Encoding) + end; get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Shell, Ls0, Encoding) when ((Mode =:= none) and (Char =:= $\^P)) or ((Mode =:= meta_left_sq_bracket) and (Char =:= $A)) -> @@ -590,21 +626,60 @@ get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Shell, Ls, Encoding) {more_chars,Ncont,Nrs} = edlin:start(Pbs, search), send_drv_reqs(Drv, Nrs), get_line1(edlin:edit_line1(Cs, Ncont), Drv, Shell, Ls, Encoding); -get_line1({expand, Before, Cs0, Cont,Rs}, Drv, Shell, Ls0, Encoding) -> +get_line1({Expand, Before, Cs0, Cont,Rs}, Drv, Shell, Ls0, Encoding) + when Expand =:= expand; Expand =:= expand_full -> send_drv_reqs(Drv, Rs), ExpandFun = get(expand_fun), - {Found, Add, Matches} = ExpandFun(Before), + {Found, CompleteChars, Matches} = ExpandFun(Before, []), case Found of - no -> send_drv(Drv, beep); - yes -> ok + no -> send_drv(Drv, beep); + _ -> 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, + {Width, _Height} = get_tty_geometry(Drv), + Cs1 = append(CompleteChars, Cs0, Encoding), + + MatchStr = case Matches of + [] -> []; + _ -> edlin_expand:format_matches(Matches, Width) + end, + Cs = case {Cs1, MatchStr} of + {_, []} -> Cs1; + {Cs1, _} when Cs1 =/= [] -> Cs1; + _ -> + NlMatchStr = unicode:characters_to_binary("\n"++MatchStr), + case get(expand_below) of + true -> + Lines = string:split(string:trim(MatchStr), "\n", all), + NoLines = length(Lines), + if NoLines > 5, Expand =:= expand -> + %% Only show 5 lines to start with + [L1,L2,L3,L4,L5|_] = Lines, + String = lists:join( + $\n, + [L1,L2,L3,L4,L5, + io_lib:format("Press tab to see all ~p expansions", + [edlin_expand:number_matches(Matches)])]), + send_drv(Drv, {put_expand, unicode, + unicode:characters_to_binary(String)}), + Cs1; + true -> + case get_tty_geometry(Drv) of + {_, Rows} when Rows > NoLines -> + %% If all lines fit on screen, we expand below + send_drv(Drv, {put_expand, unicode, NlMatchStr}), + Cs1; + _ -> + %% If there are more results than fit on + %% screen we expand above + send_drv(Drv, {put_chars, unicode, NlMatchStr}), + [$\e, $l | Cs1] + end + end; + false -> + send_drv(Drv, {put_chars, unicode, NlMatchStr}), + [$\e, $l | Cs1] + end + end, get_line1(edlin:edit_line(Cs, Cont), Drv, Shell, Ls0, Encoding); get_line1({undefined,_Char,Cs,Cont,Rs}, Drv, Shell, Ls, Encoding) -> send_drv_reqs(Drv, Rs), @@ -674,7 +749,7 @@ more_data(What, Cont0, Drv, Shell, Ls, Encoding) -> io_request(Req, From, ReplyAs, Drv, Shell, []), %WRONG!!! send_drv_reqs(Drv, edlin:redraw_line(Cont)), get_line1({more_chars,Cont,[]}, Drv, Shell, Ls, Encoding); - {reply,{{From,ReplyAs},Reply}} -> + {reply,{From,ReplyAs},Reply} -> %% We take care of replies from puts here as well io_reply(From, ReplyAs, Reply), more_data(What, Cont0, Drv, Shell, Ls, Encoding); @@ -702,7 +777,7 @@ get_line_echo_off1({Chars,[]}, Drv, Shell) -> {io_request,From,ReplyAs,Req} when is_pid(From) -> io_request(Req, From, ReplyAs, Drv, Shell, []), get_line_echo_off1({Chars,[]}, Drv, Shell); - {reply,{{From,ReplyAs},Reply}} when From =/= undefined -> + {reply,{From,ReplyAs},Reply} when From =/= undefined -> %% We take care of replies from puts here as well io_reply(From, ReplyAs, Reply), get_line_echo_off1({Chars,[]},Drv, Shell); @@ -713,6 +788,8 @@ get_line_echo_off1({Chars,[]}, Drv, Shell) -> {'EXIT',Shell,R} -> exit(R) end; +get_line_echo_off1(eof, _Drv, _Shell) -> + {done,eof,eof}; get_line_echo_off1({Chars,Rest}, _Drv, _Shell) -> {done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}. @@ -729,7 +806,7 @@ get_chars_echo_off1(Drv, Shell) -> {io_request,From,ReplyAs,Req} when is_pid(From) -> io_request(Req, From, ReplyAs, Drv, Shell, []), get_chars_echo_off1(Drv, Shell); - {reply,{{From,ReplyAs},Reply}} when From =/= undefined -> + {reply,{From,ReplyAs},Reply} when From =/= undefined -> %% We take care of replies from puts here as well io_reply(From, ReplyAs, Reply), get_chars_echo_off1(Drv, Shell); @@ -750,8 +827,10 @@ get_chars_echo_off1(Drv, Shell) -> %% - ^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, []) -> + eof; edit_line(eof, Chars) -> - {Chars,done}; + {Chars,eof}; edit_line([],Chars) -> {Chars,[]}; edit_line([$\r,$\n|Cs],Chars) -> @@ -877,7 +956,7 @@ get_password1({Chars,[]}, Drv, Shell) -> %% set to []. But do we expect anything but plain output? get_password1({Chars, []}, Drv, Shell); - {reply,{{From,ReplyAs},Reply}} -> + {reply,{From,ReplyAs},Reply} -> %% We take care of replies from puts here as well io_reply(From, ReplyAs, Reply), get_password1({Chars, []},Drv, Shell); diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl index aae4748139..7738a2155e 100644 --- a/lib/kernel/src/group_history.erl +++ b/lib/kernel/src/group_history.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017-2022. All Rights Reserved. +%% Copyright Ericsson AB 2017-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -310,10 +310,7 @@ disk_log_info(Tag) -> Value. find_wrap_values() -> - ConfSize = case application:get_env(kernel, shell_history_file_bytes) of - undefined -> ?DEFAULT_SIZE; - {ok, S} -> S - end, + ConfSize = application:get_env(kernel, shell_history_file_bytes, ?DEFAULT_SIZE), SizePerFile = max(?MIN_HISTORY_SIZE, ConfSize div ?MAX_HISTORY_FILES), FileCount = if SizePerFile > ?MIN_HISTORY_SIZE -> ?MAX_HISTORY_FILES diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index d836f6b367..780abec149 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -35,8 +35,10 @@ ip/1, is_ipv4_address/1, is_ipv6_address/1, is_ip_address/1, stats/0, options/0, pushf/3, popf/1, close/1, gethostname/0, gethostname/1, - parse_ipv4_address/1, parse_ipv6_address/1, parse_ipv4strict_address/1, - parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1, + parse_ipv4_address/1, parse_ipv6_address/1, + parse_ipv4strict_address/1, parse_ipv6strict_address/1, + parse_address/1, parse_strict_address/1, + parse_address/2, parse_strict_address/2, ntoa/1, ipv4_mapped_ipv6_address/1]). -export([connect_options/2, listen_options/2, udp_options/2, sctp_options/2]). @@ -912,6 +914,19 @@ parse_ipv6strict_address(Addr) -> parse_address(Addr) -> inet_parse:address(Addr). +-spec parse_address(Address, inet) -> + {ok, IPAddress} | {error, einval} when + Address :: string(), + IPAddress :: ip_address(); + (Address, inet6) -> + {ok, IPv6Address} | {error, einval} when + Address :: string(), + IPv6Address :: ip6_address(). +parse_address(Addr, inet) -> + inet_parse:ipv4_address(Addr); +parse_address(Addr, inet6) -> + inet_parse:ipv6_address(Addr). + -spec parse_strict_address(Address) -> {ok, IPAddress} | {error, einval} when Address :: string(), @@ -919,6 +934,19 @@ parse_address(Addr) -> parse_strict_address(Addr) -> inet_parse:strict_address(Addr). +-spec parse_strict_address(Address, inet) -> + {ok, IPAddress} | {error, einval} when + Address :: string(), + IPAddress :: ip_address(); + (Address, inet6) -> + {ok, IPv6Address} | {error, einval} when + Address :: string(), + IPv6Address :: ip6_address(). +parse_strict_address(Addr, inet) -> + inet_parse:ipv4strict_address(Addr); +parse_strict_address(Addr, inet6) -> + inet_parse:ipv6strict_address(Addr). + -spec ipv4_mapped_ipv6_address(ip_address()) -> ip_address(). ipv4_mapped_ipv6_address({D1,D2,D3,D4}) when (D1 bor D2 bor D3 bor D4) < 256 -> @@ -953,9 +981,9 @@ stats() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% connect_options() -> [debug, - tos, tclass, priority, reuseaddr, keepalive, linger, nodelay, - sndbuf, recbuf, - recvtos, recvtclass, ttl, recvttl, + tos, tclass, priority, reuseaddr, reuseport, reuseport_lb, + exclusiveaddruse, keepalive, + linger, nodelay, sndbuf, recbuf, recvtos, recvtclass, ttl, recvttl, header, active, packet, packet_size, buffer, mode, deliver, line_delimiter, exit_on_close, high_watermark, low_watermark, high_msgq_watermark, low_msgq_watermark, send_timeout, send_timeout_close, delay_send, raw, @@ -1044,8 +1072,8 @@ con_add(Name, Val, #connect_opts{} = R, Opts, AllOpts) -> listen_options() -> [debug, tos, tclass, - priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay, - recvtos, recvtclass, ttl, recvttl, + priority, reuseaddr, reuseport, reuseport_lb, exclusiveaddruse, keepalive, + linger, sndbuf, recbuf, nodelay, recvtos, recvtclass, ttl, recvttl, header, active, packet, buffer, mode, deliver, backlog, ipv6_v6only, exit_on_close, high_watermark, low_watermark, high_msgq_watermark, low_msgq_watermark, send_timeout, send_timeout_close, delay_send, diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index 408f563909..b7d5afcc64 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2022. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -47,7 +47,7 @@ -export([set_cache_size/1, set_cache_refresh/1]). -export([set_timeout/1, set_retry/1, set_servfail_retry_timeout/1, set_inet6/1, set_usevc/1]). --export([set_edns/1, set_udp_payload_size/1]). +-export([set_edns/1, set_udp_payload_size/1, set_dnssec_ok/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]). @@ -227,6 +227,8 @@ set_edns(Version) -> res_option(edns, Version). set_udp_payload_size(Size) -> res_option(udp_payload_size, Size). +set_dnssec_ok(DnssecOk) -> res_option(dnssec_ok, DnssecOk). + set_resolv_conf(Fname) when is_list(Fname) -> res_option(resolv_conf, Fname). @@ -312,7 +314,7 @@ valid_lookup() -> [dns, file, yp, nis, nisplus, native]. get_rc() -> get_rc([hosts, domain, nameservers, search, alt_nameservers, timeout, retry, servfail_retry_timeout, inet6, usevc, - edns, udp_payload_size, resolv_conf, hosts_file, + edns, udp_payload_size, dnssec_ok, resolv_conf, hosts_file, socks5_server, socks5_port, socks5_methods, socks5_noproxy, udp, sctp, tcp, host, cache_size, cache_refresh, lookup], []). @@ -361,6 +363,10 @@ get_rc([K | Ks], Ls) -> res_udp_payload_size, ?DNS_UDP_PAYLOAD_SIZE, Ks, Ls); + dnssec_ok -> get_rc(dnssec_ok, + res_res_dnssec_ok, + false, + Ks, Ls); resolv_conf -> get_rc(resolv_conf, res_resolv_conf, undefined, @@ -483,6 +489,7 @@ 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(dnssec_ok) -> res_dnssec_ok; res_optname(resolv_conf) -> res_resolv_conf; res_optname(resolv_conf_name) -> res_resolv_conf; res_optname(hosts_file) -> res_hosts_file; @@ -498,7 +505,7 @@ res_check_option(nameservers, NSs) -> res_check_option(alt_nameservers, NSs) -> res_check_list(NSs, fun res_check_ns/1); res_check_option(domain, Dom) -> - Dom =:= "" orelse inet_parse:visible_string(Dom); + inet_parse:visible_string(Dom); res_check_option(lookup, Methods) -> try lists_subtract(Methods, valid_lookup()) of [] -> true; @@ -517,6 +524,7 @@ 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(dnssec_ok, D) when is_boolean(D) -> true; res_check_option(resolv_conf, "") -> true; res_check_option(resolv_conf, F) -> res_check_option_absfile(F); @@ -550,7 +558,6 @@ 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); @@ -579,8 +586,11 @@ res_update(Option, TagTm) -> end. db_get(Name) -> - try ets:lookup_element(inet_db, Name, 2) - catch error:badarg -> undefined + try + ets:lookup_element(inet_db, Name, 2, undefined) + catch + %% Case where the table does not exist yet. + error:badarg -> undefined end. add_rr(RR) -> @@ -878,6 +888,7 @@ take_socket_type(MRef) -> %% 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_dnssec_ok Bool - the DO bit in RFC6891 & RFC3225 %% 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 @@ -955,6 +966,7 @@ reset_db(Db) -> {res_inet6, false}, {res_edns, false}, {res_udp_payload_size, ?DNS_UDP_PAYLOAD_SIZE}, + {res_dnssec_ok, false}, {cache_size, ?CACHE_LIMIT}, {cache_refresh_interval,?CACHE_REFRESH}, {socks5_server, ""}, @@ -1044,7 +1056,7 @@ handle_call(Request, From, #state{db=Db}=State) -> end; {set_hostname, Name} -> - case inet_parse:visible_string(Name) of + case inet_parse:visible_string(Name) andalso Name =/= "" of true -> ets:insert(Db, {hostname, Name}), {reply, ok, State}; @@ -1638,6 +1650,7 @@ 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(dnssec_ok) -> true; is_res_set(resolv_conf) -> true; is_res_set(hosts_file) -> true; is_res_set(_) -> false. diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl index c236dfd0d6..2aeb6a9847 100644 --- a/lib/kernel/src/inet_dns.erl +++ b/lib/kernel/src/inet_dns.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2021. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,7 +23,7 @@ %% %% RFC 1035: Domain Names - Implementation and Specification %% RFC 2181: Clarifications to the DNS Specification -%% RFC 2671: Extension Mechanisms for DNS (EDNS0) +%% RFC 6891: 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 %% RFC 6488: DNS Certification Authority Authorization (CAA) Resource Record @@ -49,6 +49,7 @@ make_dns_query/2, make_dns_query/3]). -include("inet_dns_record_adts.hrl"). + %% Function merge of #dns_rr{} and #dns_rr_opt{} %% @@ -112,6 +113,10 @@ lists_member(H, [H|_]) -> true; lists_member(H, [_|T]) -> lists_member(H, T). +-define(in_range(Low, X, High), ((Low =< (X)) andalso ((X) =< High))). +-define(is_decimal(X), (?in_range(0, (X), 9))). + + %% must match a clause in inet_res:query_nss_e?dns -define(DECODE_ERROR, formerr). @@ -230,7 +235,8 @@ decode_rr_section(Bin, N, Buffer, RRs) -> RR = case Type of ?S_OPT -> - <<ExtRcode,Version,Z:16>> = TTL, + <<ExtRcode,Version,DO:1,Z:15>> = TTL, + DnssecOk = (DO =/= 0), #dns_rr_opt{ domain = Name, type = Type, @@ -238,7 +244,8 @@ decode_rr_section(Bin, N, Buffer, RRs) -> ext_rcode = ExtRcode, version = Version, z = Z, - data = D}; + data = D, + do = DnssecOk}; _ -> {Class,CacheFlush} = decode_class(C), Data = decode_data(D, Class, Type, Buffer), @@ -297,8 +304,8 @@ encode_query_section(Bin0, Comp0, [#dns_query{domain=DName}=Q | Qs]) -> {Bin,Comp} = encode_name(Bin0, Comp0, byte_size(Bin0), DName), encode_query_section(<<Bin/binary,T:16,C:16>>, Comp, Qs). -%% RFC 1035: 4.1.3. Resource record format -%% RFC 2671: 4.3, 4.4, 4.6 OPT RR format +%% RFC 1035: 4.1.3. Resource record format +%% RFC 6891: 6.1.2, 6.1.3, 6.2.3 Opt RR format %% encode_res_section(Bin, Comp, []) -> {Bin,Comp}; encode_res_section( @@ -321,10 +328,12 @@ encode_res_section( ext_rcode = ExtRCode, version = Version, z = Z, - data = Data} | Rs]) -> + data = Data, + do = DnssecOk} | Rs]) -> + DO = case DnssecOk of true -> 1; false -> 0 end, encode_res_section_rr( Bin, Comp, Rs, DName, ?S_OPT, UdpPayloadSize, false, - <<ExtRCode,Version,Z:16>>, Data). + <<ExtRCode,Version,DO:1,Z:15>>, Data). encode_res_section_rr( Bin0, Comp0, Rs, DName, Type, Class, CacheFlush, TTL, Data) -> @@ -360,6 +369,7 @@ decode_type(Type) -> ?T_MX -> ?S_MX; ?T_TXT -> ?S_TXT; ?T_AAAA -> ?S_AAAA; + ?T_LOC -> ?S_LOC; ?T_SRV -> ?S_SRV; ?T_NAPTR -> ?S_NAPTR; ?T_OPT -> ?S_OPT; @@ -401,6 +411,7 @@ encode_type(Type) -> ?S_MX -> ?T_MX; ?S_TXT -> ?T_TXT; ?S_AAAA -> ?T_AAAA; + ?S_LOC -> ?T_LOC; ?S_SRV -> ?T_SRV; ?S_NAPTR -> ?T_NAPTR; ?S_OPT -> ?T_OPT; @@ -539,6 +550,21 @@ decode_data(Data, ?S_MX, Buffer) -> Data, <<Prio:16,Dom/binary>>, {Prio,decode_domain(Dom, Buffer)}); +decode_data(Data, ?S_LOC, _) -> + ?MATCH_ELSE_DECODE_ERROR( + Data, + <<Version:8, SizeBase:4, SizeExp:4, + HorizPreBase:4, HorizPreExp:4, VertPreBase:4, VertPreExp:4, + Latitude:32, Longitude:32, Altitude:32>>, + ((Version =:= 0) andalso + ?is_decimal(SizeBase) andalso ?is_decimal(SizeExp) andalso + ?is_decimal(HorizPreBase) andalso ?is_decimal(HorizPreExp) andalso + ?is_decimal(VertPreBase) andalso ?is_decimal(VertPreExp)), + {{decode_loc_angle(Latitude), decode_loc_angle(Longitude)}, + decode_loc_altitude(Altitude), + decode_loc_size(SizeBase, SizeExp), + {decode_loc_size(HorizPreBase, HorizPreExp), + decode_loc_size(VertPreBase, VertPreExp)}}); decode_data(Data, ?S_SRV, Buffer) -> ?MATCH_ELSE_DECODE_ERROR( Data, @@ -735,6 +761,25 @@ encode_data(Comp, Pos, ?S_MINFO, Data) -> encode_data(Comp, Pos, ?S_MX, Data) -> {Pref,Exch} = Data, encode_name(<<Pref:16>>, Comp, Pos+2, Exch); +encode_data(Comp, _, ?S_LOC, Data) -> + %% Similar to the Master File Format in section 3 of RFC 1876 + case Data of + {{Latitude, Longitude}, Altitude, Size, {HorizPre, VertPre}} -> + ok; + {{Latitude, Longitude}, Altitude, Size} -> + HorizPre = 10_000_00, VertPre = 10_00, + ok; + {{Latitude, Longitude}, Altitude} -> + Size = 1_00, HorizPre = 10_000_00, VertPre = 10_00, + ok + end, + Version = 0, + {<<Version:8, (encode_loc_size(Size))/binary, + (encode_loc_size(HorizPre))/binary, (encode_loc_size(VertPre))/binary, + (encode_loc_angle(Latitude)):32, + (encode_loc_angle(Longitude)):32, + (encode_loc_altitude(Altitude)):32>>, + Comp}; encode_data(Comp, Pos, ?S_SRV, Data) -> {Prio,Weight,Port,Target} = Data, encode_name(<<Prio:16,Weight:16,Port:16>>, Comp, Pos+2+2+2, Target); @@ -854,3 +899,51 @@ encode_labels(Bin, Comp0, Pos, [L|Ls]=Labels) %% Name compression - point to already encoded name {<<Bin/binary,3:2,Ptr:14>>,Comp0} end. + + +decode_loc_angle(X) -> + (X - 16#8000_0000) / 3600_000. + +encode_loc_angle(X) when is_float(X) -> + %% Degrees (1/360 of a turn) + encode_loc_angle(round(X * 3600_000)); +encode_loc_angle(X) + when is_integer(X), -16#8000_0000 =< X, X =< 16#7FFF_FFFF -> + %% 1/1000:s of arc second + X + 16#8000_0000. % Zero is encoded as 2^31 + + +decode_loc_altitude(X) -> + (X - 100_000_00) / 100. + +encode_loc_altitude(X) when is_float(X) -> + %% Meters + encode_loc_altitude(round(X * 100)); +encode_loc_altitude(X) + when is_integer(X), -100_000_00 =< X, X =< 16#FFFF_FFFF - 100_000_00 -> + %% Centimeters above a base level 100_000 m below + %% the GPS reference spheroid [DoD WGS-1984] + X + 100_000_00. + + +decode_loc_size(Base, Exponent) -> + round(Base * math:pow(10, Exponent)) / 100. + +%% Return the smallest encoded value >= X; +%% a bit like ceil(X) of encoded values +%% +encode_loc_size(X) when is_float(X) -> + %% Meters + encode_loc_size(round(X * 100)); +encode_loc_size(0) -> + 0; +encode_loc_size(X) + when is_integer(X), 0 =< X, X =< 9000_000_000 -> + %% Centimeters, to be encoded as Digit * 10^Exponent + %% with both Digit and Exponent in 0..9, + %% limiting the range to 0..9e9 + %% + Exponent = floor(math:log10((X - 0.05) / 0.9)), + Multiplier = round(math:pow(10, Exponent)), + Base = (X + Multiplier - 1) div Multiplier, + <<Base:4, Exponent:4>>. diff --git a/lib/kernel/src/inet_dns.hrl b/lib/kernel/src/inet_dns.hrl index 5288c570b2..cf8f984e05 100644 --- a/lib/kernel/src/inet_dns.hrl +++ b/lib/kernel/src/inet_dns.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2021. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -72,11 +72,13 @@ -define(T_MX, 15). %% mail routing information -define(T_TXT, 16). %% text strings -define(T_AAAA, 28). %% ipv6 address +%% LOC (RFC 1876) +-define(T_LOC, 29). %% location information %% 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) +-define(T_OPT, 41). %% EDNS pseudo-rr RFC6891(7) %% SPF (RFC 4408) -define(T_SPF, 99). %% server policy framework %% non standard @@ -114,11 +116,13 @@ -define(S_MX, mx). %% mail routing information -define(S_TXT, txt). %% text strings -define(S_AAAA, aaaa). %% ipv6 address +%% LOC (RFC 1876) +-define(S_LOC, loc). %% location information %% 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) +-define(S_OPT, opt). %% EDNS pseudo-rr RFC6891(7) %% SPF (RFC 4408) -define(S_SPF, spf). %% server policy framework %% non standard @@ -201,15 +205,16 @@ -define(DNS_UDP_PAYLOAD_SIZE, 1280). --record(dns_rr_opt, %% EDNS RR OPT (RFC2671), dns_rr{type=opt} +-record(dns_rr_opt, %% EDNS RR OPT (RFC6891), 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) + udp_payload_size = ?DNS_UDP_PAYLOAD_SIZE, %% RFC6891(6.2.3 CLASS) + ext_rcode = 0, %% RFC6891(6.1.3 EXTENDED-RCODE) + version = 0, %% RFC6891(6.1.3 VERSION) + z = 0, %% RFC6891(6.1.3 Z) + data = [], %% RFC6891(6.1.2 RDATA) + do = false %% RFC6891(6.1.3 DO) }). -record(dns_query, diff --git a/lib/kernel/src/inet_dns_record_adts.pl b/lib/kernel/src/inet_dns_record_adts.pl index c89d837098..f3331222fc 100644 --- a/lib/kernel/src/inet_dns_record_adts.pl +++ b/lib/kernel/src/inet_dns_record_adts.pl @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2009-2016. All Rights Reserved. +# Copyright Ericsson AB 2009-2023. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -32,7 +32,7 @@ my %Names = ('msg' => ['dns_rec', 'header', 'qdlist', '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'], + 'z', 'data', 'do'], 'dns_query' => ['dns_query', 'domain', 'type', 'class'], 'header' => ['dns_header', 'id', 'qr', 'opcode', 'aa', 'tc', 'rd', 'ra', 'pr', 'rcode']); diff --git a/lib/kernel/src/inet_epmd_dist.erl b/lib/kernel/src/inet_epmd_dist.erl new file mode 100644 index 0000000000..33ad46b858 --- /dev/null +++ b/lib/kernel/src/inet_epmd_dist.erl @@ -0,0 +1,822 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(inet_epmd_dist). +-feature(maybe_expr, enable). + +%% DistMod API - own inet_tcp_dist equivalence implementation +-export([net_address/0, listen_open/2, listen_port/3, listen_close/1, + accept_open/2, accept_controller/3, accepted/3, + connect/3]). +%% DistMod helper API +-export([check_ip/2, + hs_data/2, f_address/2, tick/1, getstat/1, setopts/2, getopts/2, + nodelay/0, merge_options/3]). + +%% net_kernel and dist_util distribution Module API +-export([address/1, listen/2, + accept/1, accept_connection/5, + select/1, setup/5, + close/1]). + +-include("net_address.hrl"). +-include("dist.hrl"). +-include("dist_util.hrl"). + +-define(DISTNAME, inet_epmd). + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% DistMod API +%% +%% Called by net_kernel: +%% +%% net_address() -> +%% #net_address{ protocol = Protocol, family = Family }. +%% +%% listen_open(NetAddress, ListenOptions) -> +%% {ok, StateO} | +%% {error, _}. +%% +%% listen_port(NetAddress, Port, StateO) -> +%% {ok, {StateL, {Ip, Port}}} | +%% {error, _}. +%% +%% listen_close(StateL) -> +%% ok. +%% +%% +%% Called by Acceptor: +%% +%% %% Wait for incoming connection, +%% %% return new socket and endpoint addresses +%% accept_open(NetAddress, StateL) -> +%% {StateA, PeerAddress}. +%% +%% %% Notification about the process id of the Controller +%% %% - transfer socket ownership to it +%% accept_controller(NetAddress, Controller, StateA) -> +%% StateC. +%% +%% +%% Called by Accept Controller: +%% +%% accepted(NetAddress, Timer, StateC) -> +%% #hs_data{} | {error, Reason} +%% +%% +%% Called by Connect Controller: +%% connect(NetAddress, Timer, ConnectOptions) -> +%% #hs_data{} | {error, Reason} +%% +%% ------------------------------------------------------------ +%% Own DistMod API implementation - +%% when used by this module the combination +%% is equivalent to inet_tcp_dist + +-define(DRIVER, inet_tcp). +-define(PROTOCOL, tcp). + +%% ------------------------------------------------------------ +net_address() -> + Family = ?DRIVER:family(), + #net_address{ + protocol = ?PROTOCOL, + family = Family }. + +%% ------------------------------------------------------------ +listen_open(_NetAddress, Options) -> + {ok, merge_options(Options, [{active, false}, {packet, 2}], [])}. + +%% ------------------------------------------------------------ +listen_port(_NetAddress, Port, ListenOptions) -> + maybe + {ok, ListenSocket} ?= + ?DRIVER:listen(Port, ListenOptions), + {ok, Address} ?= + inet:sockname(ListenSocket), + {ok, {ListenSocket, Address}} + end. + +%% ------------------------------------------------------------ +listen_close(ListenSocket) -> + ?DRIVER:close(ListenSocket). + +%% ------------------------------------------------------------ +accept_open(_NetAddress, ListenSocket) -> + maybe + {ok, Socket} ?= + ?DRIVER:accept(ListenSocket), + {ok, {Ip, _}} ?= + inet:sockname(Socket), + {ok, {PeerIp, _} = PeerAddress} ?= + inet:peername(Socket), + check_ip(Ip, PeerIp), + {Socket, PeerAddress} + else + {error, Reason} -> + exit({accept, Reason}) + end. + +%% ------------------------------------------------------------ +accept_controller(_NetAddress, Controller, Socket) -> + ?DRIVER:controlling_process(Socket, Controller), +%%% flush_to(Socket, Controller), + Socket. + +-ifdef(undefined). +flush_to(Socket, Pid) -> + receive + {tcp, Socket, Data} -> + Pid ! {tcp, Socket, Data}, + flush_to(Socket, Pid); + {tcp_closed, Socket} -> + Pid ! {tcp_closed, Socket}, + flush_to(Socket, Pid) + after 0 -> + ok + end. +-endif. + +%% ------------------------------------------------------------ +accepted(NetAddress, _Timer, Socket) -> + hs_data(NetAddress, Socket). + +%% ------------------------------------------------------------ +connect(NetAddress, _Timer, Options) -> + ConnectOptions = + merge_options(Options, [{active, false}, {packet, 2}], []), + #net_address{ address = {Ip, Port} } = NetAddress, + maybe + {ok, Socket} ?= + ?DRIVER:connect(Ip, Port, ConnectOptions), + hs_data(NetAddress, Socket) + else + {error, _} = Error -> + Error + end. + +%% ------- +hs_data(NetAddress, Socket) -> + Nodelay = nodelay(), + #hs_data{ + socket = Socket, + f_send = fun ?DRIVER:send/2, + f_recv = fun ?DRIVER:recv/3, + f_setopts_pre_nodeup = + fun (S) when S =:= Socket -> + f_setopts_pre_nodeup(S, Nodelay) + end, + f_setopts_post_nodeup = + fun (S) when S =:= Socket -> + f_setopts_post_nodeup(S, Nodelay) + end, + f_address = + fun (S, Node) when S =:= Socket -> + f_address(NetAddress, Node) + end, + f_getll = fun inet:getll/1, + mf_tick = fun ?MODULE:tick/1, + mf_getstat = fun ?MODULE:getstat/1, + mf_setopts = fun ?MODULE:setopts/2, + mf_getopts = fun ?MODULE:getopts/2 }. + +f_setopts_pre_nodeup(Socket, Nodelay) -> + inet:setopts(Socket, [{active, false}, {packet, 4}, Nodelay]). + +f_setopts_post_nodeup(Socket, Nodelay) -> + inet:setopts( + Socket, + [{active, true}, {packet,4}, {deliver, port}, binary, Nodelay]). + +f_address(NetAddress, Node) -> + case dist_util:split_node(Node) of + {node, _Name, Host} -> + NetAddress#net_address{ + host = Host }; + Other -> + ?shutdown2(Node, {split_node, Other}) + end. + +tick(Socket) when is_port(Socket) -> + Result = ?DRIVER:send(Socket, [], [force]), + _ = (Result =:= {error, closed}) andalso + (self() ! {tcp_closed, Socket}), + Result. + +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}. + +setopts(S, Opts) -> + case [Opt || {K,_}=Opt <- Opts, + K =:= active orelse K =:= deliver orelse K =:= packet] of + [] -> inet:setopts(S,Opts); + Opts1 -> {error, {badopts,Opts1}} + end. + +getopts(S, OptNames) -> + inet:getopts(S, OptNames). + + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% net_kernel distribution module API + + +%% ------------------------------------------------------------ +%% Return which #net_address{} we handle +%% ------------------------------------------------------------ + +address(Host) -> + try + pt_init(Host), + pt_get(net_address) + catch error : Reason : Stacktrace -> + error_logger:error_msg( + "error : ~p in ~n ~p~n", [Reason, Stacktrace]), + erlang:raise(error, Reason, Stacktrace) + end. + +%% ------------------------------------------------------------ +%% Create the listen socket, i.e. the port that this erlang +%% node is accessible through. +%% ------------------------------------------------------------ + +listen(Name, Host) -> + try + maybe + pt_init(Host), + NetAddress = pt_get(net_address), + DistMod = pt_get(dist_mod), + EpmdMod = net_kernel:epmd_module(), + %% + {ok, ListenOptions} ?= + %% ******* + DistMod:listen_open(NetAddress, listen_options()), + {First, Last} = + case + call_epmd_function( + EpmdMod, listen_port_please, [Name, Host]) + of + {ok, 0} -> + get_port_range(); + {ok, PortNum} -> + {PortNum, PortNum} + end, + #net_address{ family = Family } = NetAddress = pt_get(net_address), + %% + {ok, Result} ?= + listen_loop(First, NetAddress, ListenOptions, Last, DistMod), + {StateL, {_Ip, Port} = Address} = Result, + %% + {ok, Creation} ?= + EpmdMod:register_node(Name, Port, Family), + NetAddress_1 = NetAddress#net_address{ address = Address }, + {ok, {{NetAddress_1, StateL}, NetAddress_1, Creation}} + else + {error, _} = Error -> + Error + end + catch error : Reason : Stacktrace -> + error_logger:error_msg( + "error : ~p in ~n ~p~n", [Reason, Stacktrace]), + erlang:raise(error, Reason, Stacktrace) + end. + +get_port_range() -> + 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. + +listen_loop(Port, NetAddress, ListenOptions, LastPort, DistMod) + when Port =< LastPort -> + case + %% ******* + DistMod:listen_port(NetAddress, Port, ListenOptions) + of + {error, eaddrinuse} -> + listen_loop( + Port + 1, NetAddress, ListenOptions, LastPort, DistMod); + Result -> + Result + end; +listen_loop(_, _, _, _, _) -> + {error, eaddrinuse}. + +%% ------------------------------------------------------------ +%% Close the listen socket +%% ------------------------------------------------------------ +close(ListenSocket) -> + (pt_get(dist_mod)):listen_close(ListenSocket). + +%% ------------------------------------------------------------ +%% Accepts new connection attempts from other Erlang nodes. +%% Loops accept on the listen socket and notifies net_kernel. +%% ------------------------------------------------------------ + +accept({NetAddress, StateL}) -> + try + NetKernel = self(), + DistMod = pt_get(dist_mod), + AcceptLoop = + spawn_link( + fun () -> + _ = process_flag(trap_exit, true), + accept_loop( + StateL, NetAddress, NetKernel, DistMod, + erlang:system_info(schedulers_online), #{}) + end), + AcceptLoop + catch error : Reason : Stacktrace -> + error_logger:error_msg( + "error : ~p in ~n ~p~n", [Reason, Stacktrace]), + erlang:raise(error, Reason, Stacktrace) + end. + +%% Open parallel acceptors on the listen socket +%% +accept_loop( + StateL, NetAddress, NetKernel, DistMod, MaxPending, Acceptors) + when map_size(Acceptors) =< MaxPending -> + AcceptRef = make_ref(), + Acceptor = + spawn_link( + acceptor_fun(StateL, NetAddress, NetKernel, DistMod, AcceptRef)), + accept_loop( + StateL, NetAddress, NetKernel, DistMod, MaxPending, + Acceptors#{ Acceptor => AcceptRef }); +accept_loop( + StateL, NetAddress, NetKernel, DistMod, MaxPending, Acceptors) -> + receive Msg -> + case Msg of + {'EXIT', Acceptor, Reason} + when is_map_key(Acceptor, Acceptors) -> + AcceptRef = maps:get(Acceptor, Acceptors), + case Reason of + AcceptRef -> % Done ok + accept_loop( + StateL, NetAddress, NetKernel, DistMod, + MaxPending, maps:remove(Acceptor, Acceptors)); + {accept, _} -> + %% Should mean that accept failed + %% so we need to restart the listener + exit(Reason); + _ -> + error_logger:warning_msg( + "~w:~w acceptor ~w failed: ~p", + [?MODULE, ?FUNCTION_NAME, Acceptor, Reason]), + accept_loop( + StateL, NetAddress, NetKernel, DistMod, + MaxPending, maps:remove(Acceptor, Acceptors)) + end; + {'EXIT', NetKernel, Reason} -> + exit(Reason); + _ -> + error_logger:warning_msg( + "~w:~w unknown message: ~p", + [?MODULE, ?FUNCTION_NAME, Msg]), + accept_loop( + StateL, NetAddress, NetKernel, DistMod, + MaxPending, Acceptors) + end + end. + +%% Return value with exit/1 +-spec acceptor_fun(_, _, _, _, _) -> fun(() -> no_return()). +acceptor_fun( + StateL, + #net_address{ family = Family, protocol = Protocol } = NetAddress, + NetKernel, DistMod, AcceptRef) -> + fun () -> + {StateA, PeerAddress} = + %% ******* + DistMod:accept_open(NetAddress, StateL), + %% + NetAddress_1 = NetAddress#net_address{ address = PeerAddress }, + Acceptor = self(), + NetKernel ! {accept, Acceptor, NetAddress_1, Family, Protocol}, + receive + {NetKernel, controller, Controller} -> + StateD = + %% ******* + DistMod:accept_controller( + NetAddress_1, Controller, StateA), + Controller ! + {Acceptor, controller, DistMod, StateD}, + exit(AcceptRef); + {NetKernel, unsupported_protocol = Reason} -> + exit(Reason) + end + end. + +%% ------------------------------------------------------------ +%% Accepts a new connection attempt from another Erlang node. +%% Performs the handshake with the other side. +%% ------------------------------------------------------------ + +accept_connection(Acceptor, NetAddress, MyNode, Allowed, SetupTime) -> + try + NetKernel = self(), + Controller = + spawn_opt( + fun () -> + accept_controller( + Acceptor, NetAddress, MyNode, Allowed, SetupTime, + NetKernel) + end, dist_util:net_ticker_spawn_options()), + Controller + catch error : Reason : Stacktrace -> + error_logger:error_msg( + "error : ~p in ~n ~p~n", [Reason, Stacktrace]), + erlang:raise(error, Reason, Stacktrace) + end. + +accept_controller( + Acceptor, NetAddress, MyNode, Allowed, SetupTime, + NetKernel) -> + receive + {Acceptor, controller, DistMod, StateD} -> + Timer = dist_util:start_timer(SetupTime), + case + %% ******* + DistMod:accepted(NetAddress, Timer, StateD) + of + #hs_data{} = HsData -> + dist_util:handshake_other_started( + HsData + #hs_data{ + kernel_pid = NetKernel, + this_node = MyNode, + timer = Timer, + allowed = Allowed }); + {error, Reason} -> + ?shutdown({{DistMod, accepted}, Reason}) + end + end. + +%% ------------------------------------------------------------ +%% Select this protocol based on node name +%% select(Node) => Bool +%% ------------------------------------------------------------ + +select(Node) -> + try + case dist_util:split_node(Node) of + {node, Name, Host} -> + #net_address{ family = Family } = pt_get(net_address), + EpmdMod = net_kernel:epmd_module(), + case + call_epmd_function( + EpmdMod, address_please, [Name, Host, Family]) + of + {ok, _Addr} -> true; + {ok, _Addr, _Port, _Creation} -> true; + _ -> false + end; + _ -> false + end + catch error : Reason : Stacktrace -> + error_logger:error_msg( + "error : ~p in ~n ~p~n", [Reason, Stacktrace]), + erlang:raise(error, Reason, Stacktrace) + end. + +%% ------------------------------------------------------------ +%% Setup a new connection to another Erlang node. +%% Performs the handshake with the other side. +%% ------------------------------------------------------------ + +setup(Node, Type, MyNode, LongOrShortNames, SetupTime) -> + try + NetKernel = self(), + Controller = + spawn_opt( + fun () -> + setup( + Node, Type, MyNode, LongOrShortNames, SetupTime, + NetKernel) + end, dist_util:net_ticker_spawn_options()), + Controller + catch error : Reason : Stacktrace -> + error_logger:error_msg( + "error : ~p in ~n ~p~n", [Reason, Stacktrace]), + erlang:raise(error, Reason, Stacktrace) + end. + +setup(Node, Type, MyNode, LongOrShortNames, SetupTime, NetKernel) -> + Timer = dist_util:start_timer(SetupTime), + DistMod = pt_get(dist_mod), + #net_address{ family = Family } = NetAddress = pt_get(net_address), + {Name, Host} = split_node(Node, LongOrShortNames, Family), + ErlEpmd = net_kernel:epmd_module(), + {Address, Version} = + case + call_epmd_function( + ErlEpmd, address_please, [Name, Host, Family]) + of + {ok, Ip, Port, Ver} -> + {{Ip, Port}, Ver}; + {ok, Ip} -> + case ErlEpmd:port_please(Name, Ip) of + {port, Port, Ver} -> + {{Ip, Port}, Ver}; + Other -> + ?shutdown2(Node, {port_please, Other}) + end; + Other -> + ?shutdown2(Node, {address_please, Other}) + end, + NetAddress_1 = + NetAddress#net_address{ + host = Host, + address = Address }, + dist_util:reset_timer(Timer), + case + %% ******* + DistMod:connect(NetAddress_1, Timer, connect_options()) + of + #hs_data{} = HsData -> + dist_util:handshake_we_started( + HsData + #hs_data{ + kernel_pid = NetKernel, + other_node = Node, + this_node = MyNode, + timer = Timer, + other_version = Version, + request_type = Type }); + {error, Reason} -> + ?shutdown2(Node, {{DistMod, connect}, Reason}) + end. + +%% ------------------------------------------------------------ +%% Check that accepted address is on our subnet +%% +%% Only accept new connection attempts from nodes at our +%% own LAN, if the check_ip environment parameter is true. +%% ------------------------------------------------------------ +check_ip(Ip, PeerIp) -> + try + case application:get_env(kernel, check_ip) of + {ok, true} -> + maybe + {ok, Ifaddrs} ?= inet:getifaddrs(), + {ok, Netmask} ?= find_netmask(Ip, Ifaddrs), + mask(Ip, Netmask) =:= mask(PeerIp, Netmask) orelse + begin + error_logger:error_msg( + "** Connection attempt from " + "disallowed IP ~w ** ~n", + [PeerIp]), + ?shutdown(no_node) + end, + ok + else + Other -> + exit({check_ip, Other}) + end; + _ -> + ok + end + catch error : Reason : Stacktrace -> + error_logger:error_msg( + "error : ~p in ~n ~p~n", [Reason, Stacktrace]), + erlang:raise(error, Reason, Stacktrace) + end. + +find_netmask(Ip, [{_Name,Items} | Ifaddrs]) -> + find_netmask(Ip, Ifaddrs, Items); +find_netmask(_, []) -> + {error, no_netmask}. +%% +find_netmask(Ip, _Ifaddrs, [{addr, Ip}, {netmask, Netmask} | _]) -> + {ok, Netmask}; +find_netmask(Ip, Ifaddrs, [_ | Items]) -> + find_netmask(Ip, Ifaddrs, Items); +find_netmask(Ip, Ifaddrs, []) -> + find_netmask(Ip, Ifaddrs). + +mask(Addr, Mask) -> + mask(Addr, Mask, 1). +%% +mask(Addr, Mask, N) when N =< tuple_size(Addr) -> + [element(N, Addr) band element(N, Mask) | mask(Addr, Mask, N + 1)]; +mask(_, _, _) -> + []. + + +%% ------------------------------------------------------------ +%% Split and validate node name +%% ------------------------------------------------------------ + +split_node(Node, LongOrShortNames, Family) -> + case dist_util:split_node(Node) of + {node, Name, Host} -> + Dots = members($., Host), + if + LongOrShortNames =:= longnames, 0 < Dots -> + {Name, Host}; + LongOrShortNames =:= longnames -> + case inet:parse_strict_address(Host, Family) of + {ok, _} -> + %% We count an IP address as a long name + %% since it is not relative to the current + %% domain. + %% + %% This clause is for for IPv6 addresses + %% that are : separated. + {Name, Host}; + {error, Reason} -> + error_logger:error_msg( + "** System running to use fully qualified " + "hostnames **~n" + "** Hostname ~ts is illegal **~n", + [Host]), + ?shutdown2(Node, {parse_address, Reason}) + end; + LongOrShortNames =:= shortnames, 0 < Dots -> + error_logger:error_msg( + "** System NOT running to use fully qualified " + "hostnames **~n" + "** Hostname ~ts is illegal **~n", + [Host]), + ?shutdown(Node); + LongOrShortNames =:= shortnames -> + {Name, Host} + end; + Other -> + error_logger:error_msg("** Nodename ~p illegal **~n", [Node]), + ?shutdown2(Node, {split_node, Other}) + end. + +%% Count list members +members(X, [X | T]) -> members(X, T) + 1; +members(X, [_ | T]) -> members(X, T); +members(_, []) -> 0. + +%% ------------------------------------------------------------ +%% Determine if EPMD module supports the called functions. +%% If not call the builtin erl_epmd +%% ------------------------------------------------------------ +call_epmd_function(Mod, Fun, Args) -> + case erlang:function_exported(Mod, Fun, length(Args)) of + true -> apply(Mod,Fun,Args); + _ -> apply(erl_epmd, Fun, Args) + end. + + +%% ------------------------------------------------------------ + +listen_options() -> + DefaultOpts = [{reuseaddr, true}, {backlog, 128}], + ForcedOpts = + case application:get_env(kernel, inet_dist_use_interface) of + {ok, Ip} -> [{ip, Ip}]; + undefined -> [] + end, + InetDistListenOpts = + case application:get_env(kernel, inet_dist_listen_options) of + {ok, Opts} -> Opts; + undefined -> [] + end, + merge_options(InetDistListenOpts, ForcedOpts, DefaultOpts). + +connect_options() -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok, ConnectOpts} -> + ConnectOpts; + _ -> + [] + end. + +nodelay() -> + case application:get_env(kernel, dist_nodelay) of + undefined -> + {nodelay, true}; + {ok, true} -> + {nodelay, true}; + {ok, false} -> + {nodelay, false}; + _ -> + {nodelay, true} + end. + + +merge_options(Opts, ForcedOpts, DefaultOpts) -> + Forced = merge_options(ForcedOpts), + Default = merge_options(DefaultOpts), + ForcedOpts ++ merge_options(Opts, Forced, DefaultOpts, Default). + +%% Collect expanded 2-tuple options in a map +merge_options(Opts) -> + lists:foldr( + fun (Opt, Acc) -> + case expand_option(Opt) of + {OptName, OptVal} -> + maps:put(OptName, OptVal, Acc); + _ -> + Acc + end + end, #{}, Opts). + +%% Pass through all options that are not forced, +%% which we already have prepended, +%% and remove options that we see from the Default map +%% +merge_options([Opt | Opts], Forced, DefaultOpts, Default) -> + case expand_option(Opt) of + {OptName, _} -> + %% Remove from the Default map + Default_1 = maps:remove(OptName, Default), + if + is_map_key(OptName, Forced) -> + %% Forced option - do not pass through + merge_options(Opts, Forced, DefaultOpts, Default_1); + true -> + %% Pass through + [Opt | + merge_options(Opts, Forced, DefaultOpts, Default_1)] + end; + _ -> + %% Unhandled options e.g {raw, ...} - pass through + [Opt | merge_options(Opts, Forced, DefaultOpts, Default)] + end; +merge_options([], _Forced, DefaultOpts, Default) -> + %% Append the needed default options (that we have not seen) + [Opt || + Opt <- DefaultOpts, + is_map_key(element(1, expand_option(Opt)), Default)]. + +%% Expand an atom option into its tuple equivalence, +%% pass through others +expand_option(Opt) -> + if + Opt =:= list; Opt =:= binary -> + {mode, Opt}; + Opt =:= inet; Opt =:= inet6; Opt =:= local -> + %% 'family' is not quite an option name, but could/should be + {family, Opt}; + true -> + Opt + end. + +%% ------------------------------------------------------------ +%% Cache distribution module parameters +%% ------------------------------------------------------------ + +pt_get(Key) + when Key =:= dist_mod; + Key =:= net_address -> + persistent_term:get({?MODULE, Key}). + +pt_init(Host) -> + maybe + {ok, [[DistModStr]]} ?= init:get_argument(?DISTNAME), + DistMod = list_to_atom(atom_to_list(?DISTNAME) ++ "_" ++ DistModStr), + persistent_term:put({?MODULE, dist_mod}, DistMod), + NetAddress = + %% ******* + (DistMod:net_address()) + #net_address{ host = Host }, + persistent_term:put({?MODULE, net_address}, NetAddress) + else + Other -> + exit({{init,get_argument,[?DISTNAME]},Other}) + end. diff --git a/lib/kernel/src/inet_epmd_socket.erl b/lib/kernel/src/inet_epmd_socket.erl new file mode 100644 index 0000000000..431c1076d6 --- /dev/null +++ b/lib/kernel/src/inet_epmd_socket.erl @@ -0,0 +1,485 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(inet_epmd_socket). +-feature(maybe_expr, enable). + +%% DistMod API +-export([net_address/0, listen_open/2, listen_port/3, listen_close/1, + accept_open/2, accept_controller/3, accepted/3, + connect/3]). + +-export([supported/0]). + +-export([start_dist_ctrl/2]). + +-include("net_address.hrl"). +-include("dist.hrl"). +-include("dist_util.hrl"). + +-define(PROTOCOL, tcp). +-define(FAMILY, inet). + +%% ------------------------------------------------------------ +net_address() -> + #net_address{ + protocol = ?PROTOCOL, + family = ?FAMILY }. + +%% ------------------------------------------------------------ +listen_open(#net_address{ family = Family}, ListenOptions) -> + maybe + Key = backlog, + Default = 128, + Backlog = proplists:get_value(Key, ListenOptions, Default), + {ok, ListenSocket} ?= + socket:open(Family, stream), + ok ?= + setopts( + ListenSocket, + [inet_epmd_dist:nodelay() | + proplists:delete( + Key, + proplists:delete(nodelay, ListenOptions))]), + {ok, {ListenSocket, Backlog}} + else + {error, _} = Error -> + Error + end. + +setopts(Socket, Options) -> + gen_tcp_socket:socket_setopts(Socket, Options). + +%% ------------------------------------------------------------ +listen_port( + #net_address{ family = Family }, Port, {ListenSocket, Backlog}) -> + maybe + Sockaddr = + #{family => Family, + addr => any, + port => Port}, + ok ?= + socket:bind(ListenSocket, Sockaddr), + ok ?= + socket:listen(ListenSocket, Backlog), + {ok, #{ addr := Ip, port := ListenPort}} ?= + socket:sockname(ListenSocket), + {ok, {ListenSocket, {Ip, ListenPort}}} + else + {error, _} = Error -> + Error + end. + +%% ------------------------------------------------------------ +listen_close(ListenSocket) -> + socket:close(ListenSocket). + +%% ------------------------------------------------------------ +accept_open(_NetAddress, ListenSocket) -> + maybe + {ok, Socket} ?= + socket:accept(ListenSocket), + {ok, #{ addr := Ip }} ?= + socket:sockname(Socket), + {ok, #{ addr := PeerIp, port := PeerPort }} ?= + socket:peername(Socket), + inet_epmd_dist:check_ip(Ip, PeerIp), + {Socket, {PeerIp, PeerPort}} + else + {error, Reason} -> + exit({?FUNCTION_NAME, Reason}) + end. + +%% ------------------------------------------------------------ +accept_controller(_NetAddress, Controller, Socket) -> + maybe + ok ?= + socket:setopt(Socket, {otp,controlling_process}, Controller), + Socket + else + {error, Reason} -> + exit({?FUNCTION_NAME, Reason}) + end. + +%% ------------------------------------------------------------ +accepted(NetAddress, _Timer, Socket) -> + start_dist_ctrl(NetAddress, Socket). + +%% ------------------------------------------------------------ +connect( + #net_address{ address = {Ip, Port}, family = Family } = NetAddress, + _Timer, ConnectOptions) -> + maybe + {ok, Socket} ?= + socket:open(Family, stream), + ok ?= + setopts(Socket, ConnectOptions), + ConnectAddress = + #{ family => Family, + addr => Ip, + port => Port }, + ok ?= + socket:connect(Socket, ConnectAddress), + start_dist_ctrl(NetAddress, Socket) + else + {error, _} = Error -> + Error + end. + +%% ------------------------------------------------------------ +start_dist_ctrl(NetAddress, Socket) -> + Controller = self(), + DistCtrlTag = make_ref(), + DistCtrl = + spawn_link( + fun () -> + receive + {DistCtrlTag, handshake_complete, From, DistHandle} -> + Sync = make_ref(), + DistC = self(), + InputHandler = + spawn_link( + fun () -> + link(Controller), + DistC ! Sync, + receive Sync -> ok end, + input_handler_start( + Socket, DistHandle) + end), + false = + erlang:dist_ctrl_set_opt( + DistHandle, get_size, true), + ok = + erlang:dist_ctrl_input_handler( + DistHandle, InputHandler), + receive Sync -> InputHandler ! Sync end, + From ! {DistCtrlTag, handshake_complete}, % Reply + output_handler_start(Socket, DistHandle) + end + end), + #hs_data{ + socket = Socket, + f_send = + fun (S, Packet) when S =:= Socket -> + send_packet_2(S, Packet) + end, + f_recv = + fun (S, 0, infinity) when S =:= Socket -> + recv_packet_2(S) + end, + f_setopts_pre_nodeup = f_ok(Socket), +%%% fun (S) when S =:= Socket -> +%%% socket:setopt(S, {otp,debug}, true) +%%% end, + f_setopts_post_nodeup = f_ok(Socket), + f_address = + fun (S, Node) when S =:= Socket -> + inet_epmd_dist:f_address(NetAddress, Node) + end, + f_getll = + fun (S) when S =:= Socket -> + {ok, DistCtrl} + end, + + f_handshake_complete = + fun (S, _Node, DistHandle) when S =:= Socket -> + handshake_complete(DistCtrl, DistCtrlTag, DistHandle) + end, + + mf_tick = + fun (S) when S =:= Socket -> + tick(DistCtrl) + end }. + +%%% mf_getstat = +%%% fun (S) when S =:= Socket -> +%%% getstat(S) +%%% end, +%%% mf_setopts = mf_setopts(Socket), +%%% mf_getopts = mf_getopts(Socket) }. + +send_packet_2(Socket, Packet) -> + Size = iolist_size(Packet), + true = Size < 1 bsl 16, + socket:send(Socket, [<<Size:16>>, Packet]). + +recv_packet_2(Socket) -> + maybe + {ok, <<Size:16>>} ?= + socket:recv(Socket, 2), + {ok, Data} ?= + socket:recv(Socket, Size), + {ok, binary_to_list(Data)} + else + {error, _} = Error -> + Error + end. + +f_ok(Socket) -> + fun (S) when S =:= Socket -> + ok + end. + +-ifdef(undefined). +getstat(S) -> + #{ counters := + #{ read_pkg := ReadPkg, + write_pkg := WritePkg } } = socket:info(S), + %% Ignoring that the counters may wrap since dist_util + %% only looks for changing values anyway + {ok, [{recv_cnt, ReadPkg}, {send_cnt, WritePkg}, {send_pend, 0}]}. + +mf_setopts(Socket) -> + f_ok(Socket). + +mf_getopts(Socket) -> + fun (S, Opts) when S =:= Socket, is_list(Opts) -> + {ok, []} + end. +-endif. + +handshake_complete(DistCtrl, DistCtrlTag, DistHandle) -> + DistCtrl ! {DistCtrlTag, handshake_complete, self(), DistHandle}, + receive + {DistCtrlTag, handshake_complete} -> + ok + end. + +tick(DistCtrl) -> + DistCtrl ! dist_tick, + ok. + +%% ------------------------------------------------------------ +-spec output_handler_start(_, _) -> no_return(). % Server loop +output_handler_start(Socket, DistHandle) -> + try + erlang:dist_ctrl_get_data_notification(DistHandle), + output_handler(Socket, DistHandle) + catch + Class : Reason : Stacktrace when Class =:= error -> + error_logger:error_report( + [output_handler_exception, + {class, Class}, + {reason, Reason}, + {stacktrace, Stacktrace}]), + erlang:raise(Class, Reason, Stacktrace) + end. + +output_handler(Socket, DistHandle) -> + receive Msg -> + case Msg of + dist_tick -> + output_handler_tick(Socket, DistHandle); + dist_data -> + output_handler_data(Socket, DistHandle); + _ -> % Ignore + output_handler(Socket, DistHandle) + end + end. + +output_handler_tick(Socket, DistHandle) -> + receive Msg -> + case Msg of + dist_tick -> + output_handler_tick(Socket, DistHandle); + dist_data -> + output_handler_data(Socket, DistHandle); + _ -> % Ignore + output_handler_tick(Socket, DistHandle) + end + after 0 -> + output_data(Socket, [<<0:32>>]), + output_handler(Socket, DistHandle) + end. + +output_handler_data(Socket, DistHandle) -> + output_handler_data(Socket, DistHandle, [], 0). +%% +output_handler_data(Socket, DistHandle, Buffer, Size) + when 1 bsl 16 =< Size -> + output_data(Socket, Buffer), + output_handler_data(Socket, DistHandle); +output_handler_data(Socket, DistHandle, Buffer, Size) -> + case erlang:dist_ctrl_get_data(DistHandle) of + none -> + if + Size =:= 0 -> + [] = Buffer, % ASSERT + erlang:dist_ctrl_get_data_notification(DistHandle), + output_handler(Socket, DistHandle); + true -> + output_data(Socket, Buffer), + output_handler_data(Socket, DistHandle) + end; + {Len, Iovec} -> + %% erlang:display({Len, '==>>'}), + output_handler_data( + Socket, DistHandle, + lists:reverse(Iovec, [<<Len:32>> | Buffer]), Len + 4 + Size) + end. + +%% Output data to socket +output_data(Socket, Buffer) -> + Iovec = lists:reverse(Buffer), + case socket:sendmsg(Socket, #{ iov => Iovec }) of + ok -> + %% erlang:display({iolist_size(Iovec), '>>'}), + ok; + {error, Reason} -> + exit(Reason) + end. + +%% ------------------------------------------------------------ +-spec input_handler_start(_, _) -> no_return(). % Server loop +input_handler_start(Socket, DistHandle) -> + try input_handler(Socket, DistHandle) + catch + Class : Reason : Stacktrace when Class =:= error -> + error_logger:error_report( + [input_handler_exception, + {class, Class}, + {reason, Reason}, + {stacktrace, Stacktrace}]), + erlang:raise(Class, Reason, Stacktrace) + end. + +input_handler(Socket, DistHandle) -> + input_handler(Socket, DistHandle, <<>>, [], 0). + +input_handler(Socket, DistHandle, First, Buffer, Size) -> + %% Size is size of First + Buffer + case First of + <<PacketSize1:32, Packet1:PacketSize1/binary, + PacketSize2:32, Packet2:PacketSize2/binary, Rest/binary>> -> + put_data(DistHandle, PacketSize1, Packet1), + put_data(DistHandle, PacketSize2, Packet2), + DataSize = 4 + PacketSize1 + 4 + PacketSize2, + input_handler( + Socket, DistHandle, Rest, Buffer, Size - DataSize); + <<PacketSize:32, Packet:PacketSize/binary, Rest/binary>> -> + DataSize = 4 + PacketSize, + put_data(DistHandle, PacketSize, Packet), + input_handler( + Socket, DistHandle, Rest, Buffer, Size - DataSize); + <<PacketSize:32, PacketStart/binary>> -> + input_handler( + Socket, DistHandle, PacketStart, Buffer, Size - 4, + PacketSize); + <<Bin/binary>> -> + if + 4 =< Size -> + {First_1, Buffer_1, PacketSize} = + input_get_packet_size(Bin, lists:reverse(Buffer)), + input_handler( + Socket, DistHandle, First_1, Buffer_1, Size - 4, + PacketSize); + true -> + Data = input_data(Socket), + Buffer_1 = [Data | Buffer], + DataSize = byte_size(Data), + input_handler( + Socket, DistHandle, First, Buffer_1, Size + DataSize) + end + end. + +%% PacketSize has been matched in PacketStart +input_handler(Socket, DistHandle, PacketStart, Buffer, Size, PacketSize) -> + %% Size is size of PacketStart + Buffer + RestSize = Size - PacketSize, + if + RestSize < 0 -> + %% Incomplete packet received so far + More = input_data(Socket), + MoreSize = byte_size(More), + input_handler( + Socket, DistHandle, PacketStart, + [More | Buffer], Size + MoreSize, PacketSize); + 0 < RestSize, Buffer =:= [] -> + %% Rest data in PacketStart + <<Packet:PacketSize/binary, Rest/binary>> = PacketStart, + put_data(DistHandle, PacketSize, Packet), + input_handler(Socket, DistHandle, Rest, [], RestSize); + Buffer =:= [] -> + %% No rest data + RestSize = 0, % ASSERT + put_data(DistHandle, PacketSize, PacketStart), + input_handler(Socket, DistHandle); + true -> + %% Split packet from rest data + Bin = hd(Buffer), + LastSize = byte_size(Bin) - RestSize, + <<LastBin:LastSize/binary, Rest/binary>> = Bin, + Packet = [PacketStart|lists:reverse(tl(Buffer), [LastBin])], + put_data(DistHandle, PacketSize, Packet), + input_handler(Socket, DistHandle, Rest, [], RestSize) + end. + +%% There are enough bytes (4) in First + [Bin|Buffer] +%% to get the packet size, but not enough in First +input_get_packet_size(First, [Bin|Buffer]) -> + MissingSize = 4 - byte_size(First), + if + MissingSize =< byte_size(Bin) -> + <<Last:MissingSize/binary, Rest/binary>> = Bin, + <<PacketSize:32>> = <<First/binary, Last/binary>>, + {Rest, lists:reverse(Buffer), PacketSize}; + true -> + input_get_packet_size(<<First/binary, Bin/binary>>, Buffer) + end. + +%% Input data from socket +input_data(Socket) -> + case socket:recv(Socket) of + {ok, Data} -> + %% erlang:display({'<<', byte_size(Data)}), + Data; + {error, Reason} -> + exit(Reason) + end. + +%%% put_data(_DistHandle, 0, _) -> +%%% ok; +%% We deliver ticks (packets size 0) to the VM, +%% so that erlang:dist_get_stat(DistHandle) that +%% dist_util:getstat/3 falls back to becomes good enough +put_data(DistHandle, _PacketSize, Packet) -> + %% erlang:display({'<<==', _PacketSize}), + erlang:dist_ctrl_put_data(DistHandle, Packet). + +%% ------------------------------------------------------------ +supported() -> + try socket:info() of + #{io_backend := #{name := BackendName}} + when (BackendName =/= win_esaio) -> + ok; + _ -> + {skip, "Temporary exclusion"} + catch + error : notsup -> + {skip, "esock not supported"}; + error : undef -> + {skip, "esock not configured"} + end. + %% try socket:is_supported(ipv6) of + %% _ -> + %% ok + %% catch error : notsup -> + %% "Module 'socket' not supported" + %% end. diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index f4e16c6a76..2f50f2c23c 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -135,6 +135,9 @@ -define(UDP_OPT_ADD_MEMBERSHIP, 14). -define(UDP_OPT_DROP_MEMBERSHIP, 15). -define(INET_OPT_IPV6_V6ONLY, 16). +-define(INET_OPT_REUSEPORT, 17). +-define(INET_OPT_REUSEPORT_LB, 18). +-define(INET_OPT_EXCLUSIVEADDRUSE, 19). % "Local" options: codes start from 20: -define(INET_LOPT_BUFFER, 20). -define(INET_LOPT_HEADER, 21). diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl index 31d759428d..9d54d2c6bd 100644 --- a/lib/kernel/src/inet_parse.erl +++ b/lib/kernel/src/inet_parse.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2021. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -386,14 +386,9 @@ port_proto([$/ | Proto], Port) when Port =/= 0 -> %% 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. +visible_string([C | Cs]) when C >= 16#21, C =< 16#7e -> visible_string(Cs); +visible_string([]) -> true; +visible_string(_) -> false. %% %% Check if a String is a domain name according to RFC XXX. diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index 4e7809564c..0fb46332f2 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2022. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -17,7 +17,7 @@ %% %% %CopyrightEnd% %% -%% RFC 1035, 2671, 2782, 2915. +%% RFC 1035, 2782, 2915, 6891. %% -module(inet_res). @@ -61,6 +61,7 @@ | {retry, integer()} | {timeout, integer()} | {udp_payload_size, integer()} + | {dnssec_ok, boolean()} | {usevc, boolean()} | {nxdomain_reply, boolean()}. @@ -263,7 +264,7 @@ do_nslookup(Name, Class, Type, Opts, Timeout) -> %% options record %% -record(options, { % These must be sorted! - alt_nameservers,edns,inet6,nameservers, + alt_nameservers,dnssec_ok,edns,inet6,nameservers, nxdomain_reply, % this is a local option, not in inet_db recurse,retry,servfail_retry_timeout,timeout, udp_payload_size,usevc, @@ -573,12 +574,13 @@ res_getby_search(Name, [Dom | Ds], _Reason, Type, Timer) -> QueryName = %% Join Name and Dom with a single dot. %% Allow Dom to be "." or "", but not to lead with ".". - %% Do not allow Name to be "". if - Name =/= "" andalso (Dom =:= "." orelse Dom =:= "") -> + Dom =:= "."; Dom =:= "" -> Name; - Name =/= "" andalso hd(Dom) =/= $. -> - Name++"."++Dom; + Name =/= "", hd(Dom) =/= $. -> + Name ++ "." ++ Dom; + Name =:= "", hd(Dom) =/= $. -> + Dom; true -> erlang:error({if_clause, Name, Dom}) end, @@ -672,9 +674,12 @@ make_query(Dname, Class, Type, Options, Edns) -> ARList = case Edns of false -> []; _ -> - PSz = Options#options.udp_payload_size, + #options{ + udp_payload_size = PSz, + dnssec_ok = DnssecOk } = Options, [#dns_rr_opt{udp_payload_size=PSz, - version=Edns}] + version=Edns, + do=DnssecOk}] end, Msg = #dns_rec{header=#dns_header{id=Id, qr=false, diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl index b53de6281b..8c5c8a1cf2 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2022. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,10 +14,11 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% -module(inet_tcp_dist). +-feature(maybe_expr, enable). %% Handles the connection setup phase with other Erlang nodes. @@ -30,6 +31,11 @@ %% Generalized dist API -export([gen_listen/3, gen_accept/2, gen_accept_connection/6, gen_setup/6, gen_select/2, gen_address/1]). +-export([fam_select/2, fam_address/1, fam_listen/4, fam_setup/4]). +%% OTP internal (e.g ssl) +-export([gen_hs_data/2, nodelay/0]). + +-export([merge_options/2, merge_options/3]). %% internal exports @@ -42,20 +48,28 @@ -include("dist.hrl"). -include("dist_util.hrl"). +-define(DRIVER, inet_tcp). +-define(PROTOCOL, tcp). + %% ------------------------------------------------------------ %% Select this protocol based on node name %% select(Node) => Bool %% ------------------------------------------------------------ select(Node) -> - gen_select(inet_tcp, Node). + gen_select(?DRIVER, Node). gen_select(Driver, Node) -> + fam_select(Driver:family(), Node). + +fam_select(Family, Node) -> case dist_util:split_node(Node) of {node, Name, Host} -> - case call_epmd_function( - net_kernel:epmd_module(), address_please, - [Name, Host, Driver:family()]) of + EpmdMod = net_kernel:epmd_module(), + case + call_epmd_function( + EpmdMod, address_please, [Name, Host, Family]) + of {ok, _Addr} -> true; {ok, _Addr, _Port, _Creation} -> true; _ -> false @@ -67,47 +81,115 @@ gen_select(Driver, Node) -> %% Get the address family that this distribution uses %% ------------------------------------------------------------ address() -> - gen_address(inet_tcp). + gen_address(?DRIVER). + gen_address(Driver) -> - get_tcp_address(Driver). + fam_address(Driver:family()). + +fam_address(Family) -> + {ok, Host} = inet:gethostname(), + #net_address{ + host = Host, + protocol = ?PROTOCOL, + family = Family + }. + +%% ------------------------------------------------------------ +%% Set up the general fields in #hs_data{} +%% ------------------------------------------------------------ +gen_hs_data(Driver, Socket) -> + %% The only thing Driver actually is used for is to + %% implement non-blocking send of distribution tick + Nodelay = nodelay(), + #hs_data{ + socket = Socket, + f_send = fun Driver:send/2, + f_recv = fun Driver: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}, {packet,4}, + {deliver, port}, binary, Nodelay]) + end, + f_getll = fun inet:getll/1, + mf_tick = fun (S) -> ?MODULE:tick(Driver, S) end, + mf_getstat = fun ?MODULE:getstat/1, + mf_setopts = fun ?MODULE:setopts/2, + mf_getopts = fun ?MODULE:getopts/2}. %% ------------------------------------------------------------ %% Create the listen socket, i.e. the port that this erlang %% node is accessible through. %% ------------------------------------------------------------ -listen(Name, Host) -> - gen_listen(inet_tcp, Name, Host). - -%% Keep this clause for third-party dist controllers reusing this API +%% Keep this function for third-party dist controllers reusing this API listen(Name) -> {ok, Host} = inet:gethostname(), listen(Name, Host). +listen(Name, Host) -> + gen_listen(?DRIVER, Name, Host). + gen_listen(Driver, Name, Host) -> - ErlEpmd = net_kernel:epmd_module(), - case gen_listen(ErlEpmd, Name, Host, Driver) of - {ok, Socket} -> - TcpAddress = get_tcp_address(Driver, Socket), - {_,Port} = TcpAddress#net_address.address, - case ErlEpmd:register_node(Name, Port, Driver) of - {ok, Creation} -> - {ok, {Socket, TcpAddress, Creation}}; - Error -> - Error - end; - Error -> - Error + ForcedOptions = [{active, false}, {packet,2}, {nodelay, true}], + ListenFun = + fun (First, Last, ListenOptions) -> + listen_loop( + Driver, First, Last, + merge_options(ListenOptions, ForcedOptions)) + end, + Family = Driver:family(), + maybe + %% + {ok, {ListenSocket, Address, Creation}} ?= + fam_listen(Family, Name, Host, ListenFun), + NetAddress = + #net_address{ + host = Host, + protocol = ?PROTOCOL, + family = Family, + address = Address}, + {ok, {ListenSocket, NetAddress, Creation}} + end. + +listen_loop(_Driver, First, Last, _Options) when First > Last -> + {error,eaddrinuse}; +listen_loop(Driver, First, Last, Options) -> + case Driver:listen(First, Options) of + {error, eaddrinuse} -> + listen_loop(Driver, First+1, Last, Options); + Other -> + Other end. -gen_listen(ErlEpmd, Name, Host, Driver) -> - ListenOptions = listen_options(), - case call_epmd_function(ErlEpmd, listen_port_please, [Name, Host]) of - {ok, 0} -> - {First,Last} = get_port_range(), - do_listen(Driver, First, Last, ListenOptions); - {ok, Prt} -> - do_listen(Driver, Prt, Prt, ListenOptions) + +fam_listen(Family, Name, Host, ListenFun) -> + maybe + EpmdMod = net_kernel:epmd_module(), + %% + {ok, ListenSocket} ?= + case + call_epmd_function( + EpmdMod, listen_port_please, [Name, Host]) + of + {ok, 0} -> + {First,Last} = get_port_range(), + ListenFun(First, Last, listen_options()); + {ok, PortNum} -> + ListenFun(PortNum, PortNum, listen_options()) + end, + {ok, {_IP,Port} = Address} = inet:sockname(ListenSocket), + %% + {ok, Creation} ?= + EpmdMod:register_node(Name, Port, Family), + {ok, {ListenSocket, Address, Creation}} end. get_port_range() -> @@ -123,70 +205,89 @@ get_port_range() -> {0,0} end. -do_listen(_Driver, First,Last,_) when First > Last -> - {error,eaddrinuse}; -do_listen(Driver, First,Last,Options) -> - case Driver:listen(First, Options) of - {error, eaddrinuse} -> - do_listen(Driver, First+1,Last,Options); - Other -> - Other - end. listen_options() -> DefaultOpts = [{reuseaddr, true}, {backlog, 128}], ForcedOpts = - [{active, false}, {packet,2} | - case application:get_env(kernel, inet_dist_use_interface) of - {ok, Ip} -> [{ip, Ip}]; - undefined -> [] - end], - Force = maps:from_list(ForcedOpts), + case application:get_env(kernel, inet_dist_use_interface) of + {ok, Ip} -> [{ip, Ip}]; + undefined -> [] + end, InetDistListenOpts = case application:get_env(kernel, inet_dist_listen_options) of {ok, Opts} -> Opts; undefined -> [] end, - ListenOpts = listen_options(InetDistListenOpts, ForcedOpts, Force), - Seen = - maps:from_list( - lists:filter( - fun ({_,_}) -> true; - (_) -> false - end, ListenOpts)), - lists:filter( - fun ({OptName,_}) when is_map_key(OptName, Seen) -> - false; - (_) -> - true - end, DefaultOpts) ++ ListenOpts. - -%% Pass through all but forced -listen_options([Opt | Opts], ForcedOpts, Force) -> - case Opt of - {OptName,_} -> - case is_map_key(OptName, Force) of + merge_options(InetDistListenOpts, ForcedOpts, DefaultOpts). + + +merge_options(Opts, ForcedOpts) -> + merge_options(Opts, ForcedOpts, []). +%% +merge_options(Opts, ForcedOpts, DefaultOpts) -> + Forced = merge_options(ForcedOpts), + Default = merge_options(DefaultOpts), + ForcedOpts ++ merge_options(Opts, Forced, DefaultOpts, Default). + +%% Collect expanded 2-tuple options in a map +merge_options(Opts) -> + lists:foldr( + fun (Opt, Acc) -> + case expand_option(Opt) of + {OptName, OptVal} -> + maps:put(OptName, OptVal, Acc); + _ -> + Acc + end + end, #{}, Opts). + +%% Pass through all options that are not forced, +%% which we already have prepended, +%% and remove options that we see from the Default map +%% +merge_options([Opt | Opts], Forced, DefaultOpts, Default) -> + case expand_option(Opt) of + {OptName, _} -> + %% Remove from the Default map + Default_1 = maps:remove(OptName, Default), + if + is_map_key(OptName, Forced) -> + %% Forced option - do not pass through + merge_options(Opts, Forced, DefaultOpts, Default_1); true -> - listen_options(Opts, ForcedOpts, Force); - false -> + %% Pass through [Opt | - listen_options(Opts, ForcedOpts, Force)] + merge_options(Opts, Forced, DefaultOpts, Default_1)] end; _ -> - [Opt | - listen_options(Opts, ForcedOpts, Force)] + %% Unhandled options e.g {raw, ...} - pass through + [Opt | merge_options(Opts, Forced, DefaultOpts, Default)] end; -listen_options([], ForcedOpts, _Force) -> - %% Append forced - ForcedOpts. - +merge_options([], _Forced, DefaultOpts, Default) -> + %% Append the needed default options (that we have not seen) + [Opt || + Opt <- DefaultOpts, + is_map_key(element(1, expand_option(Opt)), Default)]. + +%% Expand an atom option into its tuple equivalence, +%% pass through others +expand_option(Opt) -> + if + Opt =:= list; Opt =:= binary -> + {mode, Opt}; + Opt =:= inet; Opt =:= inet6; Opt =:= local -> + %% 'family' is not quite an option name, but could/should be + {family, Opt}; + true -> + Opt + end. %% ------------------------------------------------------------ %% Accepts new connection attempts from other Erlang nodes. %% ------------------------------------------------------------ accept(Listen) -> - gen_accept(inet_tcp, Listen). + gen_accept(?DRIVER, Listen). gen_accept(Driver, Listen) -> spawn_opt(?MODULE, accept_loop, [Driver, self(), Listen], [link, {priority, max}]). @@ -194,7 +295,7 @@ gen_accept(Driver, Listen) -> accept_loop(Driver, Kernel, Listen) -> case Driver:accept(Listen) of {ok, Socket} -> - Kernel ! {accept,self(),Socket,Driver:family(),tcp}, + Kernel ! {accept,self(),Socket,Driver:family(),?PROTOCOL}, _ = controller(Driver, Kernel, Socket), accept_loop(Driver, Kernel, Listen); Error -> @@ -230,7 +331,7 @@ flush_controller(Pid, Socket) -> %% ------------------------------------------------------------ accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - gen_accept_connection(inet_tcp, AcceptPid, Socket, MyNode, Allowed, SetupTime). + gen_accept_connection(?DRIVER, AcceptPid, Socket, MyNode, Allowed, SetupTime). gen_accept_connection(Driver, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> spawn_opt(?MODULE, do_accept, @@ -243,40 +344,19 @@ do_accept(Driver, Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> Timer = dist_util:start_timer(SetupTime), case check_ip(Driver, Socket) of true -> - HSData = #hs_data{ - kernel_pid = Kernel, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - allowed = Allowed, - f_send = fun Driver:send/2, - f_recv = fun Driver: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}, - binary, - nodelay()]) - end, - f_getll = fun(S) -> - inet:getll(S) - end, - f_address = fun(S, Node) -> get_remote_id(Driver, S, Node) end, - mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end, - mf_getstat = fun ?MODULE:getstat/1, - mf_setopts = fun ?MODULE:setopts/2, - mf_getopts = fun ?MODULE:getopts/2 - }, + Family = Driver:family(), + HSData = + (gen_hs_data(Driver, Socket)) + #hs_data{ + kernel_pid = Kernel, + this_node = MyNode, + timer = Timer, + this_flags = 0, + allowed = Allowed, + f_address = + fun (S, Node) -> + get_remote_id(Family, S, Node) + end}, dist_util:handshake_other_started(HSData); {false,IP} -> error_msg("** Connection attempt from " @@ -304,13 +384,13 @@ nodelay() -> %% ------------------------------------------------------------ %% Get remote information about a Socket. %% ------------------------------------------------------------ -get_remote_id(Driver, Socket, Node) -> +get_remote_id(Family, 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=Driver:family()}; + protocol=?PROTOCOL,family=Family}; _ -> %% No '@' or more than one '@' in node name. ?shutdown(no_node) @@ -325,130 +405,109 @@ get_remote_id(Driver, Socket, Node) -> %% ------------------------------------------------------------ setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> - gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime). + gen_setup(?DRIVER, Node, Type, MyNode, LongOrShortNames, SetupTime). gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) -> - spawn_opt(?MODULE, do_setup, + spawn_opt(?MODULE, do_setup, [Driver, self(), Node, Type, MyNode, LongOrShortNames, SetupTime], dist_util:net_ticker_spawn_options()). do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> - ?trace("~p~n",[{inet_tcp_dist,self(),setup,Node}]), - [Name, Address] = splitnode(Driver, Node, LongOrShortNames), - AddressFamily = Driver:family(), - ErlEpmd = net_kernel:epmd_module(), + ?trace("~p~n",[{?MODULE,self(),setup,Node}]), Timer = dist_util:start_timer(SetupTime), - case call_epmd_function(ErlEpmd,address_please,[Name, Address, AddressFamily]) of + Family = Driver:family(), + {#net_address{ address = {Ip, TcpPort} } = NetAddress, + ConnectOptions, + Version} = + fam_setup( + Family, Node, LongOrShortNames, fun Driver:parse_address/1), + dist_util:reset_timer(Timer), + case Driver:connect(Ip, TcpPort, ConnectOptions) of + {ok, Socket} -> + HSData = + (gen_hs_data(Driver, Socket)) + #hs_data{ + kernel_pid = Kernel, + other_node = Node, + this_node = MyNode, + timer = Timer, + this_flags = 0, + other_version = Version, + f_address = + fun(_,_) -> + NetAddress + end, + request_type = Type}, + dist_util:handshake_we_started(HSData); + _ -> + %% Other Node may have closed since + %% discovery ! + ?trace("other node (~p) " + "closed since discovery (port_please).~n", + [Node]), + ?shutdown(Node) + end. + +fam_setup(Family, Node, LongOrShortNames, ParseAddress) -> + ?trace("~p~n",[{?MODULE,self(),?FUNCTION_NAME,Node}]), + [Name, Host] = splitnode(ParseAddress, Node, LongOrShortNames), + ErlEpmd = net_kernel:epmd_module(), + case + call_epmd_function( + ErlEpmd, address_please, [Name, Host, Family]) + of {ok, Ip, TcpPort, Version} -> - ?trace("address_please(~p) -> version ~p~n", - [Node,Version]), - do_setup_connect(Driver, Kernel, Node, Address, AddressFamily, - Ip, TcpPort, Version, Type, MyNode, Timer); - {ok, Ip} -> + ?trace("address_please(~p) -> version ~p~n", [Node,Version]), + fam_setup(Family, Host, Ip, TcpPort, Version); + {ok, Ip} -> case ErlEpmd:port_please(Name, Ip) of {port, TcpPort, Version} -> - ?trace("port_please(~p) -> version ~p~n", + ?trace("port_please(~p) -> version ~p~n", [Node,Version]), - do_setup_connect(Driver, Kernel, Node, Address, AddressFamily, - Ip, TcpPort, Version, Type, MyNode, Timer); + fam_setup(Family, Host, Ip, TcpPort, Version); _ -> ?trace("port_please (~p) failed.~n", [Node]), ?shutdown(Node) end; _Other -> - ?trace("inet_getaddr(~p) " - "failed (~p).~n", [Node,_Other]), + ?trace("inet_getaddr(~p) failed (~p).~n", [Node,_Other]), ?shutdown(Node) end. -%% -%% Actual setup of connection -%% -do_setup_connect(Driver, Kernel, Node, Address, AddressFamily, - Ip, TcpPort, Version, Type, MyNode, Timer) -> - dist_util:reset_timer(Timer), - case - Driver:connect( - Ip, TcpPort, - connect_options([{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 Driver:send/2, - f_recv = fun Driver: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 = AddressFamily} - end, - mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end, - mf_getstat = fun ?MODULE:getstat/1, - request_type = Type, - mf_setopts = fun ?MODULE:setopts/2, - mf_getopts = fun ?MODULE:getopts/2 - }, - dist_util:handshake_we_started(HSData); - _ -> - %% Other Node may have closed since - %% discovery ! - ?trace("other node (~p) " - "closed since discovery (port_please).~n", - [Node]), - ?shutdown(Node) - end. - -connect_options(Opts) -> - case application:get_env(kernel, inet_dist_connect_options) of - {ok,ConnectOpts} -> - ConnectOpts ++ Opts; - _ -> - Opts - end. +fam_setup(Family, Host, Ip, TcpPort, Version) -> + NetAddress = + #net_address{ + address = {Ip, TcpPort}, + host = Host, + protocol = ?PROTOCOL, + family = Family}, + {NetAddress, connect_options(), Version}. + +connect_options() -> + merge_options( + case application:get_env(kernel, inet_dist_connect_options) of + {ok, ConnectOpts} -> + ConnectOpts; + _ -> + [] + end, [{active, false}, {packet, 2}]). + %% %% Close a socket. %% close(Socket) -> - inet_tcp:close(Socket). + ?DRIVER:close(Socket). %% If Node is illegal terminate the connection setup!! -splitnode(Driver, Node, LongOrShortNames) -> +splitnode(ParseAddress, 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 -> - case Driver:parse_address(Host) of + case ParseAddress(Host) of {ok, _} -> [Name, Host]; _ -> @@ -482,21 +541,6 @@ 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(Driver, Socket) -> - {ok, Address} = inet:sockname(Socket), - NetAddr = get_tcp_address(Driver), - NetAddr#net_address{ address = Address }. -get_tcp_address(Driver) -> - {ok, Host} = inet:gethostname(), - #net_address { - host = Host, - protocol = tcp, - family = Driver:family() - }. - -%% ------------------------------------------------------------ %% Determine if EPMD module supports the called functions. %% If not call the builtin erl_epmd %% ------------------------------------------------------------ diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 0b760b12fe..5e76e55911 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -55,6 +55,8 @@ inet6_udp, inet6_sctp, inet_config, + inet_epmd_dist, + inet_epmd_socket, inet_hosts, inet_gethost_native, inet_tcp_dist, @@ -83,9 +85,9 @@ os, ram_file, rpc, - user, user_drv, user_sup, + prim_tty, disk_log, disk_log_1, disk_log_server, @@ -158,6 +160,7 @@ {shell_docs_ansi,auto} ]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-13.1.3", "stdlib-4.1.1", "sasl-3.0", "crypto-5.0"]} + {runtime_dependencies, ["erts-@OTP-18248:OTP-18344@", "stdlib-@OTP-17932@", + "sasl-3.0", "crypto-5.0"]} ] }. diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 9aec16ace7..5fd95871ca 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -58,14 +58,19 @@ config_change(Changed, New, Removed) -> %%% | kernel_sup (A)| %%% --------------- %%% | -%%% ------------------------------- -%%% | | | -%%% <std services> ------------- ------------- -%%% (file,code, | erl_dist (A)| | safe_sup (1)| -%%% rpc, ...) ------------- ------------- -%%% | | -%%% (net_kernel, (disk_log, pg, -%%% auth, ...) ...) +%%% ------------------------------------------ +%%% | | | | | +%%% <std services> | ------------- | ------------- +%%% (code, [stderr], | | erl_dist (A)| | | safe_sup (1)| +%%% ...) | ------------- | ------------- +%%% | | | | +%%% <on_load> ([net_sup], | (disk_log, pg, +%%% (transient) rpc, global, | ...) +%%% ...) | +%%% | +%%% <more services> +%%% (file, peer, [user], +%%% [logger], ...) %%% %%% The rectangular boxes are supervisors. All supervisors except %%% for kernel_safe_sup terminates the entire erlang node if any of @@ -118,6 +123,15 @@ init([]) -> type => supervisor, modules => [standard_error]}, + OnLoad = #{id => on_load, + start => + {proc_lib, start_link, + [?MODULE, ?FUNCTION_NAME, [on_load]]}, + restart => transient, + shutdown => 2000, + type => worker, + modules => [?MODULE]}, + User = #{id => user, start => {user_sup, start, []}, restart => temporary, @@ -145,10 +159,34 @@ init([]) -> none -> [] end, + %% Start the file server early, if possible, so on_load functions + %% can do file server operations. + %% + %% This is a workaround. The combination of having a remote + %% file server i.e the file server on a master node, with on_load + %% functions that uses file operations over the file server, + %% will not, and cannot work. + %% + %% A "proper" solution will have to sort out how code loading + %% over all code server backends should interact with all + %% file server backends and nif on_load functions + %% that need to find a shared object file. + %% + case init:get_argument(master) of + {ok, [[_MasterNode]]} -> + EarlyFile = [], + LateFile = [File]; + _ -> + EarlyFile = [File], + LateFile = [] + end, + case init:get_argument(mode) of {ok, [["minimal"]|_]} -> {ok, {SupFlags, - [Code, File, StdError] ++ Peer ++ + [Code, StdError | EarlyFile] ++ + [OnLoad | LateFile] ++ + Peer ++ [User, LoggerSup, Config, RefC, SafeSup]}}; _ -> DistChildren = @@ -175,11 +213,19 @@ init([]) -> CompileServer = start_compile_server(), {ok, {SupFlags, - [Code, InetDb | DistChildren] ++ - [File, SigSrv, StdError] ++ Peer ++ - [User, Config, RefC, SafeSup, LoggerSup] ++ + [Code, StdError | EarlyFile] ++ + [OnLoad, InetDb | DistChildren] ++ LateFile ++ + [SigSrv | Peer] ++ + [User, LoggerSup, Config, RefC, SafeSup] ++ Timer ++ CompileServer}} end; +init(on_load) -> + %% Run the on_load handlers for all modules that have been + %% loaded so far. Running them at this point means that + %% on_load handlers can safely call some essential kernel processes, + %% in particular call code:priv_dir/1 or code:lib_dir/1. + init:run_on_load_handlers(), + proc_lib:init_ack({ok, self()}); init(safe) -> SupFlags = #{strategy => one_for_one, intensity => 4, @@ -189,12 +235,6 @@ init(safe) -> DiskLog = start_disk_log(), Pg = start_pg(), - %% Run the on_load handlers for all modules that have been - %% loaded so far. Running them at this point means that - %% on_load handlers can safely call kernel processes - %% (and in particular call code:priv_dir/1 or code:lib_dir/1). - init:run_on_load_handlers(), - {ok, {SupFlags, Boot ++ DiskLog ++ Pg}}. start_distribution() -> diff --git a/lib/kernel/src/logger_formatter.erl b/lib/kernel/src/logger_formatter.erl index 579b4f8f73..75d85de744 100644 --- a/lib/kernel/src/logger_formatter.erl +++ b/lib/kernel/src/logger_formatter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017-2020. All Rights Reserved. +%% Copyright Ericsson AB 2017-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -48,7 +48,8 @@ format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0) Config = add_default_config(Config0), Meta1 = maybe_add_legacy_header(Level,Meta,Config), Template = maps:get(template,Config), - {BT,AT0} = lists:splitwith(fun(msg) -> false; (_) -> true end, Template), + LinearTemplate = linearize_template(Meta1,Template), + {BT,AT0} = lists:splitwith(fun(msg) -> false; (_) -> true end, LinearTemplate), {DoMsg,AT} = case AT0 of [msg|Rest] -> {true,Rest}; @@ -89,6 +90,18 @@ format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0) end, truncate(B,MsgStr,A,maps:get(max_size,Config)). +linearize_template(Data,[{Key,IfExist,Else}|Format]) -> + BranchForUse = + case value(Key,Data) of + {ok,_Value} -> linearize_template(Data,IfExist); + error -> linearize_template(Data,Else) + end, + BranchForUse ++ linearize_template(Data,Format); +linearize_template(Data,[StrOrKey|Format]) -> + [StrOrKey|linearize_template(Data,Format)]; +linearize_template(_Data,[]) -> + []. + trim([H|T],Rev) when H==$\s; H==$\r; H==$\n -> trim(T,Rev); trim([H|T],false) when is_list(H) -> @@ -110,13 +123,6 @@ trim(String,_) -> do_format(Level,Data,[level|Format],Config) -> [to_string(level,Level,Config)|do_format(Level,Data,Format,Config)]; -do_format(Level,Data,[{Key,IfExist,Else}|Format],Config) -> - String = - case value(Key,Data) of - {ok,Value} -> do_format(Level,Data#{Key=>Value},IfExist,Config); - error -> do_format(Level,Data,Else,Config) - end, - [String|do_format(Level,Data,Format,Config)]; do_format(Level,Data,[Key|Format],Config) when is_atom(Key) orelse (is_list(Key) andalso is_atom(hd(Key))) -> diff --git a/lib/kernel/src/logger_h_common.erl b/lib/kernel/src/logger_h_common.erl index f0db587af1..3c99d49f3d 100644 --- a/lib/kernel/src/logger_h_common.erl +++ b/lib/kernel/src/logger_h_common.erl @@ -350,7 +350,7 @@ call(_, Name, Op) -> {error,{badarg,{Op,[Name]}}}. notify({mode_change,Mode0,Mode1},#{id:=Name}=State) -> - log_handler_info(Name,"Handler ~p switched from ~p to ~p mode", + log_handler_info(Name,"Handler ~p switched from ~p to ~p mode", [Name,Mode0,Mode1], State); notify({flushed,Flushed},#{id:=Name}=State) -> log_handler_info(Name, "Handler ~p flushed ~w log events", diff --git a/lib/kernel/src/logger_olp.erl b/lib/kernel/src/logger_olp.erl index 1379f8cf54..6bbf9963b6 100644 --- a/lib/kernel/src/logger_olp.erl +++ b/lib/kernel/src/logger_olp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017-2022. All Rights Reserved. +%% Copyright Ericsson AB 2017-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -193,13 +193,11 @@ init([Name,Module,Args,Options]) -> gen_server:enter_loop(?MODULE, [], State); Error -> unregister(Name), - proc_lib:init_ack(Error), - ignore %% Just to shut Dialyzer up - ignored + proc_lib:init_fail(Error, {exit,normal}) catch - _:Error -> + _:Reason -> unregister(Name), - proc_lib:init_ack(Error), - ignore %% Just to shut Dialyzer up - ignored + proc_lib:init_fail({error,Reason}, {exit,normal}) end. %% This is the synchronous load event. diff --git a/lib/kernel/src/logger_simple_h.erl b/lib/kernel/src/logger_simple_h.erl index fe8db09e83..d35c533b6d 100644 --- a/lib/kernel/src/logger_simple_h.erl +++ b/lib/kernel/src/logger_simple_h.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017-2020. All Rights Reserved. +%% Copyright Ericsson AB 2017-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -68,14 +68,14 @@ log(#{msg:=_,meta:=#{time:=_}=M}=Log,_Config) -> %% Log directly from client just to get it out case maps:get(internal_log_event, M, false) of false -> - do_log( + do_log(simple, #{level=>error, msg=>{report,{error,simple_handler_process_dead}}, meta=>#{time=>logger:timestamp()}}); true -> ok end, - do_log(Log); + do_log(simple,Log); _ -> ?MODULE ! {log,Log} end, @@ -90,9 +90,9 @@ log(_,_) -> init(Starter) -> register(?MODULE,self()), Starter ! {self(),started}, - loop(#{buffer_size=>10,dropped=>0,buffer=>[]}). + loop(rich, #{buffer_size=>10,dropped=>0,buffer=>[]}). -loop(Buffer) -> +loop(Mode, Buffer) -> receive stop -> %% We replay the logger messages if there is @@ -109,11 +109,11 @@ loop(Buffer) -> unlink(whereis(logger)), ok; {log,#{msg:=_,meta:=#{time:=_}}=Log} -> - do_log(Log), - loop(update_buffer(Buffer,Log)); + NewMode = do_log(Mode, Log), + loop(NewMode, update_buffer(Buffer,Log)); _ -> %% Unexpected message - flush it! - loop(Buffer) + loop(Mode, Buffer) end. update_buffer(#{buffer_size:=0,dropped:=D}=Buffer,_Log) -> @@ -139,16 +139,42 @@ drop_msg(N) -> %%%----------------------------------------------------------------- %%% Internal -do_log(Log) -> - try - Str = logger_formatter:format(Log, - #{ legacy_header => true, single_line => false - ,depth => unlimited, time_offset => "" - }), - erlang:display_string(lists:flatten(unicode:characters_to_list(Str))) - catch _E:_R:_ST -> - % erlang:display({_E,_R,_ST}), - display_log(Log) +%% If the init process is busy (for instance doing a shutdown) +%% we can get blocked while trying to load code. So we spawn a process +%% for each log message that can potentially block. If the logging cannot +%% be done within 300ms, we instead log the raw log message to stdout +%% and switch mode to always log using the raw format. +do_log(simple, Log) -> + display_log(Log), simple; +do_log(rich = Mode, Log) -> + + {Pid, Ref} = + spawn_monitor( + fun() -> + Str = logger_formatter:format( + Log, + #{ legacy_header => true, single_line => false, + depth => unlimited, time_offset => "" + }), + erlang:display_string(stdout, lists:flatten(unicode:characters_to_list(Str))) + end), + receive + {'DOWN', Ref, _, _, normal} -> + Mode; + {'DOWN', Ref, _, _, _Else} -> + display_log(Log), + Mode + after 300 -> + %% init:terminate/3 sleeps for 500 ms before exiting, + %% so we wait for 300 ms for the log to happen + exit(Pid, kill), + receive + {'DOWN', Ref, _, _, normal} -> + Mode; + {'DOWN', Ref, _, _, _Else} -> + display_log(Log), + simple + end end. display_log(#{msg:={report,Report}, @@ -165,6 +191,7 @@ display_date(Timestamp) when is_integer(Timestamp) -> {{Y,Mo,D},{H,Mi,S}} = erlang:universaltime_to_localtime( erlang:posixtime_to_universaltime(Sec)), erlang:display_string( + stdout, integer_to_list(Y) ++ "-" ++ pad(Mo,2) ++ "-" ++ pad(D,2) ++ " " ++ @@ -182,7 +209,8 @@ pad(Str,Size) -> display({string,Chardata}) -> try unicode:characters_to_list(Chardata) of - String -> erlang:display_string(String), erlang:display_string("\n") + String -> erlang:display_string(stdout, String), + erlang:display_string(stdout, "\n") catch _:_ -> erlang:display(Chardata) end; display({report,Report}) when is_map(Report) -> @@ -190,9 +218,9 @@ display({report,Report}) when is_map(Report) -> display({report,Report}) -> display_report(Report); display({F, A}) when is_list(F), is_list(A) -> - erlang:display_string(F ++ "\n"), + erlang:display_string(stdout, F ++ "\n"), [begin - erlang:display_string("\t"), + erlang:display_string(stdout, "\t"), erlang:display(Arg) end || Arg <- A], ok. @@ -203,7 +231,7 @@ display_report(Atom, A) when is_atom(Atom) -> AtomString = atom_to_list(Atom), AtomLength = length(AtomString), Padding = lists:duplicate(ColumnWidth - AtomLength, $\s), - erlang:display_string(AtomString ++ Padding), + erlang:display_string(stdout, AtomString ++ Padding), display_report(A); display_report(F, A) -> erlang:display({F, A}). @@ -216,13 +244,12 @@ display_report([A, []]) -> display_report(A = [_|_]) -> case lists:all(fun({Key,_Value}) -> is_atom(Key); (_) -> false end, A) of true -> - erlang:display_string("\n"), + erlang:display_string(stdout, "\n"), lists:foreach( fun({Key, Value}) -> erlang:display_string( - " " ++ - atom_to_list(Key) ++ - ": "), + stdout, + " " ++ atom_to_list(Key) ++ ": "), erlang:display(Value) end, A); false -> diff --git a/lib/kernel/src/logger_std_h.erl b/lib/kernel/src/logger_std_h.erl index 1fe740d5ec..1b2fabad72 100644 --- a/lib/kernel/src/logger_std_h.erl +++ b/lib/kernel/src/logger_std_h.erl @@ -507,6 +507,15 @@ ensure_open(Filename, Modes) -> exit({could_not_create_dir_for_file,Error}) end. +write_to_dev(Bin,#{dev:=standard_io}=State) -> + try + io:put_chars(user, Bin) + catch _E:_R -> + io:put_chars( + standard_error, "Failed to write log message to stdout, trying stderr\n"), + io:put_chars(standard_error, Bin) + end, + State; write_to_dev(Bin,#{dev:=DevName}=State) -> io:put_chars(DevName, Bin), State; diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 2123e3e1bf..a3d983d310 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -22,7 +22,7 @@ -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(nodeup(N, State), verbose({?MODULE, ?LINE, nodeup, N}, 1, State)). %%-define(dist_debug, true). @@ -577,6 +577,10 @@ init(#{name := Name, supervisor := Supervisor, dist_listen := DistListen, hidden := Hidden}) -> + %% We enable async_dist so that we won't need to do the + %% nosuspend/spawn trick which just cause even larger + %% memory consumption... + _ = process_flag(async_dist, true), process_flag(trap_exit,true), persistent_term:put({?MODULE, publish_type}, if Hidden -> hidden; @@ -794,12 +798,9 @@ handle_call({is_auth, _Node}, From, State) -> %% %% Not applicable any longer !? %% -handle_call({apply,_Mod,_Fun,_Args}, {From,Tag}, State) - when is_pid(From), node(From) =:= node() -> - async_gen_server_reply({From,Tag}, not_implemented), -% Port = State#state.port, -% catch apply(Mod,Fun,[Port|Args]), - {noreply,State}; +handle_call({apply,_Mod,_Fun,_Args}, {Pid, _Tag} = From, State) + when is_pid(Pid), node(Pid) =:= node() -> + async_reply({reply, not_implemented, State}, From); handle_call(longnames, From, State) -> async_reply({reply, get(longnames), State}, From); @@ -985,7 +986,7 @@ handle_info({auto_connect,Node, DHandle}, State) -> %% %% accept a new connection. %% -handle_info({accept,AcceptPid,Socket,Family,Proto}, State) -> +handle_info({accept,AcceptPid,Socket,Family,Proto}=Accept, State) -> case get_proto_mod(Family,Proto,State#state.listen) of {ok, Mod} -> Pid = Mod:accept_connection(AcceptPid, @@ -993,9 +994,11 @@ handle_info({accept,AcceptPid,Socket,Family,Proto}, State) -> State#state.node, State#state.allowed, State#state.connecttime), + verbose({Accept,Pid}, 2, State), AcceptPid ! {self(), controller, Pid}, {noreply,State}; _ -> + verbose({Accept,unsupported_protocol}, 2, State), AcceptPid ! {self(), unsupported_protocol}, {noreply, State} end; @@ -1012,6 +1015,7 @@ handle_info({dist_ctrlr, Ctrlr, Node, SetupPid} = Msg, andalso (is_port(Ctrlr) orelse is_pid(Ctrlr)) andalso (node(Ctrlr) == node()) -> link(Ctrlr), + verbose(Msg, 2, State), ets:insert(sys_dist, Conn#connection{ctrlr = Ctrlr}), {noreply, State#state{dist_ctrlrs = DistCtrlrs#{Ctrlr => Node}}}; _ -> @@ -1022,7 +1026,7 @@ handle_info({dist_ctrlr, Ctrlr, Node, SetupPid} = Msg, %% %% A node has successfully been connected. %% -handle_info({SetupPid, {nodeup,Node,Address,Type,NamedMe}}, +handle_info({SetupPid, {nodeup,Node,Address,Type,NamedMe} = Nodeup}, #state{tick = Tick} = State) -> case ets:lookup(sys_dist, Node) of [Conn] when (Conn#connection.state =:= pending) @@ -1043,6 +1047,8 @@ handle_info({SetupPid, {nodeup,Node,Address,Type,NamedMe}}, true -> State#state{node = node()}; false -> State end, + verbose(Nodeup, 1, State1), + verbose({nodeup,Node,SetupPid,Conn#connection.ctrlr}, 2, State1), {noreply, State1}; _ -> SetupPid ! {self(), bad_request}, @@ -1060,6 +1066,7 @@ handle_info({AcceptPid, {accept_pending,MyNode,NodeOrHost,Type}}, State0) -> if MyNode > Node -> AcceptPid ! {self(),{accept_pending,nok_pending}}, + verbose({accept_pending_nok, Node, AcceptPid}, 2, State), {noreply,State}; true -> %% @@ -1069,13 +1076,18 @@ handle_info({AcceptPid, {accept_pending,MyNode,NodeOrHost,Type}}, State0) -> OldOwner = Conn#connection.owner, case maps:is_key(OldOwner, State#state.conn_owners) of true -> + verbose({remark,OldOwner,AcceptPid}, 2, State), ?debug({net_kernel, remark, old, OldOwner, new, AcceptPid}), exit(OldOwner, remarked), receive - {'EXIT', OldOwner, _} -> + {'EXIT', OldOwner, _} = Exit -> + verbose(Exit, 2, State), true end; false -> + verbose( + {accept_pending, OldOwner, inconsistency}, + 2, State), ok % Owner already exited end, ets:insert(sys_dist, Conn#connection{owner = AcceptPid}), @@ -1157,7 +1169,6 @@ handle_info({'DOWN', ReqId, process, _Pid, Reason}, %% Handle different types of process terminations. %% handle_info({'EXIT', From, Reason}, State) -> - verbose({'EXIT', From, Reason}, 1, State), handle_exit(From, Reason, State); %% @@ -1271,30 +1282,33 @@ 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), + listen_exit(Pid, Reason, State), + accept_exit(Pid, Reason, State), conn_own_exit(Pid, Reason, State), dist_ctrlr_exit(Pid, Reason, State), - pending_own_exit(Pid, State), - ticker_exit(Pid, State), - restarter_exit(Pid, State), + pending_own_exit(Pid, Reason, State), + ticker_exit(Pid, Reason, State), + restarter_exit(Pid, Reason, State), + verbose({'EXIT', Pid, Reason}, 2, State), {noreply,State}. -listen_exit(Pid, State) -> +listen_exit(Pid, Reason, State) -> case lists:keymember(Pid, ?LISTEN_ID, State#state.listen) of true -> + verbose({listen_exit, Pid, Reason}, 2, State), error_msg("** Netkernel terminating ... **\n", []), throw({stop,no_network,State}); false -> false end. -accept_exit(Pid, State) -> +accept_exit(Pid, Reason, State) -> Listen = State#state.listen, case lists:keysearch(Pid, ?ACCEPT_ID, Listen) of {value, ListenR} -> ListenS = ListenR#listen.listen, Mod = ListenR#listen.module, + verbose({accept_exit, Pid, Reason, Mod}, 2, State), AcceptPid = Mod:accept(ListenS), L = lists:keyreplace(Pid, ?ACCEPT_ID, Listen, ListenR#listen{accept = AcceptPid}), @@ -1306,16 +1320,20 @@ accept_exit(Pid, State) -> conn_own_exit(Pid, Reason, #state{conn_owners = Owners} = State) -> case maps:get(Pid, Owners, undefined) of undefined -> false; - Node -> throw({noreply, nodedown(Pid, Node, Reason, State)}) + Node -> + verbose({conn_own_exit, Pid, Reason, Node}, 2, State), + throw({noreply, nodedown(Pid, Node, Reason, State)}) end. dist_ctrlr_exit(Pid, Reason, #state{dist_ctrlrs = DCs} = State) -> case maps:get(Pid, DCs, undefined) of undefined -> false; - Node -> throw({noreply, nodedown(Pid, Node, Reason, State)}) + Node -> + verbose({dist_ctrlr_exit, Pid, Reason, Node}, 2, State), + throw({noreply, nodedown(Pid, Node, Reason, State)}) end. -pending_own_exit(Pid, #state{pend_owners = Pend} = State) -> +pending_own_exit(Pid, Reason, #state{pend_owners = Pend} = State) -> case maps:get(Pid, Pend, undefined) of undefined -> false; @@ -1323,31 +1341,43 @@ pending_own_exit(Pid, #state{pend_owners = Pend} = State) -> State1 = State#state { pend_owners = maps:remove(Pid, Pend)}, case get_conn(Node) of {ok, Conn} when Conn#connection.state =:= up_pending -> + verbose( + {pending_own_exit, Pid, Reason, Node, up_pending}, + 2, State), reply_waiting(Node,Conn#connection.waiting, true), Conn1 = Conn#connection { state = up, waiting = [], pending_owner = undefined }, ets:insert(sys_dist, Conn1); _ -> + verbose({pending_own_exit, Pid, Reason, Node}, 2, State), ok end, throw({noreply, State1}) end. -ticker_exit(Pid, #state{tick = #tick{ticker = Pid, time = T} = Tck} = State) -> +ticker_exit( + Pid, Reason, + #state{tick = #tick{ticker = Pid, time = T} = Tck} = State) -> + verbose({ticker_exit, Pid, Reason, Tck}, 2, 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) -> +ticker_exit( + Pid, Reason, + #state{tick = #tick_change{ticker = Pid, time = T} = TckCng} = State) -> + verbose({ticker_exit, Pid, Reason, TckCng}, 2, State), Tckr = restart_ticker(T), - throw({noreply, State#state{tick = TckCng#tick_change{ticker = Tckr}}}); -ticker_exit(_, _) -> + throw({noreply, Reason, State#state{tick = TckCng#tick_change{ticker = Tckr}}}); +ticker_exit(_, _, _) -> false. -restarter_exit(Pid, State) -> +restarter_exit(Pid, Reason, State) -> case State#state.supervisor of {restart, Pid} -> - error_msg("** Distribution restart failed, net_kernel terminating... **\n", []), + verbose({restarter_exit, Pid, Reason}, 2, State), + error_msg( + "** Distribution restart failed, net_kernel terminating... **\n", + []), throw({stop, restarter_exit, State}); _ -> false @@ -1783,6 +1813,9 @@ setup(Node, ConnId, Type, From, State) -> MyNode, State#state.type, State#state.connecttime), + verbose( + {setup,Node,Type,MyNode,State#state.type,Pid}, + 2, State), Addr = LAddr#net_address { address = undefined, host = undefined }, @@ -2026,7 +2059,7 @@ start_protos(Node, Ps, CleanHalt, Listen) -> end. start_protos_no_listen(Node, [Proto | Ps], Ls, CleanHalt) -> - {Name, "@"++_Host} = split_node(Node), + {Name, "@"++Host} = split_node(Node), Ok = case Name of "undefined" -> erts_internal:dynamic_node_name(true), @@ -2038,9 +2071,14 @@ start_protos_no_listen(Node, [Proto | Ps], Ls, CleanHalt) -> true -> auth:sync_cookie(), Mod = list_to_atom(Proto ++ "_dist"), + Address = + try Mod:address(Host) + catch error:undef -> + Mod:address() + end, L = #listen { listen = undefined, - address = Mod:address(), + address = Address, accept = undefined, module = Mod }, start_protos_no_listen(Node, Ps, [L|Ls], CleanHalt); @@ -2124,7 +2162,7 @@ register_error(false, Proto, Reason) -> proto_error(false, Proto, lists:flatten(S)); register_error(true, Proto, Reason) -> S = "Protocol '" ++ Proto ++ "': register/listen error: ", - erlang:display_string(S), + erlang:display_string(stdout, S), erlang:display(Reason). proto_error(CleanHalt, Proto, String) -> @@ -2248,7 +2286,7 @@ reply_waiting(_Node, Waiting, Rep) -> reply_waiting1(lists:reverse(Waiting), Rep). reply_waiting1([From|W], Rep) -> - async_gen_server_reply(From, Rep), + gen_server:reply(From, Rep), reply_waiting1(W, Rep); reply_waiting1([], _) -> ok. @@ -2354,24 +2392,23 @@ return_call({noreply, _State}=R, _From) -> return_call(R, From) -> async_reply(R, From). -async_reply({reply, Msg, State}, From) -> - async_gen_server_reply(From, Msg), - {noreply, State}. - -async_gen_server_reply(From, Msg) -> - {Pid, Tag} = From, - M = {Tag, Msg}, - try erlang:send(Pid, M, [nosuspend, noconnect]) of - ok -> - ok; - nosuspend -> - _ = spawn(fun() -> catch erlang:send(Pid, M, [noconnect]) end), - ok; - noconnect -> - ok % The gen module takes care of this case. - catch - _:_ -> ok - end. +-compile({inline, [async_reply/2]}). +async_reply({reply, _Msg, _State} = Res, _From) -> + %% This function call is kept in order to not unnecessarily create a huge diff + %% in the code. + %% + %% Here we used to send the reply explicitly using 'noconnect' and 'nosuspend'. + %% + %% * 'noconnect' since setting up a connection from net_kernel itself would + %% deadlock when connects were synchronous. Since connects nowadays are + %% asynchronous this is no longer an issue. + %% * 'nosuspend' and spawn a process taking care of the reply in case + %% we would have suspended. This in order not to block net_kernel. We now + %% use 'async_dist' enabled and by this prevent the blocking, keep the + %% signal order, avoid one extra copying of the reply, avoid the overhead + %% of creating a process, and avoid the extra memory consumption due to the + %% extra process. + Res. handle_async_response(ResponseType, ReqId, Result, #state{req_map = ReqMap0} = S0) -> if ResponseType == down -> ok; @@ -2385,20 +2422,19 @@ handle_async_response(ResponseType, ReqId, Result, #state{req_map = ReqMap0} = S reply -> Result; down -> {error, noconnection} end, - S1 = S0#state{req_map = ReqMap1}, - async_reply({reply, Reply, S1}, From); + gen_server:reply(From, Reply), + {noreply, S0#state{req_map = ReqMap1}}; {{setopts_new, Op}, ReqMap1} -> case maps:get(Op, ReqMap1) of {setopts_new, From, 1} -> %% Last response for this operation... + gen_server:reply(From, ok), ReqMap2 = maps:remove(Op, ReqMap1), - S1 = S0#state{req_map = ReqMap2}, - async_reply({reply, ok, S1}, From); + {noreply, S0#state{req_map = ReqMap2}}; {setopts_new, From, N} -> ReqMap2 = ReqMap1#{Op => {setopts_new, From, N-1}}, - S1 = S0#state{req_map = ReqMap2}, - {noreply, S1} + {noreply, S0#state{req_map = ReqMap2}} end end. diff --git a/lib/kernel/src/pg.erl b/lib/kernel/src/pg.erl index 017b1942b4..8204576ba7 100644 --- a/lib/kernel/src/pg.erl +++ b/lib/kernel/src/pg.erl @@ -204,10 +204,10 @@ get_members(Group) -> -spec get_members(Scope :: atom(), Group :: group()) -> [pid()]. get_members(Scope, Group) -> try - ets:lookup_element(Scope, Group, 2) + ets:lookup_element(Scope, Group, 2, []) catch - error:badarg -> - [] + %% Case where the table does not exist yet. + error:badarg -> [] end. %%-------------------------------------------------------------------- @@ -220,10 +220,10 @@ get_local_members(Group) -> -spec get_local_members(Scope :: atom(), Group :: group()) -> [pid()]. get_local_members(Scope, Group) -> try - ets:lookup_element(Scope, Group, 3) + ets:lookup_element(Scope, Group, 3, []) catch - error:badarg -> - [] + %% Case where the table does not exist yet. + error:badarg -> [] end. %%-------------------------------------------------------------------- @@ -305,7 +305,7 @@ handle_call({leave_local, Group, PidOrPids}, _From, #state{scope = Scope, local handle_call(monitor, {Pid, _Tag}, #state{scope = Scope, scope_monitors = ScopeMon} = State) -> %% next line could also be done with iterating over process state, but it appears to be slower - Local = maps:from_list([{G,P} || [G,P] <- ets:match(Scope, {'$1', '$2', '_'})]), + Local = #{G => P || [G,P] <- ets:match(Scope, {'$1', '$2', '_'})}, MRef = erlang:monitor(process, Pid), %% monitor the monitor, to discard it upon termination, and generate MRef {reply, {MRef, Local}, State#state{scope_monitors = ScopeMon#{MRef => Pid}}}; @@ -339,10 +339,7 @@ handle_call(_Request, _From, _S) -> erlang:error(badarg). -spec handle_cast( - {sync, Peer :: pid(), Groups :: [{group(), [pid()]}]} | - {discover, Peer :: pid()} | - {join, Peer :: pid(), group(), pid() | [pid()]} | - {leave, Peer :: pid(), pid() | [pid()], [group()]}, + {sync, Peer :: pid(), Groups :: [{group(), [pid()]}]}, State :: state()) -> {noreply, state()}. handle_cast({sync, Peer, Groups}, #state{scope = Scope, remote = Remote, scope_monitors = ScopeMon, @@ -354,6 +351,7 @@ handle_cast(_, _State) -> -spec handle_info( {discover, Peer :: pid()} | + {discover, Peer :: pid(), any()} | {join, Peer :: pid(), group(), pid() | [pid()]} | {leave, Peer :: pid(), pid() | [pid()], [group()]} | {'DOWN', reference(), process, pid(), term()} | @@ -395,17 +393,13 @@ handle_info({leave, Peer, PidOrPids, Groups}, #state{scope = Scope, remote = Rem end; %% we're being discovered, let's exchange! -handle_info({discover, Peer}, #state{remote = Remote, local = Local} = State) -> - gen_server:cast(Peer, {sync, self(), all_local_pids(Local)}), - %% do we know who is looking for us? - case maps:is_key(Peer, Remote) of - true -> - {noreply, State}; - false -> - MRef = erlang:monitor(process, Peer), - erlang:send(Peer, {discover, self()}, [noconnect]), - {noreply, State#state{remote = Remote#{Peer => {MRef, #{}}}}} - end; +handle_info({discover, Peer}, State) -> + handle_discover(Peer, State); + +%% New discover message sent by a future pg version. +%% Accepted first in OTP 26, to be used by OTP 28 or later. +handle_info({discover, Peer, _ProtocolVersion}, State) -> + handle_discover(Peer, State); %% handle local process exit, or a local monitor exit handle_info({'DOWN', MRef, process, Pid, _Info}, #state{scope = Scope, local = Local, @@ -440,7 +434,7 @@ handle_info({nodedown, _Node}, State) -> handle_info({nodeup, Node}, State) when Node =:= node() -> {noreply, State}; handle_info({nodeup, Node}, #state{scope = Scope} = State) -> - {Scope, Node} ! {discover, self()}, + erlang:send({Scope, Node}, {discover, self()}, [noconnect]), {noreply, State}; handle_info(_Info, _State) -> @@ -453,6 +447,21 @@ terminate(_Reason, #state{scope = Scope}) -> %%-------------------------------------------------------------------- %% Internal implementation +handle_discover(Peer, #state{remote = Remote, local = Local} = State) -> + gen_server:cast(Peer, {sync, self(), all_local_pids(Local)}), + %% do we know who is looking for us? + case maps:is_key(Peer, Remote) of + true -> + {noreply, State}; + false -> + MRef = erlang:monitor(process, Peer), + erlang:send(Peer, {discover, self()}, [noconnect]), + {noreply, State#state{remote = Remote#{Peer => {MRef, #{}}}}} + end; +handle_discover(_, _) -> + erlang:error(badarg). + + %% Ensures argument is either a node-local pid or a list of such, or it throws an error ensure_local(Pid) when is_pid(Pid), node(Pid) =:= node() -> ok; @@ -492,7 +501,7 @@ sync_groups(Scope, ScopeMon, MG, RemoteGroups, [{Group, Pids} | Tail]) -> {Pids, NewRemoteGroups} -> sync_groups(Scope, ScopeMon, MG, NewRemoteGroups, Tail); {OldPids, NewRemoteGroups} -> - [{Group, AllOldPids, LocalPids}] = ets:lookup(Scope, Group), + [{_Group, AllOldPids, LocalPids}] = ets:lookup(Scope, Group), %% should be really rare... AllNewPids = Pids ++ AllOldPids -- OldPids, true = ets:insert(Scope, {Group, AllNewPids, LocalPids}), @@ -517,7 +526,7 @@ join_local([Pid | Tail], Group, Local) -> join_local_update_ets(Scope, ScopeMon, MG, Group, Pid) when is_pid(Pid) -> case ets:lookup(Scope, Group) of - [{Group, All, Local}] -> + [{_Group, All, Local}] -> ets:insert(Scope, {Group, [Pid | All], [Pid | Local]}); [] -> ets:insert(Scope, {Group, [Pid], [Pid]}) @@ -525,7 +534,7 @@ join_local_update_ets(Scope, ScopeMon, MG, Group, Pid) when is_pid(Pid) -> notify_group(ScopeMon, MG, join, Group, [Pid]); join_local_update_ets(Scope, ScopeMon, MG, Group, Pids) -> case ets:lookup(Scope, Group) of - [{Group, All, Local}] -> + [{_Group, All, Local}] -> ets:insert(Scope, {Group, Pids ++ All, Pids ++ Local}); [] -> ets:insert(Scope, {Group, Pids, Pids}) @@ -534,7 +543,7 @@ join_local_update_ets(Scope, ScopeMon, MG, Group, Pids) -> join_remote_update_ets(Scope, ScopeMon, MG, Group, Pid) when is_pid(Pid) -> case ets:lookup(Scope, Group) of - [{Group, All, Local}] -> + [{_Group, All, Local}] -> ets:insert(Scope, {Group, [Pid | All], Local}); [] -> ets:insert(Scope, {Group, [Pid], []}) @@ -542,7 +551,7 @@ join_remote_update_ets(Scope, ScopeMon, MG, Group, Pid) when is_pid(Pid) -> notify_group(ScopeMon, MG, join, Group, [Pid]); join_remote_update_ets(Scope, ScopeMon, MG, Group, Pids) -> case ets:lookup(Scope, Group) of - [{Group, All, Local}] -> + [{_Group, All, Local}] -> ets:insert(Scope, {Group, Pids ++ All, Local}); [] -> ets:insert(Scope, {Group, Pids, []}) @@ -576,10 +585,10 @@ leave_local([Pid | Tail], Group, Local) -> leave_local_update_ets(Scope, ScopeMon, MG, Group, Pid) when is_pid(Pid) -> case ets:lookup(Scope, Group) of - [{Group, [Pid], [Pid]}] -> + [{_Group, [Pid], [Pid]}] -> ets:delete(Scope, Group), notify_group(ScopeMon, MG, leave, Group, [Pid]); - [{Group, All, Local}] -> + [{_Group, All, Local}] -> ets:insert(Scope, {Group, lists:delete(Pid, All), lists:delete(Pid, Local)}), notify_group(ScopeMon, MG, leave, Group, [Pid]); [] -> @@ -588,7 +597,7 @@ leave_local_update_ets(Scope, ScopeMon, MG, Group, Pid) when is_pid(Pid) -> end; leave_local_update_ets(Scope, ScopeMon, MG, Group, Pids) -> case ets:lookup(Scope, Group) of - [{Group, All, Local}] -> + [{_Group, All, Local}] -> case All -- Pids of [] -> ets:delete(Scope, Group); @@ -603,10 +612,10 @@ leave_local_update_ets(Scope, ScopeMon, MG, Group, Pids) -> leave_remote_update_ets(Scope, ScopeMon, MG, Pid, Groups) when is_pid(Pid) -> _ = [ case ets:lookup(Scope, Group) of - [{Group, [Pid], []}] -> + [{_Group, [Pid], []}] -> ets:delete(Scope, Group), notify_group(ScopeMon, MG, leave, Group, [Pid]); - [{Group, All, Local}] -> + [{_Group, All, Local}] -> ets:insert(Scope, {Group, lists:delete(Pid, All), Local}), notify_group(ScopeMon, MG, leave, Group, [Pid]); [] -> @@ -616,7 +625,7 @@ leave_remote_update_ets(Scope, ScopeMon, MG, Pid, Groups) when is_pid(Pid) -> leave_remote_update_ets(Scope, ScopeMon, MG, Pids, Groups) -> _ = [ case ets:lookup(Scope, Group) of - [{Group, All, Local}] -> + [{_Group, All, Local}] -> case All -- Pids of [] when Local =:= [] -> ets:delete(Scope, Group); diff --git a/lib/kernel/src/prim_tty.erl b/lib/kernel/src/prim_tty.erl new file mode 100644 index 0000000000..7ed418de5e --- /dev/null +++ b/lib/kernel/src/prim_tty.erl @@ -0,0 +1,1000 @@ +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2021. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(prim_tty). + +%% Todo: +%% * Try to move buffer handling logic to Erlang +%% * This may not be possible for performance reasons, but should be tried +%% * It seems like unix decodes and then encodes utf8 when emitting it +%% * user_drv module should be able to handle both nif and driver without too many changes. +%% +%% Problems to solve: +%% * Do not use non blocking io +%% * Reset tty settings at _exit +%% * Allow remsh in oldshell (can we do this?) +%% * See if we can run a tty in windows shell +%% * Allow unicode detection for noshell/noinput +%% * ?Allow multi-line editing? +%% * The current implementation only allows the cursor to move and edit on current line +%% +%% Concepts to keep in mind: +%% Code point: A single unicode "thing", examples: "a", "😀" (unicode smilie) +%% Grapheme cluster: One or more code points, " +%% Logical character: Any character that the user typed or printed. +%% One unicode grapheme cluster is a logical character +%% Examples: "a", "\t", "😀" (unicode smilie), "\x{1F600}", "\e[0m" (ansi sequences), +%% "^C" +%% When we step or delete we count logical characters even if they are multiple chars. +%% (I'm unsure how ansi should be handled with regard to delete?) +%% +%% Actual characters: The actual unicode grapheme clusters printed +%% Column: The number of rendered columns for a logical character +%% +%% When navigating using move(left) and move(right) the terminal will move one +%% actual character, so if we want to move one logical character we may have to +%% emit more moves. The same is true when overwriting. +%% +%% When calculating the current column position we have to use the column size +%% of the characters as otherwise smilies will becomes incorrect. +%% +%% In the current ttysl_drv and also this implementation there are never any newlines +%% in the buffer. +%% +%% Printing of unicode characters: +%% Read this post: https://jeffquast.com/post/terminal_wcwidth_solution/ +%% Summary: the wcwidth implementation in libc is often lacking. So we should +%% create our own. We can get the size of all unicode graphemes by rendering +%% them on a terminal and see how much the cursor moves. We can query where the +%% cursor is by using "\033[6n"[1]. How many valid grapheme clusters are there? +%% +%% On consoles that does support fetching the surrent cursor position, we may get +%% away with only using that to check where we are and where to go. And on consoles +%% that do not we just have to make a best effort and use libc wcwidth. +%% +%% We need to know the width of characters when: +%% * Printing a \t +%% * Compensating for xn +%% [1]: https://www.linuxquestions.org/questions/programming-9/get-cursor-position-in-c-947833/ +%% Notes: +%% - [129306,127996] (hand with skintone) seems to move the cursor more than +%% it should on iTerm...The skintone code point seems to not +%% work at all on Linux and instead emits hand + brown square which is 4 characters +%% wide which is what the cursor on iTerm was positioned at. So maybe +%% there is a mismatch somewhere in iTerm wcwidth handling. +%% - edlin and user needs to agree on what one "character" is, right now edlin uses +%% code points and not grapheme clusters. +%% - We can deal with xn by always emitting it after a put_chars command. We must make +%% sure not to emit it before we emit any newline in the put_chars though as that +%% potentially will insert two newlines instead of one. +%% +%% Windows: +%% Since 2017:ish we can use Virtual Terminal Sequences[2] to control the terminal. +%% It seems like these are mostly ANSI escape comparitible, so it should be possible +%% to just use the same mechanism on windows and unix. +%% [2]: https://docs.microsoft.com/en-us/windows/console/console-virtual-terminal-sequences +%% Windows does not seem to have any wcwidth, so maybe we have to generate a similar table +%% as the PR in [3] and add string:width/1. +%% [3]: https://github.com/microsoft/terminal/pull/5795 +%% +%% +%% Things I've tried and discarded: +%% * Use get position to figure out xn fix for newlines +%% * There is too large a latency (about 10ms) to get the position, so things like +%% `c:i()` becomes a lot slower. +%% * Use tty insert mode +%% * This only works when the cursor is on the last line, when it is on a previous +%% line it only edit that line. +%% * Use tty delete mode +%% * Same problem as insert mode, it only deleted current line, and does not move +%% to previous line automatically. + +-export([init/1, reinit/2, isatty/1, handles/1, unicode/1, unicode/2, + handle_signal/2, window_size/1, handle_request/2, write/2, write/3, npwcwidth/1, + npwcwidthstring/1]). +-export([reader_stop/1, disable_reader/1, enable_reader/1]). + +-nifs([isatty/1, tty_create/0, tty_init/3, tty_set/1, setlocale/1, + tty_select/3, tty_window_size/1, write_nif/2, read_nif/2, isprint/1, + wcwidth/1, wcswidth/1, + sizeof_wchar/0, tgetent_nif/1, tgetnum_nif/1, tgetflag_nif/1, tgetstr_nif/1, + tgoto_nif/2, tgoto_nif/3, tty_read_signal/2]). + +%% Exported in order to remove "unused function" warning +-export([sizeof_wchar/0, wcswidth/1, tgoto/2, tgoto/3]). + +%% proc_lib exports +-export([reader/1, writer/1]). + +-on_load(on_load/0). + +%%-define(debug, true). +-ifdef(debug). +-define(dbg(Term), dbg(Term)). +-else. +-define(dbg(Term), ok). +-endif. +%% Copied from https://github.com/chalk/ansi-regex/blob/main/index.js +-define(ANSI_REGEXP, <<"^[\e",194,155,"][[\\]()#;?]*(?:(?:(?:(?:;[-a-zA-Z\\d\\/#&.:=?%@~_]+)*|[a-zA-Z\\d]+(?:;[-a-zA-Z\\d\\/#&.:=?%@~_]*)*)?",7,")|(?:(?:\\d{1,4}(?:;\\d{0,4})*)?[\\dA-PR-TZcf-nq-uy=><~]))">>). +-record(state, {tty, + reader, + writer, + options, + unicode, + buffer_before = [], %% Current line before cursor in reverse + buffer_after = [], %% Current line after cursor not in reverse + buffer_expand, %% Characters in expand buffer + cols = 80, + rows = 24, + xn = false, + clear = <<"\e[H\e[2J">>, + up = <<"\e[A">>, + down = <<"\n">>, + left = <<"\b">>, + right = <<"\e[C">>, + %% Tab to next 8 column windows is "\e[1I", for unix "ta" termcap + tab = <<"\e[1I">>, + delete_after_cursor = <<"\e[J">>, + insert = false, + delete = false, + position = <<"\e[6n">>, %% "u7" on my Linux + position_reply = <<"\e\\[([0-9]+);([0-9]+)R">>, + ansi_regexp + }). + +-type options() :: #{ tty => boolean(), + input => boolean(), + canon => boolean(), + echo => boolean(), + sig => boolean() + }. +-type request() :: + {putc, unicode:unicode_binary()} | + {expand, unicode:unicode_binary()} | + {insert, unicode:unicode_binary()} | + {delete, integer()} | + {move, integer()} | + clear | + beep. +-opaque state() :: #state{}. +-export_type([state/0]). + +-spec on_load() -> ok. +on_load() -> + on_load(#{}). + +-spec on_load(Extra) -> ok when + Extra :: map(). +on_load(Extra) -> + case erlang:load_nif(atom_to_list(?MODULE), Extra) of + ok -> ok; + {error,{reload,_}} -> + ok + end. + +-spec window_size(state()) -> {ok, {non_neg_integer(), non_neg_integer()}} | {error, term()}. +window_size(State = #state{ tty = TTY }) -> + case tty_window_size(TTY) of + {error, enotsup} when map_get(tty, State#state.options) -> + %% When the TTY is enabled, we should return a "dummy" row and column + %% when we cannot find the proper size. + {ok, {State#state.cols, State#state.rows}}; + WinSz -> + WinSz + end. + +-spec init(options()) -> state(). +init(UserOptions) when is_map(UserOptions) -> + + Options = options(UserOptions), + {ok, TTY} = tty_create(), + + %% Initialize the locale to see if we support utf-8 or not + UnicodeMode = + case setlocale(TTY) of + primitive -> + lists:any( + fun(Key) -> + string:find(os:getenv(Key,""),"UTF-8") =/= nomatch + end, ["LC_ALL", "LC_CTYPE", "LANG"]); + UnicodeLocale when is_boolean(UnicodeLocale) -> + UnicodeLocale + end, + {ok, ANSI_RE_MP} = re:compile(?ANSI_REGEXP, [unicode]), + init_term(#state{ tty = TTY, unicode = UnicodeMode, options = Options, ansi_regexp = ANSI_RE_MP }). +init_term(State = #state{ tty = TTY, options = Options }) -> + TTYState = + case maps:get(tty, Options) of + true -> + ok = tty_init(TTY, stdout, Options), + NewState = init(State, os:type()), + ok = tty_set(TTY), + NewState; + false -> + State + end, + + WriterState = + if TTYState#state.writer =:= undefined -> + {ok, Writer} = proc_lib:start_link(?MODULE, writer, [State#state.tty]), + TTYState#state{ writer = Writer }; + true -> + TTYState + end, + ReaderState = + case {maps:get(input, Options), TTYState#state.reader} of + {true, undefined} -> + {ok, Reader} = proc_lib:start_link(?MODULE, reader, [[State#state.tty, self()]]), + WriterState#state{ reader = Reader }; + {true, _} -> + WriterState; + {false, undefined} -> + WriterState + end, + + update_geometry(ReaderState). + +-spec reinit(state(), options()) -> state(). +reinit(State, UserOptions) -> + init_term(State#state{ options = options(UserOptions) }). + +options(UserOptions) -> + maps:merge( + #{ input => true, + tty => true, + canon => false, + echo => false }, UserOptions). + +init(State, {unix,_}) -> + + case os:getenv("TERM") of + false -> + error(enotsup); + Term -> + case tgetent(Term) of + ok -> ok; + {error,_} -> error(enotsup) + end + end, + + %% See https://www.gnu.org/software/termutils/manual/termcap-1.3/html_mono/termcap.html#SEC23 + %% for a list of all possible termcap capabilities + Clear = case tgetstr("clear") of + {ok, C} -> C; + false -> (#state{})#state.clear + end, + Cols = case tgetnum("co") of + {ok, Cs} -> Cs; + _ -> (#state{})#state.cols + end, + Up = case tgetstr("up") of + {ok, U} -> U; + false -> error(enotsup) + end, + Down = case tgetstr("do") of + false -> (#state{})#state.down; + {ok, D} -> D + end, + Left = case {tgetflag("bs"),tgetstr("bc")} of + {true,_} -> (#state{})#state.left; + {_,false} -> (#state{})#state.left; + {_,{ok, L}} -> L + end, + + Right = case tgetstr("nd") of + {ok, R} -> R; + false -> error(enotsup) + end, + Insert = + case tgetstr("IC") of + {ok, IC} -> IC; + false -> (#state{})#state.insert + end, + + Tab = case tgetstr("ta") of + {ok, TA} -> TA; + false -> (#state{})#state.tab + end, + + Delete = case tgetstr("DC") of + {ok, DC} -> DC; + false -> (#state{})#state.delete + end, + + Position = case tgetstr("u7") of + {ok, <<"\e[6n">> = U7} -> + %% User 7 should contain the codes for getting + %% cursor position. + % User 6 should contain how to parse the reply + {ok, <<"\e[%i%d;%dR">>} = tgetstr("u6"), + <<"\e[6n">> = U7; + false -> (#state{})#state.position + end, + + %% According to the manual this should only be issued when the cursor + %% is at position 0, but until we encounter such a console we keep things + %% simple and issue this with the cursor anywhere + DeleteAfter = case tgetstr("cd") of + {ok, DA} -> + DA; + false -> + (#state{})#state.delete_after_cursor + end, + + State#state{ + cols = Cols, + clear = Clear, + xn = tgetflag("xn"), + up = Up, + down = Down, + left = Left, + right = Right, + insert = Insert, + delete = Delete, + tab = Tab, + position = Position, + delete_after_cursor = DeleteAfter + }; +init(State, {win32, _}) -> + State#state{ + %% position = false, + xn = true }. + +-spec handles(state()) -> #{ read := undefined | reference(), + write := reference() }. +handles(#state{ reader = undefined, + writer = {_WriterPid, WriterRef}}) -> + #{ read => undefined, write => WriterRef }; +handles(#state{ reader = {_ReaderPid, ReaderRef}, + writer = {_WriterPid, WriterRef}}) -> + #{ read => ReaderRef, write => WriterRef }. + +-spec unicode(state()) -> boolean(). +unicode(State) -> + State#state.unicode. + +-spec unicode(state(), boolean()) -> state(). +unicode(#state{ reader = Reader } = State, Bool) -> + case Reader of + {ReaderPid, _} -> + call(ReaderPid, {set_unicode_state, Bool}); + undefined -> + ok + end, + State#state{ unicode = Bool }. + +-spec reader_stop(state()) -> state(). +reader_stop(#state{ reader = {ReaderPid, _} } = State) -> + {error, _} = call(ReaderPid, stop), + State#state{ reader = undefined }. + +-spec handle_signal(state(), winch | cont) -> state(). +handle_signal(State, winch) -> + update_geometry(State); +handle_signal(State, cont) -> + tty_set(State#state.tty), + State. + +-spec disable_reader(state()) -> ok. +disable_reader(#state{ reader = {ReaderPid, _} }) -> + ok = call(ReaderPid, disable). + +-spec enable_reader(state()) -> ok. +enable_reader(#state{ reader = {ReaderPid, _} }) -> + ok = call(ReaderPid, enable). + +call(Pid, Msg) -> + Alias = erlang:monitor(process, Pid, [{alias, reply_demonitor}]), + Pid ! {Alias, Msg}, + receive + {Alias, Reply} -> + Reply; + {'DOWN',Alias,_,_,Reason} -> + {error, Reason} + end. + +reader([TTY, Parent]) -> + register(user_drv_reader, self()), + ReaderRef = make_ref(), + SignalRef = make_ref(), + ok = tty_select(TTY, SignalRef, ReaderRef), + proc_lib:init_ack({ok, {self(), ReaderRef}}), + FromEnc = case os:type() of + {unix, _} -> utf8; + {win32, _} -> + case isatty(stdin) of + true -> + {utf16, little}; + _ -> + %% When not reading from a console + %% the data read is utf8 encoded + utf8 + end + end, + reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, <<>>). + +reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc) -> + receive + {DisableAlias, disable} -> + DisableAlias ! {DisableAlias, ok}, + receive + {EnableAlias, enable} -> + EnableAlias ! {EnableAlias, ok}, + reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc) + end; + {select, TTY, SignalRef, ready_input} -> + {ok, Signal} = tty_read_signal(TTY, SignalRef), + Parent ! {ReaderRef,{signal,Signal}}, + reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc); + {Alias, {set_unicode_state, _}} when FromEnc =:= {utf16, little} -> + %% Ignore requests on windows + Alias ! {Alias, true}, + reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc); + {Alias, {set_unicode_state, Bool}} -> + Alias ! {Alias, FromEnc =/= latin1}, + NewFromEnc = if Bool -> utf8; not Bool -> latin1 end, + reader_loop(TTY, Parent, SignalRef, ReaderRef, NewFromEnc, Acc); + {_Alias, stop} -> + ok; + {select, TTY, ReaderRef, ready_input} -> + case read_nif(TTY, ReaderRef) of + {error, closed} -> + Parent ! {ReaderRef, eof}, + ok; + {ok, <<>>} -> + %% EAGAIN or EINTR + reader_loop(TTY, Parent, SignalRef, ReaderRef, FromEnc, Acc); + {ok, UtfXBytes} -> + + {Bytes, NewAcc, NewFromEnc} = + case unicode:characters_to_binary([Acc, UtfXBytes], FromEnc, utf8) of + {error, B, Error} -> + %% We should only be able to get incorrect encoded data when + %% using utf8 (i.e. we are on unix) + FromEnc = utf8, + Parent ! {self(), set_unicode_state, false}, + receive + {Alias, {set_unicode_state, false}} -> + Alias ! {Alias, true} + end, + receive + {Parent, set_unicode_state, true} -> ok + end, + Latin1Chars = unicode:characters_to_binary(Error, latin1, utf8), + {<<B/binary,Latin1Chars/binary>>, <<>>, latin1}; + {incomplete, B, Inc} -> + {B, Inc, FromEnc}; + B when is_binary(B) -> + {B, <<>>, FromEnc} + end, + Parent ! {ReaderRef, {data, Bytes}}, + reader_loop(TTY, Parent, SignalRef, ReaderRef, NewFromEnc, NewAcc) + end + end. + +writer(TTY) -> + register(user_drv_writer, self()), + WriterRef = make_ref(), + proc_lib:init_ack({ok, {self(), WriterRef}}), + writer_loop(TTY, WriterRef). + +-spec write(state(), unicode:chardata()) -> ok. +write(#state{ writer = {WriterPid, _}}, Chars) -> + WriterPid ! {write, erlang:iolist_to_iovec(Chars)}, ok. +-spec write(state(), unicode:chardata(), From :: pid()) -> {ok, reference()}. +write(#state{ writer = {WriterPid, _WriterRef}}, Chars, From) -> + Ref = erlang:monitor(process, WriterPid), + WriterPid ! {write, From, erlang:iolist_to_iovec(Chars)}, + {ok, Ref}. + +writer_loop(TTY, WriterRef) -> + receive + {write, []} -> + writer_loop(TTY, WriterRef); + {write, Chars} -> + _ = write_nif(TTY, Chars), + writer_loop(TTY, WriterRef); + {write, From, []} -> + From ! {WriterRef, ok}, + writer_loop(TTY, WriterRef); + {write, From, Chars} -> + case write_nif(TTY, Chars) of + ok -> + From ! {WriterRef, ok}, + writer_loop(TTY, WriterRef); + {error, Reason} -> + exit(self(), Reason) + end + end. + +-spec handle_request(state(), request()) -> {erlang:iovec(), state()}. +handle_request(State = #state{ options = #{ tty := false } }, Request) -> + case Request of + {putc, Binary} -> + {encode(Binary, State#state.unicode), State}; + beep -> + {<<7>>, State}; + _Ignore -> + {<<>>, State} + end; +%% Clear the expand buffer after the cursor when we handle any request. +handle_request(State = #state{ buffer_expand = Expand, unicode = U }, Request) + when Expand =/= undefined -> + BBCols = cols(State#state.buffer_before, U), + BACols = cols(State#state.buffer_after, U), + ClearExpand = [move_cursor(State, BBCols, BBCols + BACols), + State#state.delete_after_cursor, + move_cursor(State, BBCols + BACols, BBCols)], + {Output, NewState} = handle_request(State#state{ buffer_expand = undefined }, Request), + {[ClearExpand, encode(Output, U)], NewState}; +%% Print characters in the expandbuffer after the cursor +handle_request(State = #state{ unicode = U }, {expand, Binary}) -> + BBCols = cols(State#state.buffer_before, U), + BACols = cols(State#state.buffer_after, U), + Expand = iolist_to_binary(["\r\n",string:trim(Binary, both)]), + MoveToEnd = move_cursor(State, BBCols, BBCols + BACols), + {ExpandBuffer, NewState} = insert_buf(State#state{ buffer_expand = [] }, Expand), + BECols = cols(NewState#state.cols, BBCols + BACols, NewState#state.buffer_expand, U), + MoveToOrig = move_cursor(State, BECols, BBCols), + {[MoveToEnd, encode(ExpandBuffer, U), MoveToOrig], NewState}; +%% putc prints Binary and overwrites any existing characters +handle_request(State = #state{ unicode = U }, {putc, Binary}) -> + %% Todo should handle invalid unicode? + {PutBuffer, NewState} = insert_buf(State, Binary), + if NewState#state.buffer_after =:= [] -> + {encode(PutBuffer, U), NewState}; + true -> + %% Delete any overwritten characters after current the cursor + OldLength = logical(State#state.buffer_before), + NewLength = logical(NewState#state.buffer_before), + {_, _, _, NewBA} = split(NewLength - OldLength, NewState#state.buffer_after, U), + {encode(PutBuffer, U), NewState#state{ buffer_after = NewBA }} + end; +handle_request(State = #state{ unicode = U }, {delete, N}) when N > 0 -> + {_DelNum, DelCols, _, NewBA} = split(N, State#state.buffer_after, U), + BBCols = cols(State#state.buffer_before, U), + NewBACols = cols(NewBA, U), + {[encode(NewBA, U), + lists:duplicate(DelCols, $\s), + xnfix(State, BBCols + NewBACols + DelCols), + move_cursor(State, + BBCols + NewBACols + DelCols, + BBCols)], + State#state{ buffer_after = NewBA }}; +handle_request(State = #state{ unicode = U }, {delete, N}) when N < 0 -> + {_DelNum, DelCols, _, NewBB} = split(-N, State#state.buffer_before, U), + NewBBCols = cols(NewBB, U), + BACols = cols(State#state.buffer_after, U), + {[move_cursor(State, NewBBCols + DelCols, NewBBCols), + encode(State#state.buffer_after,U), + lists:duplicate(DelCols, $\s), + xnfix(State, NewBBCols + BACols + DelCols), + move_cursor(State, NewBBCols + BACols + DelCols, NewBBCols)], + State#state{ buffer_before = NewBB } }; +handle_request(State, {delete, 0}) -> + {"",State}; +handle_request(State = #state{ unicode = U }, {move, N}) when N < 0 -> + {_DelNum, DelCols, NewBA, NewBB} = split(-N, State#state.buffer_before, U), + NewBBCols = cols(NewBB, U), + Moves = move_cursor(State, NewBBCols + DelCols, NewBBCols), + {Moves, State#state{ buffer_before = NewBB, + buffer_after = NewBA ++ State#state.buffer_after} }; +handle_request(State = #state{ unicode = U }, {move, N}) when N > 0 -> + {_DelNum, DelCols, NewBB, NewBA} = split(N, State#state.buffer_after, U), + BBCols = cols(State#state.buffer_before, U), + {move_cursor(State, BBCols, BBCols + DelCols), + State#state{ buffer_after = NewBA, + buffer_before = NewBB ++ State#state.buffer_before} }; +handle_request(State, {move, 0}) -> + {"",State}; +handle_request(State = #state{ xn = OrigXn, unicode = U }, {insert, Chars}) -> + {InsertBuffer, NewState0} = insert_buf(State#state{ xn = false }, Chars), + NewState = NewState0#state{ xn = OrigXn }, + BBCols = cols(NewState#state.buffer_before, U), + BACols = cols(NewState#state.buffer_after, U), + {[ encode(InsertBuffer, U), + encode(NewState#state.buffer_after, U), + xnfix(State, BBCols + BACols), + move_cursor(State, BBCols + BACols, BBCols) ], + NewState}; +handle_request(State, beep) -> + {<<7>>, State}; +handle_request(State, clear) -> + {State#state.clear, State}; +handle_request(State, Req) -> + erlang:display({unhandled_request, Req}), + {"", State}. + +%% Split the buffer after N logical characters returning +%% the number of real characters deleted and the column length +%% of those characters +split(N, Buff, Unicode) -> + ?dbg({?FUNCTION_NAME, N, Buff, Unicode}), + split(N, Buff, [], 0, 0, Unicode). +split(0, Buff, Acc, Chars, Cols, _Unicode) -> + ?dbg({?FUNCTION_NAME, {Chars, Cols, Acc, Buff}}), + {Chars, Cols, Acc, Buff}; +split(N, _Buff, _Acc, _Chars, _Cols, _Unicode) when N < 0 -> + ok = N; +split(_N, [], Acc, Chars, Cols, _Unicode) -> + {Chars, Cols, Acc, []}; +split(N, [Char | T], Acc, Cnt, Cols, Unicode) when is_integer(Char) -> + split(N - 1, T, [Char | Acc], Cnt + 1, Cols + npwcwidth(Char, Unicode), Unicode); +split(N, [Chars | T], Acc, Cnt, Cols, Unicode) when is_list(Chars) -> + split(N - length(Chars), T, [Chars | Acc], + Cnt + length(Chars), Cols + cols(Chars, Unicode), Unicode); +split(N, [SkipChars | T], Acc, Cnt, Cols, Unicode) when is_binary(SkipChars) -> + split(N, T, [SkipChars | Acc], Cnt, Cols, Unicode). + +logical([]) -> + 0; +logical([Char | T]) when is_integer(Char) -> + 1 + logical(T); +logical([Chars | T]) when is_list(Chars) -> + length(Chars) + logical(T); +logical([SkipChars | T]) when is_binary(SkipChars) -> + logical(T). + +move_cursor(#state{ cols = W } = State, FromCol, ToCol) -> + ?dbg({?FUNCTION_NAME, FromCol, ToCol}), + [case (ToCol div W) - (FromCol div W) of + 0 -> ""; + N when N < 0 -> + ?dbg({move, up, -N}), + move(up, State, -N); + N -> + ?dbg({move, down, N}), + move(down, State, N) + end, + case (ToCol rem W) - (FromCol rem W) of + 0 -> ""; + N when N < 0 -> + ?dbg({down, left, -N}), + move(left, State, -N); + N -> + ?dbg({down, right, N}), + move(right, State, N) + end]. + +move(up, #state{ up = Up }, N) -> + lists:duplicate(N, Up); +move(down, #state{ down = Down }, N) -> + lists:duplicate(N, Down); +move(left, #state{ left = Left }, N) -> + lists:duplicate(N, Left); +move(right, #state{ right = Right }, N) -> + lists:duplicate(N, Right). + +cols([],_Unicode) -> + 0; +cols([Char | T], Unicode) when is_integer(Char) -> + npwcwidth(Char, Unicode) + cols(T, Unicode); +cols([Chars | T], Unicode) when is_list(Chars) -> + cols(Chars, Unicode) + cols(T, Unicode); +cols([SkipSeq | T], Unicode) when is_binary(SkipSeq) -> + %% Any binary should be an ANSI escape sequence + %% so we skip that + cols(T, Unicode). + +cols(ColsPerLine, CurrCols, Chars, Unicode) when CurrCols > ColsPerLine -> + ColsPerLine + cols(ColsPerLine, CurrCols - ColsPerLine, Chars, Unicode); +cols(_ColsPerLine, CurrCols, [], _Unicode) -> + CurrCols; +cols(ColsPerLine, CurrCols, ["\r\n" | T], Unicode) -> + CurrCols + (ColsPerLine - CurrCols) + cols(ColsPerLine, 0, T, Unicode); +cols(ColsPerLine, CurrCols, [H | T], Unicode) -> + cols(ColsPerLine, CurrCols + cols([H], Unicode), T, Unicode). + +update_geometry(State) -> + case tty_window_size(State#state.tty) of + {ok, {Cols, Rows}} when Cols > 0 -> + ?dbg({?FUNCTION_NAME, Cols}), + State#state{ cols = Cols, rows = Rows }; + _Error -> + ?dbg({?FUNCTION_NAME, _Error}), + State + end. + +npwcwidthstring(String) when is_list(String) -> + npwcwidthstring(unicode:characters_to_binary(String)); +npwcwidthstring(String) -> + case string:next_grapheme(String) of + [] -> 0; + [$\e | Rest] -> + case re:run(String, ?ANSI_REGEXP, [unicode]) of + {match, [{0, N}]} -> + <<_Ansi:N/binary, AnsiRest/binary>> = String, + npwcwidthstring(AnsiRest); + _ -> + npwcwidth($\e) + npwcwidthstring(Rest) + end; + [H|Rest] -> npwcwidth(H) + npwcwidthstring(Rest) + end. + +npwcwidth(Char) -> + npwcwidth(Char, true). +npwcwidth(Char, true) -> + case wcwidth(Char) of + {error, not_printable} -> 0; + {error, enotsup} -> + case unicode_util:is_wide(Char) of + true -> 2; + false -> 1 + end; + C -> C + end; +npwcwidth(Char, false) -> + byte_size(char_to_latin1(Char)). + + +%% Return the xn fix for the current cursor position. +%% We use get_position to figure out if we need to calculate the current columns +%% or not. +%% +%% We need to know the actual column because get_position will return the last +%% column number when the cursor is: +%% * in the last column +%% * off screen +%% +%% and it is when the cursor is off screen that we should do the xnfix. +xnfix(#state{ position = _, unicode = U } = State) -> + xnfix(State, cols(State#state.buffer_before, U)). +%% Return the xn fix for CurrCols location. +xnfix(#state{ xn = true, cols = Cols } = State, CurrCols) + when CurrCols =/= 0, CurrCols rem Cols == 0 -> + [<<"\s">>,move(left, State, 1)]; +xnfix(_, _CurrCols) -> + ?dbg({xnfix, _CurrCols}), + []. + +characters_to_output(Chars) -> + try unicode:characters_to_binary(Chars) of + Binary -> + Binary + catch error:badarg -> + unicode:characters_to_binary( + lists:map( + fun({ansi, Ansi}) -> + Ansi; + (Char) -> + Char + end, Chars) + ) + end. +characters_to_buffer(Chars) -> + lists:flatmap( + fun({ansi, _Ansi}) -> + ""; + (Char) -> + [Char] + end, Chars). + +insert_buf(State, Binary) when is_binary(Binary) -> + insert_buf(State, Binary, [], []). +insert_buf(State, Bin, LineAcc, Acc) -> + case string:next_grapheme(Bin) of + [] when State#state.buffer_expand =/= undefined -> + Expand = lists:reverse(LineAcc), + {[Acc, characters_to_output(Expand)], + State#state{ buffer_expand = characters_to_buffer(Expand) }}; + [] -> + NewBB = characters_to_buffer(LineAcc) ++ State#state.buffer_before, + NewState = State#state{ buffer_before = NewBB }, + {[Acc, characters_to_output(lists:reverse(LineAcc)), xnfix(NewState)], + NewState}; + [$\t | Rest] -> + insert_buf(State, Rest, [State#state.tab | LineAcc], Acc); + [$\e | Rest] -> + case ansi_sgr(Bin) of + none -> + case re:run(Bin, State#state.ansi_regexp) of + {match, [{0, N}]} -> + %% Any other ansi sequences are just printed and + %% then dropped as they "should" not effect rendering + <<Ansi:N/binary, AnsiRest/binary>> = Bin, + insert_buf(State, AnsiRest, [{ansi, Ansi} | LineAcc], Acc); + _ -> + insert_buf(State, Rest, [$\e | LineAcc], Acc) + end; + {Ansi, AnsiRest} -> + %% We include the graphics ansi sequences in the + %% buffer that we step over + insert_buf(State, AnsiRest, [Ansi | LineAcc], Acc) + end; + [NLCR | Rest] when NLCR =:= $\n; NLCR =:= $\r -> + Tail = + if NLCR =:= $\n -> + <<$\r,$\n>>; + true -> + <<$\r>> + end, + if State#state.buffer_expand =:= undefined -> + insert_buf(State#state{ buffer_before = [], buffer_after = [] }, Rest, [], + [Acc, [characters_to_output(lists:reverse(LineAcc)), Tail]]); + true -> + insert_buf(State, Rest, [binary_to_list(Tail) | LineAcc], Acc) + end; + [Cluster | Rest] when is_list(Cluster) -> + insert_buf(State, Rest, [Cluster | LineAcc], Acc); + %% We have gotten a code point that may be part of the previous grapheme cluster. + [Char | Rest] when Char >= 128, LineAcc =:= [], State#state.buffer_before =/= [], + State#state.buffer_expand =:= undefined -> + [PrevChar | BB] = State#state.buffer_before, + case string:next_grapheme([PrevChar | Bin]) of + [PrevChar | _] -> + %% It was not part of the previous cluster, so just insert + %% it as a normal character + insert_buf(State, Rest, [Char | LineAcc], Acc); + [Cluster | ClusterRest] -> + %% It was part of the previous grapheme cluster, so we output + %% it and insert it into the before_buffer + %% TODO: If an xnfix was done on PrevChar, + %% then we should rewrite the entire grapheme cluster. + {_, ToWrite} = lists:split(length(lists:flatten([PrevChar])), Cluster), + insert_buf(State#state{ buffer_before = [Cluster | BB] }, + ClusterRest, LineAcc, + [Acc, unicode:characters_to_binary(ToWrite)]) + end; + [Char | Rest] when Char >= 128 -> + insert_buf(State, Rest, [Char | LineAcc], Acc); + [Char | Rest] -> + case {isprint(Char), Char} of + {true,_} -> + insert_buf(State, Rest, [Char | LineAcc], Acc); + {false, 8#177} -> %% DEL + insert_buf(State, Rest, ["^?" | LineAcc], Acc); + {false, _} -> + insert_buf(State, Rest, ["^" ++ [Char bor 8#40] | LineAcc], Acc) + end + end. + +%% ANSI Select Graphic Rendition parameters: +%% https://en.wikipedia.org/wiki/ANSI_escape_code#SGR +%% This function replicates this regex pattern <<"^[\e",194,155,"]\\[[0-9;:]*m">> +%% calling re:run/2 nif on compiled regex_pattern was significantly +%% slower than this implementation. +ansi_sgr(<<N, $[, Rest/binary>>=Bin) when N =:= $\e; N =:= 194; N =:= 155 -> + case ansi_sgr(Rest, 2) of + {ok, Size} -> + <<Result:Size/binary, Bin1/binary>> = Bin, + {Result, Bin1}; + none -> none + end; +ansi_sgr(<<_/binary>>) -> none. +ansi_sgr(<<M, Rest/binary>>, Size) when $0 =< M, M =< $; -> + ansi_sgr(Rest, Size + 1); +ansi_sgr(<<$m, _Rest/binary>>, Size) -> + {ok, Size + 1}; +ansi_sgr(<<_/binary>>, _) -> none. + +-spec to_latin1(erlang:binary()) -> erlang:iovec(). +to_latin1(Bin) -> + case is_usascii(Bin) of + true -> [Bin]; + false -> lists:flatten([binary_to_latin1(Bin)]) + end. + +is_usascii(<<Char/utf8,T/binary>>) when Char < 128 -> + is_usascii(T); +is_usascii(<<>>) -> + true; +is_usascii(_) -> + false. + +binary_to_latin1(Buffer) -> + [char_to_latin1(CP) || CP <- unicode:characters_to_list(Buffer)]. +char_to_latin1(UnicodeChar) when UnicodeChar >= 512 -> + <<"\\x{",(integer_to_binary(UnicodeChar, 16))/binary,"}">>; +char_to_latin1(UnicodeChar) when UnicodeChar >= 128 -> + <<"\\",(integer_to_binary(UnicodeChar, 8))/binary>>; +char_to_latin1(UnicodeChar) -> + <<UnicodeChar>>. + +encode(UnicodeChars, true) -> + unicode:characters_to_binary(UnicodeChars); +encode(UnicodeChars, false) -> + to_latin1(unicode:characters_to_binary(UnicodeChars)). + +%% Using get_position adds about 10ms of latency +%% get_position(#state{ position = false }) -> +%% unknown; +%% get_position(State) -> +%% [] = write(State, State#state.position), +%% get_position(State, <<>>). +%% get_position(State, Acc) -> +%% receive +%% {select,TTY,Ref,ready_input} +%% when TTY =:= State#state.tty, +%% Ref =:= State#state.read -> +%% {Bytes, <<>>} = read_input(State#state{ acc = Acc }), +%% case re:run(Bytes, State#state.position_reply, [unicode]) of +%% {match,[{Start,Length},Row,Col]} -> +%% <<Before:Start/binary,_:Length/binary,After/binary>> = Bytes, +%% %% This should be put in State in order to not screw up the +%% %% message order... +%% [State#state.parent ! {{self(), State#state.tty}, {data, <<Before/binary, After/binary>>}} +%% || Before =/= <<>>, After =/= <<>>], +%% {binary_to_integer(binary:part(Bytes,Row)), +%% binary_to_integer(binary:part(Bytes,Col))}; +%% nomatch -> +%% get_position(State, Bytes) +%% end +%% after 1000 -> +%% unknown +%% end. + +-ifdef(debug). +dbg(_) -> + ok. +-endif. + +%% Nif functions +-spec isatty(stdin | stdout | stderr) -> boolean() | ebadf. +isatty(_Fd) -> + erlang:nif_error(undef). +tty_create() -> + erlang:nif_error(undef). +tty_init(_TTY, _Fd, _Options) -> + erlang:nif_error(undef). +tty_set(_TTY) -> + erlang:nif_error(undef). +setlocale(_TTY) -> + erlang:nif_error(undef). +tty_select(_TTY, _SignalRef, _ReadRef) -> + erlang:nif_error(undef). +write_nif(_TTY, _IOVec) -> + erlang:nif_error(undef). +read_nif(_TTY, _Ref) -> + erlang:nif_error(undef). +tty_window_size(_TTY) -> + erlang:nif_error(undef). +isprint(_Char) -> + erlang:nif_error(undef). +wcwidth(_Char) -> + erlang:nif_error(undef). +sizeof_wchar() -> + erlang:nif_error(undef). +wcswidth(_Char) -> + erlang:nif_error(undef). +tgetent(Char) -> + tgetent_nif([Char,0]). +tgetnum(Char) -> + tgetnum_nif([Char,0]). +tgetflag(Char) -> + tgetflag_nif([Char,0]). +tgetstr(Char) -> + tgetstr_nif([Char,0]). +tgoto(Char, Arg) -> + tgoto_nif([Char,0], Arg). +tgoto(Char, Arg1, Arg2) -> + tgoto_nif([Char,0], Arg1, Arg2). +tgetent_nif(_Char) -> + erlang:nif_error(undef). +tgetnum_nif(_Char) -> + erlang:nif_error(undef). +tgetflag_nif(_Char) -> + erlang:nif_error(undef). +tgetstr_nif(_Char) -> + erlang:nif_error(undef). +tgoto_nif(_Ent, _Arg) -> + erlang:nif_error(undef). +tgoto_nif(_Ent, _Arg1, _Arg2) -> + erlang:nif_error(undef). +tty_read_signal(_TTY, _Ref) -> + erlang:nif_error(undef). + diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index d537e21239..47c4355f10 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2020. All Rights Reserved. +%% Copyright Ericsson AB 1998-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -74,7 +74,7 @@ set_token(Type, Val) -> get_token() -> element(2,process_info(self(),sequential_trace_token)). --spec get_token(Component) -> {Component, Val} when +-spec get_token(Component) -> [] | {Component, Val} when Component :: component(), Val :: value(). get_token(Type) -> diff --git a/lib/kernel/src/socket.erl b/lib/kernel/src/socket.erl index ccacb84293..02e199d088 100644 --- a/lib/kernel/src/socket.erl +++ b/lib/kernel/src/socket.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2020-2022. All Rights Reserved. +%% Copyright Ericsson AB 2020-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -36,6 +36,7 @@ debug/1, socket_debug/1, use_registry/1, info/0, info/1, i/0, i/1, i/2, + tables/0, table/1, monitor/1, cancel_monitor/1, supports/0, supports/1, supports/2, is_supported/1, is_supported/2, is_supported/3, @@ -87,6 +88,10 @@ select_handle/0, select_info/0, + completion_tag/0, + completion_handle/0, + completion_info/0, + invalid/0, socket_counters/0, @@ -151,15 +156,18 @@ %% We need #file_descriptor{} for sendfile/2,3,4,5 -include("file_int.hrl"). +%% -define(DBG(T), erlang:display({{self(), ?MODULE, ?LINE, ?FUNCTION_NAME}, T})). + %% Also in prim_socket -define(REGISTRY, socket_registry). -type invalid() :: {invalid, What :: term()}. -type info() :: - #{counters := #{atom() := non_neg_integer()}, - iov_max := non_neg_integer(), - use_registry := boolean()}. + #{counters := #{atom() := non_neg_integer()}, + iov_max := non_neg_integer(), + use_registry := boolean(), + io_backend := #{name := atom()}}. -type socket_counters() :: #{read_byte := non_neg_integer(), read_fails := non_neg_integer(), @@ -771,18 +779,27 @@ %% Interface term formats %% --opaque select_tag() :: atom() | {atom(), ContData :: term()}. +-opaque select_tag() :: atom() | {atom(), ContData :: term()}. +-opaque completion_tag() :: atom(). % | {atom(), ContData :: term()}. -type select_handle() :: reference(). +-type completion_handle() :: reference(). -type select_info() :: {select_info, SelectTag :: select_tag(), SelectHandle :: select_handle()}. +-type completion_info() :: + {completion_info, + CompletionTag :: completion_tag(), + CompletionHandle :: completion_handle()}. -define(SELECT_INFO(Tag, SelectHandle), {select_info, Tag, SelectHandle}). +-define(COMPLETION_INFO(Tag, CompletionHandle), + {completion_info, Tag, CompletionHandle}). + %% =========================================================================== %% @@ -988,6 +1005,17 @@ use_registry(D) when is_boolean(D) -> prim_socket:use_registry(D). +tables() -> + #{protocols => table(protocols), + options => table(options), + ioctl_requests => table(ioctl_requests), + ioctl_flags => table(ioctl_flags), + msg_flags => table(msg_flags)}. + +table(Table) -> + prim_socket:p_get(Table). + + %% =========================================================================== %% %% i/0,1,2 - List sockets @@ -1111,12 +1139,23 @@ i_socket_info(_Proto, _Socket, #{domain := Domain} = _Info, domain) -> atom_to_list(Domain); i_socket_info(_Proto, _Socket, #{type := Type} = _Info, type) -> string:to_upper(atom_to_list(Type)); -i_socket_info(Proto, _Socket, _Info, protocol) -> - string:to_upper(atom_to_list(Proto)); +i_socket_info(Proto, _Socket, #{type := Type} = _Info, protocol) -> + string:to_upper(atom_to_list(if + (Proto =:= 0) -> + case Type of + stream -> tcp; + dgram -> udp; + _ -> unknown + end; + true -> + Proto + end)); i_socket_info(_Proto, Socket, _Info, fd) -> - case socket:getopt(Socket, otp, fd) of + try socket:getopt(Socket, otp, fd) of {ok, FD} -> integer_to_list(FD); {error, _} -> " " + catch + _:_ -> " " end; i_socket_info(_Proto, _Socket, #{owner := Pid} = _Info, owner) -> pid_to_list(Pid); @@ -1128,11 +1167,14 @@ i_socket_info(Proto, Socket, _Info, local_address) -> " " end; i_socket_info(Proto, Socket, _Info, remote_address) -> - case peername(Socket) of + try peername(Socket) of {ok, Addr} -> fmt_sockaddr(Addr, Proto); {error, _} -> " " + catch + _:_ -> + " " end; i_socket_info(_Proto, _Socket, #{counters := #{read_byte := N}} = _Info, recv) -> @@ -1552,59 +1594,77 @@ connect(Socket, SockAddr) -> -spec connect(Socket, SockAddr, Timeout :: 'nowait') -> 'ok' | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - SockAddr :: sockaddr(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid() | 'already'; - - (Socket, SockAddr, SelectHandle :: select_handle()) -> + Socket :: socket(), + SockAddr :: sockaddr(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid() | 'already' | + 'not_bound' | + {add_socket, posix()} | + {update_connect_context, posix()}; + + (Socket, SockAddr, Handle :: select_handle() | completion_handle()) -> 'ok' | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - SockAddr :: sockaddr(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid() | 'already'; + Socket :: socket(), + SockAddr :: sockaddr(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid() | 'already' | + 'not_bound' | + {add_socket, posix()} | + {update_connect_context, posix()}; (Socket, SockAddr, Timeout :: 'infinity') -> 'ok' | {'error', Reason} when Socket :: socket(), SockAddr :: sockaddr(), - Reason :: posix() | 'closed' | invalid() | 'already'; + Reason :: posix() | 'closed' | invalid() | 'already' | + 'not_bound' | + {add_socket, posix()} | + {update_connect_context, posix()}; (Socket, SockAddr, Timeout :: non_neg_integer()) -> 'ok' | {'error', Reason} when Socket :: socket(), SockAddr :: sockaddr(), - Reason :: posix() | 'closed' | invalid() | 'already' | 'timeout'. + Reason :: posix() | 'closed' | invalid() | 'already' | + 'not_bound' | 'timeout' | + {add_socket, posix()} | + {update_connect_context, posix()}. %% <KOLLA> %% Is it possible to connect with family = local for the (dest) sockaddr? %% </KOLLA> -connect(?socket(SockRef), SockAddr, Timeout) +connect(?socket(SockRef), SockAddr, TimeoutOrHandle) when is_reference(SockRef) -> - case deadline(Timeout) of + case deadline(TimeoutOrHandle) of invalid -> - erlang:error({invalid, {timeout, Timeout}}); + erlang:error({invalid, {timeout, TimeoutOrHandle}}); nowait -> - SelectHandle = make_ref(), - connect_nowait(SockRef, SockAddr, SelectHandle); - select_handle -> - SelectHandle = Timeout, - connect_nowait(SockRef, SockAddr, SelectHandle); + Handle = make_ref(), + connect_nowait(SockRef, SockAddr, Handle); + handle -> + Handle = TimeoutOrHandle, + connect_nowait(SockRef, SockAddr, Handle); Deadline -> connect_deadline(SockRef, SockAddr, Deadline) end; connect(Socket, SockAddr, Timeout) -> erlang:error(badarg, [Socket, SockAddr, Timeout]). -connect_nowait(SockRef, SockAddr, SelectHandle) -> - case prim_socket:connect(SockRef, SelectHandle, SockAddr) of +connect_nowait(SockRef, SockAddr, Handle) -> + case prim_socket:connect(SockRef, Handle, SockAddr) of select -> - {select, ?SELECT_INFO(connect, SelectHandle)}; + {select, ?SELECT_INFO(connect, Handle)}; + completion -> + {completion, ?COMPLETION_INFO(connect, Handle)}; Result -> Result end. @@ -1624,6 +1684,18 @@ connect_deadline(SockRef, SockAddr, Deadline) -> _ = cancel(SockRef, connect, Ref), {error, timeout} end; + completion -> + %% Connecting... + Timeout = timeout(Deadline), + receive + ?socket_msg(_Socket, completion, {Ref, CompletionStatus}) -> + CompletionStatus; + ?socket_msg(_Socket, abort, {Ref, Reason}) -> + {error, Reason} + after Timeout -> + _ = cancel(SockRef, connect, Ref), + {error, timeout} + end; Result -> Result end. @@ -1650,7 +1722,7 @@ connect(Socket) -> -spec listen(Socket) -> 'ok' | {'error', Reason} when Socket :: socket(), - Reason :: posix() | 'closed'. + Reason :: posix() | 'closed' | 'not_bound'. listen(Socket) -> listen(Socket, ?ESOCK_LISTEN_BACKLOG_DEFAULT). @@ -1683,34 +1755,50 @@ accept(ListenSocket) -> -spec accept(ListenSocket, Timeout :: 'nowait') -> {'ok', Socket} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when ListenSocket :: socket(), Socket :: socket(), SelectInfo :: select_info(), - Reason :: posix() | closed | invalid(); + CompletionInfo :: completion_info(), + Reason :: posix() | closed | invalid() | + {create_accept_socket, posix()} | + {add_accept_socket, posix()} | + {update_accept_context, posix()}; - (ListenSocket, SelectHandle :: select_handle()) -> + (ListenSocket, Handle :: select_handle() | completion_handle()) -> {'ok', Socket} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when ListenSocket :: socket(), Socket :: socket(), SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid() | + {create_accept_socket, posix()} | + {add_socket, posix()} | + {update_accept_context, posix()}; (ListenSocket, Timeout :: 'infinity') -> {'ok', Socket} | {'error', Reason} when ListenSocket :: socket(), Socket :: socket(), - Reason :: posix() | 'closed' | invalid(); + Reason :: posix() | 'closed' | invalid() | + {create_accept_socket, posix()} | + {add_socket, posix()} | + {update_accept_context, posix()}; (ListenSocket, Timeout :: non_neg_integer()) -> {'ok', Socket} | {'error', Reason} when ListenSocket :: socket(), Socket :: socket(), - Reason :: posix() | 'closed' | invalid() | 'timeout'. + Reason :: posix() | 'closed' | invalid() | 'timeout' | + {create_accept_socket, posix()} | + {add_socket, posix()} | + {update_accept_context, posix()}. accept(?socket(LSockRef), Timeout) when is_reference(LSockRef) -> @@ -1718,23 +1806,25 @@ accept(?socket(LSockRef), Timeout) invalid -> erlang:error({invalid, {timeout, Timeout}}); nowait -> - SelectHandle = make_ref(), - accept_nowait(LSockRef, SelectHandle); - select_handle -> - SelectHandle = Timeout, - accept_nowait(LSockRef, SelectHandle); + Handle = make_ref(), + accept_nowait(LSockRef, Handle); + handle -> + Handle = Timeout, + accept_nowait(LSockRef, Handle); Deadline -> accept_deadline(LSockRef, Deadline) end; accept(ListenSocket, Timeout) -> erlang:error(badarg, [ListenSocket, Timeout]). -accept_nowait(LSockRef, SelectHandle) -> - case prim_socket:accept(LSockRef, SelectHandle) of +accept_nowait(LSockRef, Handle) -> + case prim_socket:accept(LSockRef, Handle) of select -> - {select, ?SELECT_INFO(accept, SelectHandle)}; + {select, ?SELECT_INFO(accept, Handle)}; + completion -> + {completion, ?COMPLETION_INFO(accept, Handle)}; Result -> - accept_result(LSockRef, SelectHandle, Result) + accept_result(LSockRef, Handle, Result) end. accept_deadline(LSockRef, Deadline) -> @@ -1754,6 +1844,22 @@ accept_deadline(LSockRef, Deadline) -> _ = cancel(LSockRef, accept, AccRef), {error, timeout} end; + completion -> + %% Each call is non-blocking, but even then it takes + %% *some* time, so just to be sure, recalculate before + %% the receive. + Timeout = timeout(Deadline), + receive + %% CompletionStatus = {ok, Socket} | {error, Reason} + ?socket_msg(?socket(LSockRef), completion, + {AccRef, CompletionStatus}) -> + CompletionStatus; + ?socket_msg(_Socket, abort, {AccRef, Reason}) -> + {error, Reason} + after Timeout -> + _ = cancel(LSockRef, accept, AccRef), + {error, timeout} + end; Result -> accept_result(LSockRef, AccRef, Result) end. @@ -1814,31 +1920,35 @@ send(Socket, Data) -> RestData :: binary(), Reason :: posix() | 'closed' | invalid(); - (Socket, Data, SelectHandle :: 'nowait') -> + (Socket, Data, Handle :: 'nowait') -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Data, SelectHandle :: select_handle()) -> + Socket :: socket(), + Data :: iodata(), + RestData :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Data, Handle :: select_handle() | completion_handle()) -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Data :: iodata(), + RestData :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Timeout :: 'infinity') -> 'ok' | @@ -1870,33 +1980,37 @@ send(Socket, Data, Timeout) -> send(Socket, Data, ?ESOCK_SEND_FLAGS_DEFAULT, Timeout). --spec send(Socket, Data, Flags, SelectHandle :: 'nowait') -> +-spec send(Socket, Data, Flags, Handle :: 'nowait') -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Flags :: [msg_flag() | integer()], - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Data, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + Data :: iodata(), + Flags :: [msg_flag() | integer()], + RestData :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Data, Flags, Handle :: select_handle() | completion_handle()) -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Flags :: [msg_flag() | integer()], - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Data :: iodata(), + Flags :: [msg_flag() | integer()], + RestData :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Flags, Timeout :: 'infinity') -> 'ok' | @@ -1929,12 +2043,12 @@ send(Socket, Data, Timeout) -> {'select', {SelectInfo, RestData}} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Cont :: select_info(), - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Data :: iodata(), + Cont :: select_info(), + RestData :: binary(), + SelectInfo :: select_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Cont, SelectHandle :: select_handle()) -> 'ok' | @@ -1984,7 +2098,7 @@ send(?socket(SockRef), Data, ?SELECT_INFO(SelectTag, _) = Cont, Timeout) nowait -> SelectHandle = make_ref(), send_nowait_cont(SockRef, Data, ContData, SelectHandle); - select_handle -> + handle -> SelectHandle = Timeout, send_nowait_cont(SockRef, Data, ContData, SelectHandle); Deadline -> @@ -2001,11 +2115,11 @@ send(?socket(SockRef), Data, Flags, Timeout) invalid -> erlang:error({invalid, {timeout, Timeout}}); nowait -> - SelectHandle = make_ref(), - send_nowait(SockRef, Data, Flags, SelectHandle); - select_handle -> - SelectHandle = Timeout, - send_nowait(SockRef, Data, Flags, SelectHandle); + Handle = make_ref(), + send_nowait(SockRef, Data, Flags, Handle); + handle -> + Handle = Timeout, + send_nowait(SockRef, Data, Flags, Handle); Deadline -> send_deadline(SockRef, Data, Flags, Deadline) end; @@ -2024,40 +2138,45 @@ send(?socket(SockRef) = Socket, Data, Flags, Timeout) send(Socket, Data, Flags, Timeout) -> erlang:error(badarg, [Socket, Data, Flags, Timeout]). -send_nowait(SockRef, Bin, Flags, SelectHandle) -> +send_nowait(SockRef, Bin, Flags, Handle) -> send_common_nowait_result( - SelectHandle, send, - prim_socket:send(SockRef, Bin, Flags, SelectHandle)). + Handle, send, + prim_socket:send(SockRef, Bin, Flags, Handle)). +%% On Windows, writes either succeed directly (it their entirety), +%% they are scheduled (completion) or they fail. *No* partial success, +%% and therefor no need to handle theme here (in cont). send_nowait_cont(SockRef, Bin, Cont, SelectHandle) -> send_common_nowait_result( SelectHandle, send, prim_socket:send(SockRef, Bin, Cont, SelectHandle)). send_deadline(SockRef, Bin, Flags, Deadline) -> - SelectHandle = make_ref(), + Handle = make_ref(), HasWritten = false, send_common_deadline_result( - SockRef, Bin, SelectHandle, Deadline, HasWritten, + SockRef, Bin, Handle, Deadline, HasWritten, send, fun send_deadline_cont/5, - prim_socket:send(SockRef, Bin, Flags, SelectHandle)). + prim_socket:send(SockRef, Bin, Flags, Handle)). send_deadline_cont(SockRef, Bin, Cont, Deadline, HasWritten) -> - SelectHandle = make_ref(), + Handle = make_ref(), send_common_deadline_result( - SockRef, Bin, SelectHandle, Deadline, HasWritten, + SockRef, Bin, Handle, Deadline, HasWritten, send, fun send_deadline_cont/5, - prim_socket:send(SockRef, Bin, Cont, SelectHandle)). + prim_socket:send(SockRef, Bin, Cont, Handle)). -compile({inline, [send_common_nowait_result/3]}). -send_common_nowait_result(SelectHandle, Op, Result) -> +send_common_nowait_result(Handle, Op, Result) -> case Result of + completion -> + {completion, ?COMPLETION_INFO(Op, Handle)}; {select, ContData} -> - {select, ?SELECT_INFO({Op, ContData}, SelectHandle)}; + {select, ?SELECT_INFO({Op, ContData}, Handle)}; {select, Data, ContData} -> - {select, {?SELECT_INFO({Op, ContData}, SelectHandle), Data}}; + {select, {?SELECT_INFO({Op, ContData}, Handle), Data}}; %% Result -> Result @@ -2065,7 +2184,7 @@ send_common_nowait_result(SelectHandle, Op, Result) -> -compile({inline, [send_common_deadline_result/8]}). send_common_deadline_result( - SockRef, Data, SelectHandle, Deadline, HasWritten, + SockRef, Data, Handle, Deadline, HasWritten, Op, Fun, SendResult) -> %% case SendResult of @@ -2073,26 +2192,40 @@ send_common_deadline_result( %% Would block, wait for continuation Timeout = timeout(Deadline), receive - ?socket_msg(_Socket, select, SelectHandle) -> + ?socket_msg(_Socket, select, Handle) -> Fun(SockRef, Data, Cont, Deadline, HasWritten); - ?socket_msg(_Socket, abort, {SelectHandle, Reason}) -> + ?socket_msg(_Socket, abort, {Handle, Reason}) -> send_common_error(Reason, Data, HasWritten) after Timeout -> - _ = cancel(SockRef, Op, SelectHandle), + _ = cancel(SockRef, Op, Handle), send_common_error(timeout, Data, HasWritten) end; {select, Data_1, Cont} -> %% Partial send success, wait for continuation Timeout = timeout(Deadline), receive - ?socket_msg(_Socket, select, SelectHandle) -> + ?socket_msg(_Socket, select, Handle) -> Fun(SockRef, Data_1, Cont, Deadline, true); - ?socket_msg(_Socket, abort, {SelectHandle, Reason}) -> + ?socket_msg(_Socket, abort, {Handle, Reason}) -> send_common_error(Reason, Data_1, true) after Timeout -> - _ = cancel(SockRef, Op, SelectHandle), + _ = cancel(SockRef, Op, Handle), send_common_error(timeout, Data_1, true) end; + + completion -> + %% Would block, wait for continuation + Timeout = timeout(Deadline), + receive + ?socket_msg(_Socket, completion, {Handle, CompletionStatus}) -> + CompletionStatus; + ?socket_msg(_Socket, abort, {Handle, Reason}) -> + send_common_error(Reason, Data, false) + after Timeout -> + _ = cancel(SockRef, Op, Handle), + send_common_error(timeout, Data, false) + end; + %% {error, {_Reason, RestIOV}} = Error when is_list(RestIOV) -> Error; @@ -2165,45 +2298,49 @@ sendto(Socket, Data, Dest_Cont) -> RestData :: binary(), Reason :: posix() | 'closed' | invalid(); - (Socket, Data, Dest, SelectHandle :: 'nowait') -> + (Socket, Data, Dest, Handle :: 'nowait') -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Dest :: sockaddr(), - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Data, Dest, SelectHandle :: select_handle()) -> + Socket :: socket(), + Data :: iodata(), + Dest :: sockaddr(), + RestData :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Data, Dest, Handle :: select_handle() | completion_handle()) -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Dest :: sockaddr(), - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Data :: iodata(), + Dest :: sockaddr(), + RestData :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Dest, Timeout :: 'infinity') -> 'ok' | {'ok', RestData} | {'error', Reason} | {'error', {Reason, RestData}} - when - Socket :: socket(), - Data :: iodata(), - Dest :: sockaddr(), - RestData :: binary(), - Reason :: posix() | 'closed' | invalid(); + when + Socket :: socket(), + Data :: iodata(), + Dest :: sockaddr(), + RestData :: binary(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Dest, Timeout :: non_neg_integer()) -> 'ok' | @@ -2224,12 +2361,12 @@ sendto(Socket, Data, Dest_Cont) -> {'select', {SelectInfo, RestData}} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Cont :: select_info(), - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Data :: iodata(), + Cont :: select_info(), + RestData :: binary(), + SelectInfo :: select_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Cont, SelectHandle :: select_handle()) -> 'ok' | @@ -2238,12 +2375,12 @@ sendto(Socket, Data, Dest_Cont) -> {'select', {SelectInfo, RestData}} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Cont :: select_info(), - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Data :: iodata(), + Cont :: select_info(), + RestData :: binary(), + SelectInfo :: select_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Cont, Timeout :: 'infinity') -> 'ok' | @@ -2301,35 +2438,39 @@ sendto(Socket, Data, Dest, Timeout) -> sendto(Socket, Data, Dest, ?ESOCK_SENDTO_FLAGS_DEFAULT, Timeout). --spec sendto(Socket, Data, Dest, Flags, SelectHandle :: 'nowait') -> +-spec sendto(Socket, Data, Dest, Flags, Handle :: 'nowait') -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Dest :: sockaddr(), - Flags :: [msg_flag() | integer()], - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Data, Dest, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + Data :: iodata(), + Dest :: sockaddr(), + Flags :: [msg_flag() | integer()], + RestData :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Data, Dest, Flags, Handle :: select_handle() | completion_handle()) -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Data :: iodata(), - Dest :: sockaddr(), - Flags :: [msg_flag() | integer()], - RestData :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Data :: iodata(), + Dest :: sockaddr(), + Flags :: [msg_flag() | integer()], + RestData :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Dest, Flags, Timeout :: 'infinity') -> 'ok' | @@ -2366,9 +2507,9 @@ sendto(?socket(SockRef), Data, Dest, Flags, Timeout) nowait -> SelectHandle = make_ref(), sendto_nowait(SockRef, Data, Dest, Flags, SelectHandle); - select_handle -> - SelectHandle = Timeout, - sendto_nowait(SockRef, Data, Dest, Flags, SelectHandle); + handle -> + Handle = Timeout, + sendto_nowait(SockRef, Data, Dest, Flags, Handle); Deadline -> HasWritten = false, sendto_deadline(SockRef, Data, Dest, Flags, Deadline, HasWritten) @@ -2395,37 +2536,38 @@ sendto_timeout_cont(SockRef, Bin, Cont, Timeout) -> nowait -> SelectHandle = make_ref(), sendto_nowait_cont(SockRef, Bin, Cont, SelectHandle); - select_handle -> - SelectHandle = Timeout, - sendto_nowait_cont(SockRef, Bin, Cont, SelectHandle); + handle -> + Handle = Timeout, + sendto_nowait_cont(SockRef, Bin, Cont, Handle); Deadline -> HasWritten = false, sendto_deadline_cont(SockRef, Bin, Cont, Deadline, HasWritten) end. -sendto_nowait(SockRef, Bin, To, Flags, SelectHandle) -> +sendto_nowait(SockRef, Bin, To, Flags, Handle) -> send_common_nowait_result( - SelectHandle, sendto, - prim_socket:sendto(SockRef, Bin, To, Flags, SelectHandle)). + Handle, sendto, + prim_socket:sendto(SockRef, Bin, To, Flags, Handle)). -sendto_nowait_cont(SockRef, Bin, Cont, SelectHandle) -> +sendto_nowait_cont(SockRef, Bin, Cont, Handle) -> send_common_nowait_result( - SelectHandle, sendto, - prim_socket:sendto(SockRef, Bin, Cont, SelectHandle)). + Handle, sendto, + prim_socket:sendto(SockRef, Bin, Cont, Handle)). sendto_deadline(SockRef, Bin, To, Flags, Deadline, HasWritten) -> - SelectHandle = make_ref(), + Handle = make_ref(), send_common_deadline_result( - SockRef, Bin, SelectHandle, Deadline, HasWritten, + SockRef, Bin, Handle, Deadline, HasWritten, sendto, fun sendto_deadline_cont/5, - prim_socket:sendto(SockRef, Bin, To, Flags, SelectHandle)). + prim_socket:sendto(SockRef, Bin, To, Flags, Handle)). sendto_deadline_cont(SockRef, Bin, Cont, Deadline, HasWritten) -> - SelectHandle = make_ref(), + Handle = make_ref(), send_common_deadline_result( - SockRef, Bin, SelectHandle, Deadline, HasWritten, + SockRef, Bin, Handle, Deadline, HasWritten, sendto, fun sendto_deadline_cont/5, - prim_socket:sendto(SockRef, Bin, Cont, SelectHandle)). + prim_socket:sendto(SockRef, Bin, Cont, Handle)). + %% --------------------------------------------------------------------------- %% @@ -2480,28 +2622,32 @@ sendmsg(Socket, Msg) -> {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, RestData}} when - Socket :: socket(), - Msg :: msg_send(), - RestData :: erlang:iovec(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Msg, SelectHandle :: select_handle()) -> + Socket :: socket(), + Msg :: msg_send(), + RestData :: erlang:iovec(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Msg, Handle :: select_handle() | completion_handle()) -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, RestData}} when - Socket :: socket(), - Msg :: msg_send(), - RestData :: erlang:iovec(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Msg :: msg_send(), + RestData :: erlang:iovec(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Msg, Timeout :: 'infinity') -> 'ok' | @@ -2533,35 +2679,39 @@ sendmsg(Socket, Msg, Timeout) -> sendmsg(Socket, Msg, ?ESOCK_SENDMSG_FLAGS_DEFAULT, Timeout). --spec sendmsg(Socket, Msg, Flags, SelectHandle :: 'nowait') -> +-spec sendmsg(Socket, Msg, Flags, Timeout :: 'nowait') -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, RestData}} when - Socket :: socket(), - Msg :: msg_send(), - Flags :: [msg_flag() | integer()], - RestData :: erlang:iovec(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Msg, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + Msg :: msg_send(), + Flags :: [msg_flag() | integer()], + RestData :: erlang:iovec(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Msg, Flags, Handle :: select_handle() | completion_handle()) -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, RestData}} when - Socket :: socket(), - Msg :: msg_send(), - Flags :: [msg_flag() | integer()], - RestData :: erlang:iovec(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Msg :: msg_send(), + Flags :: [msg_flag() | integer()], + RestData :: erlang:iovec(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Msg, Flags, Timeout :: 'infinity') -> 'ok' | @@ -2587,20 +2737,22 @@ sendmsg(Socket, Msg, Timeout) -> RestData :: erlang:iovec(), Reason :: posix() | 'closed' | invalid(); - (Socket, Data, Cont, SelectHandle :: 'nowait') -> + (Socket, Data, Cont, Timeout :: 'nowait') -> 'ok' | {'ok', RestData} | {'select', SelectInfo} | {'select', {SelectInfo, RestData}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, RestData}} when - Socket :: socket(), - Data :: msg_send() | erlang:iovec(), - Cont :: select_info(), - RestData :: erlang:iovec(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Data :: msg_send() | erlang:iovec(), + Cont :: select_info(), + RestData :: erlang:iovec(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Data, Cont, SelectHandle :: select_handle()) -> 'ok' | @@ -2664,11 +2816,11 @@ sendmsg(?socket(SockRef), #{iov := IOV} = Msg, Flags, Timeout) invalid -> erlang:error({invalid, {timeout, Timeout}}); nowait -> - SelectHandle = make_ref(), - sendmsg_nowait(SockRef, Msg, Flags, SelectHandle, IOV); - select_handle -> - SelectHandle = Timeout, - sendmsg_nowait(SockRef, Msg, Flags, SelectHandle, IOV); + Handle = make_ref(), + sendmsg_nowait(SockRef, Msg, Flags, Handle, IOV); + handle -> + Handle = Timeout, + sendmsg_nowait(SockRef, Msg, Flags, Handle, IOV); Deadline -> HasWritten = false, sendmsg_deadline(SockRef, Msg, Flags, Deadline, HasWritten, IOV) @@ -2683,7 +2835,7 @@ sendmsg_timeout_cont(SockRef, RestData, Cont, Timeout) -> nowait -> SelectHandle = make_ref(), sendmsg_nowait_cont(SockRef, RestData, Cont, SelectHandle); - select_handle -> + handle -> SelectHandle = Timeout, sendmsg_nowait_cont(SockRef, RestData, Cont, SelectHandle); Deadline -> @@ -2692,10 +2844,10 @@ sendmsg_timeout_cont(SockRef, RestData, Cont, Timeout) -> SockRef, RestData, Cont, Deadline, HasWritten) end. -sendmsg_nowait(SockRef, Msg, Flags, SelectHandle, IOV) -> +sendmsg_nowait(SockRef, Msg, Flags, Handle, IOV) -> send_common_nowait_result( - SelectHandle, sendmsg, - prim_socket:sendmsg(SockRef, Msg, Flags, SelectHandle, IOV)). + Handle, sendmsg, + prim_socket:sendmsg(SockRef, Msg, Flags, Handle, IOV)). sendmsg_nowait_cont(SockRef, RestData, Cont, SelectHandle) -> send_common_nowait_result( @@ -2703,11 +2855,11 @@ sendmsg_nowait_cont(SockRef, RestData, Cont, SelectHandle) -> prim_socket:sendmsg(SockRef, RestData, Cont, SelectHandle)). sendmsg_deadline(SockRef, Msg, Flags, Deadline, HasWritten, IOV) -> - SelectHandle = make_ref(), + Handle = make_ref(), send_common_deadline_result( - SockRef, IOV, SelectHandle, Deadline, HasWritten, + SockRef, IOV, Handle, Deadline, HasWritten, sendmsg, fun sendmsg_deadline_cont/5, - prim_socket:sendmsg(SockRef, Msg, Flags, SelectHandle, IOV)). + prim_socket:sendmsg(SockRef, Msg, Flags, Handle, IOV)). sendmsg_deadline_cont(SockRef, Data, Cont, Deadline, HasWritten) -> SelectHandle = make_ref(), @@ -2716,6 +2868,7 @@ sendmsg_deadline_cont(SockRef, Data, Cont, Deadline, HasWritten) -> sendmsg, fun sendmsg_deadline_cont/5, prim_socket:sendmsg(SockRef, Data, Cont, SelectHandle)). + %% =========================================================================== %% %% sendfile - send a file on a socket @@ -2901,7 +3054,7 @@ sendfile_int(SockRef, State, Timeout) -> nowait -> SelectHandle = make_ref(), sendfile_nowait(SockRef, State, SelectHandle); - select_handle -> + handle -> SelectHandle = Timeout, sendfile_nowait(SockRef, State, SelectHandle); Deadline -> @@ -3043,52 +3196,55 @@ recv(Socket) -> recv(Socket, Flags) when is_list(Flags) -> recv(Socket, 0, Flags, ?ESOCK_RECV_TIMEOUT_DEFAULT); -recv(Socket, Length) -> - recv( - Socket, Length, - ?ESOCK_RECV_FLAGS_DEFAULT, ?ESOCK_RECV_TIMEOUT_DEFAULT). +recv(Socket, Length) when is_integer(Length) andalso (Length >= 0) -> + recv(Socket, Length, + ?ESOCK_RECV_FLAGS_DEFAULT, ?ESOCK_RECV_TIMEOUT_DEFAULT). --spec recv(Socket, Flags, SelectHandle :: 'nowait') -> +-spec recv(Socket, Flags, Handle :: 'nowait') -> {'ok', Data} | {'select', SelectInfo} | {'select', {SelectInfo, Data}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Flags :: [msg_flag() | integer()], - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + Flags :: [msg_flag() | integer()], + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Flags, Handle :: select_handle() | completion_handle()) -> {'ok', Data} | {'select', SelectInfo} | {'select', {SelectInfo, Data}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Flags :: [msg_flag() | integer()], - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Flags :: [msg_flag() | integer()], + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Flags, Timeout :: 'infinity') -> {'ok', Data} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), + Socket :: socket(), Flags :: [msg_flag() | integer()], - Data :: binary(), - Reason :: posix() | 'closed' | invalid(); + Data :: binary(), + Reason :: posix() | 'closed' | invalid(); (Socket, Flags, Timeout :: non_neg_integer()) -> {'ok', Data} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), + Socket :: socket(), Flags :: [msg_flag() | integer()], - Data :: binary(), - Reason :: posix() | 'closed' | invalid() | 'timeout'; + Data :: binary(), + Reason :: posix() | 'closed' | invalid() | 'timeout'; (Socket, Length, Flags) -> {'ok', Data} | @@ -3100,47 +3256,51 @@ recv(Socket, Length) -> Data :: binary(), Reason :: posix() | 'closed' | invalid(); - (Socket, Length, SelectHandle :: 'nowait') -> + (Socket, Length, Handle :: 'nowait') -> {'ok', Data} | {'select', SelectInfo} | {'select', {SelectInfo, Data}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Length :: non_neg_integer(), - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Length, SelectHandle :: select_handle()) -> + Socket :: socket(), + Length :: non_neg_integer(), + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Length, Handle :: select_handle() | completion_handle()) -> {'ok', Data} | {'select', SelectInfo} | {'select', {SelectInfo, Data}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Length :: non_neg_integer(), - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Length :: non_neg_integer(), + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Length, Timeout :: 'infinity') -> {'ok', Data} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Length :: non_neg_integer(), - Data :: binary(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Length :: non_neg_integer(), + Data :: binary(), + Reason :: posix() | 'closed' | invalid(); (Socket, Length, Timeout :: non_neg_integer()) -> {'ok', Data} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Length :: non_neg_integer(), - Data :: binary(), - Reason :: posix() | 'closed' | invalid() | 'timeout'. + Socket :: socket(), + Length :: non_neg_integer(), + Data :: binary(), + Reason :: posix() | 'closed' | invalid() | 'timeout'. recv(Socket, Flags, Timeout) when is_list(Flags) -> recv(Socket, 0, Flags, Timeout); @@ -3149,31 +3309,35 @@ recv(Socket, Length, Flags) when is_list(Flags) -> recv(Socket, Length, Timeout) -> recv(Socket, Length, ?ESOCK_RECV_FLAGS_DEFAULT, Timeout). --spec recv(Socket, Length, Flags, SelectHandle :: 'nowait') -> +-spec recv(Socket, Length, Flags, Handle :: 'nowait') -> {'ok', Data} | {'select', SelectInfo} | {'select', {SelectInfo, Data}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Length :: non_neg_integer(), - Flags :: [msg_flag() | integer()], - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Length, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + Length :: non_neg_integer(), + Flags :: [msg_flag() | integer()], + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Length, Flags, Handle :: select_handle() | completion_handle()) -> {'ok', Data} | {'select', SelectInfo} | {'select', {SelectInfo, Data}} | + {'completion', CompletionInfo} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Length :: non_neg_integer(), - Flags :: [msg_flag() | integer()], - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Length :: non_neg_integer(), + Flags :: [msg_flag() | integer()], + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Length, Flags, Timeout :: 'infinity') -> {'ok', Data} | @@ -3189,11 +3353,11 @@ recv(Socket, Length, Timeout) -> {'ok', Data} | {'error', Reason} | {'error', {Reason, Data}} when - Socket :: socket(), - Length :: non_neg_integer(), - Flags :: [msg_flag() | integer()], - Data :: binary(), - Reason :: posix() | 'closed' | invalid() | 'timeout'. + Socket :: socket(), + Length :: non_neg_integer(), + Flags :: [msg_flag() | integer()], + Data :: binary(), + Reason :: posix() | 'closed' | invalid() | 'timeout'. recv(?socket(SockRef), Length, Flags, Timeout) when is_reference(SockRef), @@ -3203,11 +3367,11 @@ recv(?socket(SockRef), Length, Flags, Timeout) invalid -> erlang:error({invalid, {timeout, Timeout}}); nowait -> - SelectHandle = make_ref(), - recv_nowait(SockRef, Length, Flags, SelectHandle, <<>>); - select_handle -> - SelectHandle = Timeout, - recv_nowait(SockRef, Length, Flags, SelectHandle, <<>>); + Handle = make_ref(), + recv_nowait(SockRef, Length, Flags, Handle, <<>>); + handle -> + Handle = Timeout, + recv_nowait(SockRef, Length, Flags, Handle, <<>>); zero -> case prim_socket:recv(SockRef, Length, Flags, zero) of ok -> @@ -3224,8 +3388,8 @@ recv(Socket, Length, Flags, Timeout) -> %% We will only recurse with Length == 0 if Length is 0, %% so Length == 0 means to return all available data also when recursing -recv_nowait(SockRef, Length, Flags, SelectHandle, Acc) -> - case prim_socket:recv(SockRef, Length, Flags, SelectHandle) of +recv_nowait(SockRef, Length, Flags, Handle, Acc) -> + case prim_socket:recv(SockRef, Length, Flags, Handle) of {more, Bin} -> %% We got what we requested but will not waste more time %% although there might be more data available @@ -3233,23 +3397,28 @@ recv_nowait(SockRef, Length, Flags, SelectHandle, Acc) -> {select, Bin} -> %% We got less than requested so the caller will %% get a select message when there might be more to read - {select, {?SELECT_INFO(recv, SelectHandle), bincat(Acc, Bin)}}; + {select, {?SELECT_INFO(recv, Handle), bincat(Acc, Bin)}}; select -> %% The caller will get a select message when there %% might be data to read if byte_size(Acc) =:= 0 -> - {select, ?SELECT_INFO(recv, SelectHandle)}; + {select, ?SELECT_INFO(recv, Handle)}; true -> - {select, {?SELECT_INFO(recv, SelectHandle), Acc}} + {select, {?SELECT_INFO(recv, Handle), Acc}} end; + completion -> + %% The caller will get a completion message (with the + %% result) when the data arrives. *No* further action + %% is required. + {completion, ?COMPLETION_INFO(recv, Handle)}; Result -> recv_result(Acc, Result) end. recv_deadline(SockRef, Length, Flags, Deadline, Acc) -> - SelectHandle = make_ref(), - case prim_socket:recv(SockRef, Length, Flags, SelectHandle) of + Handle = make_ref(), + case prim_socket:recv(SockRef, Length, Flags, Handle) of {more, Bin} -> %% There is more data readily available %% - repeat unless time's up @@ -3262,12 +3431,13 @@ recv_deadline(SockRef, Length, Flags, Deadline, Acc) -> true -> {ok, bincat(Acc, Bin)} end; + %% {select, Bin} -> %% We got less than requested Timeout = timeout(Deadline), receive - ?socket_msg(?socket(SockRef), select, SelectHandle) -> + ?socket_msg(?socket(SockRef), select, Handle) -> if 0 < Timeout -> %% Recv more @@ -3277,10 +3447,10 @@ recv_deadline(SockRef, Length, Flags, Deadline, Acc) -> true -> {error, {timeout, bincat(Acc, Bin)}} end; - ?socket_msg(_Socket, abort, {SelectHandle, Reason}) -> + ?socket_msg(_Socket, abort, {Handle, Reason}) -> {error, {Reason, bincat(Acc, Bin)}} after Timeout -> - _ = cancel(SockRef, recv, SelectHandle), + _ = cancel(SockRef, recv, Handle), {error, {timeout, bincat(Acc, Bin)}} end; %% @@ -3288,14 +3458,15 @@ recv_deadline(SockRef, Length, Flags, Deadline, Acc) -> %% We first got some data and are then asked to wait, %% but we only want the first that comes %% - cancel and return what we have - _ = cancel(SockRef, recv, SelectHandle), + _ = cancel(SockRef, recv, Handle), {ok, Acc}; + %% select -> %% There is nothing just now, but we will be notified when there %% is something to read (a select message). Timeout = timeout(Deadline), receive - ?socket_msg(?socket(SockRef), select, SelectHandle) -> + ?socket_msg(?socket(SockRef), select, Handle) -> if 0 < Timeout -> %% Retry @@ -3304,12 +3475,62 @@ recv_deadline(SockRef, Length, Flags, Deadline, Acc) -> true -> recv_error(Acc, timeout) end; - ?socket_msg(_Socket, abort, {SelectHandle, Reason}) -> + ?socket_msg(_Socket, abort, {Handle, Reason}) -> recv_error(Acc, Reason) after Timeout -> - _ = cancel(SockRef, recv, SelectHandle), + _ = cancel(SockRef, recv, Handle), recv_error(Acc, timeout) end; + + %% + completion -> + %% There is nothing just now, but we will be notified when the + %% data has been read (with a completion message). + Timeout = timeout(Deadline), + receive + ?socket_msg(?socket(SockRef), completion, + {Handle, {ok, _Bin} = OK}) + when (Length =:= 0) -> + recv_result(Acc, OK); + ?socket_msg(?socket(SockRef), completion, + {Handle, {ok, Bin} = OK}) + when (Length =:= byte_size(Bin)) -> + recv_result(Acc, OK); + ?socket_msg(?socket(SockRef), completion, + {Handle, {ok, Bin}}) -> + if + 0 < Timeout -> + %% Recv more + recv_deadline( + SockRef, Length - byte_size(Bin), Flags, + Deadline, bincat(Acc, Bin)); + true -> + {error, {timeout, bincat(Acc, Bin)}} + end; + ?socket_msg(?socket(SockRef), completion, + {Handle, {error, Reason}}) -> + recv_error(Acc, Reason); + ?socket_msg(_Socket, abort, {Handle, Reason}) -> + recv_error(Acc, Reason) + after Timeout -> + _ = cancel(SockRef, recv, Handle), + recv_error(Acc, timeout) + end; + + %% We got some data, but not all + {ok, Bin} when (Length > byte_size(Bin)) -> + Timeout = timeout(Deadline), + if + 0 < Timeout -> + %% Recv more + recv_deadline( + SockRef, Length - byte_size(Bin), Flags, + Deadline, bincat(Acc, Bin)); + true -> + {error, {timeout, bincat(Acc, Bin)}} + end; + + %% Result -> recv_result(Acc, Result) end. @@ -3332,6 +3553,7 @@ recv_error(Acc, Reason) -> {error, {Reason, Acc}} end. + %% --------------------------------------------------------------------------- %% %% With recvfrom we get messages, which means that regardless of how @@ -3382,27 +3604,31 @@ recvfrom(Socket, BufSz) -> ?ESOCK_RECV_FLAGS_DEFAULT, ?ESOCK_RECV_TIMEOUT_DEFAULT). --spec recvfrom(Socket, Flags, SelectHandle :: 'nowait') -> +-spec recvfrom(Socket, Flags, Handle :: 'nowait') -> {'ok', {Source, Data}} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Flags :: [msg_flag() | integer()], - Source :: sockaddr_recv(), - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + Flags :: [msg_flag() | integer()], + Source :: sockaddr_recv(), + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Flags, Handle :: select_handle() | completion_handle()) -> {'ok', {Source, Data}} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Flags :: [msg_flag() | integer()], - Source :: sockaddr_recv(), - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Flags :: [msg_flag() | integer()], + Source :: sockaddr_recv(), + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Flags, Timeout :: 'infinity') -> {'ok', {Source, Data}} | @@ -3432,27 +3658,31 @@ recvfrom(Socket, BufSz) -> Data :: binary(), Reason :: posix() | 'closed' | invalid(); - (Socket, BufSz, SelectHandle :: 'nowait') -> + (Socket, BufSz, Handle :: 'nowait') -> {'ok', {Source, Data}} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - BufSz :: non_neg_integer(), - Source :: sockaddr_recv(), - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, BufSz, SelectHandle :: select_handle()) -> + Socket :: socket(), + BufSz :: non_neg_integer(), + Source :: sockaddr_recv(), + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, BufSz, Handle :: select_handle() | completion_handle()) -> {'ok', {Source, Data}} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - BufSz :: non_neg_integer(), - Source :: sockaddr_recv(), - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + BufSz :: non_neg_integer(), + Source :: sockaddr_recv(), + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, BufSz, Timeout :: 'infinity') -> {'ok', {Source, Data}} | @@ -3479,29 +3709,33 @@ recvfrom(Socket, BufSz, Flags) when is_list(Flags) -> recvfrom(Socket, BufSz, Timeout) -> recvfrom(Socket, BufSz, ?ESOCK_RECV_FLAGS_DEFAULT, Timeout). --spec recvfrom(Socket, BufSz, Flags, SelectHandle :: 'nowait') -> +-spec recvfrom(Socket, BufSz, Flags, Handle :: 'nowait') -> {'ok', {Source, Data}} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - BufSz :: non_neg_integer(), - Flags :: [msg_flag() | integer()], - Source :: sockaddr_recv(), - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, BufSz, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + BufSz :: non_neg_integer(), + Flags :: [msg_flag() | integer()], + Source :: sockaddr_recv(), + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, BufSz, Flags, Handle :: select_handle() | completion_handle()) -> {'ok', {Source, Data}} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - BufSz :: non_neg_integer(), - Flags :: [msg_flag() | integer()], - Source :: sockaddr_recv(), - Data :: binary(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + BufSz :: non_neg_integer(), + Flags :: [msg_flag() | integer()], + Source :: sockaddr_recv(), + Data :: binary(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, BufSz, Flags, Timeout :: 'infinity') -> {'ok', {Source, Data}} | @@ -3531,11 +3765,11 @@ recvfrom(?socket(SockRef), BufSz, Flags, Timeout) invalid -> erlang:error({invalid, {timeout, Timeout}}); nowait -> - SelectHandle = make_ref(), - recvfrom_nowait(SockRef, BufSz, SelectHandle, Flags); - select_handle -> - SelectHandle = Timeout, - recvfrom_nowait(SockRef, BufSz, SelectHandle, Flags); + Handle = make_ref(), + recvfrom_nowait(SockRef, BufSz, Handle, Flags); + handle -> + Handle = Timeout, + recvfrom_nowait(SockRef, BufSz, Handle, Flags); zero -> case prim_socket:recvfrom(SockRef, BufSz, Flags, zero) of ok -> @@ -3549,30 +3783,48 @@ recvfrom(?socket(SockRef), BufSz, Flags, Timeout) recvfrom(Socket, BufSz, Flags, Timeout) -> erlang:error(badarg, [Socket, BufSz, Flags, Timeout]). -recvfrom_nowait(SockRef, BufSz, SelectHandle, Flags) -> - case prim_socket:recvfrom(SockRef, BufSz, Flags, SelectHandle) of - select -> - {select, ?SELECT_INFO(recvfrom, SelectHandle)}; +recvfrom_nowait(SockRef, BufSz, Handle, Flags) -> + case prim_socket:recvfrom(SockRef, BufSz, Flags, Handle) of + select = Tag -> + {Tag, ?SELECT_INFO(recvfrom, Handle)}; + completion = Tag -> + {Tag, ?COMPLETION_INFO(recvfrom, Handle)}; Result -> recvfrom_result(Result) end. recvfrom_deadline(SockRef, BufSz, Flags, Deadline) -> - SelectHandle = make_ref(), - case prim_socket:recvfrom(SockRef, BufSz, Flags, SelectHandle) of + Handle = make_ref(), + case prim_socket:recvfrom(SockRef, BufSz, Flags, Handle) of select -> %% There is nothing just now, but we will be notified when there %% is something to read (a select message). Timeout = timeout(Deadline), receive - ?socket_msg(?socket(SockRef), select, SelectHandle) -> + ?socket_msg(?socket(SockRef), select, Handle) -> recvfrom_deadline(SockRef, BufSz, Flags, Deadline); - ?socket_msg(_Socket, abort, {SelectHandle, Reason}) -> + ?socket_msg(_Socket, abort, {Handle, Reason}) -> {error, Reason} after Timeout -> - _ = cancel(SockRef, recvfrom, SelectHandle), + _ = cancel(SockRef, recvfrom, Handle), {error, timeout} end; + + completion -> + %% There is nothing just now, but we will be notified when there + %% is something to read (a completion message). + Timeout = timeout(Deadline), + receive + ?socket_msg(?socket(SockRef), completion, + {Handle, CompletionStatus}) -> + recvfrom_result(CompletionStatus); + ?socket_msg(_Socket, abort, {Handle, Reason}) -> + {error, Reason} + after Timeout -> + _ = cancel(SockRef, recvfrom, Handle), + {error, timeout} + end; + Result -> recvfrom_result(Result) end. @@ -3612,20 +3864,24 @@ recvmsg(Socket) -> (Socket, Timeout :: 'nowait') -> {'ok', Msg} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Msg :: msg_recv(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Msg :: msg_recv(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); - (Socket, SelectHandle :: select_handle()) -> + (Socket, Handle :: select_handle() | completion_handle()) -> {'ok', Msg} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Msg :: msg_recv(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Msg :: msg_recv(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Timeout :: 'infinity') -> {'ok', Msg} | @@ -3647,27 +3903,31 @@ recvmsg(Socket, Timeout) -> recvmsg(Socket, 0, 0, ?ESOCK_RECV_FLAGS_DEFAULT, Timeout). --spec recvmsg(Socket, BufSz, CtrlSz, SelectHandle :: 'nowait') -> +-spec recvmsg(Socket, BufSz, CtrlSz, Timeout :: 'nowait') -> {'ok', Msg} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - BufSz :: non_neg_integer(), - CtrlSz :: non_neg_integer(), - Msg :: msg_recv(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, BufSz, CtrlSz, SelectHandle :: select_handle()) -> + Socket :: socket(), + BufSz :: non_neg_integer(), + CtrlSz :: non_neg_integer(), + Msg :: msg_recv(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, BufSz, CtrlSz, Handle :: select_handle() | completion_handle()) -> {'ok', Msg} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - BufSz :: non_neg_integer(), - CtrlSz :: non_neg_integer(), - Msg :: msg_recv(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + BufSz :: non_neg_integer(), + CtrlSz :: non_neg_integer(), + Msg :: msg_recv(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, BufSz, CtrlSz, Timeout :: 'infinity') -> {'ok', Msg} | @@ -3694,22 +3954,26 @@ recvmsg(Socket, BufSz, CtrlSz, Timeout) -> -spec recvmsg(Socket, Flags, Timeout :: 'nowait') -> {'ok', Msg} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Flags :: [msg_flag() | integer()], - Msg :: msg_recv(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + Flags :: [msg_flag() | integer()], + Msg :: msg_recv(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, Flags, Handle :: select_handle() | completion_handle()) -> {'ok', Msg} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - Flags :: [msg_flag() | integer()], - Msg :: msg_recv(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + Flags :: [msg_flag() | integer()], + Msg :: msg_recv(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, Flags, Timeout :: 'infinity') -> {'ok', Msg} | @@ -3743,29 +4007,33 @@ recvmsg(Socket, BufSz, CtrlSz) when is_integer(BufSz), is_integer(CtrlSz) -> ?ESOCK_RECV_FLAGS_DEFAULT, ?ESOCK_RECV_TIMEOUT_DEFAULT). --spec recvmsg(Socket, BufSz, CtrlSz, Flags, SelectHandle :: 'nowait') -> +-spec recvmsg(Socket, BufSz, CtrlSz, Flags, Timeout :: 'nowait') -> {'ok', Msg} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - BufSz :: non_neg_integer(), - CtrlSz :: non_neg_integer(), - Flags :: [msg_flag() | integer()], - Msg :: msg_recv(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); - - (Socket, BufSz, CtrlSz, Flags, SelectHandle :: select_handle()) -> + Socket :: socket(), + BufSz :: non_neg_integer(), + CtrlSz :: non_neg_integer(), + Flags :: [msg_flag() | integer()], + Msg :: msg_recv(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); + + (Socket, BufSz, CtrlSz, Flags, Handle :: select_handle() | completion_handle()) -> {'ok', Msg} | {'select', SelectInfo} | + {'completion', CompletionInfo} | {'error', Reason} when - Socket :: socket(), - BufSz :: non_neg_integer(), - CtrlSz :: non_neg_integer(), - Flags :: [msg_flag() | integer()], - Msg :: msg_recv(), - SelectInfo :: select_info(), - Reason :: posix() | 'closed' | invalid(); + Socket :: socket(), + BufSz :: non_neg_integer(), + CtrlSz :: non_neg_integer(), + Flags :: [msg_flag() | integer()], + Msg :: msg_recv(), + SelectInfo :: select_info(), + CompletionInfo :: completion_info(), + Reason :: posix() | 'closed' | invalid(); (Socket, BufSz, CtrlSz, Flags, Timeout :: 'infinity') -> {'ok', Msg} | @@ -3796,11 +4064,11 @@ recvmsg(?socket(SockRef), BufSz, CtrlSz, Flags, Timeout) invalid -> erlang:error({invalid, {timeout, Timeout}}); nowait -> - SelectHandle = make_ref(), - recvmsg_nowait(SockRef, BufSz, CtrlSz, Flags, SelectHandle); - select_handle -> - SelectHandle = Timeout, - recvmsg_nowait(SockRef, BufSz, CtrlSz, Flags, SelectHandle); + Handle = make_ref(), + recvmsg_nowait(SockRef, BufSz, CtrlSz, Flags, Handle); + handle -> + Handle = Timeout, + recvmsg_nowait(SockRef, BufSz, CtrlSz, Flags, Handle); zero -> case prim_socket:recvmsg(SockRef, BufSz, CtrlSz, Flags, zero) of ok -> @@ -3814,36 +4082,55 @@ recvmsg(?socket(SockRef), BufSz, CtrlSz, Flags, Timeout) recvmsg(Socket, BufSz, CtrlSz, Flags, Timeout) -> erlang:error(badarg, [Socket, BufSz, CtrlSz, Flags, Timeout]). -recvmsg_nowait(SockRef, BufSz, CtrlSz, Flags, SelectHandle) -> - case prim_socket:recvmsg(SockRef, BufSz, CtrlSz, Flags, SelectHandle) of +recvmsg_nowait(SockRef, BufSz, CtrlSz, Flags, Handle) -> + case prim_socket:recvmsg(SockRef, BufSz, CtrlSz, Flags, Handle) of select -> - {select, ?SELECT_INFO(recvmsg, SelectHandle)}; + {select, ?SELECT_INFO(recvmsg, Handle)}; + completion -> + {completion, ?COMPLETION_INFO(recvmsg, Handle)}; Result -> recvmsg_result(Result) end. recvmsg_deadline(SockRef, BufSz, CtrlSz, Flags, Deadline) -> - SelectHandle = make_ref(), - case prim_socket:recvmsg(SockRef, BufSz, CtrlSz, Flags, SelectHandle) of + Handle = make_ref(), + case prim_socket:recvmsg(SockRef, BufSz, CtrlSz, Flags, Handle) of select -> %% There is nothing just now, but we will be notified when there %% is something to read (a select message). Timeout = timeout(Deadline), receive - ?socket_msg(?socket(SockRef), select, SelectHandle) -> + ?socket_msg(?socket(SockRef), select, Handle) -> recvmsg_deadline( SockRef, BufSz, CtrlSz, Flags, Deadline); - ?socket_msg(_Socket, abort, {SelectHandle, Reason}) -> + ?socket_msg(_Socket, abort, {Handle, Reason}) -> + {error, Reason} + after Timeout -> + _ = cancel(SockRef, recvmsg, Handle), + {error, timeout} + end; + + completion -> + %% There is nothing just now, but we will be notified when there + %% is something to read (a completion message). + Timeout = timeout(Deadline), + receive + ?socket_msg(?socket(SockRef), completion, + {Handle, CompletionStatus}) -> + recvmsg_result(CompletionStatus); + ?socket_msg(_Socket, abort, {Handle, Reason}) -> {error, Reason} after Timeout -> - _ = cancel(SockRef, recvmsg, SelectHandle), + _ = cancel(SockRef, recvmsg, Handle), {error, timeout} end; + Result -> recvmsg_result(Result) end. recvmsg_result(Result) -> + %% ?DBG([{result, Result}]), case Result of {ok, _Msg} = OK -> OK; @@ -4258,9 +4545,14 @@ ioctl(Socket, SetRequest, Arg1, Arg2) -> %% -spec cancel(Socket, SelectInfo) -> 'ok' | {'error', Reason} when - Socket :: socket(), - SelectInfo :: select_info(), - Reason :: 'closed' | invalid(). + Socket :: socket(), + SelectInfo :: select_info(), + Reason :: 'closed' | invalid(); + + (Socket, CompletionInfo) -> 'ok' | {'error', Reason} when + Socket :: socket(), + CompletionInfo :: completion_info(), + Reason :: 'closed' | invalid(). cancel(?socket(SockRef), ?SELECT_INFO(SelectTag, SelectHandle) = SelectInfo) when is_reference(SockRef) -> @@ -4278,21 +4570,43 @@ cancel(?socket(SockRef), ?SELECT_INFO(SelectTag, SelectHandle) = SelectInfo) Result -> Result end; -cancel(Socket, SelectInfo) -> - erlang:error(badarg, [Socket, SelectInfo]). +cancel(?socket(SockRef), + ?COMPLETION_INFO(CompletionTag, CompletionHandle) = CompletionInfo) + when is_reference(SockRef) -> + case CompletionTag of + {Op, _} when is_atom(Op) -> + ok; + Op when is_atom(Op) -> + ok + end, + case cancel(SockRef, Op, CompletionHandle) of + ok -> + ok; + invalid -> + {error, {invalid, CompletionInfo}}; + Result -> + Result + end; +cancel(Socket, Info) -> + erlang:error(badarg, [Socket, Info]). -cancel(SockRef, Op, SelectHandle) -> - case prim_socket:cancel(SockRef, Op, SelectHandle) of +cancel(SockRef, Op, Handle) -> + case prim_socket:cancel(SockRef, Op, Handle) of select_sent -> - flush_select_msg(SockRef, SelectHandle), - _ = flush_abort_msg(SockRef, SelectHandle), + _ = flush_select_msg(SockRef, Handle), + _ = flush_abort_msg(SockRef, Handle), ok; not_found -> - _ = flush_abort_msg(SockRef, SelectHandle), + _ = flush_completion_msg(SockRef, Handle), + _ = flush_abort_msg(SockRef, Handle), invalid; Result -> - _ = flush_abort_msg(SockRef, SelectHandle), + %% Since we do not actually if we are using + %% select or completion here, so flush both... + _ = flush_select_msg(SockRef, Handle), + _ = flush_completion_msg(SockRef, Handle), + _ = flush_abort_msg(SockRef, Handle), Result end. @@ -4304,6 +4618,14 @@ flush_select_msg(SockRef, Ref) -> ok end. +flush_completion_msg(SockRef, Ref) -> + receive + ?socket_msg(?socket(SockRef), completion, {Ref, Result}) -> + Result + after 0 -> + ok + end. + flush_abort_msg(SockRef, Ref) -> receive ?socket_msg(?socket(SockRef), abort, {Ref, Reason}) -> @@ -4319,39 +4641,14 @@ flush_abort_msg(SockRef, Ref) -> %% %% =========================================================================== -%% formated_timestamp() -> -%% format_timestamp(os:timestamp()). - -%% format_timestamp(Now) -> -%% N2T = fun(N) -> calendar:now_to_local_time(N) end, -%% format_timestamp(Now, N2T, true). - -%% format_timestamp({_N1, _N2, N3} = N, N2T, true) -> -%% FormatExtra = ".~.2.0w", -%% ArgsExtra = [N3 div 10000], -%% format_timestamp(N, N2T, FormatExtra, ArgsExtra); -%% format_timestamp({_N1, _N2, _N3} = N, N2T, false) -> -%% FormatExtra = "", -%% ArgsExtra = [], -%% format_timestamp(N, N2T, FormatExtra, ArgsExtra). - -%% format_timestamp(N, N2T, FormatExtra, ArgsExtra) -> -%% {Date, Time} = N2T(N), -%% {YYYY,MM,DD} = Date, -%% {Hour,Min,Sec} = Time, -%% FormatDate = -%% io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w" ++ FormatExtra, -%% [YYYY, MM, DD, Hour, Min, Sec] ++ ArgsExtra), -%% lists:flatten(FormatDate). - deadline(Timeout) -> case Timeout of nowait -> Timeout; infinity -> Timeout; - SelectHandle when is_reference(SelectHandle) -> - select_handle; + Handle when is_reference(Handle) -> + handle; 0 -> zero; _ when is_integer(Timeout), 0 < Timeout -> @@ -4362,7 +4659,7 @@ deadline(Timeout) -> timeout(Deadline) -> case Deadline of - %% nowait | select_handle shall not be passed here + %% nowait | handle shall not be passed here %% infinity -> Deadline; @@ -4392,6 +4689,39 @@ bincat(<<_/binary>> = A, <<_/binary>> = B) -> f(F, A) -> lists:flatten(io_lib:format(F, A)). +%% mq() -> +%% pi(messages). + +%% pi(Item) -> +%% {Item, Val} = process_info(self(), Item), +%% Val. + + +%% formated_timestamp() -> +%% format_timestamp(os:timestamp()). + +%% format_timestamp(Now) -> +%% N2T = fun(N) -> calendar:now_to_local_time(N) end, +%% format_timestamp(Now, N2T, true). + +%% format_timestamp({_N1, _N2, N3} = N, N2T, true) -> +%% FormatExtra = ".~.2.0w", +%% ArgsExtra = [N3 div 10000], +%% format_timestamp(N, N2T, FormatExtra, ArgsExtra); +%% format_timestamp({_N1, _N2, _N3} = N, N2T, false) -> +%% FormatExtra = "", +%% ArgsExtra = [], +%% format_timestamp(N, N2T, FormatExtra, ArgsExtra). + +%% format_timestamp(N, N2T, FormatExtra, ArgsExtra) -> +%% {Date, Time} = N2T(N), +%% {YYYY,MM,DD} = Date, +%% {Hour,Min,Sec} = Time, +%% FormatDate = +%% io_lib:format("~.4w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w" ++ FormatExtra, +%% [YYYY, MM, DD, Hour, Min, Sec] ++ ArgsExtra), +%% lists:flatten(FormatDate). + %% p(F) -> %% p(F, []). diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 1aad064392..4aa4907194 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2020. All Rights Reserved. +%% Copyright Ericsson AB 2009-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -66,6 +66,7 @@ server(PortName,PortSettings) -> run(P) -> put(encoding, latin1), + put(onlcr, false), server_loop(P). server_loop(Port) -> @@ -161,7 +162,7 @@ io_request({get_geometry,rows},Port) -> io_request(getopts, _Port) -> getopts(); io_request({setopts,Opts}, _Port) when is_list(Opts) -> - setopts(Opts); + do_setopts(Opts); io_request({requests,Reqs}, Port) -> io_requests(Reqs, {ok,ok}, Port); io_request(R, _Port) -> %Unknown request @@ -203,19 +204,27 @@ put_chars(Chars, Port) when is_binary(Chars) -> {ok,ok}. %% setopts -setopts(Opts0) -> +do_setopts(Opts0) -> Opts = expand_encoding(Opts0), case check_valid_opts(Opts) of true -> - do_setopts(Opts); + lists:foreach( + fun({encoding, Enc}) -> + put(encoding, Enc); + ({onlcr, Bool}) -> + put(onlcr, Bool) + end, Opts), + {ok, ok}; false -> {error,{error,enotsup}} end. check_valid_opts([]) -> true; -check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; - Valid =:= utf8; Valid =:= latin1 -> +check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; Valid =:= utf8; + Valid =:= latin1 -> + check_valid_opts(T); +check_valid_opts([{onlcr,Bool}|T]) when is_boolean(Bool) -> check_valid_opts(T); check_valid_opts(_) -> false. @@ -226,27 +235,21 @@ expand_encoding([latin1 | T]) -> [{encoding,latin1} | expand_encoding(T)]; expand_encoding([unicode | T]) -> [{encoding,unicode} | expand_encoding(T)]; +expand_encoding([utf8 | T]) -> + [{encoding,unicode} | expand_encoding(T)]; +expand_encoding([{encoding,utf8} | T]) -> + [{encoding,unicode} | expand_encoding(T)]; expand_encoding([H|T]) -> [H|expand_encoding(T)]. -do_setopts(Opts) -> - case proplists:get_value(encoding, Opts) of - Valid when Valid =:= unicode; Valid =:= utf8 -> - put(encoding, unicode); - latin1 -> - put(encoding, latin1); - undefined -> - ok - end, - {ok,ok}. - getopts() -> Uni = {encoding,get(encoding)}, - {ok,[Uni]}. + Onlcr = {onlcr, get(onlcr)}, + {ok,[Uni, Onlcr]}. wrap_characters_to_binary(Chars,From,To) -> - TrNl = (whereis(user_drv) =/= undefined), - Limit = case To of + TrNl = get(onlcr), + Limit = case To of latin1 -> 255; _Else -> diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl deleted file mode 100644 index 67c2eafdbe..0000000000 --- a/lib/kernel/src/user.erl +++ /dev/null @@ -1,769 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2020. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(user). --compile(inline). - -%% Basic standard i/o server for user interface port. - --export([start/0, start/1, start_out/0]). --export([interfaces/1]). - --define(NAME, user). - -%% Defines for control ops --define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). --define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). - -%% -%% The basic server and start-up. -%% - -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(fun() -> server(Pid) end), - register(?NAME, Id), - Id. - -start_out() -> - %% Output-only version of start/0 - start_port([out,binary]). - -start_port(PortSettings) -> - Id = spawn(fun() -> server({fd,0,1}, PortSettings) end), - 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(encoding,latin1), - 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_port(<<"*** ">>, Port); - _ -> - put_port(<<"*** ERROR: ">>, Port) - end, - put_port(<<"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 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} -> - ok = 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 - case wrap_characters_to_binary(Chars, unicode, get(encoding)) of - error -> - {error,{error,put_chars},Q}; - Bin -> - put_chars(Bin, Port, Q) - end; -io_request({put_chars,unicode,Mod,Func,Args}, Port, Q) -> - case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - case wrap_characters_to_binary(Data, unicode, get(encoding)) of - Bin when is_binary(Bin) -> - put_chars(Bin, Port, Q); - error -> - {error,{error,put_chars},Q} - end; - Undef -> - put_chars(Undef, Port, Q) - end; -io_request({put_chars,latin1,Chars}, Port, Q) -> % Binary new in R9C - case catch unicode:characters_to_binary(Chars, latin1, get(encoding)) of - Data when is_binary(Data) -> - put_chars(Data, Port, Q); - _ -> - {error,{error,put_chars},Q} - end; -io_request({put_chars,latin1,Mod,Func,Args}, Port, Q) -> - case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - case - catch unicode:characters_to_binary(Data,latin1,get(encoding)) - of - Bin when is_binary(Bin) -> - put_chars(Bin, Port, Q); - _ -> - {error,{error,put_chars},Q} - end; - Undef -> - put_chars(Undef, Port, Q) - end; -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) -> - true = port_command(Port, List), - ok. - -%% send_port(Port, Command) - -send_port(Port, Command) -> - Port ! {self(),Command}, - ok. - -%% 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) -> - ok = 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(encoding,unicode); - latin1 -> - put(encoding,latin1); - 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, get(read_mode) =:= binary}, - Uni = {encoding, get(encoding)}, - {ok,[Bin,Uni],Q}. - -get_line_bin(Prompt,Port,Q, Enc) -> - case prompt(Port, Prompt) of - error -> - {error,{error,get_line},Q}; - ok -> - case {get(eof),queue:is_empty(Q)} of - {true,true} -> - {ok,eof,Q}; - _ -> - get_line(Prompt,Port, Q, [], Enc) - end - 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, queue:new()}; - {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()), - case prompt(Port, Prompt) of - error -> - {error,{error,get_line},Q}; - ok -> - get_line(Prompt, Port, Q, Acc, Enc) - end; - {'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)). - -%% get_chars(Prompt, Module, Function, XtraArg, Port, Queue, Encoding) -%% Gets characters from the input port until the applied function -%% returns {stop,Result,RestBuf}. Does not block output until input -%% has been received. Encoding is the encoding of the data sent to -%% the client and to Function. -%% Returns: -%% {Status,Result,NewQueue} -%% {exit,Reason} - -%% Entry function. -get_chars(Prompt, M, F, Xa, Port, Q, Enc) -> - case prompt(Port, Prompt) of - error -> - {error,{error,get_chars},Q}; - ok -> - case {get(eof),queue:is_empty(Q)} of - {true,true} -> - {ok,eof,Q}; - _ -> - get_chars(Prompt, M, F, Xa, Port, Q, start, Enc) - end - end. - -%% First loop. Wait for port data. Respond to output requests. -get_chars(Prompt, M, F, Xa, Port, Q, State, Enc) -> - case queue:is_empty(Q) of - true -> - receive - {Port,{data,Bytes}} -> - get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Enc); - {Port, eof} -> - put(eof, true), - {ok, eof, queue:new()}; - {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, Enc); - {io_request,From,ReplyAs,Request} when is_pid(From) -> - get_chars_req(Prompt, M, F, Xa, Port, Q, State, - Request, From, ReplyAs, Enc); - {'EXIT',From,What} when node(From) =:= node() -> - {exit,What} - end; - false -> - get_chars_apply(State, M, F, Xa, Port, Q, Enc) - end. - -get_chars_req(Prompt, M, F, XtraArg, Port, Q, State, - Req, From, ReplyAs, Enc) -> - do_io_request(Req, From, ReplyAs, Port, queue:new()), %Keep Q over this call - case prompt(Port, Prompt) of - error -> - {error,{error,get_chars},Q}; - ok -> - get_chars(Prompt, M, F, XtraArg, Port, Q, State, Enc) - end. - -%% 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, Enc) -> - case get(shell) of - noshell -> - get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, Bytes),Enc); - _ -> - case contains_ctrl_g_or_ctrl_c(Bytes) of - false -> - get_chars_apply(State, M, F, Xa, Port, - queue:snoc(Q, Bytes),Enc); - _ -> - throw(new_shell) - end - end. - -get_chars_apply(State0, M, F, Xa, Port, Q, Enc) -> - case catch M:F(State0, cast(queue:head(Q),Enc), Enc, 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',_Why} -> - {error,{error,err_func(M, F, Xa)},queue:new()}; - State1 -> - get_chars_more(State1, M, F, Xa, Port, queue:tail(Q), Enc) - end. - -get_chars_more(State, M, F, Xa, Port, Q, Enc) -> - 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, Enc); - {Port,eof} -> - put(eof, true), - get_chars_apply(State, M, F, Xa, Port, - queue:snoc(Q, eof), Enc); - {'EXIT',From,What} when node(From) =:= node() -> - {exit,What} - end; - _ -> - get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, eof), Enc) - end; - false -> - get_chars_apply(State, M, F, Xa, Port, Q, Enc) - end. - - -%% prompt(Port, Prompt) -%% Print Prompt onto Port - -%% common case, reduces execution time by 20% -prompt(_Port, '') -> ok; -prompt(Port, Prompt) -> - Encoding = get(encoding), - PromptString = io_lib:format_prompt(Prompt, Encoding), - case wrap_characters_to_binary(PromptString, unicode, Encoding) of - Bin when is_binary(Bin) -> - put_port(Bin, Port); - error -> - error - end. - -%% 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, _Encoding) when is_atom(Data) -> - Data; -cast(Data, Encoding) -> - IoEncoding = get(encoding), - cast(Data, get(read_mode), IoEncoding, Encoding). - -cast(B, binary, latin1, latin1) when is_binary(B) -> - B; -cast(L, binary, latin1, latin1) -> - case catch erlang:iolist_to_binary(L) of - Bin when is_binary(Bin) -> Bin; - _ -> exit({no_translation, latin1, latin1}) - end; -cast(Data, binary, unicode, latin1) when is_binary(Data); is_list(Data) -> - case catch unicode:characters_to_binary(Data, unicode, latin1) of - Bin when is_binary(Bin) -> Bin; - _ -> exit({no_translation, unicode, latin1}) - end; -cast(Data, binary, latin1, unicode) when is_binary(Data); is_list(Data) -> - case catch unicode:characters_to_binary(Data, latin1, unicode) of - Bin when is_binary(Bin) -> Bin; - _ -> exit({no_translation, latin1, unicode}) - end; -cast(B, binary, unicode, unicode) when is_binary(B) -> - B; -cast(L, binary, unicode, unicode) -> - case catch unicode:characters_to_binary(L, unicode) of - Bin when is_binary(Bin) -> Bin; - _ -> exit({no_translation, unicode, unicode}) - end; -cast(B, list, latin1, latin1) when is_binary(B) -> - binary_to_list(B); -cast(L, list, latin1, latin1) -> - case catch erlang:iolist_to_binary(L) of - Bin when is_binary(Bin) -> binary_to_list(Bin); - _ -> exit({no_translation, latin1, latin1}) - end; -cast(Data, list, unicode, latin1) when is_binary(Data); is_list(Data) -> - case catch unicode:characters_to_list(Data, unicode) of - Chars when is_list(Chars) -> - [ case X of - High when High > 255 -> - exit({no_translation, unicode, latin1}); - Low -> - Low - end || X <- Chars ]; - _ -> - exit({no_translation, unicode, latin1}) - end; -cast(Data, list, latin1, unicode) when is_binary(Data); is_list(Data) -> - case catch unicode:characters_to_list(Data, latin1) of - Chars when is_list(Chars) -> Chars; - _ -> exit({no_translation, latin1, unicode}) - end; -cast(Data, list, unicode, unicode) when is_binary(Data); is_list(Data) -> - case catch unicode:characters_to_list(Data, unicode) of - Chars when is_list(Chars) -> Chars; - _ -> exit({no_translation, unicode, unicode}) - end. - -wrap_characters_to_binary(Chars, unicode, latin1) -> - case catch unicode:characters_to_binary(Chars, unicode, latin1) of - Bin when is_binary(Bin) -> - Bin; - _ -> - case catch unicode:characters_to_list(Chars, unicode) of - L when is_list(L) -> - list_to_binary( - [ case X of - High when High > 255 -> - ["\\x{",erlang:integer_to_list(X, 16),$}]; - Low -> - Low - end || X <- L ]); - _ -> - error - end - end; -wrap_characters_to_binary(Bin, From, From) when is_binary(Bin) -> - Bin; -wrap_characters_to_binary(Chars, From, To) -> - case catch unicode:characters_to_binary(Chars, From, To) of - Bin when is_binary(Bin) -> - Bin; - _ -> - error - end. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index fa7687bf2a..bcc0d2b78b 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2021. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,591 +19,846 @@ %% -module(user_drv). -%% Basic interface to a port. - --export([start/0,start/1,start/2,start/3,server/2,server/3]). - --export([interfaces/1]). +%% Basic interface to stdin/stdout. +%% +%% This is responsible for a couple of things: +%% - Dispatching I/O messages when erl is running +%% The messages are listed in the type message/0. +%% - Any data received from the terminal is sent to the current group like this: +%% `{DrvPid :: pid(), {data, UnicodeCharacters :: list()}}` +%% - It serves as the job control manager (i.e. what happens when you type ^G) +%% - Starts potential -remsh sessions to other nodes +%% +-type message() :: + %% I/O requests that modify the terminal + {Sender :: pid(), request()} | + %% Query the server of the current dimensions of the terminal. + %% `Sender` will be sent the message: + %% `{DrvPid :: pid(), tty_geometry, {Width :: integer(), Height :: integer()}}` + {Sender :: pid(), tty_geometry} | + %% Query the server if it supports unicode characters + %% `Sender` will be sent the message: + %% `{DrvPid :: pid(), get_unicode_state, SupportUnicode :: boolean()}` + {Sender :: pid(), get_unicode_state} | + %% Change whether the server supports unicode characters or not. The reply + %% contains the previous unicode state. + %% `Sender` will be sent the message: + %% `{DrvPid :: pid(), set_unicode_state, SupportedUnicode :: boolean()}` + {Sender :: pid(), set_unicode_state, boolean()}. +-type request() :: + %% Put characters at current cursor position, + %% overwriting any characters it encounters. + {put_chars, unicode, binary()} | + %% Same as put_chars/3, but sends Reply to From when the characters are + %% guaranteed to have been written to the terminal + {put_chars_sync, unicode, binary(), {From :: pid(), Reply :: term()}} | + %% Move the cursor X characters left or right (negative is left) + {move_rel, -32768..32767} | + %% Insert characters at current cursor position moving any + %% characters after the cursor. + {insert_chars, unicode, binary()} | + %% Delete X chars before or after the cursor adjusting any test remaining + %% to the right of the cursor. + {delete_chars, -32768..32767} | + %% Trigger a terminal "bell" + beep | + %% Clears the screen + clear | + %% Execute multiple request() actions + {requests, [request()]} | + %% Open external editor + {open_editor, string()}. + +-export_type([message/0]). +-export([start/0, start/1, start_shell/0, start_shell/1, whereis_group/0]). + +%% gen_statem state callbacks +-behaviour(gen_statem). +-export([init/3,server/3,switch_loop/3]). + +%% gen_statem callbacks +-export([init/1, callback_mode/0]). -include_lib("kernel/include/logger.hrl"). --define(OP_PUTC,0). --define(OP_MOVE,1). --define(OP_INSC,2). --define(OP_DELC,3). --define(OP_BEEP,4). --define(OP_PUTC_SYNC,5). -% Control op --define(ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER, 16#018b0900). --define(CTRL_OP_GET_WINSIZE, (100 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). --define(CTRL_OP_GET_UNICODE_STATE, (101 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). --define(CTRL_OP_SET_UNICODE_STATE, (102 + ?ERTS_TTYSL_DRV_CONTROL_MAGIC_NUMBER)). - -%% start() -%% start(ArgumentList) -%% 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. - +-record(editor, { port :: port(), file :: file:name(), requester :: pid() }). +-record(state, { tty :: prim_tty:state() | undefined, + write :: reference() | undefined, + read :: reference() | undefined, + shell_started = new :: new | old | false, + editor :: #editor{} | undefined, + user :: pid(), + current_group :: pid() | undefined, + groups, queue }). + +-type shell() :: {module(), atom(), [term()]} | {node(), module(), atom(), [term()]}. +-type arguments() :: #{ initial_shell => noshell | shell() | + {remote, unicode:charlist()} | {remote, unicode:charlist(), {module(), atom(), [term()]}}, + input => boolean() }. + +%% Default line editing shell -spec start() -> pid(). +start() -> + case init:get_argument(remsh) of + {ok,[[Node]]} -> + start(#{ initial_shell => {remote, Node} }); + {ok,[[Node]|_]} -> + ?LOG_WARNING("Multiple -remsh given to erl, using the first, ~p", [Node]), + start(#{ initial_shell => {remote, Node} }); + E when E =:= error ; E =:= {ok,[[]]} -> + start(#{ }) + end. -start() -> %Default line editing shell - spawn(user_drv, server, ['tty_sl -c -e',{shell,start,[init]}]). +-spec start_shell() -> ok | {error, Reason :: term()}. +start_shell() -> + start_shell(#{ }). +-spec start_shell(arguments()) -> ok | {error, already_started}. +start_shell(Args) -> + gen_statem:call(?MODULE, {start_shell, Args}). + +-spec whereis_group() -> pid() | undefined. +whereis_group() -> + {dictionary, Dict} = + erlang:process_info(whereis(?MODULE), dictionary), + proplists:get_value(current_group, Dict). + +%% Backwards compatibility with pre OTP-26 for Elixir/LFE etc +-spec start(['tty_sl -c -e'| shell()]) -> pid(); + (arguments()) -> pid(). +start(['tty_sl -c -e', Shell]) -> + start(#{ initial_shell => Shell }); +start(Args) when is_map(Args) -> + case gen_statem:start({local, ?MODULE}, ?MODULE, Args, []) of + {ok, Pid} -> Pid; + {error, Reason} -> + {error, Reason} + end. -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]}]). +callback_mode() -> state_functions. -start(Pname, Shell) -> - spawn(user_drv, server, [Pname,Shell]). +-spec init(arguments()) -> gen_statem:init_result(init). +init(Args) -> + process_flag(trap_exit, true), -start(Iname, Oname, Shell) -> - spawn(user_drv, server, [Iname,Oname,Shell]). + IsTTY = prim_tty:isatty(stdin) =:= true andalso prim_tty:isatty(stdout) =:= true, + StartShell = maps:get(initial_shell, Args, undefined) =/= noshell, + OldShell = maps:get(initial_shell, Args, undefined) =:= oldshell, + try + if + not IsTTY andalso StartShell; OldShell -> + error(enotsup); + IsTTY, StartShell -> + TTYState = prim_tty:init(#{}), + init_standard_error(TTYState, true), + {ok, init, {Args, #state{ user = start_user() } }, + {next_event, internal, TTYState}}; + true -> + TTYState = prim_tty:init(#{input => maps:get(input, Args, true), + tty => false}), + init_standard_error(TTYState, false), + {ok, init, {Args,#state{ user = start_user() } }, + {next_event, internal, TTYState}} + end + catch error:enotsup -> + %% This is thrown by prim_tty:init when + %% it could not start the terminal, + %% probably because TERM=dumb was set. + %% + %% The oldshell mode is important as it is + %% the mode used when running erlang in an + %% emacs buffer. + CatchTTYState = prim_tty:init(#{tty => false}), + init_standard_error(CatchTTYState, false), + {ok, init, {Args,#state{ shell_started = old, user = start_user() } }, + {next_event, internal, CatchTTYState}} + end. +%% Initialize standard_error +init_standard_error(TTY, NewlineCarriageReturn) -> + Encoding = case prim_tty:unicode(TTY) of + true -> unicode; + false -> latin1 + end, + ok = io:setopts(standard_error, [{encoding, Encoding}, + {onlcr, NewlineCarriageReturn}]). + +init(internal, TTYState, {Args, State = #state{ user = User }}) -> + + %% Cleanup ancestors so that observer looks nice + put('$ancestors',[User|get('$ancestors')]), + + #{ read := ReadHandle, write := WriteHandle } = prim_tty:handles(TTYState), + + NewState = State#state{ tty = TTYState, + read = ReadHandle, write = WriteHandle, + user = User, queue = {false, queue:new()}, + groups = gr_add_cur(gr_new(), User, {}) + }, + + case Args of + #{ initial_shell := noshell } -> + init_noshell(NewState); + #{ initial_shell := {remote, Node} } -> + InitialShell = {shell,start,[]}, + exit_on_remote_shell_error( + Node, InitialShell, init_remote_shell(NewState, Node, InitialShell)); + #{ initial_shell := {remote, Node, InitialShell} } -> + exit_on_remote_shell_error( + Node, InitialShell, init_remote_shell(NewState, Node, InitialShell)); + #{ initial_shell := oldshell } -> + old = State#state.shell_started, + init_local_shell(NewState, {shell,start,[]}); + #{ initial_shell := InitialShell } -> + init_local_shell(NewState, InitialShell); + _ -> + init_local_shell(NewState, {shell,start,[init]}) + end. -%% 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. +exit_on_remote_shell_error(RemoteNode, _, {error, noconnection}) -> + io:format(standard_error, "Could not connect to ~p\n", [RemoteNode]), + erlang:halt(1); +exit_on_remote_shell_error(RemoteNode, {M, _, _}, {error, Reason}) -> + io:format(standard_error, "Could not load ~p on ~p (~p)\n", [RemoteNode, M, Reason]), + erlang:halt(1); +exit_on_remote_shell_error(_, _, Result) -> + Result. + +%% We have been started with -noshell. In this mode the current_group is +%% the `user` group process. +init_noshell(State) -> + init_shell(State#state{ shell_started = false }, ""). + +init_remote_shell(State, Node, {M, F, A}) -> + + case net_kernel:get_state() of + #{ started := no } -> + {ok, _} = net_kernel:start([undefined, shortnames]), + ok; + _ -> + ok + end, --spec interfaces(pid()) -> [{'current_group', pid()}]. + LocalNode = + case net_kernel:get_state() of + #{ name_type := dynamic } -> + net_kernel:nodename(); + #{ name_type := static } -> + node() + end, + + RemoteNode = + case string:find(Node,"@") of + nomatch -> + list_to_atom(Node ++ string:find(atom_to_list(LocalNode),"@")); + _ -> + list_to_atom(Node) + end, + + case net_kernel:connect_node(RemoteNode) of + true -> + + case erpc:call(RemoteNode, code, ensure_loaded, [M]) of + {error, Reason} when Reason =/= embedded -> + {error, Reason}; + _ -> + + %% Setup correct net tick times + case erpc:call(RemoteNode, net_kernel, get_net_ticktime, []) of + {ongoing_change_to, NetTickTime} -> + _ = net_kernel:set_net_ticktime(NetTickTime), + ok; + NetTickTime -> + _ = net_kernel:set_net_ticktime(NetTickTime), + ok + end, -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; - _ -> - [] + RShell = {RemoteNode, M, F, A}, + + %% We fetch the shell slogan from the remote node + Slogan = + case erpc:call(RemoteNode, application, get_env, + [stdlib, shell_slogan, + erpc:call(RemoteNode, erlang, system_info, [system_version])]) of + Fun when is_function(Fun, 0) -> + erpc:call(RemoteNode, Fun); + SloganEnv -> + SloganEnv + end, + + Group = group:start(self(), RShell, + [{echo,State#state.shell_started =:= new}] ++ + group_opts(RemoteNode)), + + Gr = gr_add_cur(State#state.groups, Group, RShell), + + init_shell(State#state{ groups = Gr }, [Slogan,$\n]) + end; + false -> + {error, noconnection} 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. +init_local_shell(State, InitialShell) -> -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. + Slogan = + case application:get_env( + stdlib, shell_slogan, + fun() -> erlang:system_info(system_version) end) of + Fun when is_function(Fun, 0) -> + Fun(); + SloganEnv -> + SloganEnv + 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. + Gr = gr_add_cur(State#state.groups, + group:start(self(), InitialShell, + group_opts() ++ [{echo,State#state.shell_started =:= new}]), + InitialShell), -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]]} -> - ANode = - if - node() =:= nonode@nohost -> - %% We try to connect to the node if the current node is not - %% a distributed node yet. If this succeeds it means that we - %% are running using "-sname undefined". - _ = net_kernel:start([undefined, shortnames]), - NodeName = append_hostname(Node, net_kernel:nodename()), - case net_kernel:connect_node(NodeName) of - true -> - NodeName; - _Else -> - ?LOG_ERROR("Could not connect to ~p",[Node]) - end; - true -> - append_hostname(Node, node()) - end, + init_shell(State#state{ groups = Gr }, [Slogan,$\n]). - RShell = {ANode,shell,start,[]}, - RGr = group:start(self(), RShell, rem_sh_opts(ANode)), - {RGr,RShell}; - E when E =:= error ; E =:= {ok,[[]]} -> - {group:start(self(), Shell),Shell} - end, +init_shell(State, Slogan) -> + init_standard_error(State#state.tty, State#state.shell_started =:= new), + Curr = gr_cur_pid(State#state.groups), put(current_group, Curr), - Gr = gr_add_cur(Gr1, Curr, Shell1), - %% Print some information. - io_request({put_chars, unicode, - flatten(io_lib:format("~ts\n", - [erlang:system_info(system_version)]))}, - Iport, Oport), - - %% Enter the server loop. - server_loop(Iport, Oport, Curr, User, Gr, {false, queue:new()}). - -append_hostname(Node, LocalNode) -> - case string:find(Node,"@") of - nomatch -> - list_to_atom(Node ++ string:find(atom_to_list(LocalNode),"@")); - _ -> - list_to_atom(Node) - end. - -rem_sh_opts(Node) -> - [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. + {next_state, server, State#state{ current_group = gr_cur_pid(State#state.groups) }, + {next_event, info, + {gr_cur_pid(State#state.groups), + {put_chars, unicode, + unicode:characters_to_binary(io_lib:format("~ts", [Slogan]))}}}}. %% 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(), {}), + User = group:start(self(), {}, [{echo,false}]), register(user, User), User; User -> User end. - -server_loop(Iport, Oport, User, Gr, IOQueue) -> - Curr = gr_cur_pid(Gr), - put(current_group, Curr), - server_loop(Iport, Oport, Curr, User, Gr, IOQueue). - -server_loop(Iport, Oport, Curr, User, Gr, {Resp, IOQ} = IOQueue) -> - receive - {Iport,{data,Bs}} -> - BsBin = list_to_binary(Bs), - Unicode = unicode:characters_to_list(BsBin,utf8), - port_bytes(Unicode, Iport, Oport, Curr, User, Gr, IOQueue); - {Iport,eof} -> - Curr ! {self(),eof}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - - %% We always handle geometry and unicode requests - {Requester,tty_geometry} -> - Requester ! {self(),tty_geometry,get_tty_geometry(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {Requester,get_unicode_state} -> - Requester ! {self(),get_unicode_state,get_unicode_state(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {Requester,set_unicode_state, Bool} -> - Requester ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - - Req when element(1,Req) =:= User orelse element(1,Req) =:= Curr, - tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 -> - %% We match {User|Curr,_}|{User|Curr,_,_} - NewQ = handle_req(Req, Iport, Oport, IOQueue), - server_loop(Iport, Oport, Curr, User, Gr, NewQ); - {Oport,ok} -> - %% We get this ok from the port, in io_request we store - %% info about where to send reply at head of queue - {Origin,Reply} = Resp, - Origin ! {reply,Reply}, - NewQ = handle_req(next, Iport, Oport, {false, IOQ}), - server_loop(Iport, Oport, Curr, User, Gr, NewQ); - {'EXIT',Iport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {'EXIT',Oport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {'EXIT',User,shutdown} -> % force data to port - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - {'EXIT',User,_R} -> % keep 'user' alive - NewU = start_user(), - server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {}), IOQueue); - {'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, IOQueue); - _ -> % remote shell - io_requests([{put_chars,unicode,"(^G to start new job) ***\n"}], - Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr1, IOQueue) - end; - _ -> % not current, just remove it - server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid), IOQueue) - end; - {Requester, {put_chars_sync, _, _, Reply}} -> - %% We need to ack the Req otherwise originating process will hang forever - %% Do discard the output to non visible shells (as was done previously) - Requester ! {reply, Reply}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); - _X -> - %% Ignore unknown messages. - server_loop(Iport, Oport, Curr, User, Gr, IOQueue) - end. -handle_req(next,Iport,Oport,{false,IOQ}=IOQueue) -> - case queue:out(IOQ) of - {empty,_} -> - IOQueue; - {{value,{Origin,Req}},ExecQ} -> - case io_request(Req, Iport, Oport) of - ok -> - handle_req(next,Iport,Oport,{false,ExecQ}); - Reply -> - {{Origin,Reply}, ExecQ} +server({call, From}, {start_shell, Args}, + State = #state{ tty = TTY, shell_started = false }) -> + IsTTY = prim_tty:isatty(stdin) =:= true andalso prim_tty:isatty(stdout) =:= true, + StartShell = maps:get(initial_shell, Args, undefined) =/= noshell, + OldShell = maps:get(initial_shell, Args, undefined) =:= oldshell, + NewState = + try + if + not IsTTY andalso StartShell; OldShell -> + error(enotsup); + IsTTY, StartShell -> + NewTTY = prim_tty:reinit(TTY, #{ }), + State#state{ tty = NewTTY, + shell_started = new }; + true -> + NewTTY = prim_tty:reinit(TTY, #{ tty => false }), + State#state{ tty = NewTTY, shell_started = false } end + catch error:enotsup -> + NewTTYState = prim_tty:reinit(TTY, #{ tty => false }), + State#state{ tty = NewTTYState, shell_started = old } + end, + #{ read := ReadHandle, write := WriteHandle } = prim_tty:handles(NewState#state.tty), + NewHandleState = NewState#state { + read = ReadHandle, + write = WriteHandle + }, + {Result, Reply} + = case maps:get(initial_shell, Args, undefined) of + noshell -> + {init_noshell(NewHandleState), ok}; + {remote, Node} -> + case init_remote_shell(NewHandleState, Node, {shell, start, []}) of + {error, _} = Error -> + {init_noshell(NewHandleState), Error}; + R -> + {R, ok} + end; + {remote, Node, InitialShell} -> + case init_remote_shell(NewHandleState, Node, InitialShell) of + {error, _} = Error -> + {init_noshell(NewHandleState), Error}; + R -> + {R, ok} + end; + undefined -> + case NewHandleState#state.shell_started of + old -> + {init_local_shell(NewHandleState, {shell,start,[]}), ok}; + new -> + {init_local_shell(NewHandleState, {shell,start,[init]}), ok}; + false -> + %% This can never happen, but dialyzer complains so we add + %% this clause. + {keep_state_and_data, ok} + end; + InitialShell -> + {init_local_shell(NewHandleState, InitialShell), ok} + end, + gen_statem:reply(From, Reply), + Result; +server({call, From}, {start_shell, _Args}, _State) -> + gen_statem:reply(From, {error, already_started}), + keep_state_and_data; +server(info, {ReadHandle,{data,UTF8Binary}}, State = #state{ read = ReadHandle }) + when State#state.current_group =:= State#state.user -> + State#state.current_group ! + {self(), {data, unicode:characters_to_list(UTF8Binary, utf8)}}, + keep_state_and_data; +server(info, {ReadHandle,{data,UTF8Binary}}, State = #state{ read = ReadHandle }) -> + case contains_ctrl_g_or_ctrl_c(UTF8Binary) of + ctrl_g -> {next_state, switch_loop, State, {next_event, internal, init}}; + ctrl_c -> + case gr_get_info(State#state.groups, State#state.current_group) of + undefined -> ok; + _ -> exit(State#state.current_group, interrupt) + end, + keep_state_and_data; + none -> + State#state.current_group ! + {self(), {data, unicode:characters_to_list(UTF8Binary, utf8)}}, + keep_state_and_data end; -handle_req(Msg,Iport,Oport,{false,IOQ}=IOQueue) -> - empty = queue:peek(IOQ), - {Origin,Req} = Msg, - case io_request(Req, Iport, Oport) of - ok -> - IOQueue; - Reply -> - {{Origin,Reply}, IOQ} - end; -handle_req(Msg,_Iport,_Oport,{Resp, IOQ}) -> - %% All requests are queued when we have outstanding sync put_chars - {Resp, queue:in(Msg,IOQ)}. - -%% 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, IOQueue) -> - handle_escape(Iport, Oport, User, Gr, IOQueue); - -port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr, IOQueue) -> - interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue); - -port_bytes([B], Iport, Oport, Curr, User, Gr, IOQueue) -> - Curr ! {self(),{data,[B]}}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue); -port_bytes(Bs, Iport, Oport, Curr, User, Gr, IOQueue) -> - case member($\^G, Bs) of - true -> - handle_escape(Iport, Oport, User, Gr, IOQueue); - false -> - Curr ! {self(),{data,Bs}}, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue) - end. - -interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue) -> - case gr_get_info(Gr, Curr) of - undefined -> - ok; % unknown - _ -> - exit(Curr, interrupt) +server(info, {ReadHandle,eof}, State = #state{ read = ReadHandle }) -> + State#state.current_group ! {self(), eof}, + keep_state_and_data; +server(info,{ReadHandle,{signal,Signal}}, State = #state{ tty = TTYState, read = ReadHandle }) -> + {keep_state, State#state{ tty = prim_tty:handle_signal(TTYState, Signal) }}; + +server(info, {Requester, tty_geometry}, #state{ tty = TTYState }) -> + case prim_tty:window_size(TTYState) of + {ok, Geometry} -> + Requester ! {self(), tty_geometry, Geometry}, + ok; + Error -> + Requester ! {self(), tty_geometry, Error}, + ok end, - server_loop(Iport, Oport, Curr, User, Gr, IOQueue). - -handle_escape(Iport, Oport, User, Gr, IOQueue) -> - case application:get_env(stdlib, shell_esc) of - {ok,abort} -> - Pid = gr_cur_pid(Gr), - exit(Pid, die), + keep_state_and_data; +server(info, {Requester, get_unicode_state}, #state{ tty = TTYState }) -> + Requester ! {self(), get_unicode_state, prim_tty:unicode(TTYState) }, + keep_state_and_data; +server(info, {Requester, set_unicode_state, Bool}, #state{ tty = TTYState } = State) -> + OldUnicode = prim_tty:unicode(TTYState), + NewTTYState = prim_tty:unicode(TTYState, Bool), + ok = io:setopts(standard_error,[{encoding, if Bool -> unicode; true -> latin1 end}]), + Requester ! {self(), set_unicode_state, OldUnicode}, + {keep_state, State#state{ tty = NewTTYState }}; +server(info, {Requester, get_terminal_state}, _State) -> + Requester ! {self(), get_terminal_state, prim_tty:isatty(stdout) }, + keep_state_and_data; +server(info, {Requester, {open_editor, Buffer}}, #state{tty = TTYState } = State) -> + case open_editor(TTYState, Buffer) of + false -> + Requester ! {self(), {editor_data, Buffer}}, + keep_state_and_data; + {EditorPort, TmpPath} -> + {keep_state, State#state{ editor = #editor{ port = EditorPort, + file = TmpPath, + requester = Requester }}} + end; +server(info, Req, State = #state{ user = User, current_group = Curr, editor = undefined }) + when element(1,Req) =:= User orelse element(1,Req) =:= Curr, + tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 -> + %% We match {User|Curr,_}|{User|Curr,_,_} + {NewTTYState, NewQueue} = handle_req(Req, State#state.tty, State#state.queue), + {keep_state, State#state{ tty = NewTTYState, queue = NewQueue }}; +server(info, {WriteRef, ok}, State = #state{ write = WriteRef, + queue = {{Origin, MonitorRef, Reply}, IOQ} }) -> + %% We get this ok from the user_drv_writer, in io_request we store + %% info about where to send reply at head of queue + Origin ! {reply, Reply, ok}, + erlang:demonitor(MonitorRef, [flush]), + {NewTTYState, NewQueue} = handle_req(next, State#state.tty, {false, IOQ}), + {keep_state, State#state{ tty = NewTTYState, queue = NewQueue }}; +server(info, {'DOWN', MonitorRef, _, _, Reason}, + #state{ queue = {{Origin, MonitorRef, Reply}, _IOQ} }) -> + %% The writer process died, we send the correct error to the caller and + %% then stop this process. This will bring down all linked groups (including 'user'). + %% All writes from now on will throw badarg terminated. + Origin ! {reply, Reply, {error, Reason}}, + ?LOG_INFO("Failed to write to standard out (~p)", [Reason]), + stop; +server(info,{Requester, {put_chars_sync, _, _, Reply}}, _State) -> + %% This is a sync request from an unknown or inactive group. + %% We need to ack the Req otherwise originating process will hang forever. + %% We discard the output to non visible shells + Requester ! {reply, Reply, ok}, + keep_state_and_data; + +server(info,{'EXIT',User, shutdown}, #state{ user = User }) -> + keep_state_and_data; +server(info,{'EXIT',User, _Reason}, State = #state{ user = User }) -> + NewUser = start_user(), + {keep_state, State#state{ user = NewUser, + groups = gr_set_num(State#state.groups, 1, NewUser, {})}}; +server(info, {'EXIT', EditorPort, _R}, + State = #state{tty = TTYState, + editor = #editor{ requester = Requester, + port = EditorPort, + file = PathTmp}}) -> + {ok, Content} = file:read_file(PathTmp), + _ = file:del_dir_r(PathTmp), + Unicode = case unicode:characters_to_list(Content,unicode) of + {error, _, _} -> unicode:characters_to_list( + unicode:characters_to_list(Content,latin1), unicode); + U -> U + end, + Requester ! {self(), {editor_data, string:chomp(Unicode)}}, + ok = prim_tty:enable_reader(TTYState), + {keep_state, State#state{editor = undefined}}; +server(info,{'EXIT', Group, Reason}, State) -> % shell and group leader exit + case gr_cur_pid(State#state.groups) of + Group when Reason =/= die, Reason =/= terminated -> % current shell exited + Reqs = [if + Reason =/= normal -> + {put_chars,unicode,<<"*** ERROR: ">>}; + true -> % exit not caused by error + {put_chars,unicode,<<"*** ">>} + end, + {put_chars,unicode,<<"Shell process terminated! ">>}], + Gr1 = gr_del_pid(State#state.groups, Group), + case gr_get_info(State#state.groups, Group) of + {Ix,{shell,start,Params}} -> % 3-tuple == local shell + NewTTyState = io_requests(Reqs ++ [{put_chars,unicode,<<"***\n">>}], + State#state.tty), + %% restart group leader and shell, same index + NewGroup = group:start(self(), {shell,start,Params}), + {ok,Gr2} = gr_set_cur(gr_set_num(Gr1, Ix, NewGroup, + {shell,start,Params}), Ix), + {keep_state, State#state{ tty = NewTTyState, + current_group = NewGroup, + groups = Gr2 }}; + _ -> % remote shell + NewTTYState = io_requests( + Reqs ++ [{put_chars,unicode,<<"(^G to start new job) ***\n">>}], + State#state.tty), + {keep_state, State#state{ tty = NewTTYState, groups = Gr1 }} + end; + _ -> % not current, just remove it + {keep_state, State#state{ groups = gr_del_pid(State#state.groups, Group) }} + end; +server(_, _, _) -> + keep_state_and_data. + +contains_ctrl_g_or_ctrl_c(<<$\^G,_/binary>>) -> + ctrl_g; +contains_ctrl_g_or_ctrl_c(<<$\^C,_/binary>>) -> + ctrl_c; +contains_ctrl_g_or_ctrl_c(<<_/utf8,T/binary>>) -> + contains_ctrl_g_or_ctrl_c(T); +contains_ctrl_g_or_ctrl_c(<<>>) -> + none. + +switch_loop(internal, init, State) -> + case application:get_env(stdlib, shell_esc, jcl) of + abort -> + CurrGroup = gr_cur_pid(State#state.groups), + exit(CurrGroup, die), Gr1 = - case gr_get_info(Gr, Pid) of - {_Ix,{}} -> % no shell - Gr; + case gr_get_info(State#state.groups, CurrGroup) of + {_Ix,{}} -> % no shell + State#state.groups; _ -> - receive {'EXIT',Pid,_} -> - gr_del_pid(Gr, Pid) + receive {'EXIT',CurrGroup,_} -> + gr_del_pid(State#state.groups, CurrGroup) after 1000 -> - Gr + State#state.groups 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,[]}), IOQueue); - - _ -> % {ok,jcl} | undefined - io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport), + NewGroup = group:start(self(), {shell,start,[]}), + NewTTYState = io_requests([{put_chars,unicode,<<"\n">>}], State#state.tty), + {next_state, server, + State#state{ tty = NewTTYState, + groups = gr_add_cur(Gr1, NewGroup, {shell,start,[]})}}; + jcl -> + NewTTYState = + io_requests([{put_chars,unicode,<<"\nUser switch command (type h for help)\n">>}], + State#state.tty), %% init edlin used by switch command and have it copy the %% text buffer from current group process - edlin:init(gr_cur_pid(Gr)), - server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue) - 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) + edlin:init(gr_cur_pid(State#state.groups)), + {keep_state, State#state{ tty = NewTTYState }, + {next_event, internal, line}} 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 +switch_loop(internal, line, State) -> + {more_chars, Cont, Rs} = edlin:start(" --> "), + {keep_state, {Cont, State#state{ tty = io_requests(Rs, State#state.tty) }}}; +switch_loop(internal, {line, Line}, State) -> + case erl_scan:string(Line) of + {ok, Tokens, _} -> + case switch_cmd(Tokens, State#state.groups) of + {ok, Groups} -> + Curr = gr_cur_pid(Groups), + put(current_group, Curr), + {next_state, server, + State#state{ current_group = Curr, groups = Groups } }; + {retry, Requests} -> + {keep_state, State#state{ tty = io_requests(Requests, State#state.tty) }, + {next_event, internal, line}}; + {retry, Requests, Groups} -> + Curr = gr_cur_pid(Groups), + put(current_group, Curr), + {keep_state, State#state{ + tty = io_requests(Requests, State#state.tty), + current_group = Curr, + groups = Groups }, + {next_event, internal, line}} + end; + {error, _, _} -> + NewTTYState = + io_requests([{put_chars,unicode,<<"Illegal input\n">>}], State#state.tty), + {keep_state, State#state{ tty = NewTTYState }, + {next_event, internal, line}} end; -switch_cmd({ok,[{atom,_,i},{integer,_,I}],_}, Iport, Oport, Gr) -> +switch_loop(info,{ReadHandle,{data,Cs}}, {Cont, #state{ read = ReadHandle } = State}) -> + case edlin:edit_line(unicode:characters_to_list(Cs), Cont) of + {done,Line,_Rest, Rs} -> + {keep_state, State#state{ tty = io_requests(Rs, State#state.tty) }, + {next_event, internal, {line, Line}}}; + {undefined,_Char,MoreCs,NewCont,Rs} -> + {keep_state, + {NewCont, State#state{ tty = io_requests(Rs ++ [beep], State#state.tty)}}, + {next_event, info, {ReadHandle,{data,MoreCs}}}}; + {more_chars,NewCont,Rs} -> + {keep_state, + {NewCont, State#state{ tty = io_requests(Rs, State#state.tty)}}}; + {blink,NewCont,Rs} -> + {keep_state, + {NewCont, State#state{ tty = io_requests(Rs, State#state.tty)}}, + 1000} + end; +switch_loop(timeout, _, {_Cont, State}) -> + {keep_state_and_data, + {next_event, info, {State#state.read,{data,[]}}}}; +switch_loop(info, _Unknown, _State) -> + {keep_state_and_data, postpone}. + +switch_cmd([{atom,_,Key},{Type,_,Value}], Gr) + when Type =:= atom; Type =:= integer -> + switch_cmd({Key, Value}, Gr); +switch_cmd([{atom,_,Key},{atom,_,V1},{atom,_,V2}], Gr) -> + switch_cmd({Key, V1, V2}, Gr); +switch_cmd([{atom,_,Key}], Gr) -> + switch_cmd(Key, Gr); +switch_cmd([{'?',_}], Gr) -> + switch_cmd(h, Gr); + +switch_cmd(Cmd, Gr) when Cmd =:= c; Cmd =:= i; Cmd =:= k -> + switch_cmd({Cmd, gr_cur_index(Gr)}, Gr); +switch_cmd({c, I}, Gr0) -> + case gr_set_cur(Gr0, I) of + {ok,Gr} -> {ok, Gr}; + undefined -> unknown_group() + end; +switch_cmd({i, I}, Gr) -> case gr_get_num(Gr, I) of {pid,Pid} -> exit(Pid, interrupt), - switch_loop(Iport, Oport, Gr); + {retry, []}; undefined -> - unknown_group(Iport, Oport, Gr) + unknown_group() 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) -> +switch_cmd({k, I}, 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); + retry; _ -> - Gr1 = - receive {'EXIT',Pid,_} -> - gr_del_pid(Gr, Pid) - after 1000 -> - Gr - end, - switch_loop(Iport, Oport, Gr1) + receive {'EXIT',Pid,_} -> + {retry,[],gr_del_pid(Gr, Pid)} + after 1000 -> + {retry,[],Gr} + end end; undefined -> - unknown_group(Iport, Oport, Gr) + unknown_group() 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) -> +switch_cmd(j, Gr) -> + {retry, gr_list(Gr)}; +switch_cmd({s, Shell}, Gr0) when is_atom(Shell) -> 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) -> + {retry, [], Gr}; +switch_cmd(s, Gr) -> + switch_cmd({s, shell}, Gr); +switch_cmd(r, Gr0) -> case is_alive() of true -> Node = pool:get_node(), - Pid = group:start(self(), {Node,shell,start,[]}), + Pid = group:start(self(), {Node,shell,start,[]}, group_opts(Node)), Gr = gr_add_cur(Gr0, Pid, {Node,shell,start,[]}), - switch_loop(Iport, Oport, Gr); + {retry, [], Gr}; false -> - io_request({put_chars,unicode,"Not alive\n"}, Iport, Oport), - switch_loop(Iport, Oport, Gr0) + {retry, [{put_chars,unicode,<<"Node is not alive\n">>}]} + end; +switch_cmd({r, Node}, Gr) when is_atom(Node)-> + switch_cmd({r, Node, shell}, Gr); +switch_cmd({r,Node,Shell}, Gr0) when is_atom(Node), is_atom(Shell) -> + case is_alive() of + true -> + Pid = group:start(self(), {Node,Shell,start,[]}, group_opts(Node)), + Gr = gr_add_cur(Gr0, Pid, {Node,Shell,start,[]}), + {retry, [], Gr}; + false -> + {retry, [{put_chars,unicode,"Node is not alive\n"}]} 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) -> + +switch_cmd(q, _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); + {retry, [{put_chars,unicode,<<"Unknown command\n">>}]}; 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) -> +switch_cmd(h, _Gr) -> + {retry, list_commands()}; +switch_cmd([], _Gr) -> + {retry,[]}; +switch_cmd(_Ts, _Gr) -> + {retry, [{put_chars,unicode,<<"Unknown command\n">>}]}. + +unknown_group() -> + {retry,[{put_chars,unicode,<<"Unknown job\n">>}]}. + +list_commands() -> QuitReq = case erlang:system_info(break_ignored) of - true -> + true -> []; false -> - [{put_chars, unicode," q - quit erlang\n"}] + [{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 + [{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">>}]. + +group_opts(Node) -> + VersionString = erpc:call(Node, erlang, system_info, [otp_release]), + Version = list_to_integer(VersionString), + ExpandFun = + case Version > 25 of + true -> [{expand_fun,fun(B, Opts)-> erpc:call(Node,edlin_expand,expand,[B, Opts]) end}]; + false -> [{expand_fun,fun(B, _)-> erpc:call(Node,edlin_expand,expand,[B]) end}] + end, + group_opts() ++ ExpandFun. +group_opts() -> + [{expand_below, application:get_env(stdlib, shell_expand_location, below) =:= below}]. + +-spec io_request(request(), prim_tty:state()) -> {noreply, prim_tty:state()} | + {term(), reference(), prim_tty:state()}. +io_request({requests,Rs}, TTY) -> + {noreply, io_requests(Rs, TTY)}; +io_request({put_chars, unicode, Chars}, TTY) -> + write(prim_tty:handle_request(TTY, {putc, unicode:characters_to_binary(Chars)})); +io_request({put_chars_sync, unicode, Chars, Reply}, TTY) -> + {Output, NewTTY} = prim_tty:handle_request(TTY, {putc, unicode:characters_to_binary(Chars)}), + {ok, MonitorRef} = prim_tty:write(NewTTY, Output, self()), + {Reply, MonitorRef, NewTTY}; +io_request({put_expand, unicode, Chars}, TTY) -> + write(prim_tty:handle_request(TTY, {expand, unicode:characters_to_binary(Chars)})); +io_request({move_rel, N}, TTY) -> + write(prim_tty:handle_request(TTY, {move, N})); +io_request({insert_chars, unicode, Chars}, TTY) -> + write(prim_tty:handle_request(TTY, {insert, unicode:characters_to_binary(Chars)})); +io_request({delete_chars, N}, TTY) -> + write(prim_tty:handle_request(TTY, {delete, N})); +io_request(clear, TTY) -> + write(prim_tty:handle_request(TTY, clear)); +io_request(beep, TTY) -> + write(prim_tty:handle_request(TTY, beep)). + +write({Output, TTY}) -> + ok = prim_tty:write(TTY, Output), + {noreply, TTY}. + +io_requests([{insert_chars, unicode, C1},{insert_chars, unicode, C2}|Rs], TTY) -> + io_requests([{insert_chars, unicode, [C1,C2]}|Rs], TTY); +io_requests([{put_chars, unicode, C1},{put_chars, unicode, C2}|Rs], TTY) -> + io_requests([{put_chars, unicode, [C1,C2]}|Rs], TTY); +io_requests([R|Rs], TTY) -> + {noreply, NewTTY} = io_request(R, TTY), + io_requests(Rs, NewTTY); +io_requests([], TTY) -> + TTY. + +open_editor(TTY, Buffer) -> + DefaultEditor = + case os:type() of + {win32, _} -> "notepad"; + {unix, _} -> "nano" + end, + Editor = os:getenv("VISUAL", os:getenv("EDITOR", DefaultEditor)), + TmpFile = string:chomp(mktemp()) ++ ".erl", + _ = file:write_file(TmpFile, unicode:characters_to_binary(Buffer, unicode)), + case filelib:is_file(TmpFile) of + true -> + ok = prim_tty:disable_reader(TTY), + try + EditorPort = + case os:type() of + {win32, _} -> + [Cmd | Args] = string:split(Editor," ", all), + open_port({spawn_executable, os:find_executable(Cmd)}, + [{args,Args ++ [TmpFile]}, nouse_stdio]); + {unix, _ } -> + open_port({spawn, Editor ++ " " ++ TmpFile}, [nouse_stdio]) + end, + {EditorPort, TmpFile} + catch error:enoent -> + ok = prim_tty:enable_reader(TTY), + io:format(standard_error, "Could not find EDITOR '~ts'.~n", [Editor]), + false + end; + false -> + io:format(standard_error, + "Could not find create temp file '~ts'.~n", + [TmpFile]), + false end. -%% io_request(Request, InPort, OutPort) -%% io_requests(Requests, InPort, OutPort) -%% Note: InPort is unused. -io_request({requests,Rs}, Iport, Oport) -> - io_requests(Rs, Iport, Oport); -io_request(Request, _Iport, Oport) -> - case io_command(Request) of - {Data, Reply} -> - true = port_command(Oport, Data), - Reply; - unhandled -> - ok +mktemp() -> + case os:type() of + {win32, _} -> + os:cmd("powershell \"write-host (& New-TemporaryFile | Select-Object -ExpandProperty FullName)\""); + {unix,_} -> + os:cmd("mktemp") end. -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]. - -%% When a put_chars_sync command is used, user_drv guarantees that -%% the bytes have been put in the buffer of the port before an acknowledgement -%% is sent back to the process sending the request. This command was added in -%% OTP 18 to make sure that data sent from io:format is actually printed -%% to the console before the vm stops when calling erlang:halt(integer()). --dialyzer({no_improper_lists, io_command/1}). -io_command({put_chars_sync, unicode,Cs,Reply}) -> - {[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)], Reply}; -io_command({put_chars, unicode,Cs}) -> - {[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)], ok}; -io_command({move_rel,N}) -> - {[?OP_MOVE|put_int16(N, [])], ok}; -io_command({insert_chars,unicode,Cs}) -> - {[?OP_INSC|unicode:characters_to_binary(Cs,utf8)], ok}; -io_command({delete_chars,N}) -> - {[?OP_DELC|put_int16(N, [])], ok}; -io_command(beep) -> - {[?OP_BEEP], ok}; -io_command(_) -> - unhandled. +handle_req(next, TTYState, {false, IOQ} = IOQueue) -> + case queue:out(IOQ) of + {empty, _} -> + {TTYState, IOQueue}; + {{value, {Origin, Req}}, ExecQ} -> + case io_request(Req, TTYState) of + {noreply, NewTTYState} -> + handle_req(next, NewTTYState, {false, ExecQ}); + {Reply, MonitorRef, NewTTYState} -> + {NewTTYState, {{Origin, MonitorRef, Reply}, ExecQ}} + end + end; +handle_req(Msg, TTYState, {false, IOQ} = IOQueue) -> + empty = queue:peek(IOQ), + {Origin, Req} = Msg, + case io_request(Req, TTYState) of + {noreply, NewTTYState} -> + {NewTTYState, IOQueue}; + {Reply, MonitorRef, NewTTYState} -> + {NewTTYState, {{Origin, MonitorRef, Reply}, IOQ}} + end; +handle_req(Msg,TTYState,{Resp, IOQ}) -> + %% All requests are queued when we have outstanding sync put_chars + {TTYState, {Resp, queue:in(Msg,IOQ)}}. %% gr_new() %% gr_get_num(Group, Index) @@ -611,100 +866,71 @@ io_command(_) -> %% gr_add_cur(Group, Pid, Shell) %% gr_set_cur(Group, Index) %% gr_cur_pid(Group) +%% gr_cur_index(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} - +-record(group, { index, pid, shell }). +-record(gr, { next = 0, current = 0, pid = none, groups = []}). 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}}; + #gr{}. +gr_new_group(I, P, S) -> + #group{ index = I, pid = P, shell = S }. + +gr_get_num(#gr{ groups = Gs }, I) -> + case lists:keyfind(I, #group.index, Gs) of + false -> undefined; + #group{ shell = {} } -> + undefined; + #group{ pid = Pid } -> + {pid, Pid} + end. + +gr_get_info(#gr{ groups = Gs }, Pid) -> + case lists:keyfind(Pid, #group.pid, Gs) of + false -> undefined; + #group{ index = I, shell = S } -> + {I, S} + end. + +gr_add_cur(#gr{ next = Next, groups = Gs}, Pid, Shell) -> + put(current_group, Pid), + #gr{ next = Next + 1, current = Next, pid = Pid, + groups = Gs ++ [gr_new_group(Next, Pid, Shell)] + }. + +gr_set_cur(Gr, I) -> + case gr_get_num(Gr, I) of + {pid,Pid} -> + put(current_group, Pid), + {ok, Gr#gr{ current = I, pid = Pid }}; 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. +gr_set_num(Gr = #gr{ groups = Groups }, I, Pid, Shell) -> + NewGroups = lists:keystore(I, #group.index, Groups, gr_new_group(I,Pid,Shell)), + Gr#gr{ groups = NewGroups }. + + +gr_del_pid(Gr = #gr{ groups = Groups }, Pid) -> + Gr#gr{ groups = lists:keydelete(Pid, #group.pid, Groups) }. + + +gr_cur_pid(#gr{ pid = Pid }) -> + Pid. +gr_cur_index(#gr{ current = Index }) -> + Index. + +gr_list(#gr{ current = Current, groups = Groups}) -> + lists:flatmap( + fun(#group{ shell = {} }) -> + []; + (#group{ index = I, shell = S }) -> + Marker = ["*" || Current =:= I], + [{put_chars, unicode, + unicode:characters_to_binary( + io_lib:format("~4w~.1ts ~w\n", [I,Marker,S]))}] + end, Groups). diff --git a/lib/kernel/src/user_sup.erl b/lib/kernel/src/user_sup.erl index c1fb1b1a48..25b4b8fbf3 100644 --- a/lib/kernel/src/user_sup.erl +++ b/lib/kernel/src/user_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -39,11 +39,13 @@ start() -> -spec init([]) -> 'ignore' | {'error', 'nouser'} | {'ok', pid(), pid()}. init([]) -> - case get_user() of + init(init:get_arguments()); +init(Flags) -> + case get_user(Flags) of nouser -> ignore; {master, Master} -> - Pid = start_slave(Master), + Pid = start_relay(Master), {ok, Pid, Pid}; {M, F, A} -> case start_user(M, F, A) of @@ -54,7 +56,7 @@ init([]) -> end end. -start_slave(Master) -> +start_relay(Master) -> case rpc:call(Master, erlang, whereis, [user]) of User when is_pid(User) -> spawn(?MODULE, relay, [User]); @@ -112,19 +114,23 @@ wait_for_user_p(N) -> wait_for_user_p(N-1) end. -get_user() -> - Flags = init:get_arguments(), - check_flags(Flags, {user_drv, start, []}). +get_user(Flags) -> + check_flags(Flags, lists:keymember(detached, 1, 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. +check_flags([{nouser, []} |T], Attached, _) -> check_flags(T, Attached, nouser); +check_flags([{user, [User]} | T], Attached, _) -> + check_flags(T, Attached, {list_to_atom(User), start, []}); +check_flags([{noshell, []} | T], Attached, _) -> + check_flags(T, Attached, {user_drv, start, [#{ initial_shell => noshell }]}); +check_flags([{oldshell, []} | T], false, _) -> + %% When running in detached mode, we ignore any -oldshell flags as we do not + %% want input => true to be set as they may halt the node (on bsd) + check_flags(T, false, {user_drv, start, [#{ initial_shell => oldshell }]}); +check_flags([{noinput, []} | T], Attached, _) -> + check_flags(T, Attached, {user_drv, start, [#{ initial_shell => noshell, input => false }]}); +check_flags([{master, [Node]} | T], Attached, _) -> + check_flags(T, Attached, {master, list_to_atom(Node)}); +check_flags([_H | T], Attached, User) -> check_flags(T, Attached, User); +check_flags([], _Attached, User) -> User. diff --git a/lib/kernel/src/wrap_log_reader.erl b/lib/kernel/src/wrap_log_reader.erl index 3a984e56c7..97ebde3ed1 100644 --- a/lib/kernel/src/wrap_log_reader.erl +++ b/lib/kernel/src/wrap_log_reader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% Copyright Ericsson AB 1998-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -116,11 +116,11 @@ open(File, FileNo) when is_list(File), is_integer(FileNo) -> close(#wrap_reader{fd = FD}) -> file:close(FD). --type chunk_ret() :: {Continuation2, Terms :: [term()]} - | {Continuation2, +-type chunk_ret() :: {Continuation2 :: term(), Terms :: [term()]} + | {Continuation2 :: term(), Terms :: [term()], Badbytes :: non_neg_integer()} - | {Continuation2, 'eof'} + | {Continuation2 :: term(), 'eof'} | {'error', Reason :: term()}. -spec chunk(Continuation) -> chunk_ret() when diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index f7776f44fe..0d88e3555e 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -106,6 +106,7 @@ MODULES= \ net_SUITE \ os_SUITE \ pg_SUITE \ + rtnode \ seq_trace_SUITE \ $(SOCKET_MODULES) \ wrap_log_reader_SUITE \ @@ -217,6 +218,7 @@ release_tests_spec: make_emakefile $(EMAKEFILE) $(COVERFILE) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + $(INSTALL_DIR) "$(RELSYSDIR)/kernel_SUITE_data" $(INSTALL_DATA) $(ERL_TOP)/make/otp_version_tickets "$(RELSYSDIR)/kernel_SUITE_data" release_docs_spec: diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index 0668c28692..83f1bfada9 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -30,12 +30,12 @@ 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, get_env/1, + start_phases/1, get_key/1, get_env/1, get_supervisor/1, set_env/1, set_env_persistent/1, set_env_errors/1, optional_applications/1, permit_false_start_local/1, permit_false_start_dist/1, script_start/1, nodedown_start/1, init2973/0, loop2973/0, loop5606/1, otp_16504/1]). --export([config_change/1, persistent_env/1, +-export([config_change/1, persistent_env/1, invalid_app_file/1, distr_changed_tc1/1, distr_changed_tc2/1, ensure_started/1, ensure_all_started/1, shutdown_func/1, do_shutdown/1, shutdown_timeout/1, shutdown_deadlock/1, @@ -58,11 +58,11 @@ all() -> load_use_cache, ensure_started, {group, reported_bugs}, start_phases, script_start, nodedown_start, permit_false_start_local, permit_false_start_dist, get_key, get_env, ensure_all_started, - set_env, set_env_persistent, set_env_errors, + set_env, set_env_persistent, set_env_errors, get_supervisor, {group, distr_changed}, config_change, shutdown_func, shutdown_timeout, shutdown_deadlock, config_relative_paths, optional_applications, persistent_env, handle_many_config_files, format_log_1, format_log_2, - configfd_bash, configfd_port_program]. + configfd_bash, configfd_port_program, invalid_app_file]. groups() -> [{reported_bugs, [], @@ -960,9 +960,13 @@ ensure_started(_Conf) -> ok = application:unload(app1), ok. -%% Test application:ensure_all_started/1-2. +%% Test application:ensure_all_started/1-2-3. ensure_all_started(_Conf) -> + do_ensure_all_started(serial), + do_ensure_all_started(concurrent), + ok. +do_ensure_all_started(Mode) -> {ok, Fd1} = file:open("app1.app", [write]), w_app1(Fd1), file:close(Fd1), @@ -981,9 +985,10 @@ ensure_all_started(_Conf) -> %% Single app start/stop false = lists:keyfind(app1, 1, application:which_applications()), - {ok, [app1]} = application:ensure_all_started(app1), % app1 started + {ok, [app1]} = application:ensure_all_started(app1, temporary, Mode), % app1 started {app1, _, _} = lists:keyfind(app1, 1, application:which_applications()), - {ok, []} = application:ensure_all_started(app1), % no start needed + {ok, []} = application:ensure_all_started(app1, temporary), % no start needed + {ok, []} = application:ensure_all_started(app1, permanent), % no start needed ok = application:stop(app1), false = lists:keyfind(app1, 1, application:which_applications()), ok = application:unload(app1), @@ -995,13 +1000,26 @@ ensure_all_started(_Conf) -> %% Start dependencies. {error, {not_started, app9}} = application:start(app10), - {ok, [app9,app10]} = application:ensure_all_started(app10, temporary), + {ok, [app9,app10]} = application:ensure_all_started(app10, temporary, Mode), {app9, _, _} = lists:keyfind(app9, 1, application:which_applications()), {app10, _, _} = lists:keyfind(app10, 1, application:which_applications()), %% Only report apps/dependencies that actually needed to start ok = application:stop(app10), ok = application:unload(app10), - {ok, [app10]} = application:ensure_all_started(app10, temporary), + {ok, [app10]} = application:ensure_all_started(app10, temporary, Mode), + ok = application:stop(app9), + ok = application:unload(app9), + ok = application:stop(app10), + ok = application:unload(app10), + + %% Starts several + {ok, StartedSeveral} = application:ensure_all_started([app1, app10], temporary, Mode), + [app1,app10,app9] = lists:sort(StartedSeveral), + {app1, _, _} = lists:keyfind(app1, 1, application:which_applications()), + {app9, _, _} = lists:keyfind(app9, 1, application:which_applications()), + {app10, _, _} = lists:keyfind(app10, 1, application:which_applications()), + ok = application:stop(app1), + ok = application:unload(app1), ok = application:stop(app9), ok = application:unload(app9), ok = application:stop(app10), @@ -1016,16 +1034,16 @@ ensure_all_started(_Conf) -> %% nor app10 running after failing to start %% hopefully_not_an_existing_app {error, {hopefully_not_an_existing_app, {"no such file or directory", _}}}= - application:ensure_all_started(app_chain_error), + application:ensure_all_started(app_chain_error, temporary, Mode), false = lists:keyfind(app9, 1, application:which_applications()), false = lists:keyfind(app10, 1, application:which_applications()), - false = lists:keyfind(app_chain_error2,1,application:which_applications()), + false = lists:keyfind(app_chain_error2, 1, application:which_applications()), false = lists:keyfind(app_chain_error, 1, application:which_applications()), %% Here we will have app9 already running, and app10 should be %% able to boot fine. %% In this dependency failing, we expect app9 to still be running, but %% not app10 after failing to start hopefully_not_an_existing_app - {ok, [app9]} = application:ensure_all_started(app9, temporary), + {ok, [app9]} = application:ensure_all_started(app9, temporary, Mode), {error, {hopefully_not_an_existing_app, {"no such file or directory", _}}}= application:ensure_all_started(app_chain_error), {app9, _, _} = lists:keyfind(app9, 1, application:which_applications()), @@ -1652,6 +1670,12 @@ get_env(Conf) when is_list(Conf) -> default = application:get_env(kernel, error_logger_xyz, default), ok. +get_supervisor(Conf) when is_list(Conf) -> + undefined = application:get_supervisor(stdlib), + {ok, Pid} = application:get_supervisor(kernel), + Pid = erlang:whereis(kernel_sup), + ok. + %%----------------------------------------------------------------- %% Should be started in a CC view with: %% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3] @@ -2190,17 +2214,16 @@ do_configfd_test_bash() -> case application:start(os_mon) of ok -> case total_memory() of Memory when is_integer(Memory), - Memory > 16 -> + Memory > 8 -> application:stop(os_mon), - true = - ("magic42" =/= - RunInBash( - "erl " - "-noshell " - "-configfd 3 " - "-eval " - "'io:format(\"magic42\"),erlang:halt()' " - "3< <(erl -noshell -eval '(fun W(D) -> io:put_chars(D), W([D,D]) end)(<<\"00000000000000000\">>)') ")); + Res = RunInBash( + "erl " + "-noshell " + "-configfd 3 " + "-eval " + "'io:format(\"magic42\"),erlang:halt()' " + "3< <(erl -noshell -eval '(fun W(D) -> io:put_chars(D), W([D,<<\"00000000000000000\">>]) end)([])') "), + {match, _} = re:run(Res,"Max size 134217728 bytes exceeded"); _ -> io:format("Skipped huge file check to avoid flaky test on machine with less than 8GB of memory") end; @@ -2454,6 +2477,19 @@ persistent_env(Conf) when is_list(Conf) -> %% Clean up ok = application:unload(appinc). +%% Test that application app file error handling works as it should +invalid_app_file(_Config) -> + + {error,{bad_application,{application,"name",[]}}} + = application:load({application, "name",[]}), + {error,{invalid_options,#{}}} + = application:load({application, name,#{}}), + {error, {invalid_options,_}} = + application:load({application,name,[{env,[{"key",value}]}]}), + {error, {invalid_options,_}} = + application:load({application,name,[{env,[key]}]}), + {error, {invalid_options,_}} = + application:load({application,name,[{env,[{key,value},{key,value}]}]}). %% Test more than one config file defined by one -config parameter: handle_many_config_files(Conf) when is_list(Conf) -> diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 7059d477d9..8eadcf9cb3 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2021. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -40,7 +40,7 @@ on_load_deleted/1, big_boot_embedded/1, module_status/1, - get_mode/1, + get_mode/1, code_path_cache/1, normalized_paths/1, mult_embedded_flags/1]). -export([init_per_testcase/2, end_per_testcase/2, @@ -62,7 +62,7 @@ all() -> replace_path, load_file, load_abs, ensure_loaded, delete, purge, purge_many_exits, soft_purge, is_loaded, all_loaded, all_available, load_binary, dir_req, object_code, set_path_file, - upgrade, + upgrade, code_path_cache, sticky_dir, pa_pz_option, add_del_path, dir_disappeared, ext_mod_dep, clash, where_is_file, purge_stacktrace, mult_lib_roots, @@ -316,6 +316,68 @@ replace_path(Config) when is_list(Config) -> ok. +code_path_cache(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + + non_existing = code:which(?TESTMOD), % verify dummy name not in path + code:purge(?TESTMOD), % ensure no previous version in memory + code:delete(?TESTMOD), + code:purge(?TESTMOD), + + Original = code:get_path(), + Dir = filename:join(PrivDir, "myebin"), + filelib:ensure_path(Dir), + ToBeReplacedDir1 = filename:join(PrivDir, "tobereplaced-1/ebin"), + ToBeReplacedDir2 = filename:join(PrivDir, "tobereplaced-2/ebin"), + filelib:ensure_path(ToBeReplacedDir1), + filelib:ensure_path(ToBeReplacedDir2), + + File = filename:join(Dir, ?TESTMODOBJ), + {ok,?TESTMOD,Bin} = compile:forms(dummy_ast(), []), + + %% Adding a cached path and re-adding for clearing + [begin + error = code:get_object_code(?TESTMOD), + true = code:Fun(Dir, cache), + error = code:get_object_code(?TESTMOD), + ok = file:write_file(File, Bin), + error = code:get_object_code(?TESTMOD), + true = code:Fun(Dir, cache), + {_,_,_} = code:get_object_code(?TESTMOD), + code:del_path(Dir), + ok = file:delete(File) + end || Fun <- [add_path, add_patha, add_pathz]], + + Original = code:get_path(), + + %% Adding several cached paths and explicit cache clearing + [begin + error = code:get_object_code(?TESTMOD), + ok = code:Fun([Dir, ToBeReplacedDir1], cache), + error = code:get_object_code(?TESTMOD), + ok = file:write_file(File, Bin), + error = code:get_object_code(?TESTMOD), + ok = code:clear_cache(), + {_,_,_} = code:get_object_code(?TESTMOD), + ok = code:del_paths([Dir, ToBeReplacedDir1]), + ok = file:delete(File) + end || Fun <- [add_paths, add_pathsa, add_pathsz]], + + Original = code:get_path(), + + %% Replacing a non-cached path with cache and set_path for clearing + error = code:get_object_code(?TESTMOD), + true = code:add_path(ToBeReplacedDir1), + true = code:replace_path(tobereplaced, ToBeReplacedDir2, cache), + error = code:get_object_code(?TESTMOD), + ok = file:write_file(filename:join(ToBeReplacedDir2, ?TESTMODOBJ), Bin), + error = code:get_object_code(?TESTMOD), + true = code:set_path(code:get_path(), nocache), + {_,_,_} = code:get_object_code(?TESTMOD), + + true = code:set_path(Original), + ok. + %% OTP-3977. dir_disappeared(Config) when is_list(Config) -> PrivDir = proplists:get_value(priv_dir, Config), @@ -997,8 +1059,12 @@ purge_stacktrace_test(Config) when is_list(Config) -> mult_lib_roots(Config) when is_list(Config) -> DataDir = filename:join(proplists:get_value(data_dir, Config), "mult_lib_roots"), mult_lib_compile(DataDir, "my_dummy_app-b/ebin/lists"), - mult_lib_compile(DataDir, - "my_dummy_app-c/ebin/code_SUITE_mult_root_module"), + + %% We will use this module to test both code path loading and + %% code path caching. So we ensure its beam file does not exist. + CodeSuiteMultRootBeam = + filename:join(DataDir, "first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module.beam"), + file:delete(CodeSuiteMultRootBeam), %% Set up ERL_LIBS and start a peer node. ErlLibs = filename:join(DataDir, "first_root") ++ mult_lib_sep() ++ @@ -1026,9 +1092,31 @@ mult_lib_roots(Config) when is_list(Config) -> E <- lists:sort([Lib1,Lib2,Lib3,Lib4,Lib5])], io:format("~p\n", [Path]), + %% Now let's attempt to dynamically add a module, + %% this will fail due to the boot paths cache. + error = rpc:call(Node, code, get_object_code, [code_SUITE_mult_root_module]), + mult_lib_compile(DataDir, "my_dummy_app-c/ebin/code_SUITE_mult_root_module"), + error = rpc:call(Node, code, get_object_code, [code_SUITE_mult_root_module]), + %% Test that the CWD is not cached + File = filename:join([DataDir, "first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module"]), + {ok, _} = compile:file(File, [{outdir, "."}]), + {_,_,_} = rpc:call(Node, code, get_object_code, [code_SUITE_mult_root_module]), true = rpc:call(Node, code_SUITE_mult_root_module, works_fine, []), + file:delete("code_SUITE_mult_root_module.beam"), + %% Clean up so we can start again + file:delete(CodeSuiteMultRootBeam), peer:stop(Peer), + NoCacheArgs = ["-env", "ERL_LIBS", ErlLibs, "-cache_boot_paths", "false"], + {ok, NoCachePeer, NoCacheNode} = ?CT_PEER(NoCacheArgs), + + %% Now the same code should work + error = rpc:call(NoCacheNode, code, get_object_code, [code_SUITE_mult_root_module]), + mult_lib_compile(DataDir, "my_dummy_app-c/ebin/code_SUITE_mult_root_module"), + {_,_,_} = rpc:call(NoCacheNode, code, get_object_code, [code_SUITE_mult_root_module]), + true = rpc:call(NoCacheNode, code_SUITE_mult_root_module, works_fine, []), + + peer:stop(NoCachePeer), ok. mult_lib_compile(Root, Last) -> @@ -1660,9 +1748,9 @@ on_load_self_call(_Config) -> ok. on_load_do_load(Mod, Code) -> - spawn(fun() -> - {module,Mod} = code:load_binary(Mod, "", Code) - end), + spawn_link(fun() -> + {module,Mod} = code:load_binary(Mod, "", Code) + end), receive Any -> Any end. @@ -1753,9 +1841,9 @@ on_load_deleted(_Config) -> " receive _ -> ok end.\n"]), merl:print(Tree), {ok,Mod,Code} = merl:compile(Tree), - spawn(fun() -> - {module,Mod} = code:load_binary(Mod, "", Code) - end), + spawn_link(fun() -> + {module,Mod} = code:load_binary(Mod, "", Code) + end), receive after 1 -> ok end, {module,OtherMod} = code:load_binary(OtherMod, "", OtherCode), @@ -1778,10 +1866,10 @@ delete_before_reload(Mod, Reload) -> {ok,Mod,Code1} = merl:compile(Tree1), Self = self(), - spawn(fun() -> - {module,Mod} = code:load_binary(Mod, "", Code1), - Mod:f(Self) - end), + spawn_link(fun() -> + {module,Mod} = code:load_binary(Mod, "", Code1), + Mod:f(Self) + end), receive started -> ok end, true = code:delete(Mod), diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 2be791a571..dc4b6c4862 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2022. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,6 +34,8 @@ -define(datadir(Conf), proplists:get_value(data_dir, Conf)). -endif. +-compile(export_all). + -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, @@ -52,6 +54,9 @@ wrap_ext_1/1, wrap_ext_2/1, + rotate_1/1, rotate_truncate/1, rotate_reopen/1, + rotate_breopen/1, next_rotate_file/1, + head_func/1, plain_head/1, one_header/1, wrap_notif/1, full_notif/1, trunc_notif/1, blocked_notif/1, @@ -118,7 +123,7 @@ notif, new_idx_vsn, reopen, block, unblock, open, close, error, chunk, truncate, many_users, info, change_size, open_change_size, change_attribute, otp_6278, otp_10131, - otp_16768, otp_16809]). + otp_16768, otp_16809, rotate]). suite() -> @@ -127,7 +132,7 @@ suite() -> all() -> [{group, halt_int}, {group, wrap_int}, - {group, halt_ext}, {group, wrap_ext}, + {group, halt_ext}, {group, wrap_ext}, {group, rotate}, {group, read_mode}, {group, head}, {group, notif}, new_idx_vsn, reopen, {group, block}, unblock, {group, open}, {group, close}, {group, error}, chunk, @@ -146,6 +151,9 @@ groups() -> {halt_ext, [], [halt_ext_inf, {group, halt_ext_sz}]}, {halt_ext_sz, [], [halt_ext_sz_1, halt_ext_sz_2]}, {wrap_ext, [], [wrap_ext_1, wrap_ext_2]}, + {rotate, [], + [rotate_1, rotate_truncate, rotate_reopen, + rotate_breopen, next_rotate_file]}, {head, [], [head_func, plain_head, one_header]}, {notif, [], [wrap_notif, full_notif, trunc_notif, blocked_notif]}, @@ -462,7 +470,7 @@ halt_ro_crash(Conf) when is_list(Conf) -> %% This is how it was before R6B: %% {C1,T1,15} = disk_log:chunk(a,start), %% {C2,T2} = disk_log:chunk(a,C1), - {C1,_OneItem,7478} = disk_log:chunk(a,start), + {C1,_OneItem,7476} = disk_log:chunk(a,start), {C2, [], 7} = disk_log:chunk(a,C1), eof = disk_log:chunk(a,C2), ok = disk_log:close(a), @@ -815,6 +823,166 @@ wrap_ext_2(Conf) when is_list(Conf) -> del(File3, 3), ok. +%% Test rotate disk log, external, size defined. +rotate_1(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + Name = a, + {ok, Name} = disk_log:open([{name,Name}, {type,rotate}, {size,{8000, 3}}, + {format,external}, + {file, File}]), + x2simple_log(File, Name), + ok = disk_log:close(Name), + del_rot_files(File, 4), + {ok, Name} = disk_log:open([{name,Name}, {type,rotate}, {size,{8000, 3}}, + {format,external}, + {file, File}]), + {B1, _T1} = x_mk_bytes(10000), % lost due to rotation + {B2, T2} = x_mk_bytes(5000), % file a.LOG.2.gx + {B3, T3} = x_mk_bytes(4000), % file a.LOG.1.gz + {B4, T4} = x_mk_bytes(2000), % file a.LOG.1.gz + {B5, T5} = x_mk_bytes(5000), % file a.LOG.0.gz + {B6, T6} = x_mk_bytes(5000), % in the active file + ok = disk_log:blog(Name, B1), + ok = disk_log:blog(Name, B2), + ok = disk_log:blog(Name, B3), + ok = disk_log:blog_terms(a, [B4, B5, B6]), + case get_list(File ++ ".2.gz", Name, rotate) of + T2 -> + ok; + E2 -> + test_server_fail({bad_terms, E2, T2}) + end, + T34 = T3 ++ T4, + case get_list(File ++ ".1.gz", Name, rotate) of + T34 -> + ok; + E34 -> + test_server_fail({bad_terms, E34, T34}) + end, + case get_list(File ++ ".0.gz", Name, rotate) of + T5 -> + ok; + E5 -> + test_server_fail({bad_terms, E5, T5}) + end, + case get_list(File, Name) of + T6 -> + ok; + E6 -> + test_server_fail({bad_terms, E6, T6}) + end, + ok = disk_log:close(Name), + del_rot_files(File, 3). + +%% test truncate/1 for rotate logs +rotate_truncate(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + Name = a, + {ok, Name} = disk_log:open([{name,Name}, {type,rotate}, {size,{100, 3}}, + {format,external}, + {file, File}]), + B = mk_bytes(60), + ok = disk_log:blog_terms(Name, [B, B, B]), + B = get_list(File, Name), + B = get_list(File ++ ".0.gz", Name, rotate), + B = get_list(File ++ ".1.gz", Name, rotate), + ok = disk_log:truncate(Name), + [] = get_list(File, Name), + {error, enoent} = file:read_file_info(File ++ ".0.gz"), + {error, enoent} = file:read_file_info(File ++ ".1.gz"), + ok = disk_log:close(Name), + file:delete(File). + +%% test reopen/2 for rotate logs +rotate_reopen(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + Name = a, + {ok, Name} = disk_log:open([{name,Name}, {type,rotate}, {size,{100, 3}}, + {format,external}, + {file, File}]), + B = mk_bytes(60), + ok = disk_log:blog_terms(Name, [B, B, B]), + B = get_list(File, Name), + B = get_list(File ++ ".0.gz", Name, rotate), + B = get_list(File ++ ".1.gz", Name, rotate), + File1 = filename:join(Dir, "b.LOG"), + ok = disk_log:reopen(Name, File1), + [] = get_list(File, Name), + {error, enoent} = file:read_file_info(File ++ ".0.gz"), + {error, enoent} = file:read_file_info(File ++ ".1.gz"), + B = get_list(File1 ++ ".0.gz", Name, rotate), + B = get_list(File1 ++ ".1.gz", Name, rotate), + B = get_list(File1 ++ ".2.gz", Name, rotate), + ok = disk_log:close(Name), + file:delete(File), + del_rot_files(File1, 3). + +%% test breopen/3 for rotate logs +rotate_breopen(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File1 = filename:join(Dir, "a.LOG"), + Name = a, + Head1 = "thisishead1", + {ok, Name} = disk_log:open([{name,Name}, {type,rotate}, {size,{100, 3}}, + {format,external}, + {head, Head1}, + {file, File1}]), + B = mk_bytes(60), + ok = disk_log:blog_terms(Name, [B, B, B]), + FileCont = Head1 ++ B, + FileCont = get_list(File1, Name), + FileCont = get_list(File1 ++ ".0.gz", Name, rotate), + FileCont = get_list(File1 ++ ".1.gz", Name, rotate), + File2 = filename:join(Dir, "b.LOG"), + Head2 = "thisishead2", + ok = disk_log:breopen(Name, File2, Head2), + Head2 = get_list(File1, Name), + {error, enoent} = file:read_file_info(File1 ++ ".0.gz"), + {error, enoent} = file:read_file_info(File1 ++ ".1.gz"), + FileCont = get_list(File2 ++ ".0.gz", Name, rotate), + FileCont = get_list(File2 ++ ".1.gz", Name, rotate), + FileCont = get_list(File2 ++ ".2.gz", Name, rotate), + ok = disk_log:close(Name), + file:delete(File1), + del_rot_files(File2, 3). + +%% Test rotate log, force a change to next file. +next_rotate_file(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File1 = filename:join(Dir, "a.LOG"), + File2 = filename:join(Dir, "b.LOG"), + + %% Test that halt and wrap logs get error messages + {ok, a} = disk_log:open([{name, a}, {type, halt}, + {format, internal}, + {file, File1}]), + ok = disk_log:log(a, "message one"), + {error, {halt_log, a}} = disk_log:next_file(a), + + %% test a rotate log file + {ok, b} = disk_log:open([{name, b}, {type, rotate}, {size, {100,3}}, + {format,external}, + {file, File2}]), + ok = disk_log:blog(b, "message one"), + ok = disk_log:next_file(b), + ok = disk_log:blog(b, "message two"), + ok = disk_log:next_file(b), + ok = disk_log:blog(b, "message three"), + ok = disk_log:next_file(b), + ok = disk_log:blog(b, "message four"), + ok = disk_log:sync(b), + "message one" = get_list(File2 ++ ".2.gz", b, rotate), + "message two" = get_list(File2 ++ ".1.gz", b, rotate), + "message three" = get_list(File2 ++ ".0.gz", b, rotate), + "message four" = get_list(File2, b), + ok = disk_log:close(a), + ok = disk_log:close(b), + ok = file:delete(File1), + del_rot_files(File2, 3). + simple_log(Log) -> T1 = "hej", T2 = hopp, @@ -893,6 +1061,37 @@ get_list(File, Log) -> {ok, B} = file:read_file(File), binary_to_list(B). +get_list(File, Log, rotate) -> + ct:pal(?HI_VERBOSITY, "File ~p~n", [File]), + ok = disk_log:sync(Log), + DFile = filename:rootname(File,".gz"), + decompress_file(File, DFile), + {ok, B} = file:read_file(DFile), + file:delete(DFile), + binary_to_list(B). + +decompress_file(FileName, DFileName) -> + {ok,In} = file:open(FileName,[read,binary]), + {ok,Out} = file:open(DFileName,[write]), + Z = zlib:open(), + zlib:inflateInit(Z, 31), + decompress_data(Z,In,Out), + zlib:inflateEnd(Z), + zlib:close(Z), + _ = file:close(In), + _ = file:close(Out), + ok. + +decompress_data(Z,In,Out) -> + case file:read(In,1000) of + {ok,Data} -> + Decompressed = zlib:inflate(Z, Data), + _ = file:write(Out,Decompressed), + decompress_data(Z,In,Out); + eof -> + ok + end. + get_all_terms(Log, File, Type) -> {ok, _Log} = disk_log:open([{name,Log}, {type,Type}, {size,infinity}, @@ -969,6 +1168,13 @@ del(File, N) -> file:delete(File ++ "." ++ integer_to_list(N)), del(File, N-1). +del_rot_files(File, 0) -> + file:delete(File ++ ".0.gz"), + file:delete(File); +del_rot_files(File, N) -> + file:delete(File ++ "." ++ integer_to_list(N) ++ ".gz"), + del_rot_files(File, N-1). + test_server_fail(R) -> exit({?MODULE, get(line), R}). @@ -2568,16 +2774,16 @@ error_repair(Conf) when is_list(Conf) -> %% repair a file P1 = pps(), {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, - {format, internal}, {size, {40,No}}]), + {format, internal}, {size, {38,No}}]), ok = disk_log:log_terms(n, [{this,is}]), % first file full ok = disk_log:log_terms(n, [{some,terms}]), % second file full ok = disk_log:close(n), BadFile = add_ext(File, 2), % current file set_opened(BadFile), - crash(BadFile, 28), % the binary is now invalid - {repaired,n,{recovered,0},{badbytes,26}} = + crash(BadFile, 26), % the binary is now invalid + {repaired,n,{recovered,0},{badbytes,24}} = disk_log:open([{name, n}, {file, File}, {type, wrap}, - {format, internal}, {size, {40,No}}]), + {format, internal}, {size, {38,No}}]), ok = disk_log:close(n), check_pps(P1), del(File, No), @@ -2592,8 +2798,8 @@ error_repair(Conf) when is_list(Conf) -> ok = disk_log:close(n), BadFile2 = add_ext(File, 1), % current file set_opened(BadFile2), - crash(BadFile2, 51), % the second binary is now invalid - {repaired,n,{recovered,1},{badbytes,26}} = + crash(BadFile2, 47), % the second binary is now invalid + {repaired,n,{recovered,1},{badbytes,24}} = disk_log:open([{name, n}, {file, File}, {type, wrap}, {format, internal}, {size, {4000,No}}]), ok = disk_log:close(n), @@ -2651,7 +2857,7 @@ error_repair(Conf) when is_list(Conf) -> ok = disk_log:close(n), set_opened(File), crash(File, 30), - {repaired,n,{recovered,3},{badbytes,16}} = + {repaired,n,{recovered,3},{badbytes,15}} = disk_log:open([{name, n}, {file, File}, {type, halt}, {format, internal},{repair,true}, {quiet, true}, {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]), @@ -2873,12 +3079,12 @@ chunk(Conf) when is_list(Conf) -> %% Two wrap log files, writing the second one, then reading the first %% one, where a bogus term resides. {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, - {format, internal}, {size, {40,No}}]), + {format, internal}, {size, {38,No}}]), ok = disk_log:log_terms(n, [{this,is}]), % first file full ok = disk_log:log_terms(n, [{some,terms}]), % second file full 2 = curf(n), BadFile = add_ext(File, 1), - crash(BadFile, 28), % the _binary_ is now invalid + crash(BadFile, 26), % the _binary_ is now invalid {error, {corrupt_log_file, BFile}} = disk_log:chunk(n, start, 1), BadFile = BFile, ok = disk_log:close(n), @@ -2888,7 +3094,7 @@ chunk(Conf) when is_list(Conf) -> {format, internal}]), ok = disk_log:log_terms(n, [{this,is}]), ok = disk_log:sync(n), - crash(File, 28), % the _binary_ is now invalid + crash(File, 26), % the _binary_ is now invalid {error, {corrupt_log_file, File2}} = disk_log:chunk(n, start, 1), crash(File, 10), {error,{corrupt_log_file,_}} = disk_log:bchunk(n, start, 1), @@ -2982,8 +3188,8 @@ chunk(Conf) when is_list(Conf) -> {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, {format, internal}, {mode, read_only}]), CrashFile = add_ext(File, 1), - crash(CrashFile, 51), % the binary term {some,terms} is now bad - {H1, [{this,is}], 18} = disk_log:chunk(n, start, 10), + crash(CrashFile, 47), % the binary term {some,terms} is now bad + {H1, [{this,is}], 16} = disk_log:chunk(n, start, 10), {H2, [{on,a},{wrap,file}]} = disk_log:chunk(n, H1), eof = disk_log:chunk(n, H2), ok = disk_log:close(n), @@ -2997,8 +3203,8 @@ chunk(Conf) when is_list(Conf) -> ok = disk_log:close(n), {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, {format, internal}, {mode, read_only}]), - crash(File, 51), % the binary term {some,terms} is now bad - {J1, [{this,is}], 18} = disk_log:chunk(n, start, 10), + crash(File, 47), % the binary term {some,terms} is now bad + {J1, [{this,is}], 16} = disk_log:chunk(n, start, 10), {J2, [{on,a},{halt,file}]} = disk_log:chunk(n, J1), eof = disk_log:chunk(n, J2), ok = disk_log:close(n), @@ -3013,8 +3219,8 @@ chunk(Conf) when is_list(Conf) -> ok = disk_log:close(n), {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, {format, internal}, {mode, read_only}]), - crash(File, 44), % the binary term {s} is now bad - {J11, [{this,is}], 7} = disk_log:chunk(n, start, 10), + crash(File, 41), % the binary term {s} is now bad + {J11, [{this,is}], 6} = disk_log:chunk(n, start, 10), {J21, [{on,a},{halt,file}]} = disk_log:chunk(n, J11), eof = disk_log:chunk(n, J21), ok = disk_log:close(n), @@ -3133,7 +3339,7 @@ truncate(Conf) when is_list(Conf) -> ok = disk_log:truncate(n, apa), rec(1, {disk_log, node(), n, {truncated, 6}}), {0, 0} = no_overflows(n), - 23 = curb(n), + 22 = curb(n), 1 = curf(n), 1 = cur_cnt(n), true = (Size == sz(n)), @@ -3153,7 +3359,7 @@ truncate(Conf) when is_list(Conf) -> ok = disk_log:truncate(n, apa), rec(1, {disk_log, node(), n, {truncated, 3}}), {0, 0} = no_overflows(n), - 23 = curb(n), + 22 = curb(n), 1 = curf(n), 1 = cur_cnt(n), true = (Size == sz(n)), @@ -3262,45 +3468,45 @@ info_current(Conf) when is_list(Conf) -> %% Internal with header. {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, {head, header}, {size, {100,No}}]), - {26, 1} = {curb(n), cur_cnt(n)}, + {25, 1} = {curb(n), cur_cnt(n)}, {1, 1} = {no_written_items(n), no_items(n)}, ok = disk_log:log(n, B), - {94, 2} = {curb(n), cur_cnt(n)}, + {93, 2} = {curb(n), cur_cnt(n)}, {2, 2} = {no_written_items(n), no_items(n)}, ok = disk_log:close(n), {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, {notify, true}, {head, header}, {size, {100,No}}]), - {94, 2} = {curb(n), cur_cnt(n)}, + {93, 2} = {curb(n), cur_cnt(n)}, {0, 2} = {no_written_items(n), no_items(n)}, ok = disk_log:log(n, B), rec(1, {disk_log, node(), n, {wrap, 0}}), - {94, 2} = {curb(n), cur_cnt(n)}, + {93, 2} = {curb(n), cur_cnt(n)}, {2, 4} = {no_written_items(n), no_items(n)}, disk_log:inc_wrap_file(n), rec(1, {disk_log, node(), n, {wrap, 0}}), - {26, 1} = {curb(n), cur_cnt(n)}, + {25, 1} = {curb(n), cur_cnt(n)}, {3, 4} = {no_written_items(n), no_items(n)}, ok = disk_log:log_terms(n, [B,B,B]), %% Used to be one message, but now one per wrapped file. rec(1, {disk_log, node(), n, {wrap, 0}}), rec(1, {disk_log, node(), n, {wrap, 2}}), - {94, 2} = {curb(n), cur_cnt(n)}, + {93, 2} = {curb(n), cur_cnt(n)}, {8, 7} = {no_written_items(n), no_items(n)}, ok = disk_log:log_terms(n, [B]), rec(1, {disk_log, node(), n, {wrap, 2}}), ok = disk_log:log_terms(n, [B]), rec(1, {disk_log, node(), n, {wrap, 2}}), - {94, 2} = {curb(n), cur_cnt(n)}, + {93, 2} = {curb(n), cur_cnt(n)}, {12, 7} = {no_written_items(n), no_items(n)}, ok = disk_log:log_terms(n, [BB,BB]), %% Used to be one message, but now one per wrapped file. rec(2, {disk_log, node(), n, {wrap, 2}}), - {194, 2} = {curb(n), cur_cnt(n)}, + {193, 2} = {curb(n), cur_cnt(n)}, {16, 7} = {no_written_items(n), no_items(n)}, ok = disk_log:log_terms(n, [SB,SB,SB]), rec(1, {disk_log, node(), n, {wrap, 2}}), - {80, 4} = {curb(n), cur_cnt(n)}, + {79, 4} = {curb(n), cur_cnt(n)}, {20, 9} = {no_written_items(n), no_items(n)}, ok = disk_log:close(n), del(File, No), diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl index 6ca804b5bf..067209a34d 100644 --- a/lib/kernel/test/erl_distribution_wb_SUITE.erl +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -56,7 +56,9 @@ -define(DFLAG_MAP_TAG, 16#20000). -define(DFLAG_BIG_CREATION, 16#40000). -define(DFLAG_HANDSHAKE_23, 16#1000000). +-define(DFLAG_UNLINK_ID, 16#2000000). -define(DFLAG_MANDATORY_25_DIGEST, 16#4000000). +-define(DFLAG_V4_NC, 16#400000000). %% From OTP R9 extended references are compulsory. %% From OTP R10 extended pids and ports are compulsory. @@ -64,7 +66,8 @@ %% From OTP 21 NEW_FUN_TAGS is compulsory (no more tuple fallback {fun, ...}). %% From OTP 23 BIG_CREATION is compulsory. %% From OTP 25 HANDSHAKE_23, NEW_FLOATS, MAP_TAG, EXPORT_PTR_TAG, and BIT_BINARIES are compulsory. --define(COMPULSORY_DFLAGS, + +-define(DFLAGS_MANDATORY_25, (?DFLAG_EXTENDED_REFERENCES bor ?DFLAG_FUN_TAGS bor ?DFLAG_EXTENDED_PIDS_PORTS bor @@ -75,7 +78,18 @@ ?DFLAG_NEW_FLOATS bor ?DFLAG_MAP_TAG bor ?DFLAG_EXPORT_PTR_TAG bor - ?DFLAG_BIT_BINARIES)). + ?DFLAG_BIT_BINARIES bor + ?DFLAG_HANDSHAKE_23)). + +%% From OTP 26 V4_NC and UNLINK_ID are compulsory. + +-define(DFLAGS_MANDATORY_26, + (?DFLAG_V4_NC bor + ?DFLAG_UNLINK_ID)). + +-define(COMPULSORY_DFLAGS, + (?DFLAGS_MANDATORY_25 bor + ?DFLAGS_MANDATORY_26)). -define(PASS_THROUGH, $p). @@ -429,7 +443,8 @@ missing_compulsory_dflags(Config) when is_list(Config) -> end || Version <- lists:seq(?DIST_VER_LOW, ?DIST_VER_HIGH), MissingFlags <- [?DFLAG_BIT_BINARIES, - ?DFLAG_HANDSHAKE_23]], + ?DFLAG_HANDSHAKE_23, + ?DFLAG_V4_NC]], peer:stop(Peer), ok. @@ -445,7 +460,8 @@ dflag_mandatory_25(_Config) -> PortNo, [{active,false},{packet,2}]), OtherNode = list_to_atom(?CT_PEER_NAME()++"@"++atom_to_list(NB)), - send_name(SocketA, OtherNode, ?DIST_VER_HIGH, ?DFLAG_MANDATORY_25_DIGEST), + send_name(SocketA, OtherNode, ?DIST_VER_HIGH, + ?DFLAG_MANDATORY_25_DIGEST bor ?DFLAGS_MANDATORY_26), ok = recv_status(SocketA), gen_tcp:close(SocketA), peer:stop(Peer), diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index b791a577f0..42ff6517a2 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2022. All Rights Reserved. +%% Copyright Ericsson AB 1996-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -3451,9 +3451,9 @@ pid2name(Config) when is_list(Config) -> %% {ok, Pid} = file:open(Name1, [write]), {ok, Name2} = file:pid2name(Pid), - undefined = file:pid2name(self()), + Dead = spawn(fun() -> ok end), + undefined = file:pid2name(Dead), ok = file:close(Pid), - ct:sleep(1000), false = is_process_alive(Pid), undefined = file:pid2name(Pid), ok. diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl index 297c824965..7b0dbb0d2e 100644 --- a/lib/kernel/test/gen_sctp_SUITE.erl +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2022. All Rights Reserved. +%% Copyright Ericsson AB 2007-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -16,7 +16,7 @@ %% limitations under the License. %% %% %CopyrightEnd% -%% +%% -module(gen_sctp_SUITE). -include_lib("common_test/include/ct.hrl"). @@ -770,6 +770,15 @@ api_listen(Config) when is_list(Config) -> {ok,Sb} = gen_sctp:open(Pb), {ok,Sa} = gen_sctp:open(), + + element(1, os:type()) =:= unix andalso + begin + {error, nxdomain} = gen_sctp:connect(Sa, "", 65535, []), + {error, nxdomain} = gen_sctp:connect(Sa, '', 65535, []) + end, + {error, nxdomain} = gen_sctp:connect(Sa, ".", 65535, []), + {error, nxdomain} = gen_sctp:connect(Sa, '.', 65535, []), + case gen_sctp:connect(Sa, localhost, Pb, []) of {error,econnrefused} -> {ok,{Localhost, diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl index 593a784bcc..c2ab0c3df6 100644 --- a/lib/kernel/test/gen_tcp_api_SUITE.erl +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2022. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1998-2023. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,7 +14,7 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_tcp_api_SUITE). @@ -353,15 +353,22 @@ t_connect_src_port(Config) when is_list(Config) -> %% invalid things. t_connect_bad(Config) when is_list(Config) -> NonExistingPort = 45638, % Not in use, I hope. - {error, Reason1} = gen_tcp:connect(localhost, NonExistingPort, - ?INET_BACKEND_OPTS(Config)), - io:format("Error for connection attempt to port not in use: ~p", - [Reason1]), - - {error, Reason2} = gen_tcp:connect("non-existing-host-xxx", 7, - ?INET_BACKEND_OPTS(Config)), - io:format("Error for connection attempt to non-existing host: ~p", - [Reason2]), + t_connect_bad(Config, localhost, NonExistingPort, "port not in use"), + t_connect_bad(Config, "non-existing-host-xxx", 7, "non-existing host"), + element(1, os:type()) =:= unix andalso + begin + t_connect_bad(Config, "", 7, "empty host string"), + t_connect_bad(Config, '', 7, "empty host atom") + end, + t_connect_bad(Config, ".", 7, "root domain string"), + t_connect_bad(Config, '.', 7, "root domain atom"). + +t_connect_bad(Config, Host, Port, Descr) -> + {error, Reason} = + gen_tcp:connect(Host, Port,?INET_BACKEND_OPTS(Config)), + io:format( + "Error for connection attempt to " ++ Descr ++ ": ~p~n", + [Reason]), ok. @@ -1352,7 +1359,9 @@ do_simple_sockaddr_send_recv(SockAddr, _) -> %% we have to skip on that platform. s_accept_with_explicit_socket_backend(Config) when is_list(Config) -> ?TC_TRY(s_accept_with_explicit_socket_backend, - fun() -> is_socket_supported() end, + fun() -> + is_socket_supported() + end, fun() -> do_s_accept_with_explicit_socket_backend() end). do_s_accept_with_explicit_socket_backend() -> @@ -1385,8 +1394,11 @@ do_s_accept_with_explicit_socket_backend() -> is_socket_supported() -> try socket:info() of - _ -> - ok + #{io_backend := #{name := BackendName}} + when (BackendName =/= win_esaio) -> + ok; + _ -> + {skip, "Temporary exclusion"} catch error : notsup -> {skip, "esock not supported"}; diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl index 4419999036..4aefee8a79 100644 --- a/lib/kernel/test/gen_udp_SUITE.erl +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2022. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1998-2023. All Rights Reserved. +%% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. %% You may obtain a copy of the License at @@ -14,7 +14,7 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% %% @@ -37,7 +37,7 @@ init_per_testcase/2, end_per_testcase/2]). -export([ - send_to_closed/1, active_n/1, + send_to_closed/1, send_to_empty/1, active_n/1, buffer_size/1, binary_passive_recv/1, max_buffer_size/1, bad_address/1, read_packets/1, recv_poll_after_active_once/1, open_fd/1, connect/1, reconnect/1, implicit_inet6/1, @@ -118,6 +118,7 @@ inet_backend_socket_cases() -> all_cases() -> [ send_to_closed, + send_to_empty, buffer_size, binary_passive_recv, max_buffer_size, @@ -340,6 +341,23 @@ do_send_to_closed(Config) -> %%------------------------------------------------------------- +%% Send to the empty host name + +send_to_empty(Config) when is_list(Config) -> + ?TC_TRY(?FUNCTION_NAME, fun() -> do_send_to_empty(Config) end). + +do_send_to_empty(Config) -> + {ok, Sock} = ?OPEN(Config, 0), + element(1, os:type()) =:= unix andalso + begin + {error, nxdomain} = gen_udp:send(Sock, "", ?CLOSED_PORT, "xXx"), + {error, nxdomain} = gen_udp:send(Sock, '', ?CLOSED_PORT, "xXx") + end, + {error, nxdomain} = gen_udp:send(Sock, ".", ?CLOSED_PORT, "xXx"), + {error, nxdomain} = gen_udp:send(Sock, '.', ?CLOSED_PORT, "xXx"), + ok. + +%%------------------------------------------------------------- %% Test that the UDP socket buffer sizes are settable %% Test UDP buffer size setting. @@ -410,7 +428,7 @@ buffer_size_client(Server, IP, Port, Socket, Cnt, [{B,Replies}|T]=Opts) when is_binary(B) -> ?P("buffer_size_client -> Cnt=~w send size ~w expecting ~p when" "~n Info: ~p", - [Cnt, size(B), Replies, inet:info(Socket)]), + [Cnt, byte_size(B), Replies, inet:info(Socket)]), case gen_udp:send(Socket, IP, Port, <<Cnt,B/binary>>) of ok -> receive @@ -446,7 +464,7 @@ buffer_size_client(Server, IP, Port, ?P("<ERROR> Client failed sending ~w bytes of data: " "~n SndBuf: ~p" "~n Reason: ~p", - [size(B), inet:getopts(Socket, [sndbuf]), Reason]), + [byte_size(B), inet:getopts(Socket, [sndbuf]), Reason]), ct:fail(Reason) end. @@ -465,7 +483,7 @@ buffer_size_server(Client, IP, Port, buffer_size_server(Client, IP, Port, Socket, Cnt, [{B,_}|T]) when is_binary(B) -> ?P("buffer_size_server -> try receive: Cnt=~w and ~w bytes of data", - [Cnt, size(B)]), + [Cnt, byte_size(B)]), Reply = case buffer_size_server_recv(Socket, IP, Port, Cnt) of D when is_binary(D) -> SizeD = byte_size(D), @@ -496,11 +514,11 @@ buffer_size_server_recv(Socket, IP, Port, Cnt) -> "~n Cnt: ~p", [Socket, IP, Port, Cnt]), receive {udp, Socket, IP, Port, <<Cnt, B/binary>>} -> - ?P("buffer_size_server -> received (~w) ~w bytes", [Cnt, size(B)]), + ?P("buffer_size_server -> received (~w) ~w bytes", [Cnt, byte_size(B)]), B; {udp, Socket, IP, Port, <<_B/binary>>} -> ?P("buffer_size_server -> received unexpected ~w bytes", - [size(_B)]), + [byte_size(_B)]), buffer_size_server_recv(Socket, IP, Port, Cnt); {udp, Socket, IP, Port, _CRAP} -> @@ -1744,6 +1762,11 @@ do_connect(Config) when is_list(Config) -> ?P("sleep some"), ct:sleep({seconds, 5}), + ?P("try some doomed connect targets: ~p", [P1]), + {error, nxdomain} = gen_udp:connect(S2, "", ?CLOSED_PORT), + {error, nxdomain} = gen_udp:connect(S2, '', ?CLOSED_PORT), + {error, nxdomain} = gen_udp:connect(S2, ".", ?CLOSED_PORT), + {error, nxdomain} = gen_udp:connect(S2, '.', ?CLOSED_PORT), ?P("try connect second socket to: ~p, ~p", [Addr, P1]), ok = gen_udp:connect(S2, Addr, P1), ?P("try send on second socket"), @@ -2616,6 +2639,10 @@ do_simple_sockaddr_send_recv(#{family := _Fam} = SockAddr, _) -> ?P("[server] send failed: ~p", [Reason1]), exit({skip, Reason1}); + {error, enetunreach = Reason1} -> + ?P("[server] send failed: ~p", + [Reason1]), + exit({skip, Reason1}); {error, Reason1} -> exit({send_failed, Reason1}) end @@ -2641,6 +2668,10 @@ do_simple_sockaddr_send_recv(#{family := _Fam} = SockAddr, _) -> ?P("[server] send failed: ~p", [Reason2]), exit({skip, Reason2}); + {error, enetunreach = Reason2} -> + ?P("[server] send failed: ~p", + [Reason2]), + exit({skip, Reason2}); {error, Reason2} -> exit({send_failed, Reason2}) end diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index 6298130a09..9061b67be1 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2022. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -33,7 +33,7 @@ t_gethostbyaddr/0, t_gethostbyaddr/1, t_getaddr/0, t_getaddr/1, - t_gethostbyname/0, t_gethostbyname/1, + t_gethostbyname/0, t_gethostbyname/1, t_gethostbyname_empty/1, t_gethostbyaddr_v6/0, t_gethostbyaddr_v6/1, t_getaddr_v6/0, t_getaddr_v6/1, t_gethostbyname_v6/0, t_gethostbyname_v6/1, @@ -70,7 +70,7 @@ suite() -> all() -> [ - t_gethostbyaddr, t_gethostbyname, t_getaddr, + t_gethostbyaddr, t_gethostbyname, t_gethostbyname_empty, t_getaddr, t_gethostbyaddr_v6, t_gethostbyname_v6, t_getaddr_v6, ipv4_to_ipv6, host_and_addr, is_ip_address, {group, parse}, t_gethostnative, gethostnative_parallell, cname_loop, @@ -367,6 +367,18 @@ do_gethostbyname(Config) when is_list(Config) -> {error,nxdomain} = inet:gethostbyname(IP_46_Str), ok. + +t_gethostbyname_empty(Config) when is_list(Config) -> + element(1, os:type()) =:= unix andalso + begin + {error,nxdomain} = inet:gethostbyname(""), + {error,nxdomain} = inet:gethostbyname('') + end, + {error,nxdomain} = inet:gethostbyname("."), + {error,nxdomain} = inet:gethostbyname('.'), + ok. + + t_gethostbyname_v6() -> required(v6). %% Test the inet:gethostbyname/1 inet6 function. t_gethostbyname_v6(Config) when is_list(Config) -> diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index 5adce7156e..ac147551f2 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2022. All Rights Reserved. +%% Copyright Ericsson AB 2009-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -886,6 +886,9 @@ resolve(Config) when is_list(Config) -> {ptr,"c.1.0.0.0.0.f.7."++RDomain6,[{ptr,Name}],undefined}, {hinfo,Name,[{hinfo,{"BEAM","Erlang/OTP"}}],undefined}, {mx,RDomain4,[{mx,{10,"mx."++Domain}}],undefined}, + {loc,"loc."++Name, + [{loc,{{42.0625,13.125},17.0,100.0,{10000.0,10.0}}}], + undefined}, {srv,"_srv._tcp."++Name,[{srv,{10,3,4711,Name}}],undefined}, {naptr,"naptr."++Name, [{naptr,{10,5,"s","http","","_srv._tcp."++Name}}], diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/otptest.zone b/lib/kernel/test/inet_res_SUITE_data/otptest/otptest.zone index 9e4a3513f8..98b195fd97 100644 --- a/lib/kernel/test/inet_res_SUITE_data/otptest/otptest.zone +++ b/lib/kernel/test/inet_res_SUITE_data/otptest/otptest.zone @@ -42,6 +42,9 @@ wks.resolve IN WKS 127.0.0.28 TCP ( telnet smtp ) resolve IN HINFO "BEAM" "Erlang/OTP" ns.resolve IN NS resolve mx.resolve IN MX 10 resolve +;; The LOC latitude and longitude is chosen to have an exact +;; decimal degrees floating point representation +loc.resolve IN LOC 42 3 45 N 13 7 30 E 17m 100m 10000m 10m _srv._tcp.resolve IN SRV 10 3 4711 resolve naptr.resolve IN NAPTR 10 5 "S" "HTTP" "" _srv._tcp.resolve txt.resolve IN TXT "Hej " "du " "glade " diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl index ff24b2f0c3..5c95781066 100644 --- a/lib/kernel/test/inet_sockopt_SUITE.erl +++ b/lib/kernel/test/inet_sockopt_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2021. All Rights Reserved. +%% Copyright Ericsson AB 2007-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,6 +34,7 @@ -define(C_GET_SO_REUSEADDR,14). -define(C_GET_SO_KEEPALIVE,15). -define(C_GET_SO_LINGER,16). +-define(C_GET_SO_DONTROUTE,17). -define(C_GET_LINGER_SIZE,21). -define(C_GET_TCP_INFO_SIZE,22). @@ -58,7 +59,7 @@ large_raw/1,large_raw_getbin/1,combined/1,combined_getbin/1, ipv6_v6only_udp/1, ipv6_v6only_tcp/1, ipv6_v6only_sctp/1, use_ipv6_v6only_udp/1, - type_errors/1]). + type_errors/1, windows_reuseaddr/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -74,7 +75,7 @@ all() -> large_raw_getbin, combined, combined_getbin, ipv6_v6only_udp, ipv6_v6only_tcp, ipv6_v6only_sctp, use_ipv6_v6only_udp, - type_errors]. + type_errors, windows_reuseaddr]. groups() -> []. @@ -127,10 +128,12 @@ simple(Config) when is_list(Config) -> %% Loop through all socket options and check that they work. loop_all(Config) when is_list(Config) -> ListenFailures = - lists:foldr(make_check_fun(listen,1),[],all_listen_options()), + lists:foldr(make_check_fun(listen),[],all_listen_options()), + AcceptFailures = + lists:foldr(make_check_fun(accept),[],all_accept_options()), ConnectFailures = - lists:foldr(make_check_fun(connect,2),[],all_connect_options()), - case ListenFailures++ConnectFailures of + lists:foldr(make_check_fun(connect),[],all_connect_options()), + case ListenFailures++AcceptFailures++ConnectFailures of [] -> ok; Failed -> @@ -206,56 +209,56 @@ do_multiple_raw(Config, Binary) -> SoKeepalive = ask_helper(Port, ?C_GET_SO_KEEPALIVE), SoKeepaliveTrue = {raw,SolSocket,SoKeepalive,<<1:32/native>>}, SoKeepaliveFalse = {raw,SolSocket,SoKeepalive,<<0:32/native>>}, - SoReuseaddr = ask_helper(Port, ?C_GET_SO_REUSEADDR), - SoReuseaddrTrue = {raw,SolSocket,SoReuseaddr,<<1:32/native>>}, - SoReuseaddrFalse = {raw,SolSocket,SoReuseaddr,<<0:32/native>>}, + SoDontroute = ask_helper(Port, ?C_GET_SO_DONTROUTE), + SoDontrouteTrue = {raw,SolSocket,SoDontroute,<<1:32/native>>}, + SoDontrouteFalse = {raw,SolSocket,SoDontroute,<<0:32/native>>}, {S1,S2} = create_socketpair( - [SoReuseaddrFalse,SoKeepaliveTrue], - [SoKeepaliveFalse,SoReuseaddrTrue]), - {ok,[{reuseaddr,false},{keepalive,true}]} = - inet:getopts(S1, [reuseaddr,keepalive]), + [SoDontrouteFalse,SoKeepaliveTrue], + [SoKeepaliveFalse,SoDontrouteTrue]), + {ok,[{dontroute,false},{keepalive,true}]} = + inet:getopts(S1, [dontroute,keepalive]), {ok, - [{raw,SolSocket,SoReuseaddr,S1R1}, + [{raw,SolSocket,SoDontroute,S1R1}, {raw,SolSocket,SoKeepalive,S1K1}]} = inet:getopts( S1, - [{raw,SolSocket,SoReuseaddr,binarify(4, Binary)}, + [{raw,SolSocket,SoDontroute,binarify(4, Binary)}, {raw,SolSocket,SoKeepalive,binarify(4, Binary)}]), true = nintbin2int(S1R1) =:= 0, true = nintbin2int(S1K1) =/= 0, - {ok,[{keepalive,false},{reuseaddr,true}]} = - inet:getopts(S2, [keepalive,reuseaddr]), + {ok,[{keepalive,false},{dontroute,true}]} = + inet:getopts(S2, [keepalive,dontroute]), {ok, [{raw,SolSocket,SoKeepalive,S2K1}, - {raw,SolSocket,SoReuseaddr,S2R1}]} = + {raw,SolSocket,SoDontroute,S2R1}]} = inet:getopts( S2, [{raw,SolSocket,SoKeepalive,binarify(4, Binary)}, - {raw,SolSocket,SoReuseaddr,binarify(4, Binary)}]), + {raw,SolSocket,SoDontroute,binarify(4, Binary)}]), true = nintbin2int(S2K1) =:= 0, true = nintbin2int(S2R1) =/= 0, %% ok = inet:setopts( - S1, [SoReuseaddrTrue,SoKeepaliveFalse]), + S1, [SoDontrouteTrue,SoKeepaliveFalse]), ok = inet:setopts( - S2, [SoKeepaliveTrue,SoReuseaddrFalse]), + S2, [SoKeepaliveTrue,SoDontrouteFalse]), {ok, - [{raw,SolSocket,SoReuseaddr,S1R2}, + [{raw,SolSocket,SoDontroute,S1R2}, {raw,SolSocket,SoKeepalive,S1K2}]} = inet:getopts( S1, - [{raw,SolSocket,SoReuseaddr,binarify(4, Binary)}, + [{raw,SolSocket,SoDontroute,binarify(4, Binary)}, {raw,SolSocket,SoKeepalive,binarify(4, Binary)}]), true = nintbin2int(S1R2) =/= 0, true = nintbin2int(S1K2) =:= 0, {ok, [{raw,SolSocket,SoKeepalive,S2K2}, - {raw,SolSocket,SoReuseaddr,S2R2}]} = + {raw,SolSocket,SoDontroute,S2R2}]} = inet:getopts( S2, [{raw,SolSocket,SoKeepalive,binarify(4, Binary)}, - {raw,SolSocket,SoReuseaddr,binarify(4, Binary)}]), + {raw,SolSocket,SoDontroute,binarify(4, Binary)}]), true = nintbin2int(S2K2) =/= 0, true = nintbin2int(S2R2) =:= 0, %% @@ -802,6 +805,57 @@ type_errors(Config) when is_list(Config) -> gen_tcp:close(Sock2), ok. +windows_reuseaddr(Config) when is_list(Config) -> + %% Check that emulation of reuseaddr and reuseport on Windows + %% works as expected. That is, only set SO_REUSEADDR if both + %% reuseaddr and reuseport are set. + case os:type() of + {win32, _} -> + Port = start_helper(Config), + Def = {ask_helper(Port,?C_GET_SOL_SOCKET), + ask_helper(Port,?C_GET_SO_REUSEADDR)}, + stop_helper(Port), + {false, false} = windows_reuseaddr_test(Def, + [{reuseaddr,false},{reuseport,false}], + [{reuseaddr,false},{reuseport,false}]), + {false, false} = windows_reuseaddr_test(Def, + [{reuseaddr,true},{reuseport,false}], + [{reuseaddr,true},{reuseport,false}]), + {false, false} = windows_reuseaddr_test(Def, + [{reuseaddr,false},{reuseport,true}], + [{reuseaddr,false},{reuseport,true}]), + {true, true} = windows_reuseaddr_test(Def, + [{reuseaddr,true},{reuseport,true}], + [{reuseaddr,true},{reuseport,true}]), + ok; + _ -> + {skipped, "Test for Windows only"} + end. + +windows_reuseaddr_test({SolSocket, SoReuseaddr}, LOpts, COpts) -> + OptNames = fun (Opts) -> + lists:map(fun ({Name,_}) -> Name end, Opts) + end, + {L,A,C} = create_socketpair_init(LOpts, COpts), + {ok, LOpts} = inet:getopts(L, OptNames(LOpts)), + {ok, COpts} = inet:getopts(L, OptNames(COpts)), + RawOpts = [{raw, SolSocket, SoReuseaddr, 4}], + {ok,[{raw,SolSocket,SoReuseaddr,LRes}]} = inet:getopts(L, RawOpts), + LReuseaddr = case nintbin2int(LRes) of + 0 -> false; + _ -> true + end, + {ok,[{raw,SolSocket,SoReuseaddr,CRes}]} = inet:getopts(L, RawOpts), + CReuseaddr = case nintbin2int(CRes) of + 0 -> false; + _ -> true + end, + gen_tcp:close(L), + gen_tcp:close(A), + gen_tcp:close(C), + {LReuseaddr, CReuseaddr}. + + all_ok([]) -> true; all_ok([H|T]) when H >= 0 -> @@ -810,14 +864,23 @@ all_ok(_) -> false. -make_check_fun(Type,Element) -> +make_check_fun(Type) -> fun({Name,V1,V2,Mand,Chang},Acc) -> - {LO1,CO1} = setelement(Element,{[],[]}, [{Name,V1}]), - {LO2,CO2} = setelement(Element,{[],[]}, [{Name,V2}]), - {X1,Y1} = create_socketpair(LO1,CO1), - {X2,Y2} = create_socketpair(LO2,CO2), - S1 = element(Element,{X1,Y1}), - S2 = element(Element,{X2,Y2}), + {LO1,CO1} = case Type of + connect -> {[],[{Name,V1}]}; + _ -> {[{Name,V1}],[]} + end, + {LO2,CO2} = case Type of + connect -> {[],[{Name,V2}]}; + _ -> {[{Name,V2}],[]} + end, + {X1,Y1,Z1} = create_socketpair_init(LO1,CO1), + {X2,Y2,Z2} = create_socketpair_init(LO2,CO2), + {S1,S2} = case Type of + listen -> {X1,X2}; + accept -> {Y1,Y2}; + connect -> {Z1,Z2} + end, {ok,[{Name,R1}]} = inet:getopts(S1,[Name]), {ok,[{Name,R2}]} = inet:getopts(S2,[Name]), NewAcc = @@ -856,16 +919,23 @@ make_check_fun(Type,Element) -> end, gen_tcp:close(X1), gen_tcp:close(Y1), + gen_tcp:close(Z1), gen_tcp:close(X2), gen_tcp:close(Y2), + gen_tcp:close(Z2), NewAcc end. %% {OptionName,Value1,Value2,Mandatory,Changeable} all_listen_options() -> + OsType = os:type(), + OsVersion = os:version(), [{tos,0,1,false,true}, {priority,0,1,false,true}, - {reuseaddr,false,true,false,true}, + {reuseaddr,false,true,mandatory_reuseaddr(OsType,OsVersion),false}, + {reuseport,false,true,mandatory_reuseport(OsType,OsVersion),false}, + {reuseport_lb,false,true,mandatory_reuseport_lb(OsType,OsVersion),false}, + {exclusiveaddruse,false,true,mandatory_exclusiveaddruse(OsType,OsVersion),false}, {keepalive,false,true,true,true}, {linger, {false,10}, {true,10},true,true}, {sndbuf,2048,4096,false,true}, @@ -887,10 +957,22 @@ all_listen_options() -> {delay_send,false,true,true,true}, {packet_size,0,4,true,true} ]. + +all_accept_options() -> + A0 = lists:keydelete(exclusiveaddruse, 1, all_listen_options()), + A1 = lists:keydelete(reuseaddr, 1, A0), + A2 = lists:keydelete(reuseport, 1, A1), + lists:keydelete(reuseport_lb, 1, A2). + all_connect_options() -> + OsType = os:type(), + OsVersion = os:version(), [{tos,0,1,false,true}, {priority,0,1,false,true}, - {reuseaddr,false,true,false,true}, + {reuseaddr,false,true,mandatory_reuseaddr(OsType,OsVersion),false}, + {reuseport,false,true,mandatory_reuseport(OsType,OsVersion),false}, + {reuseport_lb,false,true,mandatory_reuseport_lb(OsType,OsVersion),false}, + {exclusiveaddruse,false,true,mandatory_exclusiveaddruse(OsType,OsVersion),false}, {keepalive,false,true,true,true}, {linger, {false,10}, {true,10},true,true}, {sndbuf,2048,4096,false,true}, @@ -914,11 +996,55 @@ all_connect_options() -> ]. -create_socketpair(ListenOptions,ConnectOptions) -> +%% Mandatory on a lot of system other than those listed below. Please add more... +mandatory_reuseaddr({unix, linux}, _OsVersion) -> + true; +mandatory_reuseaddr({unix, freebsd}, _OsVersion) -> + true; +mandatory_reuseaddr({unix, darwin}, _OsVersion) -> + true; +mandatory_reuseaddr({win32, _}, _OsVersion) -> + true; %% reuseaddr and reuseport are emulated by the inet-driver +mandatory_reuseaddr(_OsType, _OsVersion) -> + false. + +%% Mandatory an a lot of system other than those listed below. Please add more... +mandatory_reuseport({win32, _}, _OsVersion) -> + true; %% reuseaddr and reuseport are emulated by the inet-driver +mandatory_reuseport({unix, linux}, {X,Y,_Z}) when X > 4 orelse X == 4 andalso Y >= 6 -> + true; +mandatory_reuseport({unix, freebsd}, {X,Y,_Z}) when X > 11 orelse X == 11 andalso Y >= 4 -> + %% I know that it is available on 11.4, but it may be available earlier... + true; +mandatory_reuseport({unix, darwin}, {X,Y,_Z}) when X > 26 orelse X == 26 andalso Y >= 6 -> + %% I know that it is available on 26.6, but it may be available earlier... + true; +mandatory_reuseport(_OsType, _OsVersion) -> + false. + +%% Perhaps mandatory an system other than those listed below. Please add more... +mandatory_reuseport_lb({unix, linux}, {X,Y,_Z}) when X > 4 orelse X == 4 andalso Y >= 6 -> + true; +mandatory_reuseport_lb({unix, freebsd}, {X,Y,_Z}) when X > 13 orelse X == 13 andalso Y >= 1 -> + %% I know that it is available on 13.1, but it may be available earlier... + true; +mandatory_reuseport_lb(_OsType, _OsVersion) -> + false. + +mandatory_exclusiveaddruse({win32, _}, {X,Y,_Z}) when X > 5 orelse X == 5 andalso Y >= 2 -> + true; +mandatory_exclusiveaddruse(_OsType, _OsVersion) -> + false. + +create_socketpair_init(ListenOptions,ConnectOptions) -> {ok,LS}=gen_tcp:listen(0,ListenOptions), {ok,Port}=inet:port(LS), {ok,CS}=gen_tcp:connect(localhost,Port,ConnectOptions), {ok,AS}=gen_tcp:accept(LS), + {LS,AS,CS}. + +create_socketpair(ListenOptions,ConnectOptions) -> + {LS,AS,CS} = create_socketpair_init(ListenOptions,ConnectOptions), gen_tcp:close(LS), {AS,CS}. diff --git a/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c b/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c index 9c8f8eb91a..31d82f4ba4 100644 --- a/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c +++ b/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c @@ -40,6 +40,7 @@ #define C_GET_SO_REUSEADDR 14 #define C_GET_SO_KEEPALIVE 15 #define C_GET_SO_LINGER 16 +#define C_GET_SO_DONTROUTE 17 #define C_GET_LINGER_SIZE 21 #define C_GET_TCP_INFO_SIZE 22 @@ -135,6 +136,11 @@ int main(void){ res = sizeof(struct linger); break; #endif +#ifdef SO_DONTROUTE + case C_GET_SO_DONTROUTE: + res = SO_DONTROUTE; + break; +#endif #if defined(TCP_INFO) && defined(HAVE_LINUX_TCP_H) case C_GET_TCP_INFO_SIZE: res = sizeof(struct tcp_info); diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl index bc3882b862..ea75f040f2 100644 --- a/lib/kernel/test/init_SUITE.erl +++ b/lib/kernel/test/init_SUITE.erl @@ -29,7 +29,7 @@ many_restarts/0, many_restarts/1, restart_with_mode/1, get_plain_arguments/1, reboot/1, stop_status/1, stop/1, get_status/1, script_id/1, - dot_erlang/1, + dot_erlang/1, unknown_module/1, find_system_processes/0]). -export([boot1/1, boot2/1]). @@ -48,7 +48,7 @@ all() -> [get_arguments, get_argument, boot_var, many_restarts, restart_with_mode, get_plain_arguments, restart, stop_status, get_status, script_id, - dot_erlang, {group, boot}]. + dot_erlang, unknown_module, {group, boot}]. groups() -> [{boot, [], [boot1, boot2]}]. @@ -689,6 +689,21 @@ dot_erlang(Config) -> ok. +unknown_module(Config) when is_list(Config) -> + Port = open_port({spawn, "erl -s unknown_module"}, + [exit_status, use_stdio, stderr_to_stdout]), + Error = "Error! Failed to load module 'unknown_module' because it cannot be found.", + [_ | _] = string:find(collect_until_exit_one(Port), Error), + ok. + +collect_until_exit_one(Port) -> + receive + {Port, {data, Msg}} -> Msg ++ collect_until_exit_one(Port); + {Port, {exit_status, 1}} -> [] + after + 30_000 -> ct:fail(erl_timeout) + end. + %% ------------------------------------------------ %% Start the slave system with -boot flag. %% ------------------------------------------------ diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl index ec3887df1d..04f4143ea9 100644 --- a/lib/kernel/test/interactive_shell_SUITE.erl +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2022. All Rights Reserved. +%% Copyright Ericsson AB 2007-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,6 +19,21 @@ %% -module(interactive_shell_SUITE). -include_lib("kernel/include/file.hrl"). +-include_lib("common_test/include/ct.hrl"). + +%% Things to add tests for: +%% - TERM=dumb +%% - Editing line > MAXSIZE (1 << 16) +%% - \t tests (use io:format("\t")) +%% - xn fix after Delete and Backspace +%% - octal_to_hex > 255 length (is this possible?) +%% 1222 0 : } else if (lastput == 0) { /* A multibyte UTF8 character */ +%% 1223 0 : for (i = 0; i < ubytes; ++i) { +%% 1224 0 : outc(ubuf[i]); +%% 1225 : } +%% 1226 : } else { +%% 1227 0 : outc(lastput); +%% - $TERM set to > 1024 long value -export([all/0, suite/0, groups/0, init_per_suite/1, end_per_suite/1, init_per_group/2, end_per_group/2, @@ -31,27 +46,45 @@ shell_history_custom/1, shell_history_custom_errors/1, job_control_remote_noshell/1,ctrl_keys/1, get_columns_and_rows_escript/1, - remsh_basic/1, remsh_longnames/1, remsh_no_epmd/1]). + shell_navigation/1, shell_xnfix/1, shell_delete/1, + shell_transpose/1, shell_search/1, shell_insert/1, + shell_update_window/1, shell_huge_input/1, + shell_invalid_unicode/1, shell_support_ansi_input/1, + shell_invalid_ansi/1, shell_suspend/1, shell_full_queue/1, + shell_unicode_wrap/1, shell_delete_unicode_wrap/1, + shell_delete_unicode_not_at_cursor_wrap/1, + shell_expand_location_above/1, + shell_expand_location_below/1, + shell_update_window_unicode_wrap/1, + shell_standard_error_nlcr/1, shell_clear/1, + remsh_basic/1, remsh_error/1, remsh_longnames/1, remsh_no_epmd/1, + remsh_expand_compatibility_25/1, remsh_expand_compatibility_later_version/1, + external_editor/1, external_editor_visual/1, + external_editor_unicode/1, shell_ignore_pager_commands/1]). -%% For spawn --export([toerl_server/3]). %% Exports for custom shell history module -export([load/0, add/1]). +%% For custom prompt testing +-export([prompt/1]). suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,3}}]. all() -> - [get_columns_and_rows_escript,get_columns_and_rows, - exit_initial, job_control_local, - job_control_remote, job_control_remote_noshell, - ctrl_keys, stop_during_init, wrap, - {group, shell_history}, - {group, remsh}]. + [{group, to_erl}, + {group, tty}]. groups() -> - [{shell_history, [], + [{to_erl,[], + [get_columns_and_rows_escript,get_columns_and_rows, + exit_initial, job_control_local, + job_control_remote, job_control_remote_noshell, + ctrl_keys, stop_during_init, wrap, + shell_invalid_ansi, + {group, shell_history}, + {group, remsh}]}, + {shell_history, [], [shell_history, shell_history_resize, shell_history_eaccess, @@ -65,26 +98,60 @@ groups() -> shell_history_custom_errors]}, {remsh, [], [remsh_basic, + remsh_error, remsh_longnames, - remsh_no_epmd]} + remsh_no_epmd, + remsh_expand_compatibility_25, + remsh_expand_compatibility_later_version]}, + {tty,[], + [{group,tty_unicode}, + {group,tty_latin1}, + shell_suspend, + shell_full_queue, + external_editor, + external_editor_visual, + shell_ignore_pager_commands + ]}, + {tty_unicode,[parallel], + [{group,tty_tests}, + shell_invalid_unicode, + external_editor_unicode + %% unicode wrapping does not work right yet + %% shell_unicode_wrap, + %% shell_delete_unicode_wrap, + %% shell_delete_unicode_not_at_cursor_wrap, + %% shell_update_window_unicode_wrap + ]}, + {tty_latin1,[],[{group,tty_tests}]}, + {tty_tests, [parallel], + [shell_navigation, shell_xnfix, shell_delete, + shell_transpose, shell_search, shell_insert, + shell_update_window, shell_huge_input, + shell_support_ansi_input, + shell_standard_error_nlcr, + shell_expand_location_above, + shell_expand_location_below, + shell_clear]} ]. init_per_suite(Config) -> - case get_progs() of - {error, Error} -> - {skip, Error}; - _ -> - Term = os:getenv("TERM", "dumb"), - os:putenv("TERM", "vt100"), - DefShell = get_default_shell(), - [{default_shell,DefShell},{term,Term}|Config] - end. + Term = os:getenv("TERM", "dumb"), + os:putenv("TERM", "vt100"), + [{term,Term}|Config]. end_per_suite(Config) -> Term = proplists:get_value(term,Config), os:putenv("TERM",Term), ok. +init_per_group(to_erl, Config) -> + case rtnode:get_progs() of + {error, Error} -> + {skip, Error}; + _ -> + DefShell = rtnode:get_default_shell(), + [{default_shell,DefShell}|Config] + end; init_per_group(remsh, Config) -> case proplists:get_value(default_shell, Config) of old -> {skip, "Not supported in old shell"}; @@ -95,13 +162,37 @@ init_per_group(shell_history, Config) -> old -> {skip, "Not supported in old shell"}; new -> Config end; +init_per_group(tty, Config) -> + case string:split(tmux("-V")," ") of + ["tmux",[Num,$.|_]] when Num >= $3, Num =< $9 -> + tmux("kill-session"), + "" = tmux("-u new-session -x 50 -y 60 -d"), + ["" = tmux(["set-environment '",Name,"' '",Value,"'"]) + || {Name,Value} <- os:env()], + Config; + ["tmux", Vsn] -> + {skip, "invalid tmux version " ++ Vsn ++ ". Need vsn 3 or later"}; + Error -> + {skip, "tmux not installed " ++ Error} + end; +init_per_group(Group, Config) when Group =:= tty_unicode; + Group =:= tty_latin1 -> + [Lang,_] = + string:split( + os:getenv("LC_ALL", + os:getenv("LC_CTYPE", + os:getenv("LANG","en_US.UTF-8"))),"."), + case Group of + tty_unicode -> + [{encoding, unicode},{env,[{"LC_ALL",Lang++".UTF-8"}]}|Config]; + tty_latin1 -> + % [{encoding, latin1},{env,[{"LC_ALL",Lang++".ISO-8859-1"}]}|Config], + {skip, "latin1 tests not implemented yet"} + end; init_per_group(sh_custom, Config) -> - %% Ensure that ERL_AFLAGS will not override the value of the - %% shell_history variable. - Name = interactive_shell_sh_custom, - Args = "-noshell -kernel shell_history not_overridden", - {ok, Node} = test_server:start_node(Name, slave, [{args,Args}]), - try erpc:call(Node, application, get_env, [kernel, shell_history], timeout(normal)) of + %% Ensure that ERL_AFLAGS will not override the value of the shell_history variable. + {ok, Peer, Node} = ?CT_PEER(["-noshell","-kernel","shell_history","not_overridden"]), + try erpc:call(Node, application, get_env, [kernel, shell_history], rtnode:timeout(normal)) of {ok, not_overridden} -> Config; _ -> @@ -112,23 +203,45 @@ init_per_group(sh_custom, Config) -> io:format("~p\n~p\n~p\n", [C,R,Stk]), {skip, "Unexpected error"} after - test_server:stop_node(Node) + peer:stop(Peer) end; init_per_group(_GroupName, Config) -> Config. +end_per_group(tty, _Config) -> + Windows = string:split(tmux("list-windows"), "\n", all), + lists:foreach( + fun(W) -> + case string:split(W, " ", all) of + ["0:" | _] -> ok; + [No, _Name | _] -> + "" = os:cmd(["tmux select-window -t ", string:split(No,":")]), + ct:log("~ts~n~ts",[W, os:cmd(lists:concat(["tmux capture-pane -p -e"]))]) + end + end, Windows), +% "" = os:cmd("tmux kill-session") + ok; end_per_group(_GroupName, Config) -> Config. -init_per_testcase(_Func, Config) -> - Config. - -end_per_testcase(_Case, _Config) -> - %% Terminate any connected nodes. They may disturb test cases that follow. - lists:foreach(fun(Node) -> - catch erpc:call(Node, erlang, halt, []) - end, nodes()), - ok. +init_per_testcase(Func, Config) -> + Path = [Func, + [proplists:get_value(name,P) || + P <- [proplists:get_value(tc_group_properties,Config,[])] ++ + proplists:get_value(tc_group_path,Config,[])]], + [{tc_path, lists:concat(lists:join("-",lists:flatten(Path)))} | Config]. + +end_per_testcase(_Case, Config) -> + GroupProperties = proplists:get_value(tc_group_properties, Config), + case (GroupProperties =/= false) andalso proplists:get_value(parallel, GroupProperties, false) of + true -> ok; + false -> + %% Terminate any connected nodes. They may disturb test cases that follow. + lists:foreach(fun(Node) -> + catch erpc:call(Node, erlang, halt, []) + end, nodes()), + ok + end. %%-define(DEBUG,1). -ifdef(DEBUG). @@ -155,7 +268,7 @@ run_unbuffer_escript(Rows, Columns, EScript, NoTermStdIn, NoTermStdOut) -> {true, true} -> io_lib:format(" > ~s < ~s ; cat ~s", [TmpFile, TmpFile, TmpFile]) end, Command = io_lib:format("unbuffer -p bash -c \"stty rows ~p; stty columns ~p; escript ~s ~s\"", - [Rows, Columns, EScript, CommandModifier]), + [Rows, Columns, EScript, CommandModifier]), %% io:format("Command: ~s ~n", [Command]), Out = os:cmd(Command), %% io:format("Out: ~p ~n", [Out]), @@ -203,50 +316,1294 @@ get_columns_and_rows(Config) when is_list(Config) -> ok. test_columns_and_rows(old, Args) -> - rtnode([{putline, ""}, - {putline, "2."}, - {expect, "2\r\n"}, - {putline, "io:columns()."}, - {expect, "{error,enotsup}\r\n"}, - {putline, "io:rows()."}, - {expect, "{error,enotsup}\r\n"} - ], [], [], Args), - - rtnode([{putline, ""}, - {putline, "2."}, - {expect, "2\r\n"}, - {putline, "io:columns()."}, - {expect, "{ok,90}\r\n"}, - {putline,"io:rows()."}, - {expect, "{ok,40}\r\n"}], - [], - "stty rows 40; stty columns 90; ", - Args); + rtnode:run( + [{putline, ""}, + {putline, "2."}, + {expect, "2\r\n"}, + {putline, "io:columns()."}, + {expect, "{error,enotsup}\r\n"}, + {putline, "io:rows()."}, + {expect, "{error,enotsup}\r\n"} + ], [], [], Args), + + rtnode:run( + [{putline, ""}, + {putline, "2."}, + {expect, "2\r\n"}, + {putline, "io:columns()."}, + {expect, "{ok,90}\r\n"}, + {putline,"io:rows()."}, + {expect, "{ok,40}\r\n"}], + [], + "stty rows 40; stty columns 90; ", + Args); test_columns_and_rows(new, _Args) -> - rtnode([{putline, ""}, - {expect, "1> $"}, - {putline, "2."}, - {expect, "\r\n2\r\n"}, - {expect, "> $"}, - {putline, "io:columns()."}, - {expect, "{ok,80}\r\n"}, - {expect, "> $"}, - {putline, "io:rows()."}, - {expect, "\r\n{ok,24}\r\n"} - ]), - - rtnode([{putline, ""}, - {expect, "1> $"}, - {putline, "2."}, - {expect, "\r\n2\r\n"}, - {expect, "> $"}, - {putline, "io:columns()."}, - {expect, "\r\n{ok,90}\r\n"}, - {expect, "> $"}, - {putline, "io:rows()."}, - {expect, "\r\n{ok,40}\r\n"}], - [], - "stty rows 40; stty columns 90; "). + rtnode:run( + [{putline, ""}, + {expect, "1> $"}, + {putline, "2."}, + {expect, "\r\n2\r\n"}, + {expect, "> $"}, + {putline, "io:columns()."}, + {expect, "{ok,80}\r\n"}, + {expect, "> $"}, + {putline, "io:rows()."}, + {expect, "\r\n{ok,24}\r\n"} + ]), + + rtnode:run( + [{putline, ""}, + {expect, "1> $"}, + {putline, "2."}, + {expect, "\r\n2\r\n"}, + {expect, "> $"}, + {putline, "io:columns()."}, + {expect, "\r\n{ok,90}\r\n"}, + {expect, "> $"}, + {putline, "io:rows()."}, + {expect, "\r\n{ok,40}\r\n"}], + [], + "stty rows 40; stty columns 90; "). + +shell_navigation(Config) -> + + Term = start_tty(Config), + + try + [begin + send_tty(Term,"{aaa,'b"++U++"b',ccc}"), + check_location(Term, {0, 0}), %% Check that cursor jump backward + check_content(Term, "{aaa,'b"++U++"b',ccc}$"), + timer:sleep(1000), %% Wait for cursor to jump back + check_location(Term, {0, width("{aaa,'b"++U++"b',ccc}")}), + send_tty(Term,"Home"), + check_location(Term, {0, 0}), + send_tty(Term,"End"), + check_location(Term, {0, width("{aaa,'b"++U++"b',ccc}")}), + send_tty(Term,"Left"), + check_location(Term, {0, width("{aaa,'b"++U++"b',ccc")}), + send_tty(Term,"C-Left"), + check_location(Term, {0, width("{aaa,'b"++U++"b',")}), + send_tty(Term,"C-Left"), + check_location(Term, {0, width("{aaa,")}), + send_tty(Term,"C-Right"), + check_location(Term, {0, width("{aaa,'b"++U++"b'")}), + send_tty(Term,"C-Left"), + check_location(Term, {0, width("{aaa,")}), + send_tty(Term,"C-Left"), + check_location(Term, {0, width("{")}), + send_tty(Term,"C-Left"), + check_location(Term, {0, 0}), + send_tty(Term,"C-E"), + check_location(Term, {0, width("{aaa,'b"++U++"b',ccc}")}), + send_tty(Term,"C-A"), + check_location(Term, {0, 0}), + send_tty(Term,"Enter") + end || U <- hard_unicode()], + ok + after + stop_tty(Term) + end. + +shell_clear(Config) -> + + Term = start_tty(Config), + {Rows, _Cols} = get_window_size(Term), + + try + send_tty(Term,"foobar."), + send_tty(Term,"Enter"), + check_content(Term, "foobar"), + check_location(Term, {0, 0}), + send_tty(Term,"bazbat"), + check_location(Term, {0, 6}), + send_tty(Term,"C-L"), + check_location(Term, {-Rows+1, 6}), + check_content(Term, "bazbat") + after + stop_tty(Term) + end. + +shell_xnfix(Config) -> + + Term = start_tty(Config), + + {_Rows, Cols} = get_window_size(Term), + {_Row, Col} = get_location(Term), + + As = lists:duplicate(Cols - Col - 1,"a"), + + try + [begin + check_location(Term, {0, 0}), + send_tty(Term,As), + check_content(Term,[As,$$]), + check_location(Term, {0, Cols - Col - 1}), + send_tty(Term,"a"), + check_location(Term, {0, -Col}), + send_tty(Term,"aaa"), + check_location(Term, {0, -Col + 3}), + [send_tty(Term,"Left") || _ <- lists:seq(1,3 + width(U))], + send_tty(Term,U), + %% a{Cols-1}U\naaaaa + check_content(Term,[lists:duplicate(Cols - Col - 1 - width(U),$a), + U,"\n",lists:duplicate(3+width(U), $a),"$"]), + check_location(Term, {0, -Col}), + send_tty(Term,"Left"), + send_tty(Term,U), + %% a{Cols-1}U\nUaaaaa + check_content(Term,[lists:duplicate(Cols - Col - 1 - width(U),$a), + U,"\n",U,lists:duplicate(3+width(U), $a),"$"]), + check_location(Term, {0, -Col}), + %% send_tty(Term,"Left"), + %% send_tty(Term,"BSpace"), + %% a{Cols-2}U\nUaaaaa + %% check_content(Term,[lists:duplicate(Cols - Col - 2 - width(U),$a), + %% U,"\n",U,lists:duplicate(3+width(U), $a),"$"]), + %% send_tty(Term,"BSpace"), + %% check_content(Term,[lists:duplicate(Cols - Col - 1 - width(U),$a), + %% U,U,"\n",lists:duplicate(3+width(U), $a),"$"]), + %% send_tty(Term,"aa"), + %% check_content(Term,[lists:duplicate(Cols - Col - 2 - width(U),$a), + %% U,"a\n",U,lists:duplicate(3+width(U), $a),"$"]), + %% check_location(Term, {0, -Col}), + send_tty(Term,"C-K"), + check_location(Term, {0, -Col}), + send_tty(Term,"C-A"), + check_location(Term, {-1, 0}), + send_tty(Term,"C-E"), + check_location(Term, {0, -Col}), + send_tty(Term,"Enter"), + ok + end || U <- hard_unicode()] + after + stop_tty(Term) + end. + + +%% Characters that are larger than 2 wide need special handling when they +%% are at the end of the current line. +shell_unicode_wrap(Config) -> + + Term = start_tty(Config), + + {_Rows, Cols} = get_window_size(Term), + {_Row, Col} = get_location(Term), + + try + [begin + FirstLine = [U,lists:duplicate(Cols - Col - width(U)*2 + 1,"a")], + OtherLineA = [U,lists:duplicate(Cols - width(U) * 2+1,"a")], + OtherLineB = [U,lists:duplicate(Cols - width(U) * 2+1,"b")], + OtherLineC = [U,lists:duplicate(Cols - width(U) * 2+1,"c")], + OtherLineD = [U,lists:duplicate(Cols - width(U) * 2+1,"d")], + send_tty(Term,FirstLine), + check_content(Term, [FirstLine,$$]), + check_location(Term, {0, Cols - Col - width(U)+1}), + + send_tty(Term,OtherLineA), + check_content(Term, [OtherLineA,$$]), + check_location(Term, {0, Cols - Col - width(U)+1}), + + send_tty(Term,OtherLineB), + check_content(Term, [OtherLineB,$$]), + check_location(Term, {0, Cols - Col - width(U)+1}), + + send_tty(Term,OtherLineC), + check_content(Term, [OtherLineC,$$]), + check_location(Term, {0, Cols - Col - width(U)+1}), + + send_tty(Term,OtherLineD), + check_content(Term, [OtherLineD,$$]), + check_location(Term, {0, Cols - Col - width(U)+1}), + + send_tty(Term,"C-A"), + check_location(Term, {-4, 0}), %% Broken + send_tty(Term,"Right"), + check_location(Term, {-4, width(U)}), %% Broken + + send_tty(Term,"DC"), %% Broken + check_content(Term, ["a.*",U,"$"]), + check_content(Term, ["^b.*",U,"c$"]), + check_content(Term, ["^c.*",U,"dd$"]), + + send_tty(Term,"a"), + check_content(Term, [FirstLine,$$]), + check_content(Term, [OtherLineA,$$]), + check_content(Term, [OtherLineB,$$]), + check_content(Term, [OtherLineC,$$]), + check_content(Term, [OtherLineD,$$]), + + send_tty(Term,"Enter") + end || U <- hard_unicode()] + after + stop_tty(Term) + end. + +shell_delete(Config) -> + + Term = start_tty(Config), + + try + + [ begin + send_tty(Term,"a"), + check_content(Term, "> a$"), + check_location(Term, {0, 1}), + send_tty(Term,"BSpace"), + check_location(Term, {0, 0}), + check_content(Term, ">$"), + send_tty(Term,"a"), + send_tty(Term,U), + check_location(Term, {0, width([$a, U])}), + send_tty(Term,"a"), + send_tty(Term,U), + check_location(Term, {0, width([$a,U,$a,U])}), + check_content(Term, ["> a",U,$a,U,"$"]), + send_tty(Term,"Left"), + send_tty(Term,"Left"), + send_tty(Term,"BSpace"), + check_location(Term, {0, width([$a])}), + check_content(Term, ["> aa",U,"$"]), + send_tty(Term,U), + check_location(Term, {0, width([$a,U])}), + send_tty(Term,"Left"), + send_tty(Term,"DC"), + check_location(Term, {0, width([$a])}), + check_content(Term, ["> aa",U,"$"]), + send_tty(Term,"DC"), + send_tty(Term,"DC"), + check_content(Term, ["> a$"]), + send_tty(Term,"C-E"), + check_location(Term, {0, width([$a])}), + send_tty(Term,"BSpace"), + check_location(Term, {0, width([])}) + end || U <- hard_unicode()] + after + stop_tty(Term) + end. + +%% When deleting characters at the edge of the screen that are "large", +%% we need to take special care. +shell_delete_unicode_wrap(Config) -> + + Term = start_tty(Config), + + {_Rows, Cols} = get_window_size(Term), + {_Row, Col} = get_location(Term), + + try + [begin + send_tty(Term,lists:duplicate(Cols - Col,"a")), + check_content(Term,"> a*$"), + send_tty(Term,[U,U,"aaaaa"]), + check_content(Term,["\n",U,U,"aaaaa$"]), + [send_tty(Term,"Left") || _ <- lists:seq(1,5+2)], + check_location(Term,{0,-Col}), + send_tty(Term,"BSpace"), + check_content(Term,"> a* \n"), + check_location(Term,{-1,Cols - Col - 1}), + send_tty(Term,"BSpace"), + check_content(Term,["> a*",U,"\n"]), + check_location(Term,{-1,Cols - Col - 2}), + send_tty(Term,"BSpace"), + check_content(Term,["> a*",U," \n"]), + check_location(Term,{-1,Cols - Col - 3}), + send_tty(Term,"BSpace"), + check_content(Term,["> a*",U,U,"\n"]), + check_content(Term,["\naaaaa$"]), + check_location(Term,{-1,Cols - Col - 4}), + send_tty(Term,"BSpace"), + check_content(Term,["> a*",U,U,"a\n"]), + check_content(Term,["\naaaa$"]), + check_location(Term,{-1,Cols - Col - 5}), + send_tty(Term,"Enter") + end || U <- hard_unicode()] + after + stop_tty(Term) + end. + +%% When deleting characters and a "large" characters is changing line we need +%% to take extra care +shell_delete_unicode_not_at_cursor_wrap(Config) -> + + Term = start_tty(Config), + + {_Rows, Cols} = get_window_size(Term), + {_Row, Col} = get_location(Term), + + try + [begin + send_tty(Term,lists:duplicate(Cols - Col,"a")), + check_content(Term,"> a*$"), + send_tty(Term,["a",U,"aaaaa"]), + check_content(Term,["\na",U,"aaaaa$"]), + send_tty(Term,"C-A"), + send_tty(Term,"DC"), + check_content(Term,["\n",U,"aaaaa$"]), + send_tty(Term,"DC"), + check_content(Term,["\n",U,"aaaaa$"]), + check_content(Term,["> a* \n"]), + send_tty(Term,"DC"), + check_content(Term,["\naaaaa$"]), + check_content(Term,["> a*",U,"\n"]), + send_tty(Term,"DC"), + check_content(Term,["\naaaa$"]), + check_content(Term,["> a*",U,"a\n"]), + send_tty(Term,"Enter") + end || U <- hard_unicode()] + after + stop_tty(Term) + end. + +%% When deleting characters and a "large" characters is changing line we need +%% to take extra care +shell_update_window_unicode_wrap(Config) -> + + Term = start_tty(Config), + + {_Rows, Cols} = get_window_size(Term), + {_Row, Col} = get_location(Term), + + try + [begin + send_tty(Term,lists:duplicate(Cols - Col - width(U) + 1,"a")), + check_content(Term,"> a*$"), + send_tty(Term,[U,"aaaaa"]), + check_content(Term,["> a* ?\n",U,"aaaaa$"]), + tmux(["resize-window -t ",tty_name(Term)," -x ",Cols+1]), + check_content(Term,["> a*",U,"\naaaaa$"]), + tmux(["resize-window -t ",tty_name(Term)," -x ",Cols]), + check_content(Term,["> a* ?\n",U,"aaaaa$"]), + send_tty(Term,"Enter") + end || U <- hard_unicode()] + after + stop_tty(Term) + end. + +shell_transpose(Config) -> + + Term = start_tty(Config), + + Unicode = [[$a]] ++ hard_unicode(), + + try + [ + begin + send_tty(Term,"a"), + [send_tty(Term,[CP]) || CP <- U], + send_tty(Term,"b"), + [[send_tty(Term,[CP]) || CP <- U2] || U2 <- Unicode], + send_tty(Term,"cde"), + check_content(Term, ["a",U,"b",Unicode,"cde$"]), + check_location(Term, {0, width(["a",U,"b",Unicode,"cde"])}), + send_tty(Term,"Home"), + check_location(Term, {0, 0}), + send_tty(Term,"Right"), + send_tty(Term,"Right"), + check_location(Term, {0, 1+width([U])}), + send_tty(Term,"C-T"), + check_content(Term, ["ab",U,Unicode,"cde$"]), + send_tty(Term,"C-T"), + check_content(Term, ["ab",hd(Unicode),U,tl(Unicode),"cde$"]), + [send_tty(Term,"C-T") || _ <- lists:seq(1,length(Unicode)-1)], + check_content(Term, ["ab",Unicode,U,"cde$"]), + send_tty(Term,"C-T"), + check_content(Term, ["ab",Unicode,"c",U,"de$"]), + check_location(Term, {0, width(["ab",Unicode,"c",U])}), + send_tty(Term,"End"), + check_location(Term, {0, width(["ab",Unicode,"c",U,"de"])}), + send_tty(Term,"Left"), + send_tty(Term,"Left"), + send_tty(Term,"BSpace"), + check_content(Term, ["ab",Unicode,"cde$"]), + send_tty(Term,"End"), + send_tty(Term,"Enter") + end || U <- Unicode], + ok + after + stop_tty(Term), + ok + end. + +shell_search(C) -> + + Term = start_tty(C), + {_Row, Cols} = get_location(Term), + + try + send_tty(Term,"a"), + send_tty(Term,"."), + send_tty(Term,"Enter"), + send_tty(Term,"'"), + send_tty(Term,"a"), + send_tty(Term,[16#1f600]), + send_tty(Term,"'"), + send_tty(Term,"."), + send_tty(Term,"Enter"), + check_location(Term, {0, 0}), + send_tty(Term,"C-r"), + check_location(Term, {0, - Cols + width(C, "(search)`': 'a😀'.") }), + send_tty(Term,"C-a"), + check_location(Term, {0, width(C, "'a😀'.")}), + send_tty(Term,"Enter"), + send_tty(Term,"C-r"), + check_location(Term, {0, - Cols + width(C, "(search)`': 'a😀'.") }), + send_tty(Term,"a"), + check_location(Term, {0, - Cols + width(C, "(search)`a': 'a😀'.") }), + send_tty(Term,"C-r"), + check_location(Term, {0, - Cols + width(C, "(search)`a': a.") }), + send_tty(Term,"BSpace"), + check_location(Term, {0, - Cols + width(C, "(search)`': 'a😀'.") }), + send_tty(Term,"BSpace"), + check_location(Term, {0, - Cols + width(C, "(search)`': 'a😀'.") }), + ok + after + stop_tty(Term), + ok + end. + +shell_insert(Config) -> + Term = start_tty(Config), + + try + send_tty(Term,"abcdefghijklm"), + check_content(Term, "abcdefghijklm$"), + check_location(Term, {0, 13}), + send_tty(Term,"Home"), + send_tty(Term,"Right"), + send_tty(Term,"C-T"), + send_tty(Term,"C-T"), + send_tty(Term,"C-T"), + send_tty(Term,"C-T"), + check_content(Term, "bcdeafghijklm$"), + send_tty(Term,"End"), + send_tty(Term,"Left"), + send_tty(Term,"Left"), + send_tty(Term,"BSpace"), + check_content(Term, "bcdeafghijlm$"), + ok + after + stop_tty(Term) + end. + +shell_update_window(Config) -> + Term = start_tty(Config), + + Text = lists:flatten(["abcdefghijklmabcdefghijklm"]), + {_Row, Col} = get_location(Term), + + try + send_tty(Term,Text), + check_content(Term,Text), + check_location(Term, {0, width(Text)}), + tmux(["resize-window -t ",tty_name(Term)," -x ",width(Text)+Col+1]), + send_tty(Term,"a"), + check_location(Term, {0, -Col}), + send_tty(Term,"BSpace"), + tmux(["resize-window -t ",tty_name(Term)," -x ",width(Text)+Col]), + %% xnfix bug! at least in tmux... seems to work in iTerm as it does not + %% need xnfix when resizing + check_location(Term, {0, -Col}), + tmux(["resize-window -t ",tty_name(Term)," -x ",width(Text) div 2 + Col]), + check_location(Term, {0, -Col + width(Text) div 2}), + ok + after + stop_tty(Term) + end. + +shell_huge_input(Config) -> + Term = start_tty(Config), + + ManyUnicode = lists:duplicate(100,hard_unicode()), + + try + send_tty(Term,ManyUnicode), + check_content(Term, hard_unicode_match(Config) ++ "$", + #{ replace => {"\n",""} }), + send_tty(Term,"Enter"), + ok + after + stop_tty(Term) + end. + +%% Test that the shell works when invalid utf-8 (aka latin1) is sent to it +shell_invalid_unicode(Config) -> + Term = start_tty(Config), + + InvalidUnicode = <<$å,$ä,$ö>>, %% åäö in latin1 + + try + send_tty(Term,hard_unicode()), + check_content(Term, hard_unicode() ++ "$"), + send_tty(Term,"Enter"), + check_content(Term, "illegal character"), + %% Send invalid utf-8 + send_stdin(Term,InvalidUnicode), + %% Check that the utf-8 was echoed + check_content(Term, "\\\\345\\\\344\\\\366$"), + send_tty(Term,"Enter"), + %% Check that the terminal entered "latin1" mode + send_tty(Term,"😀한."), + check_content(Term, "\\Q\\360\\237\\230\\200\\355\\225\\234.\\E$"), + send_tty(Term,"Enter"), + %% Check that we can reset the encoding to unicode + send_tty(Term,"io:setopts([{encoding,unicode}])."), + send_tty(Term,"Enter"), + check_content(Term, "\nok\n"), + send_tty(Term,"😀한"), + check_content(Term, "😀한$"), + ok + after + stop_tty(Term), + ok + end. + + +%% Test the we can handle ansi insert, navigation and delete +%% We currently can not so skip this test +shell_support_ansi_input(Config) -> + + Term = start_tty(Config), + + BoldText = "\e[;1m", + ClearText = "\e[0m", + + try + send_stdin(Term,["{",BoldText,"a😀b",ClearText,"}"]), + timer:sleep(1000), + try check_location(Term, {0, width("{1ma😀bm}")}) of + _ -> + throw({skip, "Do not support ansi input"}) + catch _:_ -> + ok + end, + check_location(Term, {0, width("{a😀b}")}), + check_content(fun() -> get_content(Term,"-e") end, + ["{", BoldText, "a😀b", ClearText, "}"]), + send_tty(Term,"Left"), + send_tty(Term,"Left"), + check_location(Term, {0, width("{a😀")}), + send_tty(Term,"C-Left"), + check_location(Term, {0, width("{")}), + send_tty(Term,"End"), + send_tty(Term,"BSpace"), + send_tty(Term,"BSpace"), + check_content(Term, ["{", BoldText, "a😀"]), + ok + after + stop_tty(Term), + ok + end. + +shell_expand_location_below(Config) -> + + Term = start_tty(Config), + + {Rows, _} = get_location(Term), + + NumFunctions = lists:seq(0, Rows*2), + FunctionName = "a_long_function_name", + + Module = lists:flatten( + ["-module(long_module).\n", + "-export([",lists:join($,,[io_lib:format("~s~p/0",[FunctionName,I]) || I <- NumFunctions]),"]).\n\n", + [io_lib:format("~s~p() -> ok.\n",[FunctionName,I]) || I <- NumFunctions]]), + + DoScan = fun F([]) -> + []; + F(Str) -> + {done,{ok,T,_},C} = erl_scan:tokens([],Str,0), + [ T | F(C) ] + end, + Forms = [ begin {ok,Y} = erl_parse:parse_form(X),Y end || X <- DoScan(Module) ], + {ok,_,Bin} = compile:forms(Forms, [debug_info]), + + try + tmux(["resize-window -t ",tty_name(Term)," -x 80"]), + + %% First check that basic completion works + send_stdin(Term, "escript:"), + send_stdin(Term, "\t"), + %% Cursor at correct place + check_location(Term, {-3, width("escript:")}), + %% Nothing after the start( completion + check_content(Term, "start\\($"), + + %% Check that completion is cleared when we type + send_stdin(Term, "s"), + check_location(Term, {-3, width("escript:s")}), + check_content(Term, "escript:s$"), + + %% Check that completion works when in the middle of a term + send_tty(Term, "Home"), + send_tty(Term, "["), + send_tty(Term, "End"), + send_tty(Term, ", test_after]"), + [send_tty(Term, "Left") || _ <- ", test_after]"], + send_stdin(Term, "\t"), + check_location(Term, {-3, width("[escript:s")}), + check_content(Term, "script_name\\([ ]+start\\($"), + send_tty(Term, "C-K"), + + %% Check that completion works when in the middle of a long term + send_tty(Term, ", "++ lists:duplicate(80*2, $a)++"]"), + [send_tty(Term, "Left") || _ <- ", "++ lists:duplicate(80*2, $a)++"]"], + send_stdin(Term, "\t"), + check_location(Term, {-4, width("[escript:s")}), + check_content(Term, "script_name\\([ ]+start\\($"), + send_tty(Term, "End"), + send_stdin(Term, ".\n"), + + %% Check that we behave as we should with very long completions + rpc(Term, fun() -> + {module, long_module} = code:load_binary(long_module, "long_module.beam", Bin) + end), + check_content(Term, "3>"), + send_stdin(Term, "long_module:" ++ FunctionName), + send_stdin(Term, "\t"), + %% Check that correct text is printed below expansion + check_content(Term, io_lib:format("Press tab to see all ~p expansions", + [length(NumFunctions)])), + send_stdin(Term, "\t"), + %% The expansion does not fit on screen, verify that + %% expand above mode is used + check_content(fun() -> get_content(Term, "-S -5") end, + "3> long_module:" ++ FunctionName ++ "\nfunctions"), + check_content(Term, "3> long_module:" ++ FunctionName ++ "$"), + + %% We resize the terminal to make everything fit and test that + %% expand below mode is used + tmux(["resize-window -t ", tty_name(Term), " -y ", integer_to_list(Rows+10)]), + timer:sleep(1000), %% Sleep to make sure window has resized + send_stdin(Term, "\t\t"), + check_content(Term, "3> long_module:" ++ FunctionName ++ "\nfunctions(\n|.)*a_long_function_name99\\($"), + ok + after + stop_tty(Term), + ok + end. + +shell_expand_location_above(Config) -> + + Term = start_tty([{args,["-stdlib","shell_expand_location","above"]}|Config]), + + try + tmux(["resize-window -t ",tty_name(Term)," -x 80"]), + send_stdin(Term, "escript:"), + send_stdin(Term, "\t"), + check_location(Term, {0, width("escript:")}), + check_content(Term, "start\\(\n"), + check_content(Term, "escript:$"), + send_stdin(Term, "s"), + send_stdin(Term, "\t"), + check_location(Term, {0, width("escript:s")}), + check_content(Term, "\nscript_name\\([ ]+start\\(\n"), + check_content(Term, "escript:s$"), + ok + after + stop_tty(Term), + ok + end. + +%% Test the we can handle invalid ansi escape chars. +%% tmux cannot handle this... so we test this using to_erl +shell_invalid_ansi(_Config) -> + + InvalidAnsiPrompt = + case proplists:get_value(encoding, io:getopts(user)) of + unicode -> + ["\e]94m",54620,44397,50612,47,51312,49440,47568,"\e]0m"]; + latin1 -> + ["\e]94minvalid_test\e]0m"] + end, + + rtnode:run( + [{eval, fun() -> application:set_env( + stdlib, shell_prompt_func_test, + fun() -> InvalidAnsiPrompt end) + end }, + {putline,"a."}, + {expect, "a[.]"}, + {expect, ["\\Q",InvalidAnsiPrompt,"\\E"]}], + "", "", + ["-pz",filename:dirname(code:which(?MODULE)), + "-connect_all","false", + "-kernel","logger_level","all", + "-kernel","shell_history","disabled", + "-kernel","prevent_overlapping_partitions","false", + "-eval","shell:prompt_func({interactive_shell_SUITE,prompt})." + ]). + +shell_ignore_pager_commands(Config) -> + Term = start_tty(Config), + case code:get_doc(file, #{sources=>[eep48]}) of + {error, _} -> {skip, "No documentation available"}; + _ -> + try + send_tty(Term, "h(file).\n"), + check_content(Term,"\\Qmore (y/n)? (y)\\E"), + send_tty(Term, "n\n"), + check_content(Term,"ok"), + send_tty(Term, "C-P"), + check_content(Term,"\\Qh(file).\\E"), + ok + after + stop_tty(Term), + ok + end + end. + +external_editor(Config) -> + case os:find_executable("nano") of + false -> {skip, "nano is not installed"}; + _ -> + Term = start_tty(Config), + try + tmux(["resize-window -t ",tty_name(Term)," -x 80"]), + send_tty(Term,"os:putenv(\"EDITOR\",\"nano\").\n"), + send_tty(Term, "\"some text with\nnewline in it\""), + check_content(Term,"3> \"some text with\\s*\n.+3>\\s*newline in it\""), + send_tty(Term, "C-O"), + check_content(Term,"GNU nano [\\d.]+"), + check_content(Term,"newline in it\""), + send_tty(Term, "still"), + send_tty(Term, "Enter"), + send_tty(Term, "C-O"), %% save in nano + send_tty(Term, "Enter"), + send_tty(Term, "C-X"), %% quit in nano + check_content(Term,"still\n.+3> newline in it\""), + send_tty(Term,".\n"), + check_content(Term,"\\Q\"some text with\\nstill\\nnewline in it\"\\E"), + ok + after + stop_tty(Term), + ok + end + end. + +external_editor_visual(Config) -> + case os:find_executable("vim") of + false -> + {skip, "vim is not installed"}; + _ -> + Term = start_tty(Config), + try + tmux(["resize-window -t ",tty_name(Term)," -x 80"]), + send_tty(Term,"os:putenv(\"EDITOR\",\"nano\").\n"), + check_content(Term, "3>"), + send_tty(Term,"os:putenv(\"VISUAL\",\"vim -u DEFAULTS -U NONE -i NONE\").\n"), + check_content(Term, "4>"), + send_tty(Term,"\"hello"), + send_tty(Term, "C-O"), %% Open vim + check_content(Term, "^\"hello"), + send_tty(Term, "$"), %% Set cursor at end + send_tty(Term, "a"), %% Enter insert mode at end + check_content(Term, "-- INSERT --"), + send_tty(Term, "\"."), + send_tty(Term,"Escape"), + send_tty(Term,":wq"), + send_tty(Term,"Enter"), + check_content(Term, "\"hello\"[.]$"), + send_tty(Term,"Enter"), + check_content(Term, "\"hello\""), + check_content(Term, "5>$") + after + stop_tty(Term), + ok + end + end. + +external_editor_unicode(Config) -> + NanoPath = os:find_executable("nano"), + case NanoPath of + false -> {skip, "nano is not installed"}; + _ -> + Term = start_tty(Config), + try + tmux(["resize-window -t ",tty_name(Term)," -x 80"]), + send_tty(Term,"os:putenv(\"EDITOR\",\"nano\").\n"), + send_tty(Term, hard_unicode()), + check_content(Term,"3> " ++ hard_unicode_match(Config)), + send_tty(Term, "C-O"), %% open external editor (nano) + check_content(Term,"GNU nano [\\d.]+"), + send_tty(Term, "still "), + check_content(Term,"\nstill "), + send_tty(Term, "C-O"), %% save in nano + send_tty(Term, "Enter"), + send_tty(Term, "C-X"), %% quit in nano + check_content(Term,"still "++hard_unicode_match(Config)), + ok + after + stop_tty(Term), + ok + end + end. + +%% There used to be a race condition when using shell:start_interactive where +%% the newline handling of standard_error did not change correctly to compensate +%% for the tty changing to canonical mode +shell_standard_error_nlcr(Config) -> + + [ + begin + Term = setup_tty([{env,[{"TERM",TERM}]},{args, ["-noshell"]} | Config]), + try + rpc(Term, io, format, [standard_error,"test~ntest~ntest", []]), + check_content(Term, "test\ntest\ntest$"), + rpc(Term, fun() -> shell:start_interactive(), + io:format(standard_error,"test~ntest~ntest", []) + end), + check_content(Term, "test\ntest\ntest(\n|.)*test\ntest\ntest") + after + stop_tty(Term) + end + end || TERM <- ["dumb",os:getenv("TERM")]]. + +%% We test that suspending of `erl` and then resuming restores the shell +shell_suspend(Config) -> + + Name = peer:random_name(proplists:get_value(tc_path,Config)), + %% In order to suspend `erl` we need it to run in a shell that has job control + %% so we start the peer within a tmux window instead of having it be the original + %% process. + os:cmd("tmux new-window -n " ++ Name ++ " -d -- bash --norc"), + + Peer = #{ name => Name, + post_process_args => + fun(["new-window","-n",_,"-d","--"|CmdAndArgs]) -> + FlatCmdAndArgs = + lists:join( + " ",[[$',A,$'] || A <- CmdAndArgs]), + ["send","-t",Name,lists:flatten(FlatCmdAndArgs),"Enter"] + end + }, + + + Term = start_tty([{peer, Peer}|Config]), + + try + send_tty(Term, hard_unicode()), + check_content(Term,["2> ",hard_unicode(),"$"]), + send_tty(Term, "C-Z"), + check_content(Term,"\\Q[1]+\\E\\s*Stopped"), + send_tty(Term, "fg"), + send_tty(Term, "Enter"), + send_tty(Term, "M-l"), + check_content(Term,["2> ",hard_unicode(),"$"]), + check_location(Term,{0,width(hard_unicode())}), + ok + after + stop_tty(Term), + ok + end. + +%% We test that suspending of `erl` and then resuming restores the shell +shell_full_queue(Config) -> + + [throw({skip,"Need unbuffered to run"}) || os:find_executable("unbuffered") =:= false], + + %% In order to fill the read buffer of the terminal we need to get a + %% bit creative. We first need to start erl in bash in order to be + %% able to get access to job control for suspended processes. + %% We then also wrap `erl` in `unbuffer -p` so that we can suspend + %% that program in order to block writing to stdout for a while. + + Name = peer:random_name(proplists:get_value(tc_path,Config)), + os:cmd("tmux new-window -n " ++ Name ++ " -d -- bash --norc"), + + Peer = #{ name => Name, + post_process_args => + fun(["new-window","-n",_,"-d","--"|CmdAndArgs]) -> + FlatCmdAndArgs = ["unbuffer -p "] ++ + lists:join( + " ",[[$',A,$'] || A <- CmdAndArgs]), + ["send","-t",Name,lists:flatten(FlatCmdAndArgs),"Enter"] + end + }, + + + Term = start_tty([{peer, Peer}|Config]), + + UnbufferedPid = os:cmd("ps -o ppid= -p " ++ rpc(Term,os,getpid,[])), + + WriteUntilStopped = + fun F(Char) -> + rpc(Term,io,format,[user,[Char],[]]), + put(bytes,get(bytes,0)+1), + receive + stop -> + rpc(Term,io,format,[user,[Char+1],[]]) + after 0 -> F(Char) + end + end, + + WaitUntilBlocked = + fun(Pid, Ref) -> + (fun F(Cnt) -> + receive + {'DOWN',Ref,_,_,_} = Down -> + ct:fail({io_format_did_not_block, Down}) + after 1000 -> + ok + end, + case process_info(Pid,dictionary) of + {dictionary,[{bytes,Cnt}]} -> + ct:log("Bytes until blocked: ~p~n",[Cnt]), + %% Add one extra byte as for + %% the current blocking call + Cnt + 1; + {dictionary,[{bytes,NewCnt}]} -> + F(NewCnt) + end + end)(0) + end, + + try + %% First test that we can suspend and then resume + os:cmd("kill -TSTP " ++ UnbufferedPid), + check_content(Term,"\\Q[1]+\\E\\s*Stopped"), + {Pid, Ref} = spawn_monitor(fun() -> WriteUntilStopped($a) end), + WaitUntilBlocked(Pid, Ref), + send_tty(Term, "fg"), + send_tty(Term, "Enter"), + Pid ! stop, + check_content(Term,"b$"), + + send_tty(Term, "."), + send_tty(Term, "Enter"), + + %% Then we test that all characters are written when system + %% is terminated just after writing + {ok,Cols} = rpc(Term,io,columns,[user]), + send_tty(Term, "Enter"), + os:cmd("kill -TSTP " ++ UnbufferedPid), + check_content(Term,"\\Q[1]+\\E\\s*Stopped"), + {Pid2, Ref2} = spawn_monitor(fun() -> WriteUntilStopped($c) end), + Bytes = WaitUntilBlocked(Pid2, Ref2) - 1, + stop_tty(Term), + send_tty(Term, "fg"), + send_tty(Term, "Enter"), + check_content( + fun() -> + tmux(["capture-pane -p -S - -E - -t ",tty_name(Term)]) + end, lists:flatten([lists:duplicate(Cols,$c) ++ "\n" || + _ <- lists:seq(1,(Bytes) div Cols)] + ++ [lists:duplicate((Bytes) rem Cols,$c)])), + ct:log("~ts",[tmux(["capture-pane -p -S - -E - -t ",tty_name(Term)])]), + ok + after + stop_tty(Term), + ok + end. + +get(Key,Default) -> + case get(Key) of + undefined -> + Default; + Value -> + Value + end. + +%% A list of unicode graphemes that are notoriously hard to render +hard_unicode() -> + ZWJ = + case os:type() of + %% macOS has very good rendering of ZWJ, + %% but the cursor does not agree with it.. + {unix, darwin} -> []; + _ -> [[16#1F91A,16#1F3FC]] % Hand with skintone 🤚🏼 + end, + [[16#1f600], % Smilie 😀 + "한", % Hangul + "Z̤͔ͧ̑̓","ä͖̭̈̇","lͮ̒ͫ","ǧ̗͚̚","o̙̔ͮ̇͐̇" %% Vertically stacked chars + %%"👩👩", % Zero width joiner + %%"👩👩👧👦" % Zero width joiner + | ZWJ]. + +hard_unicode_match(Config) -> + ["\\Q",[unicode_to_octet(Config, U) || U <- hard_unicode()],"\\E"]. + +unicode_to_octet(Config, U) -> + case ?config(encoding,Config) of + unicode -> U; + latin1 -> unicode_to_octet(U) + end. + +unicode_to_octet(U) -> + [if Byte >= 128 -> [$\\,integer_to_list(Byte,8)]; + true -> Byte + end || <<Byte>> <= unicode:characters_to_binary(U)]. + +unicode_to_hex(Config, U) -> + case ?config(encoding,Config) of + unicode -> U; + latin1 -> unicode_to_hex(U) + end. + +unicode_to_hex(U) when is_integer(U) -> + unicode_to_hex([U]); +unicode_to_hex(Us) -> + [if U < 128 -> U; + U < 512 -> ["\\",integer_to_list(U,8)]; + true -> ["\\x{",integer_to_list(U,16),"}"] + end || U <- Us]. + +width(C, Str) -> + case ?config(encoding, C) of + unicode -> width(Str); + latin1 -> width(unicode_to_octet(Str)) + end. +width(Str) -> + lists:sum( + [npwcwidth(CP) || CP <- lists:flatten(Str)]). + +npwcwidth(CP) -> + try prim_tty:npwcwidth(CP) + catch error:undef -> + if CP =:= 16#D55C -> + 2; %% 한 + CP =:= 16#1f91A -> + 2; %% hand + CP =:= 16#1F3Fc -> + 2; %% Skintone + CP =:= 16#1f600 -> + 2; %% smilie + true -> + case lists:member(CP, [775,776,780,785,786,787,788,791,793,794, + 804,813,848,852,854,858,871,875,878]) of + true -> + 0; + false -> + 1 + end + end + end. + +-record(tmux, {peer, node, name, orig_location }). + +tmux([Cmd|_] = Command) when is_list(Cmd) -> + tmux(lists:concat(Command)); +tmux(Command) -> + string:trim(os:cmd(["tmux ",Command])). + +rpc(#tmux{ node = N }, Fun) -> + erpc:call(N, Fun). +rpc(#tmux{ node = N }, M, F, A) -> + erpc:call(N, M, F, A). + +%% Setup a TTY, but do not type anything in terminal +setup_tty(Config) -> + Name = maps:get(name,proplists:get_value(peer, Config, #{}), + peer:random_name(proplists:get_value(tc_path, Config))), + + Envs = lists:flatmap(fun({Key,Value}) -> + ["-env",Key,Value] + end, proplists:get_value(env,Config,[])), + + ExtraArgs = proplists:get_value(args,Config,[]), + + ExecArgs = case os:getenv("TMUX_DEBUG") of + "strace" -> + STraceLog = filename:join(proplists:get_value(priv_dir,Config), + Name++".strace"), + ct:pal("Link to strace: file://~ts", [STraceLog]), + [os:find_executable("strace"),"-f", + "-o",STraceLog, + "-e","trace=all", + "-e","read=0,1,2", + "-e","write=0,1,2" + ] ++ string:split(ct:get_progname()," ",all); + "rr" -> + [os:find_executable("cerl"),"-rr"]; + _ -> + string:split(ct:get_progname()," ",all) + end, + DefaultPeerArgs = #{ name => Name, + exec => + {os:find_executable("tmux"), + ["new-window","-n",Name,"-d","--"] ++ ExecArgs }, + + args => ["-pz",filename:dirname(code:which(?MODULE)), + "-connect_all","false", +% "-kernel","logger_level","all", + "-kernel","shell_history","disabled", + "-kernel","prevent_overlapping_partitions","false", + "-eval","shell:prompt_func({interactive_shell_SUITE,prompt})." + ] ++ Envs ++ ExtraArgs, + detached => false + }, + + {ok, Peer, Node} = + ?CT_PEER(maps:merge(proplists:get_value(peer,Config,#{}), + DefaultPeerArgs)), + + Self = self(), + + %% By default peer links with the starter. For these TCs we however only + %% want the peer to die if we die, so we create a "unidirection link" using + %% monitors. + spawn(fun() -> + TCRef = erlang:monitor(process, Self), + PeerRef = erlang:monitor(process, Peer), + receive + {'DOWN',TCRef,_,_,Reason} -> + exit(Peer, Reason); + {'DOWN',PeerRef,_,_,_} -> + ok + end + end), + unlink(Peer), + + "" = tmux(["set-option -t ",Name," remain-on-exit on"]), + + %% We start tracing on the remote node in order to help debugging + TraceLog = filename:join(proplists:get_value(priv_dir,Config),Name++".trace"), + ct:log("Link to trace: file://~ts",[TraceLog]), + + spawn(Node, + fun() -> + {ok, _} = dbg:tracer(file,TraceLog), + %% dbg:p(whereis(user_drv),[c,m]), + %% dbg:p(whereis(user_drv_writer),[c,m]), + %% dbg:p(whereis(user_drv_reader),[c,m]), + %% dbg:tp(user_drv,x), + %% dbg:tp(prim_tty,x), + %% dbg:tpl(prim_tty,write_nif,x), + %% dbg:tpl(prim_tty,read_nif,x), + monitor(process, Self), + receive _ -> ok end + end), + + #tmux{ peer = Peer, node = Node, name = Name }. + +%% Start a tty, setup custom prompt and set cursor at bottom +start_tty(Config) -> + + Term = setup_tty(Config), + + Prompt = fun() -> ["\e[94m",54620,44397,50612,47,51312,49440,47568,"\e[0m"] end, + erpc:call(Term#tmux.node, application, set_env, + [stdlib, shell_prompt_func_test, + proplists:get_value(shell_prompt_func_test, Config, Prompt)]), + + {Rows, _} = get_window_size(Term), + + %% We send a lot of newlines here in order for the number of rows + %% in the window to be max so that we can predict what the cursor + %% position is. + [send_tty(Term,"\n") || _ <- lists:seq(1, Rows)], + + %% We enter an 'a' here so that we can get the correct orig position + %% with an alternative prompt. + send_tty(Term,"a.\n"), + check_content(Term,"2>$"), + OrigLocation = get_location(Term), + Term#tmux{ orig_location = OrigLocation }. + +prompt(L) -> + N = proplists:get_value(history, L, 0), + Fun = application:get_env(stdlib, shell_prompt_func_test, + fun() -> atom_to_list(node()) end), + io_lib:format("(~ts)~w> ",[Fun(),N]). + +stop_tty(Term) -> + catch peer:stop(Term#tmux.peer), + ct:log("~ts",[get_content(Term, "-e")]), +% "" = tmux("kill-window -t " ++ Term#tmux.name), + ok. + +tty_name(Term) -> + Term#tmux.name. + +send_tty(Term, "Home") -> + %% https://stackoverflow.com/a/55616731 + send_tty(Term,"Escape"), + send_tty(Term,"OH"); +send_tty(Term, "End") -> + send_tty(Term,"Escape"), + send_tty(Term,"OF"); +send_tty(#tmux{ name = Name } = _Term,Value) -> + [Head | Quotes] = string:split(Value, "'", all), + "" = tmux("send -t " ++ Name ++ " '" ++ Head ++ "'"), + [begin + "" = tmux("send -t " ++ Name ++ " \"'\""), + "" = tmux("send -t " ++ Name ++ " '" ++ V ++ "'") + end || V <- Quotes]. + +%% We use send_stdin for testing of things that we cannot sent via +%% the tmux send command, such as invalid unicode +send_stdin(Term, Chars) when is_binary(Chars) -> + rpc(Term,erlang,display_string,[stdin,Chars]); +send_stdin(Term, Chars) -> + send_stdin(Term, iolist_to_binary(unicode:characters_to_binary(Chars))). + +check_location(Term, Where) -> + check_location(Term, Where, 5). +check_location(#tmux{ orig_location = {OrigRow, OrigCol} = Orig } = Term, + {AdjRow, AdjCol} = Where, Attempt) -> + NewLocation = get_location(Term), + case {OrigRow+AdjRow,OrigCol+AdjCol} of + NewLocation -> NewLocation; + _ when Attempt =:= 0 -> + {NewRow, NewCol} = NewLocation, + ct:fail({wrong_location, {expected,{AdjRow, AdjCol}}, + {got,{NewRow - OrigRow, NewCol - OrigCol}, + {NewLocation, Orig}}}); + _ -> + timer:sleep(50), + check_location(Term, Where, Attempt -1) + end. + +get_location(Term) -> + RowAndCol = tmux("display -pF '#{cursor_y} #{cursor_x}' -t "++Term#tmux.name), + [Row, Col] = string:lexemes(string:trim(RowAndCol,both)," "), + {list_to_integer(Row), list_to_integer(Col)}. + +get_window_size(Term) -> + RowAndCol = tmux("display -pF '#{window_height} #{window_width}' -t "++Term#tmux.name), + [Row, Col] = string:lexemes(string:trim(RowAndCol,both)," "), + {list_to_integer(Row), list_to_integer(Col)}. + +check_content(Term, Match) -> + check_content(Term, Match, #{}). +check_content(Term, Match, Opts) when is_map(Opts) -> + check_content(Term, Match, Opts, 5). +check_content(Term, Match, Opts, Attempt) -> + OrigContent = case Term of + #tmux{} -> get_content(Term); + Fun when is_function(Fun,0) -> Fun() + end, + Content = case maps:find(replace, Opts) of + {ok, {RE,Repl} } -> + re:replace(OrigContent, RE, Repl, [global]); + error -> + OrigContent + end, + case re:run(string:trim(Content, both), lists:flatten(Match), [unicode]) of + {match,_} -> + ok; + _ when Attempt =:= 0 -> + io:format("Failed to find '~ts' in ~n'~ts'~n", + [unicode:characters_to_binary(Match), Content]), + io:format("Failed to find '~w' in ~n'~w'~n", + [unicode:characters_to_binary(Match), Content]), + ct:fail(nomatch); + _ -> + timer:sleep(500), + check_content(Term, Match, Opts, Attempt - 1) + end. + +get_content(Term) -> + get_content(Term, ""). +get_content(#tmux{ name = Name }, Args) -> + Content = unicode:characters_to_binary(tmux("capture-pane -p " ++ Args ++ " -t " ++ Name)), + case string:split(Content,"a.\na") of + [_Ignore,C] -> + C; + [C] -> + C + end. %% Tests that exit of initial shell restarts shell. exit_initial(Config) when is_list(Config) -> @@ -260,36 +1617,38 @@ exit_initial(Config) when is_list(Config) -> ok. test_exit_initial(old) -> - rtnode([{putline, ""}, - {putline, "2."}, - {expect, "2\r\n"}, - {putline, "exit()."}, - {expect, "Eshell"}, - {putline, ""}, - {putline, "35."}, - {expect, "35\r\n"}], - [], [], ["-oldshell"]); + rtnode:run( + [{putline, ""}, + {putline, "2."}, + {expect, "2\r\n"}, + {putline, "exit()."}, + {expect, "Eshell"}, + {putline, ""}, + {putline, "35."}, + {expect, "35\r\n"}], + [], [], ["-oldshell"]); test_exit_initial(new) -> - rtnode([{putline, ""}, - {expect, "1> $"}, - {putline, "2."}, - {expect, "2"}, - {putline,"exit()."}, - {expect, "Eshell"}, - {expect, "1> $"}, - {putline, "35."}, - {expect, "35\r\n"}]). + rtnode:run( + [{putline, ""}, + {expect, "1> $"}, + {putline, "2."}, + {expect, "2"}, + {putline,"exit()."}, + {expect, "Eshell"}, + {expect, "1> $"}, + {putline, "35."}, + {expect, "35\r\n"}]). stop_during_init(Config) when is_list(Config) -> - {RunErl,_ToErl,Erl} = get_progs(), - case create_tempdir() of + {RunErl,_ToErl,[Erl|ErlArgs]} = rtnode:get_progs(), + case rtnode:create_tempdir() of {error, Reason} -> {skip, Reason}; Tempdir -> XArg = " -kernel shell_history enabled -s init stop", - start_runerl_command(RunErl, Tempdir, "\\\""++Erl++"\\\""++XArg), - Logs = rtnode_read_logs(Tempdir), - rtnode_dump_logs(Logs), + rtnode:start_runerl_command(RunErl, Tempdir, "\\\""++Erl++"\\\""++ErlArgs++XArg), + Logs = rtnode:read_logs(Tempdir), + rtnode:dump_logs(Logs), nomatch = binary:match(map_get("erlang.log.1", Logs), <<"*** ERROR: Shell process terminated! ***">>), ok @@ -312,16 +1671,16 @@ wrap(Config) when is_list(Config) -> case proplists:get_value(default_shell, Config) of new -> As = lists:duplicate(20,"a"), - rtnode([{putline, "io:columns()."}, - {expect, "{ok,20}\r\n"}, - {putline, ["io:format(\"~s\",[lists:duplicate(20,\"a\")])."]}, - {expect, As ++ " \b"}, - {putline, ["io:format(\"~s~n~s\",[lists:duplicate(20,\"a\"),lists:duplicate(20,\"a\")])."]}, - {expect, As ++ "\r\n" ++ As ++ " \b"} - ], - [], - "stty rows 40; stty columns 20; ", - [""]); + rtnode:run( + [{putline, "io:columns()."}, + {expect, "{ok,20}\r\n"}, + {putline, ["io:format(\"~s\",[lists:duplicate(20,\"a\")])."]}, + {expect, As ++ " \b"}, + {putline, ["io:format(\"~s~n~s\",[lists:duplicate(20,\"a\"),lists:duplicate(20,\"a\")])."]}, + {expect, As ++ "\r\n" ++ As ++ " \b"} + ], + [], + "stty rows 40; stty columns 20; "); _ -> ok end, @@ -336,58 +1695,71 @@ wrap(Config) when is_list(Config) -> %% commands. shell_history(Config) when is_list(Config) -> Path = shell_history_path(Config, "basic"), - rtnode([ - {putline, "echo1."}, - {expect, "echo1\r\n"}, - {putline, "echo2."}, - {expect, "echo2\r\n"}, - {putline, "echo3."}, - {expect, "echo3\r\n"}, - {putline, "echo4."}, - {expect, "echo4\r\n"}, - {putline, "echo5."}, - {expect, "echo5\r\n"} - ], [], [], " -kernel shell_history enabled " ++ - "-kernel shell_history_drop '[\\\"init:stop().\\\"]' " ++ - mk_sh_param(Path)), + rtnode:run( + [{putline, "echo1."}, + {expect, "echo1\r\n"}, + {putline, "echo2."}, + {expect, "echo2\r\n"}, + {putline, "echo3."}, + {expect, "echo3\r\n"}, + {putline, "echo4."}, + {expect, "echo4\r\n"}, + {putline, "echo5."}, + {expect, "echo5\r\n"} + ], [], [], mk_history_param(Path)), receive after 1000 -> ok end, - rtnode([ - {putline, ""}, - %% the init:stop that stopped the node is dropped - {putdata, [$\^p]}, {expect, "echo5[.]$"}, - {putdata, [$\n]}, - {expect, "echo5\r\n"}, - {putdata, [$\^p]}, {expect, "echo5[.]$"}, - {putdata, [$\^p]}, {expect, "echo4[.]$"}, - {putdata, [$\^p]}, {expect, "echo3[.]$"}, - {putdata, [$\^p]}, {expect, "echo2[.]$"}, - {putdata, [$\^n]}, {expect, "echo3[.]$"}, - {putdata, [$\^n]}, {expect, "echo4[.]$"}, - {putdata, [$\^b]}, {sleep,50}, %% the echo4. (cursor moved one left) - {putline, ["ECHO"]}, - {expect, "echo4ECHO\r\n"} - ], [], [], " -kernel shell_history enabled " ++ mk_sh_param(Path)), + rtnode:run( + [{sleep,100}, + {putline, ""}, + %% the init:stop that stopped the node is dropped + {putdata, [$\^p]}, {expect, "echo5[.]$"}, + {putdata, [$\n]}, + {expect, "echo5\r\n"}, + {putdata, [$\^p]}, {expect, "echo5[.]$"}, + {putdata, [$\^p]}, {expect, "echo4[.]$"}, + {putdata, [$\^p]}, {expect, "echo3[.]$"}, + {putdata, [$\^p]}, {expect, "echo2[.]$"}, + {putdata, [$\^n]}, {expect, "echo3[.]$"}, + {putdata, [$\^n]}, {expect, "echo4[.]$"}, + {putdata, [$\^b]}, {sleep,50}, %% the echo4. (cursor moved one left) + {putline, ["ECHO"]}, + {expect, "echo4ECHO\r\n"} + ], [], [], + mk_history_param(Path)), + receive after 1000 -> ok end, + + %% ignore input given after io:get_line, and after h(module) pager + rtnode:run( + [{putdata, "io:get_line(\"getline>\").\n"}, + {expect, "getline>"}, + {putline, "hej"}, {expect, "hej\r\n"}, + {putdata, [$\^p]}, {expect, "\\Qio:get_line(\"getline>\")\\E[.]$"} + ], [], [], + mk_history_param(Path)), ok. shell_history_resize(Config) -> Path = shell_history_path(Config, "resize"), - rtnode([ - {putline, "echo."}, - {expect, "echo\r\n"} - ], [], [], " -kernel shell_history_file_bytes 123456 " ++ - "-kernel shell_history enabled " ++ mk_sh_param(Path)), + rtnode:run( + [{putline, "echo."}, + {expect, "echo\r\n"}, + {putline, "echo2."}, + {expect, "echo2\r\n"} + ], [], [], ["-kernel","shell_history_file_bytes","123456"] ++ + mk_history_param(Path)), {ok, Logs} = - rtnode([ - {putline, ""}, - {putdata, [$\^p]}, {expect, "init:stop\\(\\)[.]$"}, - {putdata, [$\^p]}, {expect, "echo[.]$"}, - {putdata, [$\n]}, - {expect, "echo"} - ], [], [], " -kernel shell_history_file_bytes 654321 " ++ - "-kernel shell_history enabled " ++ mk_sh_param(Path)), - - rtnode_check_logs( + rtnode:run( + [{sleep,100}, + {putline, ""}, + {putdata, [$\^p]}, {expect, "echo2[.]$$"}, + {putdata, [$\^p]}, {expect, "echo[.]$"}, + {putdata, [$\n]}, + {expect, "echo"} + ], [], [], ["-kernel","shell_history_file_bytes","654321"] ++ + mk_history_param(Path)), + + rtnode:check_logs( "erlang.log.1", "The configured log history file size is different from the size " "of the log file on disk", Logs), @@ -405,24 +1777,24 @@ shell_history_eaccess(Config) -> %% Cannot create history log in folder {ok, Logs1} = - rtnode([ - {putline, "echo."}, - {expect, "echo\r\n"} - ], [], [], "-kernel shell_history enabled " ++ mk_sh_param(Path)), + rtnode:run( + [{putline, "echo."}, + {expect, "echo\r\n"} + ], [], [], mk_history_param(Path)), - rtnode_check_logs("erlang.log.1", "Error handling file", Logs1), + ct:pal("~p",[Logs1]), + rtnode:check_logs("erlang.log.1", "Error handling file", Logs1), %% shell_docs recursively creates the folder to store the %% logs. This test checks that erlang still starts if we %% cannot create the folders to the path. {ok, Logs2} = - rtnode([ - {putline, "echo."}, - {expect, "echo\r\n"} - ], [], [], "-kernel shell_history enabled " ++ - mk_sh_param(filename:join(Path,"logs"))), + rtnode:run( + [{putline, "echo."}, + {expect, "echo\r\n"} + ], [], [], mk_history_param(filename:join(Path,"logs"))), - rtnode_check_logs("erlang.log.1", "Error handling file", Logs2) + rtnode:check_logs("erlang.log.1", "Error handling file", Logs2) after file:write_file_info(Path, Info) @@ -436,15 +1808,15 @@ shell_history_repair(Config) -> shell_history_halt(Path), {ok, Logs} = - rtnode([ - {putline, ""}, - {putdata, [$\^p]}, {expect, "echo[.]$"}, - {putdata, [$\n]}, - {expect, "echo\r\n"} - ], [], [], "-kernel shell_history enabled " ++ mk_sh_param(Path)), + rtnode:run( + [{putline, ""}, + {putdata, [$\^p]}, {expect, "echo[.]$"}, + {putdata, [$\n]}, + {expect, "echo\r\n"} + ], [], [], mk_history_param(Path)), %% The regexp below checks that he string is NOT part of the log - rtnode_check_logs("erlang.log.1", + rtnode:check_logs("erlang.log.1", "The shell history log file was corrupted and was repaired", false, Logs), @@ -462,14 +1834,14 @@ shell_history_repair_corrupt(Config) -> ok = file:close(D), {ok, Logs} = - rtnode([ - {putline, ""}, - {putdata, [$\^p]}, {expect, "echo[.]$"}, - {putdata, [$\n]}, - {expect, "echo\r\n"} - ], [], [], "-kernel shell_history enabled " ++ mk_sh_param(Path)), - - rtnode_check_logs("erlang.log.1", + rtnode:run( + [{putline, ""}, + {putdata, [$\^p]}, {expect, "echo[.]$"}, + {putdata, [$\n]}, + {expect, "echo\r\n"} + ], [], [], mk_history_param(Path)), + + rtnode:check_logs("erlang.log.1", "The shell history log file was corrupted and was repaired.", Logs), ok. @@ -478,9 +1850,12 @@ shell_history_corrupt(Config) -> Path = shell_history_path(Config, "corrupt"), %% We initialize the shell history log with a known value. - rtnode([{putline, "echo."}, - {expect, "echo\r\n"} - ], [], [], "-kernel shell_history enabled " ++ mk_sh_param(Path)), + rtnode:run( + [{putline, "echo."}, + {expect, "echo\r\n"}, + {putline, "echo2."}, + {expect, "echo2\r\n"} + ], [], [], mk_history_param(Path)), %% We corrupt the disklog. {ok, D} = file:open(filename:join(Path,"erlang-shell-log.1"), [read, append]), @@ -488,98 +1863,104 @@ shell_history_corrupt(Config) -> ok = file:close(D), {ok, Logs} = - rtnode([ - {putline, ""}, - {putdata, [$\^p]}, {expect, "init:stop\\(\\)[.]$"}, - {putdata, [$\^p]}, {expect, "echo[.]$"}, - {putdata, [$\n]}, - {expect, "echo\r\n"} - ], [], [], "-kernel shell_history enabled " ++ mk_sh_param(Path)), - - rtnode_check_logs("erlang.log.1", "Invalid chunk in the file", Logs), + rtnode:run( + [{putline, ""}, + {putdata, [$\^p]}, {expect, "echo2[.]$"}, + {putdata, [$\^p]}, {expect, "echo[.]$"}, + {putdata, [$\n]}, + {expect, "echo\r\n"} + ], [], [], mk_history_param(Path)), + + rtnode:check_logs("erlang.log.1", "Invalid chunk in the file", Logs), ok. %% Stop the node without closing the log. shell_history_halt(Path) -> try - rtnode([ - {putline, "echo."}, - {expect, "echo\r\n"}, - {sleep, 2500}, % disk_log internal cache timer is 2000 ms - {putline, "halt(0)."} - ], [], [], "-kernel shell_history enabled " ++ mk_sh_param(Path)) + rtnode:run( + [{putline, "echo."}, + {expect, "echo\r\n"}, + {sleep, 2500}, % disk_log internal cache timer is 2000 ms + {putline, "halt(0)."}, + {expect, "\r\n"}, + {sleep, 1000} %% wait for node to terminate + ], [], [], mk_history_param(Path)) catch _:_ -> ok end. shell_history_path(Config, TestCase) -> - filename:join([proplists:get_value(priv_dir, Config), - "shell_history", TestCase]). + filename:join([proplists:get_value(priv_dir, Config), + "shell_history", TestCase]). -mk_sh_param(Path) -> - "-kernel shell_history_path '\\\"" ++ Path ++ "\\\"'". +mk_history_param(Path) -> + ["-kernel","shell_history","enabled", + "-kernel","shell_history_path","\"" ++ Path ++ "\"", + "-kernel","shell_history_drop","[\"init:stop().\"]" + ]. shell_history_custom(_Config) -> %% Up key: Ctrl + P = Cp=[$\^p] - rtnode([{expect, "1> $"}, - %% {putline, ""}, - {putdata, [$\^p]}, {expect, "0[.]"}, - {putdata, [$\n]}, - {expect, "0\r\n"}, - {putline, "echo."}, - {expect, "!echo\r\n"} % exclamation mark is printed by custom history module - ], [], [], " -kernel shell_history " ++ atom_to_list(?MODULE) ++ - " -pz " ++ filename:dirname(code:which(?MODULE))), + rtnode:run( + [{expect, "1> $"}, + %% {putline, ""}, + {putdata, [$\^p]}, {expect, "0[.]"}, + {putdata, [$\n]}, + {expect, "0\r\n"}, + {putline, "echo."}, + {expect, "!echo\r\n"} % exclamation mark is printed by custom history module + ], [], [], ["-kernel","shell_history",atom_to_list(?MODULE), + "-pz",filename:dirname(code:which(?MODULE))]), ok. shell_history_custom_errors(_Config) -> %% Check that we can start with a node with an undefined %% provider module. - rtnode([{expect, "1> $"}, - {putline, "echo."}, - {expect, "echo\r\n"} - ], [], [], " -kernel shell_history very_broken " ++ - " -pz " ++ filename:dirname(code:which(?MODULE))), + rtnode:run( + [{putline, "echo."}, + {expect, "echo\r\n"} + ], [], [], ["-kernel","shell_history","very_broken", + "-pz",filename:dirname(code:which(?MODULE))]), %% Check that we can start with a node with a provider module %% that crashes in load/0. - rtnode([ - {putline, "echo."}, - {expect, "echo\r\n"} - ], [], [], " -kernel shell_history " ++ atom_to_list(?MODULE) ++ - " -kernel provider_load crash" ++ - " -pz " ++ filename:dirname(code:which(?MODULE))), + rtnode:run( + [{putline, "echo."}, + {expect, "echo\r\n"} + ], [], [], ["-kernel","shell_history",atom_to_list(?MODULE), + "-kernel","provider_load","crash", + "-pz",filename:dirname(code:which(?MODULE))]), %% Check that we can start with a node with a provider module %% that return incorrect in load/0. - rtnode([ - {putline, "echo."}, - {expect, "echo\r\n"} - ], [], [], " -kernel shell_history " ++ atom_to_list(?MODULE) ++ - " -kernel provider_load badreturn" ++ - " -pz " ++ filename:dirname(code:which(?MODULE))), + rtnode:run( + [{putline, "echo."}, + {expect, "echo\r\n"} + ], [], [], ["-kernel","shell_history",atom_to_list(?MODULE), + "-kernel","provider_load","badreturn", + "-pz",filename:dirname(code:which(?MODULE))]), %% Check that we can start with a node with a provider module %% that crashes in load/0. - rtnode([ - {putline, "echo."}, - {expect, "Disabling shell history logging.\r\n"}, - {expect, "echo\r\n"} - ], [], [], " -kernel shell_history " ++ atom_to_list(?MODULE) ++ - " -kernel provider_add crash" ++ - " -pz " ++ filename:dirname(code:which(?MODULE))), + rtnode:run( + [{putline, "echo."}, + {expect, "(Disabling shell history logging.|echo)"}, + {expect, "(Disabling shell history logging.|echo)"} + ], [], [], ["-kernel","shell_history",atom_to_list(?MODULE), + "-kernel","provider_add","crash", + "-pz",filename:dirname(code:which(?MODULE))]), %% Check that we can start with a node with a provider module %% that return incorrect in load/0. - rtnode([ - {putline, "echo."}, - {expect, "It returned {error,badreturn}.\r\n"}, - {expect, "echo\r\n"} - ], [], [], " -kernel shell_history " ++ atom_to_list(?MODULE) ++ - " -kernel provider_add badreturn" ++ - " -pz " ++ filename:dirname(code:which(?MODULE))), + rtnode:run( + [{putline, "echo."}, + {expect, "It returned {error,badreturn}.\r\n"}, + {expect, "echo\r\n"} + ], [], [], ["-kernel","shell_history",atom_to_list(?MODULE), + "-kernel","provider_add","badreturn", + "-pz",filename:dirname(code:which(?MODULE))]), ok. @@ -613,20 +1994,60 @@ job_control_local(Config) when is_list(Config) -> {skip,"No new shell found"}; new -> %% New shell tests - rtnode([{putline, ""}, - {expect, "1> $"}, - {putline, "2."}, - {expect, "\r\n2\r\n"}, - {putline, "\^g"}, - {expect, ["--> $"]}, - {putline, "s"}, - {expect, ["--> $"]}, - {putline, "c"}, - {expect, ["\r\nEshell"]}, - {expect, ["1> $"]}, - {putline, "35."}, - {expect, "\r\n35\r\n2> $"}], - []), + rtnode:run( + [{putline, ""}, + {expect, "1> $"}, + {putline, "2."}, + {expect, "\r\n2\r\n"}, + {putline, "\^g"}, + {expect, "--> $"}, + {putline, "s"}, + {expect, "--> $"}, + {putline, "c"}, + {expect, "\r\nEshell"}, + {expect, "1> $"}, + {putline, "35."}, + {expect, "\r\n35\r\n"}, + {expect, "2> $"}, + {putline, "receive M -> M end.\r\n"}, + {putline, "\^g"}, + {expect, "--> $"}, + {putline, "i 3"}, + {expect, "Unknown job"}, + {expect, "--> $"}, + {putline, "i 2"}, + {expect, "--> $"}, + {putline, "c"}, + {expect, "[*][*] exception exit: killed"}, + {expect, "[23]>"}, + {putline, "\^g"}, + {expect, "--> $"}, + {putline, "k 3"}, + {expect, "Unknown job"}, + {expect, "--> $"}, + {putline, "k 2"}, + {expect, "--> $"}, + {putline, "k"}, + {expect, "Unknown job"}, + {expect, "--> $"}, + {putline, "c"}, + {expect, "Unknown job"}, + {expect, "--> $"}, + {putline, "i"}, + {expect, "Unknown job"}, + {expect, "--> $"}, + {putline, "?"}, + {expect, "this message"}, + {expect, "--> $"}, + {putline, "h"}, + {expect, "this message"}, + {expect, "--> $"}, + {putline, "c 1"}, + {expect, "\r\n"}, + {putline, "35."}, + {expect, "\r\n35\r\n"}, + {expect, "[23]> $"} + ]), ok end. @@ -636,11 +2057,12 @@ job_control_remote(Config) when is_list(Config) -> old -> {skip,"No new shell found"}; _ -> - NSNode = start_node(?FUNCTION_NAME, []), + {ok, Peer, NSNode} = ?CT_PEER(#{ args => ["-connect_all","false"], + peer_down => continue }), try test_remote_job_control(NSNode) after - test_server:stop_node(NSNode) + peer:stop(Peer) end end. @@ -651,48 +2073,71 @@ job_control_remote_noshell(Config) when is_list(Config) -> old -> {skip,"No new shell found"}; _ -> - NSNode = start_node(?FUNCTION_NAME, ["-noshell"]), + {ok, Peer, NSNode} = ?CT_PEER(#{ name => peer:random_name(test_remote_job_control), + args => ["-connect_all","false","-noshell"], + peer_down => continue }), try test_remote_job_control(NSNode) after - test_server:stop_node(NSNode) + peer:stop(Peer) end end. test_remote_job_control(Node) -> - RemNode = create_nodename(), + RemNode = peer:random_name(test_remote_job_control), Pid = spawn_link(Node, fun() -> receive die -> ok end - end), + end), PidStr = erpc:call(Node, erlang, pid_to_list, [Pid]), true = erpc:call(Node, erlang, register, [kalaskula,Pid]), PrintedNode = printed_atom(Node), CookieString = printed_atom(erlang:get_cookie()), - rtnode([{putline, ""}, - {putline, "erlang:get_cookie()."}, - {expect, "\r\n\\Q" ++ CookieString ++ "\\E"}, - {putdata, "\^g"}, - {expect, " --> $"}, - {putline, "r " ++ PrintedNode}, - {expect, "\r\n"}, - {putline, "c"}, - {expect, "\r\n"}, - {expect, "Eshell"}, - {expect, "\\Q(" ++ atom_to_list(Node) ++")1> \\E$"}, - {putline, "whereis(kalaskula)."}, - {expect, PidStr}, - {putline, "exit()."}, - {expect, "[*][*][*] Shell process terminated!"}, - {putdata, "\^g"}, - {expect, " --> $"}, - {putline, "c 1"}, - {expect, "\r\n"}, - {putline, ""}, - {expect, "\\Q("++RemNode++")\\E[12]> $"} - ], RemNode), + rtnode:run( + [{putline, ""}, + {putline, "erlang:get_cookie()."}, + {expect, "\r\n\\Q" ++ CookieString ++ "\\E"}, + {putdata, "\^g"}, + {expect, " --> $"}, + {putline, "r " ++ PrintedNode}, + {expect, "\r\n"}, + {putline, "j"}, + {expect, "1 {shell,start,\\[init]}"}, + {expect, "2[*] {\\Q"++PrintedNode++"\\E,shell,start,\\[]}"}, + {expect, " --> $"}, + {putline, "c"}, + {expect, "\r\n"}, + {expect, "Eshell"}, + {expect, "\\Q(" ++ atom_to_list(Node) ++")1> \\E$"}, + {putline, "whereis(kalaskula)."}, + {expect, PidStr}, + {putline, "kalaskula ! die."}, + {putline, "exit()."}, + {expect, "[*][*][*] Shell process terminated!"}, + {putdata, "\^g"}, + {expect, " --> $"}, + {putline, "j"}, + {expect, "1 {shell,start,\\[init]}"}, + {expect, " --> $"}, + {putline, "c"}, + {expect, "Unknown job"}, + {expect, " --> $"}, + {putline, "c 1"}, + {expect, "\r\n"}, + {putline, ""}, + {expect, "\\Q("++RemNode++"@\\E[^)]*\\)[12]> $"}, + {putdata, "\^g"}, + {expect, " --> $"}, + {putline, "j"}, + {expect, "1[*] {shell,start,\\[init]}"}, + {putline, "c"}, + {expect, "\r\n"}, + {sleep, 100}, + {putline, "35."}, + {expect, "\\Q("++RemNode++"@\\E[^)]*\\)[123]> $"} + ], RemNode), Pid ! die, ok. @@ -703,20 +2148,21 @@ ctrl_keys(_Config) -> Cy = [$\^y], Home = [27,$O,$H], End = [27,$O,$F], - rtnode([{putline,""}, - {putline,"2."}, - {expect,"2"}, - {putline,"\"hello "++Cw++"world\"."}, % test <CTRL>+W - {expect,"\"world\""}, - {putline,"\"hello "++Cu++"\"world\"."}, % test <CTRL>+U - {expect,"\"world\""}, - {putline,"world\"."++Home++"\"hello "}, % test <HOME> - {expect,"\"hello world\""}, - {putline,"world"++Home++"\"hello "++End++"\"."}, % test <END> - {expect,"\"hello world\""}, - {putline,"\"hello world\""++Cu++Cy++"."}, - {expect,"\"hello world\""}] ++ - wordLeft() ++ wordRight(), []), + rtnode:run( + [{putline,""}, + {putline,"2."}, + {expect,"2"}, + {putline,"\"hello "++Cw++"world\"."}, % test <CTRL>+W + {expect,"\"world\""}, + {putline,"\"hello "++Cu++"\"world\"."}, % test <CTRL>+U + {expect,"\"world\""}, + {putline,"world\"."++Home++"\"hello "}, % test <HOME> + {expect,"\"hello world\""}, + {putline,"world"++Home++"\"hello "++End++"\"."}, % test <END> + {expect,"\"hello world\""}, + {putline,"\"hello world\""++Cu++Cy++"."}, + {expect,"\"hello world\""}] ++ + wordLeft() ++ wordRight()), ok. wordLeft() -> @@ -743,7 +2189,7 @@ wordRight(Chars) -> %% Test that -remsh works remsh_basic(Config) when is_list(Config) -> - TargetNode = start_node(?FUNCTION_NAME, []), + {ok, Peer, TargetNode} = ?CT_PEER(), TargetNodeStr = printed_atom(TargetNode), [_Name,Host] = string:split(atom_to_list(node()), "@"), @@ -756,19 +2202,30 @@ remsh_basic(Config) when is_list(Config) -> %% Test that remsh works with explicit -sname. HostNode = atom_to_list(?FUNCTION_NAME) ++ "_host", HostNodeStr = printed_atom(list_to_atom(HostNode ++ "@" ++ Host)), - rtnode(PreCmds ++ - [{putline,"nodes()."}, - {expect, "\\Q" ++ HostNodeStr ++ "\\E"}] ++ - PostCmds, - HostNode, [], "-remsh " ++ TargetNodeStr), + rtnode:run( + PreCmds ++ + [{putline,"nodes()."}, + {expect, "\\Q" ++ HostNodeStr ++ "\\E"}] ++ + PostCmds, + HostNode, " ", "-remsh " ++ TargetNodeStr), %% Test that remsh works without -sname. - rtnode(PreCmds ++ PostCmds, [], [], " -remsh " ++ TargetNodeStr), + rtnode:run(PreCmds ++ PostCmds, [], " ", "-remsh " ++ TargetNodeStr), + + %% Test that if multiple remsh are given, we select the first + rtnode:run([{expect, "Multiple"}] ++ PreCmds ++ PostCmds, + [], " ", + "-remsh " ++ TargetNodeStr ++ " -remsh invalid_node"), - test_server:stop_node(TargetNode), + peer:stop(Peer), ok. +%% Test that if we cannot connect to a node, we get a correct error +remsh_error(_Config) -> + "Could not connect to \"invalid_node\"\n" = + os:cmd(ct:get_progname() ++ " -remsh invalid_node"). + quit_hosting_node() -> %% Command sequence for entering a shell on the hosting node. [{putdata, "\^g"}, @@ -788,529 +2245,108 @@ remsh_longnames(Config) when is_list(Config) -> "@127.0.0.1"; _ -> "" end, - case rtstart(" -name " ++ atom_to_list(?FUNCTION_NAME)++Domain) of - {ok, _SRPid, STPid, SState} -> + Name = peer:random_name(?FUNCTION_NAME), + case rtnode:start(" -name " ++ Name ++ Domain) of + {ok, _SRPid, STPid, SNode, SState} -> try - {ok, _CRPid, CTPid, CState} = - rtstart("-name undefined" ++ Domain ++ - " -remsh " ++ atom_to_list(?FUNCTION_NAME)), + {ok, _CRPid, CTPid, CNode, CState} = + rtnode:start("-name undefined" ++ Domain ++ + " -remsh " ++ Name), try - ok = send_commands( + ok = rtnode:send_commands( + SNode, STPid, [{putline, ""}, {putline, "node()."}, - {expect, "\\Q" ++ atom_to_list(?FUNCTION_NAME) ++ "\\E"}], 1), - ok = send_commands( + {expect, "\\Q" ++ Name ++ "\\E"}], 1), + ok = rtnode:send_commands( + CNode, CTPid, [{putline, ""}, {putline, "node()."}, - {expect, "\\Q" ++ atom_to_list(?FUNCTION_NAME) ++ "\\E"} | quit_hosting_node()], 1) + {expect, "\\Q" ++ Name ++ "\\E"} | quit_hosting_node()], 1) after - rtnode_dump_logs(rtstop(CState)) + rtnode:dump_logs(rtnode:stop(CState)) end after - rtnode_dump_logs(rtstop(SState)) + rtnode:dump_logs(rtnode:stop(SState)) end; - Else -> + {skip, _} = Else -> Else end. %% Test that -remsh works without epmd. remsh_no_epmd(Config) when is_list(Config) -> - EPMD_ARGS = "-start_epmd false -erl_epmd_port 12345 ", - case rtstart([],"ERL_EPMD_PORT=12345 ", - EPMD_ARGS ++ " -sname " ++ atom_to_list(?FUNCTION_NAME)) of - {ok, _SRPid, STPid, SState} -> + EPMD_ARGS = "-start_epmd false -erl_epmd_port 12346 ", + Name = ?CT_PEER_NAME(), + case rtnode:start([],"ERL_EPMD_PORT=12345 ", + EPMD_ARGS ++ " -sname " ++ Name) of + {ok, _SRPid, STPid, SNode, SState} -> try - ok = send_commands( + ok = rtnode:send_commands( + SNode, STPid, [{putline, ""}, {putline, "node()."}, - {expect, "\\Q" ++ atom_to_list(?FUNCTION_NAME) ++ "\\E"}], 1), - {ok, _CRPid, CTPid, CState} = - rtstart([],"ERL_EPMD_PORT=12345 ", - EPMD_ARGS ++ " -remsh "++atom_to_list(?FUNCTION_NAME)), + {expect, "\\Q" ++ Name ++ "\\E"}], 1), + {ok, _CRPid, CTPid, CNode, CState} = + rtnode:start([],"ERL_EPMD_PORT=12345 ", + EPMD_ARGS ++ " -remsh "++Name), try - ok = send_commands( + ok = rtnode:send_commands( + CNode, CTPid, [{putline, ""}, {putline, "node()."}, - {expect, "\\Q" ++ atom_to_list(?FUNCTION_NAME) ++ "\\E"} | quit_hosting_node()], 1) + {expect, "\\Q" ++ Name ++ "\\E"} | quit_hosting_node()], 1) after - rtstop(CState) + rtnode:dump_logs(rtnode:stop(CState)) end after - rtstop(SState) + rtnode:dump_logs(rtnode:stop(SState)) end; - Else -> + {skip, _} = Else -> Else end. - -rtnode(C) -> - rtnode(C, []). - -rtnode(C, N) -> - rtnode(C, N, []). - -rtnode(Commands, Nodename, ErlPrefix) -> - rtnode(Commands, Nodename, ErlPrefix, []). - -rtnode(Commands, Nodename, ErlPrefix, Args) -> - case rtstart(Nodename, ErlPrefix, Args) of - {ok, _SPid, CPid, RTState} -> - Res = catch send_commands(CPid, Commands, 1), - Logs = rtstop(RTState), - case Res of - ok -> - rtnode_dump_logs(Logs), - ok; - _ -> - rtnode_dump_logs(Logs), - ok = Res - end, - {ok, Logs}; - Skip -> - Skip - end. - -rtstart(Args) -> - rtstart([], [], Args). - -rtstart(Nodename, ErlPrefix, Args) -> - case get_progs() of - {error,_Reason} -> - {skip,"No runerl present"}; - {RunErl,ToErl,Erl} -> - case create_tempdir() of - {error, Reason2} -> - {skip, Reason2}; - Tempdir -> - SPid = - start_runerl_node(RunErl,ErlPrefix++"\\\""++Erl++"\\\"", - Tempdir,Nodename,Args), - CPid = start_toerl_server(ToErl,Tempdir), - {ok, SPid, CPid, {CPid, SPid, ToErl, Tempdir}} - end - end. - -rtstop({CPid, SPid, ToErl, Tempdir}) -> - case stop_runerl_node(CPid) of - {error,_} -> - catch rtstop_try_harder(ToErl, Tempdir); - _ -> - ok - end, - wait_for_runerl_server(SPid), - Logs = rtnode_read_logs(Tempdir), - file:del_dir_r(Tempdir), - Logs. - -rtstop_try_harder(ToErl, Tempdir) -> - CPid = start_toerl_server(ToErl, Tempdir), - ok = send_commands(CPid, - [{putline,[7]}, - {expect, " --> $"}, - {putline, "s"}, - {putline, "c"}, - {putline, ""}], 1), - stop_runerl_node(CPid). - -timeout(longest) -> - timeout(long) + timeout(normal); -timeout(long) -> - 2 * timeout(normal); -timeout(short) -> - timeout(normal) div 10; -timeout(normal) -> - 10000 * test_server:timetrap_scale_factor(). - -start_node(Name, Args0) -> - PaDir = filename:dirname(code:which(?MODULE)), - Args1 = ["-pa",PaDir|Args0], - Args = lists:append(lists:join(" ", Args1)), - {ok, Node} = test_server:start_node(Name, slave, [{args,Args}]), - Node. - -send_commands(CPid, [{sleep, X}|T], N) -> - ?dbg({sleep, X}), - receive - after X -> - send_commands(CPid, T, N+1) - end; -send_commands(CPid, [{expect, Expect}|T], N) when is_list(Expect) -> - ?dbg(Exp), - case command(CPid, {expect, [Expect], timeout(normal)}) of - ok -> - send_commands(CPid, T, N + 1); - {expect_timeout, Got} -> - ct:pal("expect timed out waiting for ~p\ngot: ~p\n", [Expect,Got]), - {error, timeout}; - Other -> - Other - end; -send_commands(CPid, [{putline, Line}|T], N) -> - send_commands(CPid, [{putdata, Line ++ "\n"}|T], N); -send_commands(CPid, [{putdata, Data}|T], N) -> - ?dbg({putdata, Data}), - case command(CPid, {send_data, Data}) of - ok -> - send_commands(CPid, T, N+1); - Error -> - Error - end; -send_commands(_CPid, [], _) -> - ok. - -command(Pid, Req) -> - Timeout = timeout(longest), - Ref = erlang:monitor(process, Pid), - Pid ! {self(), Ref, Req}, - receive - {Ref, Reply} -> - erlang:demonitor(Ref, [flush]), - Reply; - {'DOWN', Ref, _, _, Reason} -> - {error, Reason} - after Timeout -> - io:format("timeout while executing ~p\n", [Req]), - {error, timeout} - end. - -wait_for_runerl_server(SPid) -> - Ref = erlang:monitor(process, SPid), - Timeout = timeout(long), - receive - {'DOWN', Ref, process, SPid, _Reason} -> - ok - after Timeout -> - {error, runerl_server_timeout} - end. - -stop_runerl_node(CPid) -> - Ref = erlang:monitor(process, CPid), - CPid ! {self(), kill_emulator}, - Timeout = timeout(longest), - receive - {'DOWN', Ref, process, CPid, noproc} -> - ok; - {'DOWN', Ref, process, CPid, normal} -> - ok; - {'DOWN', Ref, process, CPid, {error, Reason}} -> - {error, Reason} - after Timeout -> - {error, toerl_server_timeout} - end. - -get_progs() -> - try - do_get_progs() - catch - throw:Thrown -> - {error, Thrown} - end. - -do_get_progs() -> - case os:type() of - {unix,freebsd} -> - throw("Can't use run_erl on FreeBSD"); - {unix,openbsd} -> - throw("Can't use run_erl on OpenBSD"); - {unix,_} -> - RunErl = find_executable("run_erl"), - ToErl = find_executable("to_erl"), - Erl = find_executable("erl"), - {RunErl, ToErl, Erl}; - _ -> - throw("Not a Unix OS") - end. - -find_executable(Name) -> - case os:find_executable(Name) of - Prog when is_list(Prog) -> - Prog; - false -> - throw("Could not find " ++ Name) - 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,Args) -> - XArg = case Nodename of - [] -> - []; - _ -> - " -sname "++(if is_atom(Nodename) -> atom_to_list(Nodename); - true -> Nodename - end)++ - " -setcookie "++atom_to_list(erlang:get_cookie()) - end ++ " " ++ Args, - spawn(fun() -> start_runerl_command(RunErl, Tempdir, Erl++XArg) end). - -start_runerl_command(RunErl, Tempdir, Cmd) -> - FullCmd = "\""++RunErl++"\" "++Tempdir++"/ "++Tempdir++" \""++Cmd++"\"", - ct:pal("~ts",[FullCmd]), - os:cmd(FullCmd). - -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]), - Timeout = timeout(short) div 2, - receive - {Port, eof} -> - timer:sleep(Timeout), - 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, - - State = #{port => Port, acc => [], kill_emulator_command => init_stop}, - case toerl_loop(State) of - normal -> - ok; - {error, Reason} -> - error_logger:error_msg("toerl_server exit with reason ~p~n", - [Reason]), - exit(Reason) - end. - -toerl_loop(#{port := Port} = State0) -> - ?dbg({toerl_loop, Port, map_get(acc, State0), - maps:get(match, State0, nomatch)}), - - State = handle_expect(State0), - - receive - {Port,{data,Data}} when is_port(Port) -> - ?dbg({?LINE,Port,{data,Data}}), - toerl_loop(State#{acc => map_get(acc, State) ++ Data}); - {Pid, Ref, {expect, Expect, Timeout}} -> - toerl_loop(init_expect(Pid, Ref, Expect, Timeout, State)); - {Pid, Ref, {send_data, Data}} -> - Port ! {self(), {command, Data}}, - Pid ! {Ref, ok}, - toerl_loop(State); - {_Pid, kill_emulator} -> - kill_emulator(State); - {timeout,Timer,expect_timeout} -> - toerl_loop(handle_expect_timeout(Timer, State)); - {Port, eof} -> - {error, unexpected_eof}; - Other -> - {error, {unexpected, Other}} - end. - -kill_emulator(#{port := Port}) -> - %% If the line happens to end in a ".", issuing "init:stop()." - %% will result in a syntax error. To avoid that, issue a "\n" - %% before "init:stop().". - Port ! {self(),{command, "\ninit:stop().\n"}}, - wait_for_eof(Port). - -wait_for_eof(Port) -> - receive - {Port,eof} -> - normal; - _Other -> - wait_for_eof(Port) - after - timeout(long) -> - {error, kill_timeout} - end. - -init_expect(Pid, Ref, ExpectList, Timeout, State) -> - try compile_expect(ExpectList) of - Expect -> - Exp = #{expect => Expect, - ref => Ref, - source => ExpectList, - timer => erlang:start_timer(Timeout, self(), expect_timeout), - from => Pid}, - State#{expect => Exp} - catch - Class:Reason:Stk -> - io:put_chars("Compilation of expect pattern failed:"), - io:format("~p\n", [ExpectList]), - io:put_chars(erl_error:format_exception(Class, Reason, Stk)), - exit(expect_pattern_error) - end. - -handle_expect(#{acc := Acc, expect := Exp} = State) -> - #{expect := Expect, from := Pid, ref := Ref} = Exp, - case Expect(Acc) of - nomatch -> - State; - {matched, Eaten, Result} -> - Pid ! {Ref, Result}, - finish_expect(Eaten, State) - end; -handle_expect(State) -> - State. - -handle_expect_timeout(Timer, State) -> - #{acc := Acc, expect := Exp} = State, - #{expect := Expect, timer := Timer, from := Pid, ref := Ref} = Exp, - case Expect({timeout, Acc}) of - nomatch -> - Result = {expect_timeout, Acc}, - Pid ! {Ref, Result}, - finish_expect(0, State); - {matched, Eaten, Result} -> - Pid ! {Ref, Result}, - finish_expect(Eaten, State) +remsh_expand_compatibility_25(Config) when is_list(Config) -> + {ok, _Peer, TargetNode} = ?CT_PEER(#{}), %% Create a vsn 26 node + NodeName = atom_to_list(TargetNode), %% compatibility + %% Start a node on vsn 25 but run the shell on vsn 26 + case rtnode:start(peer:random_name(), "stty columns 200; ERL_AFLAGS= ", "-remsh "++NodeName, [{release, "25"}|Config]) of + {ok, _SRPid, STPid, _, SState} -> + try + ok = rtnode:send_commands(undefined, + STPid, + [{putdata, "erlang:is_atom\t"}, + {expect, "\\Qerlang:is_atom(\\E"}| + quit_hosting_node()], 1) + after + Logs = rtnode:stop(SState), + rtnode:dump_logs(Logs) + end; + Else when element(1, Else) =/= ok -> Else end. - -finish_expect(Eaten, #{acc := Acc0, - expect := #{timer := Timer}}=State) -> - erlang:cancel_timer(Timer), - receive - {timeout,Timer,timeout} -> - ok - after 0 -> - ok - end, - Acc = lists:nthtail(Eaten, Acc0), - maps:remove(expect, State#{acc := Acc}). - -compile_expect([{timeout,Action}|T]) when is_function(Action, 1) -> - Next = compile_expect(T), - fun({timeout, _}=Tm) -> - {matched, 0, Action(Tm)}; - (Subject) -> - Next(Subject) - end; -compile_expect([{{re,RE0},Action}|T]) when is_binary(RE0), is_function(Action, 1) -> - {ok, RE} = re:compile(RE0), - Next = compile_expect(T), - fun({timeout, _}=Subject) -> - Next(Subject); - (Subject) -> - case re:run(Subject, RE, [{capture,first,index}]) of - nomatch -> - Next(Subject); - {match, [{Pos,Len}]} -> - Matched = binary:part(list_to_binary(Subject), Pos, Len), - {matched, Pos+Len, Action(Matched)} +remsh_expand_compatibility_later_version(Config) when is_list(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + case ?CT_PEER_REL([], "25", PrivDir) of + not_available -> {skip, "25 not available"}; + {ok, _Peer, TargetNode} -> + NodeName = atom_to_list(TargetNode), + %% Start a node on later version but run the shell on vsn 25 + case rtnode:start(peer:random_name(), "stty columns 200; ERL_AFLAGS= ", "-remsh " ++ NodeName, Config) of + {ok, _SRPid, STPid, _, SState} -> + try + ok = rtnode:send_commands(undefined, + STPid, + [{putdata, "erlang:is_atom\t"}, + {expect, "\\Qerlang:is_atom(\\E"}| + quit_hosting_node()], 1) + after + Logs = rtnode:stop(SState), + rtnode:dump_logs(Logs) + end; + Else when element(1, Else) =/= ok -> Else end - end; -compile_expect([RE|T]) when is_list(RE) -> - Ok = fun(_) -> ok end, - compile_expect([{{re,list_to_binary(RE)},Ok}|T]); -compile_expect([]) -> - fun(_) -> - nomatch - end. - -rtnode_check_logs(Logname, Pattern, Logs) -> -rtnode_check_logs(Logname, Pattern, true, Logs). -rtnode_check_logs(Logname, Pattern, Match, Logs) -> - case re:run(maps:get(Logname, Logs), Pattern) of - {match, [_]} when Match -> - ok; - nomatch when not Match -> - ok; - _ -> - rtnode_dump_logs(Logs), - ct:fail("~p not found in log ~ts",[Pattern, Logname]) - end. - -rtnode_dump_logs(Logs) -> - maps:foreach( - fun(File, Data) -> - ct:pal("~ts: ~ts",[File, Data]) - end, Logs). - -rtnode_read_logs(Tempdir) -> - {ok, LogFiles0} = file:list_dir(Tempdir), - - %% Make sure that we only read log files and not any named pipes. - LogFiles = [F || F <- LogFiles0, - case F of - "erlang.log" ++ _ -> true; - _ -> false - end], - - lists:foldl( - fun(File, Acc) -> - case file:read_file(filename:join(Tempdir, File)) of - {ok, Data} -> - Acc#{ File => Data }; - _ -> - Acc - end - end, #{}, LogFiles). - -get_default_shell() -> - try - rtnode([{putline,""}, - {putline, "is_pid(whereis(user_drv))."}, - {expect, "true\r\n"}], []), - new - catch _E:_R -> - ?dbg({_E,_R}), - old end. printed_atom(A) -> diff --git a/lib/kernel/test/logger_SUITE.erl b/lib/kernel/test/logger_SUITE.erl index ef1bef9df3..3041fb0755 100644 --- a/lib/kernel/test/logger_SUITE.erl +++ b/lib/kernel/test/logger_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2022. All Rights Reserved. +%% Copyright Ericsson AB 2018-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1517,5 +1517,5 @@ check_config(_) -> %% this function is also a test. When logger.hrl used non-qualified %% apply/3 call, any module that was implementing apply/3 could %% not use any logging macro -apply(_Any, _Any, _Any) -> +apply(_, _, _) -> ok. diff --git a/lib/kernel/test/logger_disk_log_h_SUITE.erl b/lib/kernel/test/logger_disk_log_h_SUITE.erl index 08908b8b7a..fab125e5ae 100644 --- a/lib/kernel/test/logger_disk_log_h_SUITE.erl +++ b/lib/kernel/test/logger_disk_log_h_SUITE.erl @@ -674,7 +674,7 @@ sync(Config) -> check_tracer(100), ok. sync(cleanup,_Config) -> - dbg:stop_clear(), + dbg:stop(), logger:remove_handler(?MODULE). disk_log_wrap(Config) -> @@ -720,7 +720,7 @@ disk_log_wrap(Config) -> %% wait for trace messages timer:sleep(1000), - dbg:stop_clear(), + dbg:stop(), Received = lists:flatmap(fun({trace,_M,handle_info, [_,{disk_log,_Node,_Name,What},_]}) -> [{trace,What}]; @@ -732,7 +732,7 @@ disk_log_wrap(Config) -> ok. disk_log_wrap(cleanup,_Config) -> - dbg:stop_clear(), + dbg:stop(), logger:remove_handler(?MODULE). disk_log_full(Config) -> @@ -766,7 +766,7 @@ disk_log_full(Config) -> %% wait for trace messages timer:sleep(2000), - dbg:stop_clear(), + dbg:stop(), Received = lists:flatmap(fun({trace,_M,handle_info, [_,{disk_log,_Node,_Name,What},_]}) -> [{trace,What}]; @@ -782,7 +782,7 @@ disk_log_full(Config) -> %% {trace,{error_status,{error,{full,_}}}}] = Received, ok. disk_log_full(cleanup, _Config) -> - dbg:stop_clear(), + dbg:stop(), logger:remove_handler(?MODULE). disk_log_events(_Config) -> @@ -816,7 +816,7 @@ disk_log_events(_Config) -> [whereis(h_proc_name()) ! E || E <- Events], %% wait for trace messages timer:sleep(2000), - dbg:stop_clear(), + dbg:stop(), Received = lists:map(fun({trace,_M,handle_info, [_,Got,_]}) -> Got end, test_server:messages_get()), @@ -828,7 +828,7 @@ disk_log_events(_Config) -> end, Received), ok. disk_log_events(cleanup, _Config) -> - dbg:stop_clear(), + dbg:stop(), logger:remove_handler(?MODULE). write_failure(Config) -> @@ -1603,7 +1603,7 @@ tpl([{{M,F,A},MS}|Trace]) -> {_,_,1} -> ok; _ -> - dbg:stop_clear(), + dbg:stop(), throw({skip,"Can't trace "++atom_to_list(M)++":"++ atom_to_list(F)++"/"++integer_to_list(A)}) end, @@ -1636,13 +1636,13 @@ maybe_tracer_done(Pid,Expected,Got,Caller) -> check_tracer(T) -> receive tracer_done -> - dbg:stop_clear(), + dbg:stop(), ok; {tracer_got_unexpected,Got,Expected} -> - dbg:stop_clear(), + dbg:stop(), ct:fail({tracer_got_unexpected,Got,Expected}) after T -> - dbg:stop_clear(), + dbg:stop(), ct:fail({timeout,tracer}) end. diff --git a/lib/kernel/test/logger_formatter_SUITE.erl b/lib/kernel/test/logger_formatter_SUITE.erl index f1c64110a1..a2f825f4a9 100644 --- a/lib/kernel/test/logger_formatter_SUITE.erl +++ b/lib/kernel/test/logger_formatter_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2020. All Rights Reserved. +%% Copyright Ericsson AB 2018-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -183,7 +183,7 @@ single_line(_Config) -> ct:log(String3), match = re:run(String3,"\\[1,2,3,4,5,6,7,8,9,10\\]",[{capture,none}]), match = re:run(String3, - "#{a => map,few => accociations,with => a}", + "#{((a => map|with => a|few => accociations)[,}]){3}", [{capture,none}]), %% This part is added to make sure that the previous test made @@ -272,7 +272,7 @@ template(_Config) -> [[nested,subkey]]), String8 = format(info,{"~p",[term]},Meta8,#{template=>Template8, single_line=>true}), - ct:log(String6), + ct:log(String8), SelfStr = pid_to_list(self()), RefStr8 = ref_to_list(Ref8), ListStr = "[list,\"string\",4321,#{},{tuple}]", @@ -345,6 +345,18 @@ template(_Config) -> _ -> ct:fail({full_nested_map_unexpected,MultipleKeysStr10}) end, + Meta11A = #{time=>Time,be_short=>ok}, + Meta11B = #{time=>Time}, + Template11 = + [{be_short, + ["short:",msg], + ["long:[",level,"]",msg]}], + String11A = format(info,{"~p",[term]},Meta11A,#{template=>Template11,single_line=>true}), + String11B = format(info,{"~p",[term]},Meta11B,#{template=>Template11,single_line=>true}), + ct:log(String11A), + ct:log(String11B), + {"short:term","long:[info]term"} = {String11A,String11B}, + ok. format_msg(_Config) -> diff --git a/lib/kernel/test/logger_simple_h_SUITE.erl b/lib/kernel/test/logger_simple_h_SUITE.erl index 8ac52e54c7..3e0227d5c5 100644 --- a/lib/kernel/test/logger_simple_h_SUITE.erl +++ b/lib/kernel/test/logger_simple_h_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2022. All Rights Reserved. +%% Copyright Ericsson AB 2018-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -80,6 +80,7 @@ groups() -> all() -> [start_stop, + start_crash, replace_default, replace_file, replace_disk_log @@ -101,6 +102,21 @@ start_stop(_Config) -> start_stop(cleanup,_Config) -> logger:remove_handler(simple). +%% Test that the simple logger works during startup crash +start_crash(_Config) -> + + Output = os:cmd(ct:get_progname() ++ " -user baduser"), + ErrorOutput = re:replace(unicode:characters_to_binary(Output),"\r\n","\n",[global]), + ct:log("~ts",[ErrorOutput]), + {match,[_]} = re:run(ErrorOutput,"(^=SUPERVISOR REPORT====| supervisor_report *\n)",[global,multiline]), + {match,[_, _]} = re:run(ErrorOutput," crash_report *\n",[global]), + {match,[_]} = re:run(ErrorOutput," std_info *\n",[global]), + {match,[[CD]]} = re:run(ErrorOutput,"\nCrash dump is being written to: (.*)\\.\\.\\.done", + [{capture, all_but_first, binary}, global]), + ok = file:delete(CD), + ok. + + %% This testcase just tests that it does not crash, the default handler prints %% to stdout which we cannot read from in a detached slave. replace_default(Config) -> diff --git a/lib/kernel/test/logger_std_h_SUITE.erl b/lib/kernel/test/logger_std_h_SUITE.erl index ead4418d0d..88aac32f6f 100644 --- a/lib/kernel/test/logger_std_h_SUITE.erl +++ b/lib/kernel/test/logger_std_h_SUITE.erl @@ -2219,7 +2219,7 @@ tpl([]) -> ok. stop_clear() -> - dbg:stop_clear(), + dbg:stop(), %% Remove tracer from all processes in order to eliminate %% race conditions. erlang:trace(all,false,[all]). diff --git a/lib/kernel/test/logger_stress_SUITE.erl b/lib/kernel/test/logger_stress_SUITE.erl index 7fe12ca823..9209026322 100644 --- a/lib/kernel/test/logger_stress_SUITE.erl +++ b/lib/kernel/test/logger_stress_SUITE.erl @@ -343,7 +343,7 @@ cascade({PNode,PMFA,_PStatProcs},{CNode,CMFA,_CStatProcs},TestFun) -> after TO -> All = ets:lookup_element(Tab,producer,2), Written = ets:lookup_element(Tab,consumer,2), - dbg:stop_clear(), + dbg:stop(), ?COLLECT_STATS(All, [{PNode,P,Id} || {Id,P} <- _PStatProcs] ++ [{CNode,P,Id} || {Id,P} <- _CStatProcs]), diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 01b76d83df..6d6ed337a0 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2022. All Rights Reserved. +%% Copyright Ericsson AB 1997-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -401,8 +401,8 @@ error_info(Config) -> ExhaustFDs = fun(M,F,A) -> - case os:type() of - {unix, _} -> + case no_limit_for_opened_files() of + false -> {ok, Peer, Node} = ?CT_PEER(), FN = filename:join( proplists:get_value(priv_dir, Config), @@ -426,7 +426,7 @@ error_info(Config) -> after peer:stop(Peer) end; - _ -> + true -> apply(M,F,A) end end, @@ -437,7 +437,7 @@ error_info(Config) -> {cmd, [{no, string}, no_map]}, {cmd, ["echo 1"], [{general, "too many open files \\(emfile\\)"}, {wrapper, ExhaustFDs}] ++ - [no_fail || win32 =:= element(1, os:type())]}, + [no_fail || no_limit_for_opened_files()]}, {find_executable, 1}, %Not a BIF. {find_executable, 2}, %Not a BIF. @@ -469,6 +469,19 @@ error_info(Config) -> ], error_info_lib:test_error_info(os, L). +no_limit_for_opened_files() -> + case os:type() of + {unix, freebsd} -> + %% At least some FreeBSD systems support about one million open + %% files, which means that we run out of Erlang processes before we + %% reach the open file limit. + true; + {unix, _} -> + false; + _ -> + true + end. + %% Util functions comp(Expected, Got) -> diff --git a/lib/kernel/test/pg_SUITE.erl b/lib/kernel/test/pg_SUITE.erl index d563209267..f10e89d774 100644 --- a/lib/kernel/test/pg_SUITE.erl +++ b/lib/kernel/test/pg_SUITE.erl @@ -59,7 +59,8 @@ group_leave/1, monitor_nonempty_scope/0, monitor_nonempty_scope/1, monitor_scope/0, monitor_scope/1, - monitor/1 + monitor/1, + protocol_upgrade/1 ]). -include_lib("common_test/include/ct.hrl"). @@ -87,7 +88,8 @@ all() -> groups() -> [ - {basic, [parallel], [errors, pg, leave_exit_race, single, overlay_missing]}, + {basic, [parallel], [errors, pg, leave_exit_race, single, overlay_missing, + protocol_upgrade]}, {performance, [], [thundering_herd]}, {cluster, [parallel], [process_owner_check, two, initial, netsplit, trisplit, foursplit, exchange, nolocal, double, scope_restart, missing_scope_join, empty_group_by_remote_leave, @@ -755,9 +757,32 @@ second_monitor(Msgs) -> second_monitor([Msg | Msgs]) end. +protocol_upgrade(Config) when is_list(Config) -> + Scope = ?FUNCTION_NAME, + Group = ?FUNCTION_NAME, + {Peer, Node} = spawn_node(Scope, Config), + PgPid = rpc:call(Node, erlang, whereis, [Scope]), + + RemotePid = erlang:spawn(Node, forever()), + ok = rpc:call(Node, pg, join, [Scope, Group, RemotePid]), + + %% OTP 26: + %% Just do a white-box test and verify that pg accepts + %% a "future" discover message and replies with a sync. + PgPid ! {discover, self(), "Protocol version (ignore me)"}, + {'$gen_cast', {sync, PgPid, [{Group, [RemotePid]}]}} = receive_any(), + + %% stop the peer + peer:stop(Peer), + ok. + + %%-------------------------------------------------------------------- %% Test Helpers - start/stop additional Erlang nodes +receive_any() -> + receive M -> M end. + %% flushes GS (GenServer) queue, ensuring that all prior %% messages have been processed sync(GS) -> diff --git a/lib/kernel/test/rtnode.erl b/lib/kernel/test/rtnode.erl new file mode 100644 index 0000000000..ffa0613ca7 --- /dev/null +++ b/lib/kernel/test/rtnode.erl @@ -0,0 +1,575 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2022. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(rtnode). + +-export([run/1, run/2, run/3, run/4, start/1, start/3, start/4, send_commands/4, stop/1, + start_runerl_command/3, + check_logs/3, check_logs/4, read_logs/1, dump_logs/1, + get_default_shell/0, get_progs/0, create_tempdir/0, timeout/1]). + +-include_lib("common_test/include/ct.hrl"). + +%% -define(debug, true). + +-ifdef(debug). +-define(dbg(Data),io:format(standard_error, "DBG: ~p\r\n",[Data])). +-else. +-define(dbg(Data),noop). +-endif. + +-export([toerl_server/4]). + +%% +%% Tool for running interactive shell, used by interactive_shell and io_proto SUITE +%% +run(C) -> + run(C, [], [], []). + +run(C, N) -> + run(C, N, [], []). + +run(Commands, Nodename, ErlPrefix) -> + run(Commands, Nodename, ErlPrefix, []). + +run(Commands, Nodename, ErlPrefix, Args) -> + case start(Nodename, ErlPrefix, Args) of + {ok, _SPid, CPid, Node, RTState} -> + Res = catch send_commands(Node, CPid, Commands, 1), + Logs = stop(RTState), + case Res of + ok -> + dump_logs(Logs), + ok; + _ -> + dump_logs(Logs), + ok = Res + end, + {ok, Logs}; + Skip -> + Skip + end. + +start(Args) -> + start([], " ", Args, []). +start(Nodename, ErlPrefix, Args) -> + start(Nodename, ErlPrefix, Args, []). +start(Nodename, ErlPrefix, Args, Options) -> + case get_progs(Options) of + {error,Reason} -> + {skip,Reason}; + {RunErl,ToErl,[Erl|ErlArgs] = ErlWArgs} -> + case create_tempdir() of + {error, Reason2} -> + {skip, Reason2}; + Tempdir when ErlPrefix =/= [] -> + {SPid, Node} = + start_runerl_node(RunErl, + ErlPrefix++"\\\""++Erl++"\\\" "++ + lists:join($\s, ErlArgs), + Tempdir,Nodename,Args), + CPid = start_toerl_server(ToErl,Tempdir,undefined), + {ok, SPid, CPid, Node, {CPid, SPid, ToErl, Tempdir}}; + Tempdir -> + {SPid, Node} = start_peer_runerl_node(RunErl,ErlWArgs,Tempdir,Nodename,Args), + CPid = start_toerl_server(ToErl,Tempdir,SPid), + {ok, SPid, CPid, Node, {CPid, SPid, ToErl, Tempdir}} + end + end. + +stop({CPid, SPid, ToErl, Tempdir}) -> + %% Unlink from peer so that we don't crash when peer quits + unlink(SPid), + case stop_runerl_node(CPid) of + {error,_} -> + catch stop_try_harder(ToErl, Tempdir, SPid); + _ -> + ok + end, + wait_for_runerl_server(SPid), + Logs = read_logs(Tempdir), + file:del_dir_r(Tempdir), + Logs. + +stop_try_harder(ToErl, Tempdir, SPid) -> + CPid = start_toerl_server(ToErl, Tempdir, SPid), + ok = send_commands(undefined, CPid, + [{putline,[7]}, + {expect, " --> $"}, + {putline, "s"}, + {putline, "c"}, + {putline, ""}], 1), + stop_runerl_node(CPid). + +timeout(longest) -> + timeout(long) + timeout(normal); +timeout(long) -> + 2 * timeout(normal); +timeout(short) -> + timeout(normal) div 10; +timeout(normal) -> + 10000 * test_server:timetrap_scale_factor(). + +send_commands(Node, CPid, [{sleep, X}|T], N) -> + ?dbg({sleep, X}), + receive + after X -> + send_commands(Node, CPid, T, N+1) + end; +send_commands(Node, CPid, [{expect, Expect}|T], N) when is_list(Expect) -> + send_commands(Node, CPid, [{expect, unicode, Expect}|T], N); +send_commands(Node, CPid, [{expect, Encoding, Expect}|T], N) when is_list(Expect) -> + ?dbg({expect, Expect}), + case command(CPid, {expect, Encoding, [Expect], timeout(normal)}) of + ok -> + send_commands(Node, CPid, T, N + 1); + {expect_timeout, Got} -> + ct:pal("expect timed out waiting for ~p\ngot: ~p\n", [Expect,Got]), + {error, timeout}; + Other -> + Other + end; +send_commands(Node, CPid, [{putline, Line}|T], N) -> + send_commands(Node, CPid, [{putdata, Line ++ "\n"}|T], N); +send_commands(Node, CPid, [{putdata, Data}|T], N) -> + ?dbg({putdata, Data}), + case command(CPid, {send_data, Data}) of + ok -> + send_commands(Node, CPid, T, N+1); + Error -> + Error + end; +send_commands(Node, CPid, [{eval, Fun}|T], N) -> + ?dbg({eval, Node, Fun}), + case erpc:call(Node, Fun) of + ok -> + ?dbg({eval, ok}), + send_commands(Node, CPid, T, N+1); + Error -> + ?dbg({eval, Error}), + Error + end; +send_commands(_Node, _CPid, [], _) -> + ok. + +command(Pid, Req) -> + Timeout = timeout(longest), + Ref = erlang:monitor(process, Pid), + Pid ! {self(), Ref, Req}, + receive + {Ref, Reply} -> + erlang:demonitor(Ref, [flush]), + Reply; + {'DOWN', Ref, _, _, Reason} -> + {error, Reason} + after Timeout -> + io:format("timeout while executing ~p\n", [Req]), + {error, timeout} + end. + +wait_for_runerl_server(SPid) -> + Ref = erlang:monitor(process, SPid), + Timeout = timeout(long), + receive + {'DOWN', Ref, process, SPid, _Reason} -> + ok + after Timeout -> + {error, runerl_server_timeout} + end. + +stop_runerl_node(CPid) -> + Ref = erlang:monitor(process, CPid), + CPid ! {self(), kill_emulator}, + Timeout = timeout(longest), + receive + {'DOWN', Ref, process, CPid, noproc} -> + ok; + {'DOWN', Ref, process, CPid, normal} -> + ok; + {'DOWN', Ref, process, CPid, {error, Reason}} -> + {error, Reason} + after Timeout -> + {error, toerl_server_timeout} + end. + +get_progs() -> + case os:type() of + {unix,freebsd} -> + {error,"Can't use run_erl on FreeBSD"}; + {unix,openbsd} -> + {error,"Can't use run_erl on OpenBSD"}; + {unix,_} -> + RunErl = find_executable("run_erl"), + ToErl = find_executable("to_erl"), + Erl = string:split(ct:get_progname()," ",all), + {RunErl, ToErl, Erl}; + _ -> + {error,"Not a Unix OS"} + end. +get_progs(Opts) -> + case get_progs() of + {RunErl, ToErl, Erl} -> + case proplists:get_value(release, Opts) of + undefined -> {RunErl, ToErl, Erl}; + Release -> + case test_server_node:find_release(Release) of + none -> {error, "Could not find release "++Release}; + R -> {RunErl, ToErl, [R]} + end + end; + E -> E + end. + + +find_executable(Name) -> + case os:find_executable(Name) of + Prog when is_list(Prog) -> + Prog; + false -> + throw("Could not find " ++ Name) + 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. + +start_runerl_node(RunErl,Erl,Tempdir,Nodename,Args) -> + {XArg, Node} = + case Nodename of + [] -> + {[], undefined}; + _ -> + NodenameStr = if is_atom(Nodename) -> atom_to_list(Nodename); + true -> Nodename + end, + [_Name,Host] = string:split(atom_to_list(node()), "@"), + {" -sname "++ NodenameStr ++ + " -setcookie "++atom_to_list(erlang:get_cookie()), + list_to_atom(NodenameStr ++ "@" ++ Host)} + end, + {spawn(fun() -> start_runerl_command(RunErl, Tempdir, Erl ++ XArg ++ " " ++ Args) end), + Node}. + +start_runerl_command(RunErl, Tempdir, Cmd) -> + FullCmd = "\""++RunErl++"\" "++Tempdir++"/ "++Tempdir++" \""++Cmd++"\"", + ct:pal("~ts",[FullCmd]), + os:cmd(FullCmd). + +start_peer_runerl_node(RunErl,Erl,Tempdir,[],Args) -> + start_peer_runerl_node(RunErl,Erl,Tempdir,peer:random_name(),Args); +start_peer_runerl_node(RunErl,Erl,Tempdir,Nodename,Args) -> + {ok, Peer, Node} = + ?CT_PEER(#{ name => Nodename, + exec => {RunErl,Erl}, + detached => false, + shutdown => 10000, + post_process_args => + fun(As) -> + [Tempdir++"/",Tempdir, + lists:flatten( + lists:join( + " ",[[$',A,$'] || A <- As]))] + end, + args => ["-connect_all","false"|Args] }), + Self = self(), + TraceLog = filename:join(Tempdir,Nodename++".trace"), + ct:pal("Link to trace: file://~ts",[TraceLog]), + + spawn(Node, + fun() -> + try + %% {ok, _} = dbg:tracer(file, TraceLog), + %% dbg:p(whereis(user_drv),[c,m,timestamp]), + %% dbg:p(whereis(user_drv_reader),[c,m,timestamp]), + %% dbg:p(whereis(user_drv_writer),[c,m,timestamp]), + %% dbg:p(whereis(user),[c,m,timestamp]), + %% dbg:tp(user_drv,x), + %% dbg:tp(prim_tty,x), + %% dbg:tpl(prim_tty,read_nif,x), + Ref = monitor(process, Self), + receive {'DOWN',Ref,_,_,_} -> ok end + catch E:R:ST -> + io:format(user,"~p:~p:~p",[E,R,ST]), + erlang:raise(E,R,ST) + end + end), + {Peer, Node}. + +start_toerl_server(ToErl,Tempdir,SPid) -> + Pid = spawn(?MODULE,toerl_server,[self(),ToErl,Tempdir,SPid]), + 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]), + Timeout = timeout(short) div 2, + receive + {Port, eof} -> + timer:sleep(Timeout), + try_to_erl(Command, N-1) + after Timeout -> + ?dbg(Port), + Port + end. + +toerl_server(Parent, ToErl, TempDir, SPid) -> + 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, + + {ok, InitialData} = file:read_file(filename:join(TempDir,"erlang.log.1")), + + State = #{port => Port, acc => unicode:characters_to_list(InitialData), spid => SPid}, + case toerl_loop(State) of + normal -> + ok; + {error, Reason} -> + error_logger:error_msg("toerl_server exit with reason ~p~n", + [Reason]), + exit(Reason) + end. + +toerl_loop(#{port := Port} = State0) -> + ?dbg({toerl_loop, Port, map_get(acc, State0), + maps:get(match, State0, nomatch)}), + + State = handle_expect(State0), + + receive + {Port,{data,Data}} when is_port(Port) -> + ?dbg({?LINE,Port,{data,Data}}), + toerl_loop(State#{acc => map_get(acc, State) ++ Data}); + {Pid, Ref, {expect, Encoding, Expect, Timeout}} -> + toerl_loop(init_expect(Pid, Ref, Encoding, Expect, Timeout, State)); + {Pid, Ref, {send_data, Data}} -> + ?dbg({?LINE,Port,{send_data,Data}}), + Port ! {self(), {command, Data}}, + Pid ! {Ref, ok}, + toerl_loop(State); + {_Pid, kill_emulator} -> + kill_emulator(State); + {timeout,Timer,expect_timeout} -> + toerl_loop(handle_expect_timeout(Timer, State)); + {Port, eof} -> + {error, unexpected_eof}; + Other -> + {error, {unexpected, Other}} + end. + +kill_emulator(#{spid := SPid, port := Port}) when is_pid(SPid) -> + catch peer:stop(SPid), + wait_for_eof(Port); +kill_emulator(#{port := Port}) -> + %% If the line happens to end in a ".", issuing "init:stop()." + %% will result in a syntax error. To avoid that, issue a "\n" + %% before "init:stop().". + Port ! {self(),{command, "\ninit:stop().\n"}}, + wait_for_eof(Port). + +wait_for_eof(Port) -> + receive + {Port,eof} -> + normal; + _Other -> + wait_for_eof(Port) + after + timeout(long) -> + {error, kill_timeout} + end. + +init_expect(Pid, Ref, Encoding, ExpectList, Timeout, State) -> + try compile_expect(ExpectList, Encoding) of + Expect -> + Exp = #{expect => Expect, + ref => Ref, + source => ExpectList, + timer => erlang:start_timer(Timeout, self(), expect_timeout), + from => Pid}, + State#{expect => Exp} + catch + Class:Reason:Stk -> + io:put_chars("Compilation of expect pattern failed:"), + io:format("~p\n", [ExpectList]), + io:put_chars(erl_error:format_exception(Class, Reason, Stk)), + exit(expect_pattern_error) + end. + +handle_expect(#{acc := Acc, expect := Exp} = State) -> + #{expect := Expect, from := Pid, ref := Ref} = Exp, + case Expect(Acc) of + nomatch -> + State; + {matched, Eaten, Result} -> + ?dbg({matched, Eaten, Result}), + Pid ! {Ref, Result}, + finish_expect(Eaten, State) + end; +handle_expect(State) -> + State. + +handle_expect_timeout(Timer, State) -> + #{acc := Acc, expect := Exp} = State, + #{expect := Expect, timer := Timer, from := Pid, ref := Ref} = Exp, + case Expect({timeout, Acc}) of + nomatch -> + Result = {expect_timeout, Acc}, + Pid ! {Ref, Result}, + finish_expect(0, State); + {matched, Eaten, Result} -> + Pid ! {Ref, Result}, + finish_expect(Eaten, State) + end. + +finish_expect(Eaten, #{acc := Acc0, + expect := #{timer := Timer}}=State) -> + erlang:cancel_timer(Timer), + receive + {timeout,Timer,timeout} -> + ok + after 0 -> + ok + end, + Acc = lists:nthtail(Eaten, Acc0), + maps:remove(expect, State#{acc := Acc}). + +compile_expect([{timeout,Action}|T], E) when is_function(Action, 1) -> + Next = compile_expect(T, E), + fun({timeout, _}=Tm) -> + {matched, 0, Action(Tm)}; + (Subject) -> + Next(Subject) + end; +compile_expect([{{re,RE0},Action}|T], E) when is_binary(RE0), is_function(Action, 1) -> + {ok, RE} = re:compile(RE0, [unicode || E =:= unicode]), + Next = compile_expect(T, E), + fun({timeout, _}=Subject) -> + Next(Subject); + (Subject) -> + BinarySubject = if + E =:= unicode -> + unicode:characters_to_binary(list_to_binary(Subject)); + E =:= latin1 -> + list_to_binary(Subject) + end, + case re:run(BinarySubject, RE, [{capture,first,index}]) of + nomatch -> + Next(Subject); + {match, [{Pos,Len}]} -> + Matched = binary:part(BinarySubject, Pos, Len), + {matched, Pos+Len, Action(Matched)} + end + end; +compile_expect([RE|T], E) when is_list(RE) -> + Ok = fun(_) -> ok end, + compile_expect([{{re,unicode:characters_to_binary(RE, unicode, E)},Ok}|T], E); +compile_expect([], _E) -> + fun(_) -> + nomatch + end. + +check_logs(Logname, Pattern, Logs) -> + check_logs(Logname, Pattern, true, Logs). +check_logs(Logname, Pattern, Match, Logs) -> + case re:run(maps:get(Logname, Logs), Pattern) of + {match, [_]} when Match -> + ok; + nomatch when not Match -> + ok; + _ -> + dump_logs(Logs), + ct:fail("~p not found in log ~ts",[Pattern, Logname]) + end. + +dump_logs(Logs) -> + maps:foreach( + fun(File, Data) -> + try re:replace(Data,"\e","\\\\e",[unicode,global]) of + D -> ct:pal("~ts: ~ts",[File, D]) + catch error:badarg -> + ct:pal("~ts: ~s",[File, re:replace(Data,"\e","\\\\e",[global])]) + end + end, Logs). + +read_logs(Tempdir) -> + {ok, LogFiles0} = file:list_dir(Tempdir), + + %% Make sure that we only read log files and not any named pipes. + LogFiles = [F || F <- LogFiles0, + case F of + "erlang.log" ++ _ -> true; + _ -> false + end], + + lists:foldl( + fun(File, Acc) -> + case file:read_file(filename:join(Tempdir, File)) of + {ok, Data} -> + Acc#{ File => Data }; + _ -> + Acc + end + end, #{}, LogFiles). + +get_default_shell() -> + case get_progs() of + {error,_} -> + noshell; + _ -> + try + run([{putline,""}, + {putline, "is_pid(whereis(user_drv))."}, + {expect, "true\r\n"}]), + new + catch _E:_R -> + old + end + end. diff --git a/lib/kernel/test/socket_SUITE.erl b/lib/kernel/test/socket_SUITE.erl index 673c905ddf..196af34521 100644 --- a/lib/kernel/test/socket_SUITE.erl +++ b/lib/kernel/test/socket_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2022. All Rights Reserved. +%% Copyright Ericsson AB 2018-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -67,6 +67,15 @@ %% %% Run a specific test case: %% ts:run(emulator, socket_SUITE, foo, [batch]). +%% +%% S = fun() -> ts:run(kernel, socket_SUITE, [batch]) end. +%% S = fun() -> ct:run_test([{suite, socket_SUITE}]) end. +%% G = fun(GROUP) -> ts:run(kernel, socket_SUITE, {group, GROUP}, [batch]) end. +%% G = fun(GROUP) -> ct:run_test([{suite, socket_SUITE}, {group, GROUP}]) end. +%% T = fun(TC) -> ts:run(kernel, socket_SUITE, TC, [batch]) end. +%% T = fun(TC) -> ct:run_test([{suite, socket_SUITE}, {testcase, TC}]) end. + + -module(socket_SUITE). @@ -89,6 +98,10 @@ api_m_error_bind/1, %% *** API Basic *** + api_b_simple_open_and_close_udp4/1, + api_b_simple_open_and_close_udp6/1, + api_b_simple_open_and_close_tcp4/1, + api_b_simple_open_and_close_tcp6/1, api_b_open_and_info_udp4/1, api_b_open_and_info_udp6/1, api_b_open_and_info_tcp4/1, @@ -731,8 +744,11 @@ -define(TPP_LARGE_NUM, 50). -define(TPP_NUM(Config, Base), (Base) div lookup(kernel_factor, 1, Config)). +-define(WINDOWS, {win32,nt}). + -define(TTEST_RUNTIME, ?SECS(1)). -define(TTEST_MIN_FACTOR, 3). +-define(TTEST_MIN_FACTOR_WIN, ?TTEST_MIN_FACTOR-1). -define(TTEST_DEFAULT_SMALL_MAX_OUTSTANDING, 50). -define(TTEST_DEFAULT_MEDIUM_MAX_OUTSTANDING, ?TTEST_MK_DEFAULT_MAX_OUTSTANDING( @@ -918,6 +934,10 @@ api_misc_cases() -> api_basic_cases() -> [ + api_b_simple_open_and_close_udp4, + api_b_simple_open_and_close_udp6, + api_b_simple_open_and_close_tcp4, + api_b_simple_open_and_close_tcp6, api_b_open_and_info_udp4, api_b_open_and_info_udp6, api_b_open_and_info_tcp4, @@ -1387,7 +1407,12 @@ traffic_pp_sendmsg_recvmsg_cases() -> %% No point in running these cases unless the machine is %% reasonably fast. ttest_condition(Config) -> + OsType = os:type(), case ?config(kernel_factor, Config) of + Factor when (OsType =:= ?WINDOWS) andalso + is_integer(Factor) andalso + (Factor =< ?TTEST_MIN_FACTOR_WIN) -> + ok; Factor when is_integer(Factor) andalso (Factor =< ?TTEST_MIN_FACTOR) -> ok; Factor when is_integer(Factor) -> @@ -2581,6 +2606,100 @@ api_m_error_bind(Config) when is_list(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Basically open (create) and then close. +api_b_simple_open_and_close_udp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(?FUNCTION_NAME, + fun() -> + InitState = #{domain => inet, + type => dgram, + protocol => udp}, + ok = api_b_simple_open_and_close(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) and then close. +api_b_simple_open_and_close_udp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(?FUNCTION_NAME, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => dgram, + protocol => udp}, + ok = api_b_simple_open_and_close(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) and then close. +api_b_simple_open_and_close_tcp4(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(?FUNCTION_NAME, + fun() -> + InitState = #{domain => inet, + type => stream, + protocol => tcp}, + ok = api_b_simple_open_and_close(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Basically open (create) and then close. +api_b_simple_open_and_close_tcp6(_Config) when is_list(_Config) -> + ?TT(?SECS(5)), + tc_try(?FUNCTION_NAME, + fun() -> has_support_ipv6() end, + fun() -> + InitState = #{domain => inet6, + type => stream, + protocol => tcp}, + ok = api_b_simple_open_and_close(InitState) + end). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +api_b_simple_open_and_close(InitState) -> + Seq = + [ + #{desc => "open", + cmd => fun(#{domain := Domain, + type := Type, + protocol := Protocol} = State) -> + case socket:open(Domain, Type, Protocol) of + {ok, Sock} -> + {ok, State#{sock => Sock}}; + {error, _} = ERROR -> + ERROR + end + end}, + + ?SEV_SLEEP(?SECS(1)), + + #{desc => "close socket", + cmd => fun(#{sock := Sock} = _State) -> + socket:close(Sock) + end}, + + %% *** We are done *** + ?SEV_FINISH_NORMAL + ], + Evaluator = ?SEV_START("tester", Seq, InitState), + ok = ?SEV_AWAIT_FINISH([Evaluator]). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + %% Basically open (create) and info of an IPv4 UDP (dgram) socket. %% With some extra checks... api_b_open_and_info_udp4(_Config) when is_list(_Config) -> @@ -3381,7 +3500,10 @@ api_b_send_and_recv_seqpL(_Config) when is_list(_Config) -> api_b_sendmsg_and_recvmsg_tcp4(_Config) when is_list(_Config) -> ?TT(?SECS(10)), tc_try(api_b_sendmsg_and_recvmsg_tcp4, - fun() -> has_support_ipv4() end, + fun() -> + is_not_windows(), + has_support_ipv4() + end, fun() -> Send = fun(Sock, Data) -> Msg = #{iov => [Data]}, @@ -4530,6 +4652,12 @@ api_b_sendmsg_iov_stream(Domain) -> DataTooLarge = erlang:iolist_to_binary(IOVTooLarge), {ok, Sa} = socket:open(Domain, stream), try + case os:type() of + {win32,nt} -> + ok = socket:bind(Sa, which_local_socket_addr(Domain)); + _ -> + ok + end, {ok, Sb} = socket:open(Domain, stream), try ok = socket:bind(Sb, which_local_socket_addr(Domain)), @@ -4550,6 +4678,9 @@ api_b_sendmsg_iov_stream(Domain) -> {ok, DataTooLarge} = socket:recv(Sa, byte_size(DataTooLarge)), ok + catch + error:notsup = Reason:_ -> + exit({skip, Reason}) after socket:close(Sc) end @@ -4560,6 +4691,7 @@ api_b_sendmsg_iov_stream(Domain) -> socket:close(Sa) end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% @@ -6586,7 +6718,7 @@ api_a_connect_tcpD(Domain, Nowait) -> connect => Connect, send => Send, recv => Recv, - connect_sref => Nowait}, + connect_ref => Nowait}, api_a_connect_tcp(InitState). @@ -6777,41 +6909,67 @@ api_a_connect_tcp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, async_connect) end}, #{desc => "connect (async) to server", - cmd => fun(#{sock := Sock, - server_sa := SSA, - connect := Connect, - connect_sref := SR} = State) -> + cmd => fun(#{sock := Sock, + server_sa := SSA, + connect := Connect, + connect_ref := SR} = State) -> case Connect(Sock, SSA) of ok -> ?SEV_IPRINT("ok -> " "unexpected success => SKIP", []), {skip, unexpected_success}; + {select, {select_info, ST, SelectRef}} when SR =:= nowait -> ?SEV_IPRINT("select nowait ->" "~n tag: ~p" "~n ref: ~p", [ST, SelectRef]), - {ok, State#{connect_stag => ST, - connect_sref => SelectRef}}; + {ok, State#{asynch_tag => select, + connect_tag => ST, + connect_ref => SelectRef}}; {select, {select_info, ST, SR}} when is_reference(SR) -> ?SEV_IPRINT("select ref ->" "~n tag: ~p" "~n ref: ~p", [ST, SR]), - {ok, State#{connect_stag => ST}}; + {ok, State#{asynch_tag => select, + connect_tag => ST}}; + + {completion, + {completion_info, CT, CompletionRef}} + when SR =:= nowait -> + ?SEV_IPRINT("completion nowait ->" + "~n tag: ~p" + "~n ref: ~p", + [CT, CompletionRef]), + {ok, State#{asynch_tag => completion, + connect_tag => CT, + connect_ref => CompletionRef}}; + {completion, + {completion_info, CT, CR}} + when is_reference(CR) -> + ?SEV_IPRINT("completion ref ->" + "~n tag: ~p" + "~n ref: ~p", [CT, CR]), + {ok, State#{asynch_tag => completion, + connect_tag => CT}}; + {error, _} = ERROR -> ERROR end end}, - #{desc => "announce ready (connect select)", + #{desc => "announce ready (connect select|completion)", cmd => fun(#{tester := Tester}) -> ?SEV_ANNOUNCE_READY(Tester, connect_select), ok end}, - #{desc => "await select message", - cmd => fun(#{sock := Sock, connect_sref := Ref}) -> + #{desc => "await select|completion message", + cmd => fun(#{sock := Sock, + asynch_tag := select, + connect_tag := connect, + connect_ref := Ref}) -> receive {'$socket', Sock, select, Ref} -> ?SEV_IPRINT("select message ->" @@ -6822,15 +6980,35 @@ api_a_connect_tcp(InitState) -> "~n message queue: ~p", [mq()]), {error, timeout} + end; + (#{sock := Sock, + asynch_tag := completion, + connect_tag := connect, + connect_ref := Ref}) -> + receive + {'$socket', Sock, completion, {Ref, ok = Res}} -> + ?SEV_IPRINT("completion message ->" + "~n ref: ~p" + "~n res: ~p", [Ref, Res]), + ok + after 5000 -> + ?SEV_EPRINT("timeout: " + "~n message queue: ~p", + [mq()]), + {error, timeout} end end}, - #{desc => "announce ready (select)", + #{desc => "announce ready (select|completion)", cmd => fun(#{tester := Tester}) -> ?SEV_ANNOUNCE_READY(Tester, select), ok end}, - #{desc => "connect (async) to server", - cmd => fun(#{sock := Sock, server_sa := SSA, connect := Connect}) -> + #{desc => "(maybe) connect (async) to server", + cmd => fun(#{sock := Sock, + server_sa := SSA, + asynch_tag := select, + connect_tag := connect, + connect := Connect}) -> case Connect(Sock, SSA) of ok -> ok; @@ -6838,7 +7016,13 @@ api_a_connect_tcp(InitState) -> {error, {unexpected_select, SelectInfo}}; {error, _} = ERROR -> ERROR - end + end; + (#{sock := _Sock, + server_sa := _SSA, + asynch_tag := completion, + connect_tag := connect, + connect := _Connect}) -> + ok end}, #{desc => "announce ready (connect)", cmd => fun(#{tester := Tester}) -> @@ -7080,7 +7264,7 @@ api_a_connect_tcp(InitState) -> api_a_sendto_and_recvfrom_udp4(Config) when is_list(Config) -> ?TT(?SECS(5)), Nowait = nowait(Config), - tc_try(api_a_sendto_and_recvfrom_udp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> Send = fun(Sock, Data, Dest) -> @@ -7089,10 +7273,10 @@ api_a_sendto_and_recvfrom_udp4(Config) when is_list(Config) -> Recv = fun(Sock) -> socket:recvfrom(Sock, 0, Nowait) end, - InitState = #{domain => inet, - send => Send, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + send => Send, + recv => Recv, + recv_ref => Nowait}, ok = api_a_send_and_recv_udp(InitState) end). @@ -7109,7 +7293,7 @@ api_a_sendto_and_recvfrom_udp4(Config) when is_list(Config) -> api_a_sendto_and_recvfrom_udp6(Config) when is_list(Config) -> ?TT(?SECS(5)), Nowait = nowait(Config), - tc_try(api_a_sendto_and_recvfrom_udp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> Send = fun(Sock, Data, Dest) -> @@ -7118,10 +7302,10 @@ api_a_sendto_and_recvfrom_udp6(Config) when is_list(Config) -> Recv = fun(Sock) -> socket:recvfrom(Sock, 0, Nowait) end, - InitState = #{domain => inet6, - send => Send, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + send => Send, + recv => Recv, + recv_ref => Nowait}, ok = api_a_send_and_recv_udp(InitState) end). @@ -7156,14 +7340,16 @@ api_a_sendmsg_and_recvmsg_udp4(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet, - send => Send, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + send => Send, + recv => Recv, + recv_ref => Nowait}, ok = api_a_send_and_recv_udp(InitState) end). @@ -7198,14 +7384,16 @@ api_a_sendmsg_and_recvmsg_udp6(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet6, - send => Send, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + send => Send, + recv => Recv, + recv_ref => Nowait}, ok = api_a_send_and_recv_udp(InitState) end). @@ -7266,25 +7454,45 @@ api_a_send_and_recv_udp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) end}, #{desc => "try recv request (with nowait, expect select)", - cmd => fun(#{sock := Sock, - recv := Recv, - recv_sref := SR} = State) -> + cmd => fun(#{sock := Sock, + recv := Recv, + recv_ref := Ref} = State) -> case Recv(Sock) of {select, {select_info, Tag, RecvRef}} - when SR =:= nowait -> + when Ref =:= nowait -> ?SEV_IPRINT("expected select nowait: " "~n Tag: ~p" "~n Ref: ~p", [Tag, RecvRef]), - {ok, State#{recv_stag => Tag, - recv_sref => RecvRef}}; - {select, {select_info, Tag, SR}} - when is_reference(SR) -> + {ok, State#{async_tag => select, + recv_tag => Tag, + recv_ref => RecvRef}}; + {select, {select_info, Tag, Ref}} + when is_reference(Ref) -> ?SEV_IPRINT("expected select ref: " "~n Tag: ~p" - "~n Ref: ~p", [Tag, SR]), - {ok, State#{recv_stag => Tag}}; + "~n Ref: ~p", [Tag, Ref]), + {ok, State#{async_tag => select, + recv_tag => Tag}}; + + {completion, {completion_info, Tag, RecvRef}} + when Ref =:= nowait -> + ?SEV_IPRINT("expected select nowait: " + "~n Tag: ~p" + "~n Ref: ~p", [Tag, RecvRef]), + {ok, State#{async_tag => completion, + recv_tag => Tag, + recv_ref => RecvRef}}; + {completion, {completion_info, Tag, Ref}} + when is_reference(Ref) -> + ?SEV_IPRINT("expected completion ref: " + "~n Tag: ~p" + "~n Ref: ~p", [Tag, Ref]), + {ok, State#{async_tag => completion, + recv_tag => Tag}}; + {ok, X} -> - {error, {unexpected_succes, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -7294,29 +7502,74 @@ api_a_send_and_recv_udp(InitState) -> ?SEV_ANNOUNCE_READY(Tester, recv_select), ok end}, - #{desc => "await select message", - cmd => fun(#{sock := Sock, recv_sref := RecvRef}) -> + #{desc => "await select|completion message", + cmd => fun(#{async_tag := select, + sock := Sock, + recv_ref := RecvRef}) -> receive {'$socket', Sock, select, RecvRef} -> ok after 5000 -> - ?SEV_EPRINT("message queue: ~p", [mq()]), + ?SEV_EPRINT("timeout when: " + "~n Socket Info: ~p" + "~n Message Queue: ~p", + [socket:info(Sock), mq()]), + {error, timeout} + end; + (#{async_tag := completion, + sock := Sock, + recv_ref := RecvRef} = State) -> + receive + %% Recvfrom + {'$socket', Sock, completion, + {RecvRef, {ok, {Src, ?BASIC_REQ}}}} -> + {ok, State#{req_src => Src}}; + %% Recvmsg + {'$socket', Sock, completion, + {RecvRef, {ok, #{addr := Src, + iov := [?BASIC_REQ]}}}} -> + {ok, State#{req_src => Src}}; + {'$socket', Sock, completion, + {RecvRef, {ok, Unexpected}}} -> + ?SEV_EPRINT("Unexpected success result: " + "~n ~p", [Unexpected]), + {error, {unexpected_success_result, + Unexpected}}; + {'$socket', Sock, completion, + {RecvRef, {error, Reason} = ERROR}} -> + ?SEV_EPRINT("completion with error: " + "~n ~p", [Reason]), + ERROR + after 5000 -> + ?SEV_EPRINT("timeout when: " + "~n Socket Info: ~p" + "~n Message Queue: ~p", + [socket:info(Sock), mq()]), {error, timeout} end end}, #{desc => "announce ready (select)", cmd => fun(#{tester := Tester}) -> + %% We are actually done *if* this was + %% a completion event, but to make the + %% test case simple... ?SEV_ANNOUNCE_READY(Tester, select), ok end}, - #{desc => "now read the data (request)", - cmd => fun(#{sock := Sock, recv := Recv} = State) -> + #{desc => "now read the data (request), for select", + cmd => fun(#{async_tag := select, + sock := Sock, + recv := Recv} = State) -> case Recv(Sock) of {ok, {Src, ?BASIC_REQ}} -> {ok, State#{req_src => Src}}; {error, _} = ERROR -> ERROR - end + end; + (#{async_tag := completion} = _State) -> + %% We are already done! + ?SEV_IPRINT("Already done!"), + ok end}, #{desc => "announce ready (recv request)", cmd => fun(#{tester := Tester}) -> @@ -7344,10 +7597,11 @@ api_a_send_and_recv_udp(InitState) -> case ?SEV_AWAIT_TERMINATE(Tester, tester) of ok -> State2 = maps:remove(tester, State), - State3 = maps:remove(recv_stag, State2), - State4 = maps:remove(recv_sref, State3), - State5 = maps:remove(req_src, State4), - {ok, State5}; + State3 = maps:remove(async_tag, State2), + State4 = maps:remove(recv_tag, State3), + State5 = maps:remove(recv_ref, State4), + State6 = maps:remove(req_src, State5), + {ok, State6}; {error, _} = ERROR -> ERROR end @@ -7387,8 +7641,7 @@ api_a_send_and_recv_udp(InitState) -> #{desc => "open socket", cmd => fun(#{domain := Domain} = State) -> Sock = sock_open(Domain, dgram, udp), - SA = sock_sockname(Sock), - {ok, State#{sock => Sock, sa => SA}} + {ok, State#{sock => Sock}} end}, #{desc => "bind socket (to local address)", cmd => fun(#{sock := Sock, lsa := LSA}) -> @@ -7399,6 +7652,11 @@ api_a_send_and_recv_udp(InitState) -> ERROR end end}, + #{desc => "sockname", + cmd => fun(#{sock := Sock} = State) -> + SA = sock_sockname(Sock), + {ok, State#{sa => SA}} + end}, #{desc => "announce ready (init)", cmd => fun(#{tester := Tester}) -> ?SEV_ANNOUNCE_READY(Tester, init), @@ -7424,17 +7682,28 @@ api_a_send_and_recv_udp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) end}, #{desc => "try recv reply (with nowait)", - cmd => fun(#{sock := Sock, - recv := Recv, - recv_sref := SR} = State) -> + cmd => fun(#{sock := Sock, + recv := Recv, + recv_ref := Ref} = State) -> case Recv(Sock) of {select, {select_info, Tag, RecvRef}} - when SR =:= nowait -> - {ok, State#{recv_stag => Tag, - recv_sref => RecvRef}}; - {select, {select_info, Tag, SR}} - when is_reference(SR) -> - {ok, State#{recv_stag => Tag}}; + when Ref =:= nowait -> + {ok, State#{async_tag => select, + recv_tag => Tag, + recv_ref => RecvRef}}; + {select, {select_info, Tag, Ref}} + when is_reference(Ref) -> + {ok, State#{async_tag => select, + recv_tag => Tag}}; + {completion, {completion_info, Tag, RecvRef}} + when Ref =:= nowait -> + {ok, State#{async_tag => completion, + recv_tag => Tag, + recv_ref => RecvRef}}; + {completion, {completion_info, Tag, Ref}} + when is_reference(Ref) -> + {ok, State#{async_tag => completion, + recv_tag => Tag}}; {ok, X} -> {error, {unexpected_select_info, X}}; {error, _} = ERROR -> @@ -7447,10 +7716,20 @@ api_a_send_and_recv_udp(InitState) -> ok end}, #{desc => "await select message", - cmd => fun(#{sock := Sock, recv_sref := RecvRef}) -> + cmd => fun(#{async_tag := select, + sock := Sock, + recv_ref := RecvRef}) -> receive {'$socket', Sock, select, RecvRef} -> ok + end; + (#{async_tag := completion, + sock := Sock, + recv_ref := RecvRef}) -> + receive + {'$socket', Sock, completion, + {RecvRef, {ok, _}}} -> + ok end end}, #{desc => "announce ready (select)", @@ -7459,13 +7738,18 @@ api_a_send_and_recv_udp(InitState) -> ok end}, #{desc => "now read the data (reply)", - cmd => fun(#{sock := Sock, recv := Recv}) -> + cmd => fun(#{async_tag := select, + sock := Sock, + recv := Recv}) -> case Recv(Sock) of {ok, {_Src, ?BASIC_REP}} -> ok; {error, _} = ERROR -> ERROR - end + end; + (#{async_tag := completion}) -> + ?SEV_IPRINT("Already read!"), + ok end}, #{desc => "announce ready (recv reply)", cmd => fun(#{tester := Tester}) -> @@ -7479,9 +7763,10 @@ api_a_send_and_recv_udp(InitState) -> case ?SEV_AWAIT_TERMINATE(Tester, tester) of ok -> State2 = maps:remove(tester, State), - State3 = maps:remove(recv_stag, State2), - State4 = maps:remove(recv_sref, State3), - {ok, State4}; + State3 = maps:remove(async_tag, State2), + State4 = maps:remove(recv_tag, State3), + State5 = maps:remove(recv_ref, State4), + {ok, State5}; {error, _} = ERROR -> ERROR end @@ -7716,7 +8001,10 @@ api_a_sendmsg_and_recvmsg_tcp4(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), tc_try(api_a_sendmsg_and_recvmsg_tcp4, - fun() -> has_support_ipv4() end, + fun() -> + is_not_windows(), + has_support_ipv4() + end, fun() -> Send = fun(Sock, Data) -> Msg = #{iov => [Data]}, @@ -7842,20 +8130,40 @@ api_a_send_and_recv_tcp(Config, InitState) -> case socket:accept(LSock, Nowait) of {select, {select_info, Tag, Ref}} when Nowait =:= nowait -> - ?SEV_IPRINT("accept select nowait: " + ?SEV_IPRINT("select accept message: " "~n Tag: ~p" "~n Ref: ~p", [Tag, Ref]), - {ok, State#{accept_stag => Tag, + {ok, State#{sorc => select, + accept_stag => Tag, accept_sref => Ref}}; {select, {select_info, Tag, Nowait}} when is_reference(Nowait) -> - ?SEV_IPRINT("accept select ref: " + ?SEV_IPRINT("select accept result: " "~n Tag: ~p" "~n Ref: ~p", [Tag, Nowait]), - {ok, State#{accept_stag => Tag, + {ok, State#{sorc => select, + accept_stag => Tag, accept_sref => Nowait}}; + + {completion, {completion_info, Tag, Ref}} + when Nowait =:= nowait -> + ?SEV_IPRINT("completion accept result: " + "~n Tag: ~p" + "~n Ref: ~p", [Tag, Ref]), + {ok, State#{sorc => completion, + accept_stag => Tag, + accept_sref => Ref}}; + {completion, {completion_info, Tag, Nowait}} + when is_reference(Nowait) -> + ?SEV_IPRINT("completion accept result: " + "~n Tag: ~p" + "~n Ref: ~p", [Tag, Nowait]), + {ok, State#{sorc => completion, + accept_stag => Tag, + accept_sref => Nowait}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; {error, _} = ERROR -> ERROR end @@ -7865,11 +8173,25 @@ api_a_send_and_recv_tcp(Config, InitState) -> ?SEV_ANNOUNCE_READY(Tester, accept_select), ok end}, - #{desc => "await select message", - cmd => fun(#{lsock := Sock, accept_sref := Ref}) -> + #{desc => "await select|completion message", + cmd => fun(#{lsock := Sock, accept_sref := Ref} = State) -> receive {'$socket', Sock, select, Ref} -> - ok + ?SEV_IPRINT("select message: " + "ready for accept"), + ok; + {'$socket', Sock, completion, + {Ref, {ok, CSock}}} -> + ?SEV_IPRINT("completion message: accepted: " + "~n CSock: ~p", [Sock]), + {ok, State#{csock => CSock}} + after 5000 -> + ?SEV_EPRINT("select|completion message timeout:" + "~n Sock: ~p" + "~n Ref: ~p" + "~n Message Queue: ~p", + [Sock, Ref, mq()]), + {error, timeout} end end}, #{desc => "announce ready (select)", @@ -7877,8 +8199,9 @@ api_a_send_and_recv_tcp(Config, InitState) -> ?SEV_ANNOUNCE_READY(Tester, select), ok end}, - #{desc => "await connection (again)", - cmd => fun(#{lsock := LSock} = State) -> + #{desc => "try accept (again)", + cmd => fun(#{lsock := LSock, sorc := select} = State) -> + ?SEV_IPRINT("try accept again"), case socket:accept(LSock, nowait) of {ok, Sock} -> ?SEV_IPRINT("accepted: " @@ -7886,7 +8209,10 @@ api_a_send_and_recv_tcp(Config, InitState) -> {ok, State#{csock => Sock}}; {error, _} = ERROR -> ERROR - end + end; + (#{sorc := completion})-> + ?SEV_IPRINT("already accepted"), + ok end}, #{desc => "announce ready (accept)", cmd => fun(#{tester := Tester}) -> @@ -7899,8 +8225,8 @@ api_a_send_and_recv_tcp(Config, InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv_req) end}, #{desc => "try recv request (with nowait, expect select)", - cmd => fun(#{csock := Sock, - recv := Recv, + cmd => fun(#{csock := Sock, + recv := Recv, recv_sref := SR} = State) -> case Recv(Sock) of {select, {select_info, Tag, Ref}} @@ -7916,8 +8242,23 @@ api_a_send_and_recv_tcp(Config, InitState) -> "~n Tag: ~p" "~n Ref: ~p", [Tag, SR]), {ok, State#{recv_stag => Tag}}; + + {completion, {completion_info, Tag, Ref}} + when SR =:= nowait -> + ?SEV_IPRINT("recv completion nowait: " + "~n Tag: ~p" + "~n Ref: ~p", [Tag, Ref]), + {ok, State#{recv_stag => Tag, + recv_sref => Ref}}; + {completion, {completion_info, Tag, SR}} + when is_reference(SR) -> + ?SEV_IPRINT("recv completion ref: " + "~n Tag: ~p" + "~n Ref: ~p", [Tag, SR]), + {ok, State#{recv_stag => Tag}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; {error, _} = ERROR -> ERROR end @@ -7927,11 +8268,20 @@ api_a_send_and_recv_tcp(Config, InitState) -> ?SEV_ANNOUNCE_READY(Tester, recv_select), ok end}, - #{desc => "await select message", + #{desc => "await select|completion message", cmd => fun(#{csock := Sock, recv_sref := RecvRef}) -> receive {'$socket', Sock, select, RecvRef} -> - ok + ok; + {'$socket', Sock, completion, + {RecvRef, {ok, ?BASIC_REQ}}} -> + ?SEV_IPRINT("received expected data"), + ok; + {'$socket', Sock, completion, + {RecvRef, {error, Reason} = ERROR}} -> + ?SEV_EPRINT("received unexpected error: " + "~n ~p", [Reason]), + ERROR end end}, #{desc => "announce ready (select)", @@ -7940,13 +8290,19 @@ api_a_send_and_recv_tcp(Config, InitState) -> ok end}, #{desc => "now read the data (request)", - cmd => fun(#{csock := Sock, recv := Recv} = _State) -> + cmd => fun(#{sorc := select, + csock := Sock, + recv := Recv} = _State) -> case Recv(Sock) of {ok, ?BASIC_REQ} -> + ?SEV_IPRINT("read expected data"), ok; {error, _} = ERROR -> ERROR - end + end; + (#{sorc := completion}) -> + ?SEV_IPRINT("already received"), + ok end}, #{desc => "announce ready (recv request)", cmd => fun(#{tester := Tester}) -> @@ -8066,7 +8422,7 @@ api_a_send_and_recv_tcp(Config, InitState) -> ok end}, - #{desc => "try recv reply (with nowait, expect select)", + #{desc => "try recv reply (with nowait, expect select|completion)", cmd => fun(#{sock := Sock, recv := Recv, recv_sref := SR} = State) -> @@ -8076,16 +8432,35 @@ api_a_send_and_recv_tcp(Config, InitState) -> ?SEV_IPRINT("recv select nowait: " "~n Tag: ~p" "~n Ref: ~p", [Tag, Ref]), - {ok, State#{recv_stag => Tag, + {ok, State#{sorc => select, + recv_stag => Tag, recv_sref => Ref}}; {select, {select_info, Tag, SR}} when is_reference(SR) -> ?SEV_IPRINT("recv select ref: " "~n Tag: ~p" "~n Ref: ~p", [Tag, SR]), - {ok, State#{recv_stag => Tag}}; + {ok, State#{sorc => select, + recv_stag => Tag}}; + + {completion, {completion_info, Tag, Ref}} + when SR =:= nowait -> + ?SEV_IPRINT("recv completion nowait: " + "~n Tag: ~p" + "~n Ref: ~p", [Tag, Ref]), + {ok, State#{sorc => completion, + recv_stag => Tag, + recv_sref => Ref}}; + {completion, {completion_info, Tag, SR}} + when is_reference(SR) -> + ?SEV_IPRINT("recv completion ref: " + "~n Tag: ~p" + "~n Ref: ~p", [Tag, SR]), + {ok, State#{sorc => completion, + recv_stag => Tag}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; {error, _} = ERROR -> ERROR end @@ -8099,6 +8474,10 @@ api_a_send_and_recv_tcp(Config, InitState) -> cmd => fun(#{sock := Sock, recv_sref := RecvRef}) -> receive {'$socket', Sock, select, RecvRef} -> + ok; + {'$socket', Sock, completion, + {RecvRef, {ok, ?BASIC_REP}}} -> + ?SEV_IPRINT("received expected reply"), ok end end}, @@ -8108,8 +8487,13 @@ api_a_send_and_recv_tcp(Config, InitState) -> ok end}, #{desc => "now read the data (reply)", - cmd => fun(#{sock := Sock, recv := Recv}) -> + cmd => fun(#{sorc := select, sock := Sock, recv := Recv}) -> {ok, ?BASIC_REP} = Recv(Sock), + ?SEV_IPRINT("[select] received expected reply"), + ok; + (#{sorc := completion}) -> + ?SEV_IPRINT("[completion] " + "expected reply already received"), ok end}, #{desc => "announce ready (recv reply)", @@ -8311,7 +8695,7 @@ api_a_send_and_recv_tcp(Config, InitState) -> api_a_recvfrom_cancel_udp4(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_recvfrom_cancel_udp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> Recv = fun(Sock) -> @@ -8320,13 +8704,15 @@ api_a_recvfrom_cancel_udp4(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + recv => Recv, + recv_ref => Nowait}, ok = api_a_recv_cancel_udp(InitState) end). @@ -8340,7 +8726,7 @@ api_a_recvfrom_cancel_udp4(Config) when is_list(Config) -> api_a_recvfrom_cancel_udp6(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_recvfrom_cancel_udp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> Recv = fun(Sock) -> @@ -8349,13 +8735,15 @@ api_a_recvfrom_cancel_udp6(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet6, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + recv => Recv, + recv_ref => Nowait}, ok = api_a_recv_cancel_udp(InitState) end). @@ -8369,7 +8757,7 @@ api_a_recvfrom_cancel_udp6(Config) when is_list(Config) -> api_a_recvmsg_cancel_udp4(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_recvmsg_cancel_udp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> Recv = fun(Sock) -> @@ -8378,13 +8766,15 @@ api_a_recvmsg_cancel_udp4(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + recv => Recv, + recv_ref => Nowait}, ok = api_a_recv_cancel_udp(InitState) end). @@ -8398,7 +8788,7 @@ api_a_recvmsg_cancel_udp4(Config) when is_list(Config) -> api_a_recvmsg_cancel_udp6(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_recvmsg_cancel_udp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> Recv = fun(Sock) -> @@ -8407,13 +8797,15 @@ api_a_recvmsg_cancel_udp6(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet6, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + recv => Recv, + recv_ref => Nowait}, ok = api_a_recv_cancel_udp(InitState) end). @@ -8473,19 +8865,28 @@ api_a_recv_cancel_udp(InitState) -> cmd => fun(#{tester := Tester} = _State) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) end}, - #{desc => "try recv request (with nowait, expect select)", - cmd => fun(#{sock := Sock, - recv := Recv, - recv_sref := SR} = State) -> + #{desc => "try recv request (with nowait, expect select|completion)", + cmd => fun(#{sock := Sock, + recv := Recv, + recv_ref := Ref} = State) -> case Recv(Sock) of - {select, SelectInfo} when SR =:= nowait -> - {ok, State#{recv_select_info => SelectInfo}}; + {select, SI} when Ref =:= nowait -> + {ok, State#{recv_select_info => SI}}; {select, - {select_info, _Tag, SR} = SelectInfo} - when is_reference(SR) -> - {ok, State#{recv_select_info => SelectInfo}}; + {select_info, _Tag, Ref} = SI} + when is_reference(Ref) -> + {ok, State#{recv_select_info => SI}}; + + {completion, CI} when Ref =:= nowait -> + {ok, State#{recv_completion_info => CI}}; + {completion, + {completion_info, _Tag, Ref} = CI} + when is_reference(Ref) -> + {ok, State#{recv_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -8495,11 +8896,15 @@ api_a_recv_cancel_udp(InitState) -> ?SEV_ANNOUNCE_READY(Tester, recv_select), ok end}, - #{desc => "await select message (without success)", + #{desc => "wait for select message - without success", cmd => fun(#{sock := Sock}) -> receive {'$socket', Sock, select, Ref} -> - {error, {unexpected_select, Ref}} + {error, {unexpected_select, Ref}}; + + {'$socket', Sock, completion, C} -> + {error, {unexpected_completion, C}} + after 5000 -> ok end @@ -8514,9 +8919,12 @@ api_a_recv_cancel_udp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, cancel) end}, #{desc => "cancel", - cmd => fun(#{sock := Sock, recv_select_info := SelectInfo}) -> - ok = socket:cancel(Sock, SelectInfo) + cmd => fun(#{sock := Sock, recv_select_info := SI}) -> + ok = socket:cancel(Sock, SI); + (#{sock := Sock, recv_completion_info := CI}) -> + ok = socket:cancel(Sock, CI) end}, + #{desc => "announce ready (cancel)", cmd => fun(#{tester := Tester}) -> ?SEV_ANNOUNCE_READY(Tester, cancel), @@ -8528,11 +8936,10 @@ api_a_recv_cancel_udp(InitState) -> cmd => fun(#{tester := Tester} = State) -> case ?SEV_AWAIT_TERMINATE(Tester, tester) of ok -> - State2 = maps:remove(tester, State), - State3 = maps:remove(recv_stag, State2), - State4 = maps:remove(recv_sref, State3), - State5 = maps:remove(req_src, State4), - {ok, State5}; + State2 = maps:remove(tester, State), + State3 = maps:remove(recv_ref, State2), + State4 = maps:remove(req_src, State3), + {ok, State4}; {error, _} = ERROR -> ERROR end @@ -8638,7 +9045,7 @@ api_a_recv_cancel_udp(InitState) -> api_a_accept_cancel_tcp4(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_accept_cancel_tcp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> Accept = fun(Sock) -> @@ -8647,13 +9054,15 @@ api_a_accept_cancel_tcp4(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet, - accept => Accept, - accept_sref => Nowait}, + InitState = #{domain => inet, + accept => Accept, + accept_ref => Nowait}, ok = api_a_accept_cancel_tcp(InitState) end). @@ -8668,7 +9077,7 @@ api_a_accept_cancel_tcp4(Config) when is_list(Config) -> api_a_accept_cancel_tcp6(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_accept_cancel_tcp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> Accept = fun(Sock) -> @@ -8677,13 +9086,15 @@ api_a_accept_cancel_tcp6(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet6, - accept => Accept, - accept_sref => Nowait}, + InitState = #{domain => inet6, + accept => Accept, + accept_ref => Nowait}, ok = api_a_accept_cancel_tcp(InitState) end). @@ -8749,28 +9160,39 @@ api_a_accept_cancel_tcp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, accept) end}, #{desc => "await connection (nowait)", - cmd => fun(#{lsock := LSock, - accept := Accept, - accept_sref := SR} = State) -> + cmd => fun(#{lsock := LSock, + accept := Accept, + accept_ref := Ref} = State) -> case Accept(LSock) of - {select, {select_info, T, R} = SelectInfo} - when SR =:= nowait -> + {select, {select_info, T, R} = SI} + when Ref =:= nowait -> ?SEV_IPRINT("accept select nowait: " "~n T: ~p" "~n R: ~p", [T, R]), - {ok, - State#{accept_select_info => - SelectInfo}}; - {select, {select_info, T, SR} = SelectInfo} - when is_reference(SR) -> + {ok, State#{accept_select_info => SI}}; + {select, {select_info, T, Ref} = SI} + when is_reference(Ref) -> ?SEV_IPRINT("accept select ref: " "~n T: ~p" - "~n R: ~p", [T, SR]), - {ok, - State#{accept_select_info => - SelectInfo}}; + "~n R: ~p", [T, Ref]), + {ok, State#{accept_select_info => SI}}; + + {completion, {completion_info, T, R} = CI} + when Ref =:= nowait -> + ?SEV_IPRINT("accept completion nowait: " + "~n T: ~p" + "~n R: ~p", [T, R]), + {ok, State#{accept_completion_info => CI}}; + {completion, {completion_info, T, Ref} = CI} + when is_reference(Ref) -> + ?SEV_IPRINT("accept completion ref: " + "~n T: ~p" + "~n R: ~p", [T, Ref]), + {ok, State#{accept_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -8784,7 +9206,11 @@ api_a_accept_cancel_tcp(InitState) -> cmd => fun(#{lsock := Sock}) -> receive {'$socket', Sock, select, Ref} -> - {error, {unexpected_select, Ref}} + {error, {unexpected_select, Ref}}; + + {'$socket', Sock, completion, C} -> + {error, {unexpected_completion, C}} + after 5000 -> ok end @@ -8799,8 +9225,12 @@ api_a_accept_cancel_tcp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, cancel) end}, #{desc => "cancel", - cmd => fun(#{lsock := Sock, accept_select_info := SelectInfo}) -> - ok = socket:cancel(Sock, SelectInfo) + cmd => fun(#{lsock := Sock, + accept_select_info := SelectInfo}) -> + ok = socket:cancel(Sock, SelectInfo); + (#{lsock := Sock, + accept_completion_info := CompletionInfo}) -> + ok = socket:cancel(Sock, CompletionInfo) end}, #{desc => "announce ready (cancel)", cmd => fun(#{tester := Tester}) -> @@ -8911,15 +9341,15 @@ api_a_accept_cancel_tcp(InitState) -> api_a_recv_cancel_tcp4(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_recv_cancel_tcp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> Recv = fun(Sock) -> socket:recv(Sock, 0, Nowait) end, - InitState = #{domain => inet, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + recv => Recv, + recv_ref => Nowait}, ok = api_a_recv_cancel_tcp(InitState) end). @@ -8933,15 +9363,15 @@ api_a_recv_cancel_tcp4(Config) when is_list(Config) -> api_a_recv_cancel_tcp6(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_recv_cancel_tcp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> Recv = fun(Sock) -> socket:recv(Sock, 0, Nowait) end, - InitState = #{domain => inet6, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + recv => Recv, + recv_ref => Nowait}, ok = api_a_recv_cancel_tcp(InitState) end). @@ -8955,15 +9385,18 @@ api_a_recv_cancel_tcp6(Config) when is_list(Config) -> api_a_recvmsg_cancel_tcp4(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_recvmsg_cancel_tcp4, - fun() -> has_support_ipv4() end, + tc_try(?FUNCTION_NAME, + fun() -> + is_not_windows(), + has_support_ipv4() + end, fun() -> Recv = fun(Sock) -> socket:recvmsg(Sock, Nowait) end, - InitState = #{domain => inet, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + recv => Recv, + recv_ref => Nowait}, ok = api_a_recv_cancel_tcp(InitState) end). @@ -8977,15 +9410,18 @@ api_a_recvmsg_cancel_tcp4(Config) when is_list(Config) -> api_a_recvmsg_cancel_tcp6(Config) when is_list(Config) -> ?TT(?SECS(10)), Nowait = nowait(Config), - tc_try(api_a_recvmsg_cancel_tcp6, - fun() -> has_support_ipv6() end, + tc_try(?FUNCTION_NAME, + fun() -> + is_not_windows(), + has_support_ipv6() + end, fun() -> Recv = fun(Sock) -> socket:recvmsg(Sock, Nowait) end, - InitState = #{domain => inet6, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + recv => Recv, + recv_ref => Nowait}, ok = api_a_recv_cancel_tcp(InitState) end). @@ -9068,27 +9504,43 @@ api_a_recv_cancel_tcp(InitState) -> cmd => fun(#{tester := Tester} = _State) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) end}, - #{desc => "try recv request (with nowait, expect select)", - cmd => fun(#{csock := Sock, - recv := Recv, - recv_sref := SR} = State) -> + + #{desc => "try recv request (with nowait, expect select|completion)", + cmd => fun(#{csock := Sock, + recv := Recv, + recv_ref := Ref} = State) -> case Recv(Sock) of - {select, {select_info, T, R} = SelectInfo} - when SR =:= nowait -> + {select, {select_info, T, R} = SI} + when Ref =:= nowait -> ?SEV_IPRINT("recv select nowait: " "~n Tag: ~p" "~n Ref: ~p", [T, R]), - {ok, - State#{recv_select_info => SelectInfo}}; - {select, {select_info, T, SR} = SelectInfo} - when is_reference(SR) -> + {ok, State#{recv_select_info => SI}}; + {select, {select_info, T, Ref} = SI} + when is_reference(Ref) -> ?SEV_IPRINT("recv select ref: " "~n Tag: ~p" - "~n Ref: ~p", [T, SR]), - {ok, - State#{recv_select_info => SelectInfo}}; + "~n Ref: ~p", [T, Ref]), + {ok, State#{recv_select_info => SI}}; + + {completion, + {completion_info, T, R} = CI} + when Ref =:= nowait -> + ?SEV_IPRINT("recv completion nowait: " + "~n Tag: ~p" + "~n Ref: ~p", [T, R]), + {ok, State#{recv_completion_info => CI}}; + {completion, + {completion_info, T, Ref} = CI} + when is_reference(Ref) -> + ?SEV_IPRINT("recv completion ref: " + "~n Tag: ~p" + "~n Ref: ~p", [T, Ref]), + {ok, State#{recv_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -9102,7 +9554,11 @@ api_a_recv_cancel_tcp(InitState) -> cmd => fun(#{csock := Sock}) -> receive {'$socket', Sock, select, Ref} -> - {error, {unexpected_select, Ref}} + {error, {unexpected_select, Ref}}; + + {'$socket', Sock, completion, C} -> + {error, {unexpected_completion, C}} + after 5000 -> ok end @@ -9117,8 +9573,11 @@ api_a_recv_cancel_tcp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, cancel) end}, #{desc => "cancel", - cmd => fun(#{csock := Sock, recv_select_info := SelectInfo}) -> - ok = socket:cancel(Sock, SelectInfo) + cmd => fun(#{csock := Sock, recv_select_info := SI}) -> + ok = socket:cancel(Sock, SI); + + (#{csock := Sock, recv_completion_info := CI}) -> + ok = socket:cancel(Sock, CI) end}, #{desc => "announce ready (cancel)", cmd => fun(#{tester := Tester}) -> @@ -9372,13 +9831,15 @@ api_a_mrecvfrom_cancel_udp4(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + recv => Recv, + recv_ref => Nowait}, ok = api_a_mrecv_cancel_udp(InitState) end). @@ -9402,13 +9863,15 @@ api_a_mrecvfrom_cancel_udp6(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet6, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + recv => Recv, + recv_ref => Nowait}, ok = api_a_mrecv_cancel_udp(InitState) end). @@ -9432,13 +9895,15 @@ api_a_mrecvmsg_cancel_udp4(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + recv => Recv, + recv_ref => Nowait}, ok = api_a_mrecv_cancel_udp(InitState) end). @@ -9462,13 +9927,15 @@ api_a_mrecvmsg_cancel_udp6(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet6, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + recv => Recv, + recv_ref => Nowait}, ok = api_a_mrecv_cancel_udp(InitState) end). @@ -9528,21 +9995,27 @@ api_a_mrecv_cancel_udp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) end}, #{desc => "try recv request (with nowait, expect select)", - cmd => fun(#{sock := Sock, - recv := Recv, - recv_sref := SR} = State) -> + cmd => fun(#{sock := Sock, + recv := Recv, + recv_ref := Ref} = State) -> case Recv(Sock) of - {select, SelectInfo} - when SR =:= nowait -> - {ok, - State#{recv_select_info => SelectInfo}}; - {select, - {select_info, _Tag, SR} = SelectInfo} - when is_reference(SR) -> - {ok, - State#{recv_select_info => SelectInfo}}; + {select, SI} + when Ref =:= nowait -> + {ok, State#{recv_select_info => SI}}; + {select, {select_info, _Tag, Ref} = SI} + when is_reference(Ref) -> + {ok, State#{recv_select_info => SI}}; + + {completion, CI} + when Ref =:= nowait -> + {ok, State#{recv_completion_info => CI}}; + {completion, {completion_info, _Tag, Ref} = CI} + when is_reference(Ref) -> + {ok, State#{recv_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -9554,7 +10027,8 @@ api_a_mrecv_cancel_udp(InitState) -> end}, #{desc => "await abort message", cmd => fun(#{sock := Sock, - recv_select_info := {select_info, _, Ref}} = State) -> + recv_select_info := {select_info, _, Ref}} = + State) -> receive {'$socket', Sock, select, Ref} -> {error, {unexpected_select, Ref}}; @@ -9563,6 +10037,18 @@ api_a_mrecv_cancel_udp(InitState) -> after 5000 -> ?SEV_EPRINT("message queue: ~p", [mq()]), {error, timeout} + end; + (#{sock := Sock, + recv_completion_info := {completion_info, _, Ref}} = + State) -> + receive + {'$socket', Sock, completion, {Ref, CS}} -> + {error, {unexpected_completion, CS}}; + {'$socket', Sock, abort, {Ref, closed}} -> + {ok, maps:remove(sock, State)} + after 5000 -> + ?SEV_EPRINT("message queue: ~p", [mq()]), + {error, timeout} end end}, #{desc => "announce ready (abort)", @@ -9576,11 +10062,9 @@ api_a_mrecv_cancel_udp(InitState) -> cmd => fun(#{tester := Tester} = State) -> case ?SEV_AWAIT_TERMINATE(Tester, tester) of ok -> - State2 = maps:remove(tester, State), - State3 = maps:remove(recv_stag, State2), - State4 = maps:remove(recv_sref, State3), - State5 = maps:remove(req_src, State4), - {ok, State5}; + State2 = maps:remove(tester, State), + State3 = maps:remove(recv_ref, State2), + {ok, State3}; {error, _} = ERROR -> ERROR end @@ -9616,20 +10100,27 @@ api_a_mrecv_cancel_udp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) end}, #{desc => "try recv request (with nowait, expect select)", - cmd => fun(#{sock := Sock, - recv := Recv, - recv_sref := SR} = State) -> + cmd => fun(#{sock := Sock, + recv := Recv, + recv_ref := Ref} = State) -> case Recv(Sock) of - {select, SelectInfo} when SR =:= nowait -> - {ok, - State#{recv_select_info => SelectInfo}}; + {select, SI} when Ref =:= nowait -> + {ok, State#{recv_select_info => SI}}; {select, - {select_info, _Tag, SR} = SelectInfo} - when is_reference(SR) -> - {ok, - State#{recv_select_info => SelectInfo}}; + {select_info, _Tag, Ref} = SI} + when is_reference(Ref) -> + {ok, State#{recv_select_info => SI}}; + + {completion, CI} when Ref =:= nowait -> + {ok, State#{recv_completion_info => CI}}; + {completion, + {completion_info, _Tag, Ref} = CI} + when is_reference(Ref) -> + {ok, State#{recv_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -9650,6 +10141,19 @@ api_a_mrecv_cancel_udp(InitState) -> after 5000 -> ?SEV_EPRINT("message queue: ~p", [mq()]), {error, timeout} + end; + + (#{sock := Sock, + recv_completion_info := {completion_info, _, Ref}} = + State) -> + receive + {'$socket', Sock, completion, {Ref, CS}} -> + {error, {unexpected_completion, CS}}; + {'$socket', Sock, abort, {Ref, closed}} -> + {ok, maps:remove(sock, State)} + after 5000 -> + ?SEV_EPRINT("message queue: ~p", [mq()]), + {error, timeout} end end}, #{desc => "announce ready (abort)", @@ -9665,9 +10169,10 @@ api_a_mrecv_cancel_udp(InitState) -> ok -> ?SEV_IPRINT("terminating"), State1 = maps:remove(recv_select_info, State), - State2 = maps:remove(tester, State1), - State3 = maps:remove(sock, State2), - {ok, State3}; + State2 = maps:remove(recv_completion_info, State1), + State3 = maps:remove(tester, State2), + State4 = maps:remove(sock, State3), + {ok, State4}; {error, _} = ERROR -> ERROR end @@ -9879,13 +10384,15 @@ api_a_maccept_cancel_tcp4(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet, - accept => Accept, - accept_sref => Nowait}, + InitState = #{domain => inet, + accept => Accept, + accept_ref => Nowait}, ok = api_a_maccept_cancel_tcp(InitState) end). @@ -9910,13 +10417,15 @@ api_a_maccept_cancel_tcp6(Config) when is_list(Config) -> OK; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end end, - InitState = #{domain => inet6, - accept => Accept, - accept_sref => Nowait}, + InitState = #{domain => inet6, + accept => Accept, + accept_ref => Nowait}, ok = api_a_maccept_cancel_tcp(InitState) end). @@ -9982,28 +10491,39 @@ api_a_maccept_cancel_tcp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, accept) end}, #{desc => "await connection (nowait)", - cmd => fun(#{lsock := LSock, - accept := Accept, - accept_sref := SR} = State) -> + cmd => fun(#{lsock := LSock, + accept := Accept, + accept_ref := Ref} = State) -> case Accept(LSock) of - {select, {select_info, T, R} = SelectInfo} - when SR =:= nowait -> + {select, {select_info, T, R} = SI} + when Ref =:= nowait -> ?SEV_IPRINT("accept select nowait: " "~n T: ~p" "~n R: ~p", [T, R]), - {ok, - State#{accept_select_info => - SelectInfo}}; - {select, {select_info, T, SR} = SelectInfo} - when is_reference(SR) -> + {ok, State#{accept_select_info => SI}}; + {select, {select_info, T, Ref} = SI} + when is_reference(Ref) -> ?SEV_IPRINT("accept select ref: " "~n T: ~p" - "~n R: ~p", [T, SR]), - {ok, - State#{accept_select_info => - SelectInfo}}; + "~n R: ~p", [T, Ref]), + {ok, State#{accept_select_info => SI}}; + + {completion, {completion_info, T, R} = CI} + when Ref =:= nowait -> + ?SEV_IPRINT("accept completion nowait: " + "~n T: ~p" + "~n R: ~p", [T, R]), + {ok, State#{accept_completion_info => CI}}; + {completion, {completion_info, T, Ref} = CI} + when is_reference(Ref) -> + ?SEV_IPRINT("accept completion ref: " + "~n T: ~p" + "~n R: ~p", [T, Ref]), + {ok, State#{accept_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -10022,7 +10542,26 @@ api_a_maccept_cancel_tcp(InitState) -> {'$socket', Sock, abort, {Ref, closed}} -> {ok, maps:remove(lsock, State)} after 5000 -> - ?SEV_EPRINT("message queue: ~p", [mq()]), + ?SEV_EPRINT("timeout when: " + "~n Sock: ~p" + "~n Ref: ~p" + "~n message queue: ~p", + [Sock, Ref, mq()]), + {error, timeout} + end; + (#{lsock := Sock, + accept_completion_info := {completion_info, _, Ref}} = State) -> + receive + {'$socket', Sock, completion, {Ref, _} = C} -> + {error, {unexpected_completion, C}}; + {'$socket', Sock, abort, {Ref, closed}} -> + {ok, maps:remove(lsock, State)} + after 5000 -> + ?SEV_EPRINT("timeout when: " + "~n Sock: ~p" + "~n Ref: ~p" + "~n message queue: ~p", + [Sock, Ref, mq()]), {error, timeout} end end}, @@ -10073,22 +10612,25 @@ api_a_maccept_cancel_tcp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, accept) end}, #{desc => "try accept request (with nowait, expect select)", - cmd => fun(#{lsock := Sock, - accept := Accept, - accept_sref := SR} = State) -> + cmd => fun(#{lsock := Sock, + accept := Accept, + accept_ref := Ref} = State) -> case Accept(Sock) of - {select, SelectInfo} when SR =:= nowait -> - {ok, - State#{accept_select_info => - SelectInfo}}; - {select, - {select_info, _Tag, SR} = SelectInfo} - when is_reference(SR) -> - {ok, - State#{accept_select_info => - SelectInfo}}; + {select, SI} when Ref =:= nowait -> + {ok, State#{accept_select_info => SI}}; + {select, {select_info, _Tag, Ref} = SI} + when is_reference(Ref) -> + {ok, State#{accept_select_info => SI}}; + + {completion, CI} when Ref =:= nowait -> + {ok, State#{accept_completion_info => CI}}; + {completion, {completion_info, _Tag, Ref} = CI} + when is_reference(Ref) -> + {ok, State#{accept_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -10107,7 +10649,26 @@ api_a_maccept_cancel_tcp(InitState) -> {'$socket', Sock, abort, {Ref, closed}} -> {ok, maps:remove(sock, State)} after 5000 -> - ?SEV_EPRINT("message queue: ~p", [mq()]), + ?SEV_EPRINT("timeout when: " + "~n Sock: ~p" + "~n Ref: ~p" + "~n message queue: ~p", + [Sock, Ref, mq()]), + {error, timeout} + end; + (#{lsock := Sock, + accept_completion_info := {completion_info, _, Ref}} = State) -> + receive + {'$socket', Sock, completion, {Ref, _} = C} -> + {error, {unexpected_completion, C}}; + {'$socket', Sock, abort, {Ref, closed}} -> + {ok, maps:remove(sock, State)} + after 5000 -> + ?SEV_EPRINT("timeout when: " + "~n Sock: ~p" + "~n Ref: ~p" + "~n message queue: ~p", + [Sock, Ref, mq()]), {error, timeout} end end}, @@ -10125,8 +10686,9 @@ api_a_maccept_cancel_tcp(InitState) -> ?SEV_IPRINT("terminating"), State1 = maps:remove(tester, State), State2 = maps:remove(accept_select_info, State1), - State3 = maps:remove(lsock, State2), - {ok, State3}; + State3 = maps:remove(accept_completion_info, State2), + State4 = maps:remove(lsock, State3), + {ok, State4}; {error, _} = ERROR -> ERROR end @@ -10322,15 +10884,15 @@ api_a_maccept_cancel_tcp(InitState) -> api_a_mrecv_cancel_tcp4(Config) when is_list(Config) -> ?TT(?SECS(20)), Nowait = nowait(Config), - tc_try(api_a_mrecv_cancel_tcp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> Recv = fun(Sock) -> socket:recv(Sock, 0, Nowait) end, - InitState = #{domain => inet, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + recv => Recv, + recv_ref => Nowait}, ok = api_a_mrecv_cancel_tcp(InitState) end). @@ -10345,15 +10907,15 @@ api_a_mrecv_cancel_tcp4(Config) when is_list(Config) -> api_a_mrecv_cancel_tcp6(Config) when is_list(Config) -> ?TT(?SECS(20)), Nowait = nowait(Config), - tc_try(api_a_mrecv_cancel_tcp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> Recv = fun(Sock) -> socket:recv(Sock, 0, Nowait) end, - InitState = #{domain => inet6, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + recv => Recv, + recv_ref => Nowait}, ok = api_a_mrecv_cancel_tcp(InitState) end). @@ -10368,15 +10930,18 @@ api_a_mrecv_cancel_tcp6(Config) when is_list(Config) -> api_a_mrecvmsg_cancel_tcp4(Config) when is_list(Config) -> ?TT(?SECS(20)), Nowait = nowait(Config), - tc_try(api_a_mrecvmsg_cancel_tcp4, - fun() -> has_support_ipv4() end, + tc_try(?FUNCTION_NAME, + fun() -> + is_not_windows(), + has_support_ipv4() + end, fun() -> Recv = fun(Sock) -> socket:recvmsg(Sock, Nowait) end, - InitState = #{domain => inet, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet, + recv => Recv, + recv_ref => Nowait}, ok = api_a_mrecv_cancel_tcp(InitState) end). @@ -10391,15 +10956,18 @@ api_a_mrecvmsg_cancel_tcp4(Config) when is_list(Config) -> api_a_mrecvmsg_cancel_tcp6(Config) when is_list(Config) -> ?TT(?SECS(20)), Nowait = nowait(Config), - tc_try(api_a_mrecvmsg_cancel_tcp6, - fun() -> has_support_ipv6() end, + tc_try(?FUNCTION_NAME, + fun() -> + is_not_windows(), + has_support_ipv6() + end, fun() -> Recv = fun(Sock) -> socket:recvmsg(Sock, Nowait) end, - InitState = #{domain => inet6, - recv => Recv, - recv_sref => Nowait}, + InitState = #{domain => inet6, + recv => Recv, + recv_ref => Nowait}, ok = api_a_mrecv_cancel_tcp(InitState) end). @@ -10482,25 +11050,40 @@ api_a_mrecv_cancel_tcp(InitState) -> cmd => fun(#{tester := Tester} = _State) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) end}, - #{desc => "try recv request (with nowait, expect select)", - cmd => fun(#{csock := Sock, - recv := Recv, - recv_sref := SR} = State) -> + #{desc => "try recv request (with nowait, expect select|completion)", + cmd => fun(#{csock := Sock, + recv := Recv, + recv_ref := Ref} = State) -> case Recv(Sock) of - {select, {select_info, T, R} = SelectInfo} - when SR =:= nowait -> + {select, {select_info, T, R} = SI} + when Ref =:= nowait -> ?SEV_IPRINT("recv select nowait: " "~n Tag: ~p" "~n Ref: ~p", [T, R]), - {ok, State#{recv_select_info => SelectInfo}}; - {select, {select_info, T, SR} = SelectInfo} - when is_reference(SR) -> + {ok, State#{recv_select_info => SI}}; + {select, {select_info, T, Ref} = SI} + when is_reference(Ref) -> ?SEV_IPRINT("recv select nowait: " "~n Tag: ~p" - "~n Ref: ~p", [T, SR]), - {ok, State#{recv_select_info => SelectInfo}}; + "~n Ref: ~p", [T, Ref]), + {ok, State#{recv_select_info => SI}}; + + {completion, {completion_info, T, R} = CI} + when Ref =:= nowait -> + ?SEV_IPRINT("recv completion nowait: " + "~n Tag: ~p" + "~n Ref: ~p", [T, R]), + {ok, State#{recv_completion_info => CI}}; + {completion, {completion_info, T, Ref} = CI} + when is_reference(Ref) -> + ?SEV_IPRINT("recv completion nowait: " + "~n Tag: ~p" + "~n Ref: ~p", [T, Ref]), + {ok, State#{recv_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -10510,7 +11093,7 @@ api_a_mrecv_cancel_tcp(InitState) -> ?SEV_ANNOUNCE_READY(Tester, recv_select), ok end}, - #{desc => "await select message", + #{desc => "await select|completion message", cmd => fun(#{csock := Sock, recv_select_info := {select_info, _, Ref}} = State) -> receive @@ -10520,6 +11103,16 @@ api_a_mrecv_cancel_tcp(InitState) -> {ok, maps:remove(sock, State)} after 5000 -> ok + end; + (#{csock := Sock, + recv_completion_info := {completion_info, _, Ref}} = State) -> + receive + {'$socket', Sock, completion, {Ref, _} = C} -> + {error, {unexpected_completion, C}}; + {'$socket', Sock, abort, {Ref, closed}} -> + {ok, maps:remove(sock, State)} + after 5000 -> + ok end end}, #{desc => "announce ready (abort)", @@ -10572,20 +11165,25 @@ api_a_mrecv_cancel_tcp(InitState) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) end}, #{desc => "try recv request (with nowait, expect select)", - cmd => fun(#{sock := Sock, - recv := Recv, - recv_sref := SR} = State) -> + cmd => fun(#{sock := Sock, + recv := Recv, + recv_ref := Ref} = State) -> case Recv(Sock) of - {select, SelectInfo} when SR =:= nowait -> - {ok, - State#{recv_select_info => SelectInfo}}; - {select, - {select_info, _Tag, SR} = SelectInfo} - when is_reference(SR) -> - {ok, - State#{recv_select_info => SelectInfo}}; + {select, SI} when Ref =:= nowait -> + {ok, State#{recv_select_info => SI}}; + {select, {select_info, _Tag, Ref} = SI} + when is_reference(Ref) -> + {ok, State#{recv_select_info => SI}}; + + {completion, CI} when Ref =:= nowait -> + {ok, State#{recv_completion_info => CI}}; + {completion, {completion_info, _Tag, Ref} = CI} + when is_reference(Ref) -> + {ok, State#{recv_completion_info => CI}}; + {ok, X} -> - {error, {unexpected_select_info, X}}; + {error, {unexpected_success, X}}; + {error, _} = ERROR -> ERROR end @@ -10606,6 +11204,17 @@ api_a_mrecv_cancel_tcp(InitState) -> after 5000 -> ?SEV_EPRINT("message queue: ~p", [mq()]), {error, timeout} + end; + (#{sock := Sock, + recv_completion_info := {completion_info, _, Ref}} = State) -> + receive + {'$socket', Sock, completion, {Ref, _} = C} -> + {error, {unexpected_completion, C}}; + {'$socket', Sock, abort, {Ref, closed}} -> + {ok, maps:remove(sock, State)} + after 5000 -> + ?SEV_EPRINT("message queue: ~p", [mq()]), + {error, timeout} end end}, #{desc => "announce ready (abort)", @@ -10621,9 +11230,10 @@ api_a_mrecv_cancel_tcp(InitState) -> ok -> ?SEV_IPRINT("terminating"), State1 = maps:remove(recv_select_info, State), - State2 = maps:remove(tester, State1), - State3 = maps:remove(sock, State2), - {ok, State3}; + State2 = maps:remove(recv_completion_info, State1), + State3 = maps:remove(tester, State2), + State4 = maps:remove(sock, State3), + {ok, State4}; {error, _} = ERROR -> ERROR end @@ -11417,8 +12027,10 @@ api_opt_simple_otp_meta_option() -> %% protocol = tcp. api_opt_simple_otp_rcvbuf_option(_Config) when is_list(_Config) -> ?TT(?SECS(15)), - tc_try(api_opt_simple_otp_rcvbuf_option, - fun() -> api_opt_simple_otp_rcvbuf_option() end). + tc_try(?FUNCTION_NAME, + fun() -> + api_opt_simple_otp_rcvbuf_option() + end). api_opt_simple_otp_rcvbuf_option() -> Get = fun(S) -> @@ -11557,6 +12169,12 @@ api_opt_simple_otp_rcvbuf_option() -> end}, #{desc => "attempt to recv", cmd => fun(#{sock := Sock, msg_sz := MsgSz} = _State) -> + ?SEV_IPRINT("try recv ~w bytes when rcvbuf is ~s", + [MsgSz, + case Get(Sock) of + {ok, RcvBuf} -> f("~w", [RcvBuf]); + {error, _} -> "-" + end]), case socket:recv(Sock) of {ok, Data} when (size(Data) =:= MsgSz) -> ok; @@ -11614,6 +12232,10 @@ api_opt_simple_otp_rcvbuf_option() -> cmd => fun(#{tester := Tester} = State) -> case ?SEV_AWAIT_CONTINUE(Tester, tester, recv) of {ok, {ExpSz, NewRcvBuf}} -> + ?SEV_IPRINT("set new rcvbuf:" + "~n New RcvBuf: ~p" + "~n Expect Size: ~p", + [ExpSz, NewRcvBuf]), {ok, State#{msg_sz => ExpSz, rcvbuf => NewRcvBuf}}; {error, _} = ERROR -> @@ -11624,7 +12246,8 @@ api_opt_simple_otp_rcvbuf_option() -> cmd => fun(#{sock := Sock, rcvbuf := NewRcvBuf} = _State) -> case Set(Sock, NewRcvBuf) of ok -> - ?SEV_IPRINT("set new rcvbuf: ~p", [NewRcvBuf]), + ?SEV_IPRINT("set new rcvbuf: ~p", + [NewRcvBuf]), ok; {error, _} = ERROR -> ERROR @@ -11919,7 +12542,13 @@ api_opt_simple_otp_rcvbuf_option() -> #{desc => "order server continue (recv 1)", cmd => fun(#{server := Server, data := Data} = _State) -> MsgSz = size(Data), - NewRcvBuf = {2 + (MsgSz div 1024), 1024}, + NewRcvBuf = + case os:type() of + {win32, nt} -> + (((2 * MsgSz) div 1024) + 1) * 1024; + _ -> + {2 + (MsgSz div 1024), 1024} + end, ?SEV_ANNOUNCE_CONTINUE(Server, recv, NewRcvBuf), ok end}, @@ -11956,7 +12585,13 @@ api_opt_simple_otp_rcvbuf_option() -> #{desc => "order server continue (recv 2)", cmd => fun(#{server := Server, data := Data} = _State) -> MsgSz = size(Data), - NewRcvBuf = {2 + (MsgSz div 2048), 2048}, + NewRcvBuf = + case os:type() of + {win32, nt} -> + (((3 * MsgSz) div 1024) + 1) * 1024; + _ -> + {2 + (MsgSz div 2048), 2048} + end, ?SEV_ANNOUNCE_CONTINUE(Server, recv, NewRcvBuf), ok end}, @@ -11993,12 +12628,18 @@ api_opt_simple_otp_rcvbuf_option() -> ?SEV_SLEEP(?SECS(1)), #{desc => "order server continue (recv 3)", cmd => fun(#{server := Server, data := Data} = _State) -> - MsgSz = size(Data), - BufSz = 2048, - N = MsgSz div BufSz - 1, - NewRcvBuf = {N, BufSz}, + MsgSz = size(Data), + BufSz = 2048, + N = MsgSz div BufSz - 1, + {ExpSz, NewRcvBuf} = + case os:type() of + {win32, nt} -> + {N*BufSz, N*BufSz}; + _ -> + {N*BufSz, {N, BufSz}} + end, ?SEV_ANNOUNCE_CONTINUE(Server, recv, - {N*BufSz, NewRcvBuf}) + {ExpSz, NewRcvBuf}) end}, #{desc => "await client ready (send 3)", cmd => fun(#{server := Server, @@ -13233,6 +13874,11 @@ api_opt_sock_broadcast() -> ?SEV_IPRINT("Expected Success (bound): ~p", [Port]), {ok, State#{sa2 => BSA#{port => Port}}}; + {error, eaddrnotavail = Reason} -> + ?SEV_IPRINT("~p => " + "SKIP subnet-directed broadcast test", + [Reason]), + {ok, State#{sa2 => skip}}; {error, Reason} = ERROR -> ?SEV_EPRINT("Unexpected Failure: ~p", [Reason]), @@ -13240,7 +13886,10 @@ api_opt_sock_broadcast() -> end end}, #{desc => "[socket 2] UDP socket sockname", - cmd => fun(#{sock2 := Sock} = _State) -> + cmd => fun(#{sa2 := skip} = _State) -> + ?SEV_IPRINT("SKIP subnet-directed broadcast test"), + ok; + (#{sock2 := Sock} = _State) -> case socket:sockname(Sock) of {ok, SA} -> ?SEV_IPRINT("SA: ~p", [SA]), @@ -13346,7 +13995,7 @@ api_opt_sock_broadcast() -> #{desc => "[socket 3] try send to limited broadcast address", cmd => fun(#{sa1 := skip} = _State) -> - ?SEV_IPRINT("SKIP limited broadcast test"), + ?SEV_IPRINT("SKIP limited broadcast test (send)"), ok; (#{sock3 := Sock, sa1 := Dest} = _State) -> @@ -13366,7 +14015,7 @@ api_opt_sock_broadcast() -> end}, #{desc => "[socket 1] try recv", cmd => fun(#{sa1 := skip} = _State) -> - ?SEV_IPRINT("SKIP limited broadcast test"), + ?SEV_IPRINT("SKIP limited broadcast test (recv)"), ok; (#{sock1 := Sock} = State) -> case socket:recvfrom(Sock, 0, 5000) of @@ -13393,8 +14042,12 @@ api_opt_sock_broadcast() -> ?SEV_SLEEP(?SECS(1)), - #{desc => "[socket 3] try send to subnet-directed broadcast address", - cmd => fun(#{sock3 := Sock, + #{desc => "[socket 2] try send to subnet-directed broadcast address", + cmd => fun(#{sa2 := skip} = _State) -> + ?SEV_IPRINT("SKIP subnet-directed broadcast test " + "(send)"), + ok; + (#{sock2 := Sock, sa2 := Dest} = _State) -> Data = list_to_binary("hejsan"), ?SEV_IPRINT("try send to broadcast address: " @@ -13404,6 +14057,14 @@ api_opt_sock_broadcast() -> ?SEV_IPRINT("Expected Success: " "broadcast message sent"), ok; + {error, eaddrnotavail = Reason} -> + ?SEV_EPRINT("Unexpected Failure: ~p => SKIP", + [Reason]), + {skip, Reason}; + {error, eacces = Reason} -> + ?SEV_EPRINT("Unexpected Failure: ~p => SKIP", + [Reason]), + {skip, Reason}; {error, Reason} = ERROR -> ?SEV_EPRINT("Unexpected Failure: ~p", [Reason]), @@ -13411,13 +14072,17 @@ api_opt_sock_broadcast() -> end end}, #{desc => "[socket 2] try recv", - cmd => fun(#{sock2 := Sock, sa1 := SA1} = _State) -> + cmd => fun(#{sa2 := skip} = _State) -> + ?SEV_IPRINT("SKIP subnet-directed broadcast test " + "(recv)"), + ok; + (#{sock2 := Sock, sa2 := SA2} = _State) -> case socket:recvfrom(Sock, 0, 5000) of {ok, _} -> ?SEV_IPRINT("Expected Success: " "received message"), ok; - {error, timeout = Reason} when (SA1 =:= skip) -> + {error, timeout = Reason} when (SA2 =:= skip) -> ?SEV_IPRINT("Unexpected Failure: ~p", [Reason]), {skip, "receive timeout"}; @@ -17136,7 +17801,11 @@ api_opt_sock_timeo(InitState) -> api_opt_sock_rcvlowat_udp4(_Config) when is_list(_Config) -> ?TT(?SECS(5)), tc_try(api_opt_sock_rcvlowat_udp4, - fun() -> has_support_ipv4(), has_support_sock_rcvlowat() end, + fun() -> + is_not_windows(), % einval on Windows + has_support_ipv4(), + has_support_sock_rcvlowat() + end, fun() -> ok = api_opt_sock_lowat_udp4(rcvlowat) end). @@ -17155,7 +17824,11 @@ api_opt_sock_rcvlowat_udp4(_Config) when is_list(_Config) -> api_opt_sock_sndlowat_udp4(_Config) when is_list(_Config) -> ?TT(?SECS(5)), tc_try(api_opt_sock_sndlowat_udp4, - fun() -> has_support_ipv4(), has_support_sock_sndlowat() end, + fun() -> + is_not_windows(), % einval on Windows + has_support_ipv4(), + has_support_sock_sndlowat() + end, fun() -> ok = api_opt_sock_lowat_udp4(sndlowat) end). @@ -18819,7 +19492,7 @@ which_local_host_ifname(Domain) -> api_opt_ip_pktinfo_udp4(_Config) when is_list(_Config) -> ?TT(?SECS(5)), - tc_try(api_opt_ip_pktinfo_udp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4(), has_support_ip_pktinfo() end, fun() -> Set = fun(Sock, Value) -> @@ -18830,16 +19503,16 @@ api_opt_ip_pktinfo_udp4(_Config) when is_list(_Config) -> end, Send = fun(Sock, Data, Dest, default) -> Msg = #{addr => Dest, - iov => [Data]}, + iov => [Data]}, socket:sendmsg(Sock, Msg); (Sock, Data, Dest, Info) -> %% We do not support this at the moment!!! CMsg = #{level => ip, - type => pktinfo, - data => Info}, + type => pktinfo, + data => Info}, Msg = #{addr => Dest, - ctrl => [CMsg], - iov => [Data]}, + ctrl => [CMsg], + iov => [Data]}, socket:sendmsg(Sock, Msg) end, Recv = fun(Sock) -> @@ -18928,18 +19601,18 @@ api_opt_ip_pktinfo_udp(InitState) -> "~n ~p", [SADst]), {ok, State#{sa_dst => SADst}} end}, - #{desc => "default pktinfo for dst socket", + #{desc => "get default pktinfo for dst socket", cmd => fun(#{sock_dst := Sock, get := Get} = _State) -> case Get(Sock) of {ok, false = Value} -> ?SEV_IPRINT("dst recvttl: ~p", [Value]), ok; {ok, Unexpected} -> - ?SEV_EPRINT("Unexpected src recvtos: ~p", + ?SEV_EPRINT("Unexpected src pktinfo: ~p", [Unexpected]), {error, {unexpected, Unexpected}}; {error, Reason} = ERROR -> - ?SEV_EPRINT("Failed getting (default) timestamp:" + ?SEV_EPRINT("Failed getting (default) pktinfo:" " ~p", [Reason]), ERROR end @@ -19881,6 +20554,7 @@ api_opt_ip_recvtos_udp4(_Config) when is_list(_Config) -> ?TT(?SECS(5)), tc_try(api_opt_ip_recvtos_udp4, fun() -> + is_not_windows(), % IP_TOS on windows has_support_ipv4(), has_support_ip_recvtos(), has_support_ip_tos() % Used in the test @@ -20250,10 +20924,15 @@ api_opt_ip_recvtos_udp(InitState) -> %% Maybe we should send and receive from different VMs, until then %% skip darwin and OpenBSD. %% +%% Windows: +%% It seems like its possible to set and get the recvttl option, +%% but not to use the ttl control message header when sending. +%% The following is the list of types (for level ip) which are listed +%% as supported: IP_ORIGINAL_ARRIVAL_IF, IP_PKTINFO and IP_ECN api_opt_ip_recvttl_udp4(_Config) when is_list(_Config) -> ?TT(?SECS(5)), - tc_try(api_opt_ip_recvttl_udp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4(), has_support_ip_recvttl(), @@ -20269,15 +20948,15 @@ api_opt_ip_recvttl_udp4(_Config) when is_list(_Config) -> end, Send = fun(Sock, Data, Dest, default) -> Msg = #{addr => Dest, - iov => [Data]}, + iov => [Data]}, socket:sendmsg(Sock, Msg); (Sock, Data, Dest, TTL) -> CMsg = #{level => ip, - type => ttl, - value => TTL}, + type => ttl, + value => TTL}, Msg = #{addr => Dest, - ctrl => [CMsg], - iov => [Data]}, + ctrl => [CMsg], + iov => [Data]}, socket:sendmsg(Sock, Msg) end, Recv = fun(Sock) -> @@ -20442,6 +21121,69 @@ api_opt_ip_recvttl_udp(InitState) -> (catch socket:close(SSock)), (catch socket:close(DSock)), {skip, Reason}; + + {error, + {get_overlapped_result, + #{file := File, + function := Function, + line := Line, + raw_info := RawInfo, + info := invalid_parameter = Info}}} -> + %% IF we can't send it the test will not work + ?SEV_EPRINT("Cannot send TTL: " + "~p => SKIP: " + "~n File: ~s" + "~n Function: ~s" + "~n Line: ~p" + "~n Raw Info: ~p", + [Info, + File, Function, Line, + RawInfo]), + (catch socket:close(SSock)), + (catch socket:close(DSock)), + {skip, + ?F("Cannot send with TTL: ~p", [Info])}; + {error, {get_overlapped_result, + invalid_parameter = Info}} -> + %% IF we can't send it the test will not work + ?SEV_EPRINT("Cannot send TTL: " + "~p => SKIP", [Info]), + (catch socket:close(SSock)), + (catch socket:close(DSock)), + {skip, + ?F("Cannot send with TTL: ~p", [Info])}; + + {error, + {completion_status, + #{file := File, + function := Function, + line := Line, + raw_info := RawInfo, + info := invalid_parameter = Info}}} -> + %% IF we can't send it the test will not work + ?SEV_EPRINT("Cannot send TTL: " + "~p => SKIP: " + "~n File: ~s" + "~n Function: ~s" + "~n Line: ~p" + "~n Raw Info: ~p", + [Info, + File, Function, Line, + RawInfo]), + (catch socket:close(SSock)), + (catch socket:close(DSock)), + {skip, + ?F("Cannot send with TTL: ~p", [Info])}; + {error, {completion_status, + invalid_parameter = Info}} -> + %% IF we can't send it the test will not work + ?SEV_EPRINT("Cannot send TTL: " + "~p => SKIP", [Info]), + (catch socket:close(SSock)), + (catch socket:close(DSock)), + {skip, + ?F("Cannot send with TTL: ~p", [Info])}; + {error, _Reason} = ERROR -> ERROR end @@ -20636,8 +21378,12 @@ api_opt_ip_recvttl_udp(InitState) -> api_opt_ip_tos_udp4(_Config) when is_list(_Config) -> ?TT(?SECS(5)), - tc_try(api_opt_ip_tos_udp4, - fun() -> has_support_ipv4(), has_support_ip_tos() end, + tc_try(?FUNCTION_NAME, + fun() -> + is_not_windows(), % IP_TOS on windows + has_support_ipv4(), + has_support_ip_tos() + end, fun() -> Set = fun(Sock, Value) -> socket:setopt(Sock, ip, tos, Value) @@ -20992,16 +21738,33 @@ api_opt_recverr_udp(Config, InitState) -> {select, SelectInfo} when RecvRef =:= nowait -> ?SEV_IPRINT("expected select nowait: " "~n ~p", [SelectInfo]), - {ok, State#{rselect => SelectInfo}}; + {ok, State#{async_tag => select, + rselect => SelectInfo}}; {select, {select_info, _Tag, RecvRef} = SelectInfo} when is_reference(RecvRef) -> ?SEV_IPRINT("expected select ref: " "~n ~p", [SelectInfo]), - {ok, State#{rselect => SelectInfo}}; + {ok, State#{async_tag => select, + rselect => SelectInfo}}; + + {completion, CI} when RecvRef =:= nowait -> + ?SEV_IPRINT("expected completion nowait: " + "~n ~p", [CI]), + {ok, State#{asynch_tag => completion, + rcompletion => CI}}; + {completion, + {completion_info, _Tag, RecvRef} = CI} + when is_reference(RecvRef) -> + ?SEV_IPRINT("expected completion ref: " + "~n ~p", [CI]), + {ok, State#{asynch_tag => completion, + rcompletion => CI}}; + {ok, _} -> ?SEV_EPRINT("unexpected success"), {error, unexpected_success}; + {error, Reason} = ERROR -> ?SEV_EPRINT("unexpected error: ~p", [Reason]), ERROR @@ -21010,8 +21773,8 @@ api_opt_recverr_udp(Config, InitState) -> #{desc => "try send to nowhere", cmd => fun(#{domain := Domain, - sock := Sock, - send := Send} = State) -> + sock := Sock, + send := Send} = State) -> SendRef = nowait(Config), Dest = #{family => Domain, addr => if @@ -21024,18 +21787,40 @@ api_opt_recverr_udp(Config, InitState) -> case Send(Sock, <<"ping">>, Dest, SendRef) of ok -> ?SEV_IPRINT("sent"), - ok; + {ok, State#{sent => true}}; + {select, SelectInfo} when SendRef =:= nowait -> ?SEV_IPRINT("expected select nowait: ~p", [SelectInfo]), - {ok, State#{sselect => SelectInfo}}; + {ok, State#{sent => false, + asynch_tag => select, + sselect => SelectInfo}}; {select, {select_info, _Tag, SendRef} = SelectInfo} when is_reference(SendRef) -> ?SEV_IPRINT("expected select ref: ~p", [SelectInfo]), - {ok, State#{sselect => SelectInfo}}; + {ok, State#{sent => false, + asynch_tag => select, + sselect => SelectInfo}}; + + {completion, CI} + when SendRef =:= nowait -> + ?SEV_IPRINT("expected completion nowait: ~p", + [CI]), + {ok, State#{sent => false, + asynch_tag => completion, + scompletion => CI}}; + {completion, + {completion_info, _Tag, SendRef} = CI} + when is_reference(SendRef) -> + ?SEV_IPRINT("expected completion ref: ~p", + [CI]), + {ok, State#{sent => false, + asynch_tag => completion, + scompletion => CI}}; + {error, Reason} = ERROR -> ?SEV_EPRINT("unexpected error: ~p", [Reason]), @@ -21043,22 +21828,55 @@ api_opt_recverr_udp(Config, InitState) -> end end}, - #{desc => "await receive select message", - cmd => fun(#{sock := Sock, - rselect := {select_info, _, Ref}} = _State) -> + #{desc => "await receive select|completion message", + cmd => fun(#{sent := false, + asynch_tag := select, + sock := Sock, + rselect := {select_info, _, Ref}} = _State) -> receive {'$socket', Sock, select, Ref} -> - ?SEV_IPRINT("received expected (read) select message: " + ?SEV_IPRINT("received expected (read) " + "select message: " "~n ~p", [Ref]), ok - end + end; + (#{sent := false, + asynch_tag := completion, + sock := Sock, + rcompletion := {completion_info, _, Ref}} = _State) -> + receive + {'$socket', Sock, completion, + {Ref, {error, econnrefused = Reason}}} -> + ?SEV_IPRINT("expected failure: ~p", + [Reason]), + ok; + + {'$socket', Sock, completion, + {Ref, {ok, _}}} -> + ?SEV_EPRINT("unexpected success"), + {error, unexpected_success}; + {'$socket', Sock, completion, + {Ref, {error, Reason} = ERROR}} -> + ?SEV_IPRINT("unexpected failure: ~p", + [Reason]), + ERROR + + end; + (#{sent := true} = _State) -> + ?SEV_IPRINT("no action needed"), + ok end}, #{desc => "try recv - expect econnrefused", - cmd => fun(#{sock := Sock, recv := Recv} = _State) -> + cmd => fun(#{asynch_tag := completion} = _State) -> + ?SEV_IPRINT("already processed"), + ok; + (#{sock := Sock, + recv := Recv} = _State) -> case Recv(Sock, infinity) of {error, econnrefused = Reason} -> - ?SEV_IPRINT("expected failure: ~p", [Reason]), + ?SEV_IPRINT("expected failure: ~p", + [Reason]), ok; {ok, _} -> ?SEV_EPRINT("unexpected success"), @@ -21096,10 +21914,17 @@ api_opt_recverr_udp(Config, InitState) -> {ok, {Addr, <<"ring">>}} -> ?SEV_IPRINT("receive expected"), ok; + {select, SelectInfo} -> ?SEV_EPRINT("unexpected select: ~p", [SelectInfo]), {error, unexpected_success}; + + {completion, CompletionInfo} -> + ?SEV_EPRINT("unexpected completion: ~p", + [CompletionInfo]), + {error, unexpected_success}; + {error, Reason} = ERROR -> ?SEV_EPRINT("unexpected error: ~p", [Reason]), @@ -21108,7 +21933,7 @@ api_opt_recverr_udp(Config, InitState) -> end}, #{desc => "try recv error queue", - cmd => fun(#{domain := Domain, sock := Sock}) -> + cmd => fun(#{domain := Domain, sock := Sock} = State) -> %% Note that not all platforms that support %% recverr, actually supports "encoding" the data %% part, so we need to adjust for that. @@ -21139,7 +21964,7 @@ api_opt_recverr_udp(Config, InitState) -> }]} = Msg} -> ?SEV_IPRINT("expected error queue (decoded): " "~n ~p", [Msg]), - ok; + {ok, State#{asynch_tag => none}}; {ok, #{addr := #{family := Domain, addr := _Addr}, flags := [errqueue], @@ -21147,7 +21972,30 @@ api_opt_recverr_udp(Config, InitState) -> value := [#{level := Level, type := recverr}]} = _Msg} -> ?SEV_IPRINT("expected error queue"), - ok; + {ok, State#{asynch_tag => none}}; + + {completion, CI} -> + ?SEV_IPRINT("completion: " + "~n ~p", [CI]), + {ok, State#{asynch_tag => completion, + completion => CI}}; + + {error, timeout = Reason} = ERROR -> + case os:type() of + {win32, nt} -> + ?SEV_IPRINT("failed reading " + "error queue: " + "~n ~p", [Reason]), + {skip, + "Test case does not " + "work on Windows"}; + _ -> + ?SEV_EPRINT("failed reading " + "error queue: " + "~n ~p", [Reason]), + ERROR + end; + {error, Reason} = ERROR -> ?SEV_EPRINT("failed reading error queue: " "~n ~p", [Reason]), @@ -21155,6 +22003,29 @@ api_opt_recverr_udp(Config, InitState) -> end end}, + #{desc => "await receive select message", + cmd => fun(#{asynch_tag := completion, + sock := Sock, + completion := {completion_info, _, Ref}} = _State) -> + receive + {'$socket', Sock, completion, + {Ref, {ok, Info}}} -> + ?SEV_EPRINT("expected success: " + "~n ~p", [Info]), + ok; + + {'$socket', Sock, completion, + {Ref, {error, Reason} = ERROR}} -> + ?SEV_IPRINT("unexpected failure: ~p", + [Reason]), + ERROR + + end; + (#{asynch_tag := none} = _State) -> + ?SEV_IPRINT("no action needed"), + ok + end}, + #{desc => "close socket", cmd => fun(#{sock := Sock} = State) -> ok = socket:close(Sock), @@ -21201,14 +22072,20 @@ api_opt_recverr_udp(Config, InitState) -> api_opt_ip_mopts_udp4(_Config) when is_list(_Config) -> ?TT(?SECS(5)), - tc_try(api_opt_ip_mopts_udp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4(), - case is_any_options_supported( - [{ip, pktinfo}, - {ip, recvorigdstaddr}, - {ip, recvtos}, - {ip, recvttl}]) of + Opts = + [{ip, pktinfo}, + {ip, recvorigdstaddr}] ++ + case os:type() of + {win32, nt} -> + []; + _ -> + [{ip, recvtos}, + {ip, recvttl}] + end, + case is_any_options_supported(Opts) of true -> ok; false -> @@ -21244,42 +22121,49 @@ api_opt_ip_mopts_udp4(_Config) when is_list(_Config) -> false -> [] end ++ - case socket:is_supported(options, ip, recvtos) of - true -> - %% It seems that sending any of the - %% TOS or TTL values will fail on: - %% FreeBSD - %% Linux when - %% version =< 3.12.60 (at least) - %% Don't know when this starts working, - %% but it works on: - %% Ubunto 16.04.6 => 4.15.0-65 - %% SLES 12 SP2 => 4.4.120-92.70 - %% so don't! - %% - %% The latest we know it not to work was a - %% SLES 12 (plain) at 3.12.50-52.54 - %% - [{ip, recvtos, tos, - case os:type() of - {unix, freebsd} -> - default; - {unix, linux} -> - case os:version() of - Vsn when Vsn > {3,12,60} -> - 42; - _ -> - default - end; - _ -> - 42 - end}]; - false -> - [] + case os:type() of + {win32, nt} -> + []; + _ -> + case socket:is_supported(options, ip, recvtos) of + true -> + %% It seems that sending any of the + %% TOS or TTL values will fail on: + %% FreeBSD + %% Linux when + %% version =< 3.12.60 (at least) + %% Don't know when this starts + %% working, but it works on: + %% Ubunto 16.04.6 => 4.15.0-65 + %% SLES 12 SP2 => 4.4.120-92.70 + %% so don't! + %% + %% The latest we know it not to work + %% was a SLES 12 (plain) at 3.12.50-52.54 + %% + [{ip, recvtos, tos, + case os:type() of + {unix, freebsd} -> + default; + {unix, linux} -> + case os:version() of + Vsn when Vsn > {3,12,60} -> + 42; + _ -> + default + end; + _ -> + 42 + end}]; + false -> + [] + end end ++ case os:type() of {unix, darwin} -> []; + {win32, nt} -> + []; _ -> case socket:is_supported(options, ip, recvttl) of true -> @@ -21314,21 +22198,22 @@ api_opt_ip_mopts_udp4(_Config) when is_list(_Config) -> end, Enable = fun(Sock, Level, Opt) -> - ?SEV_IPRINT("try enable [~w] ~p", [Level, Opt]), + ?SEV_IPRINT("try enable [~w] ~p", + [Level, Opt]), socket:setopt(Sock, Level, Opt, true) end, Send = fun(Sock, Data, Dest, []) -> Msg = #{addr => Dest, - iov => [Data]}, + iov => [Data]}, socket:sendmsg(Sock, Msg); (Sock, Data, Dest, Hdrs) when is_list(Hdrs) -> CMsgs = [#{level => Level, - type => Type, - value => Val} || - {Level, Type, Val} <- Hdrs], + type => Type, + value => Val} || + {Level, Type, Val} <- Hdrs], Msg = #{addr => Dest, - ctrl => CMsgs, - iov => [Data]}, + ctrl => CMsgs, + iov => [Data]}, socket:sendmsg(Sock, Msg) end, Recv = fun(Sock) -> @@ -22592,7 +23477,68 @@ api_opt_ipv6_tclass_udp(InitState) -> #{desc => "send req (to dst) (w explicit tc = 1)", cmd => fun(#{sock_src := Sock, sa_dst := Dst, send := Send}) -> - Send(Sock, ?BASIC_REQ, Dst, 1) + case Send(Sock, ?BASIC_REQ, Dst, 1) of + {error, + {get_overlapped_result, + #{file := File, + function := Function, + line := Line, + raw_info := RawInfo, + info := invalid_parameter = Info}}} -> + %% IF we can't send it the test will not work + ?SEV_EPRINT("Cannot send TClass: " + "~p => SKIP: " + "~n File: ~s" + "~n Function: ~s" + "~n Line: ~p" + "~n Raw Info: ~p", + [Info, + File, Function, Line, + RawInfo]), + (catch socket:close(Sock)), + {skip, + ?F("Cannot send with TClass: ~p", [Info])}; + {error, {get_overlapped_result, + invalid_parameter = Info}} -> + %% IF we can't send it the test will not work + ?SEV_EPRINT("Cannot send TClass: " + "~p => SKIP", [Info]), + (catch socket:close(Sock)), + {skip, + ?F("Cannot send with TClass: ~p", [Info])}; + + {error, + {completion_status, + #{file := File, + function := Function, + line := Line, + raw_info := RawInfo, + info := invalid_parameter = Info}}} -> + %% IF we can't send it the test will not work + ?SEV_EPRINT("Cannot send TClass: " + "~p => SKIP: " + "~n File: ~s" + "~n Function: ~s" + "~n Line: ~p" + "~n Raw Info: ~p", + [Info, + File, Function, Line, + RawInfo]), + (catch socket:close(Sock)), + {skip, + ?F("Cannot send with TClass: ~p", [Info])}; + {error, {completion_status, + invalid_parameter = Info}} -> + %% IF we can't send it the test will not work + ?SEV_EPRINT("Cannot send TClass: " + "~p => SKIP", [Info]), + (catch socket:close(Sock)), + {skip, + ?F("Cannot send with TClass: ~p", [Info])}; + + Other -> + Other + end end}, #{desc => "recv req (from src)", cmd => fun(#{sock_dst := Sock, sa_src := Src, recv := Recv}) -> @@ -22639,7 +23585,8 @@ api_opt_ipv6_tclass_udp(InitState) -> value => "something"}, ?BASIC_REQ, UnexpData]), {error, {unexpected_data, UnexpData}}; - {error, _} = ERROR -> + + {error, _} = ERROR -> %% At the moment there is no way to get %% status or state for the socket... ERROR @@ -22700,13 +23647,19 @@ api_opt_ipv6_mopts_udp6(_Config) when is_list(_Config) -> tc_try(api_opt_ipv6_mopts_udp6, fun() -> has_support_ipv6(), - case is_any_options_supported( - [{ipv6, recvpktinfo}, - {ipv6, flowinfo}, - {ipv6, recvhoplimit}, - {ipv6, hoplimit}, - {ipv6, recvtclass}, - {ipv6, tclass}]) of + Opts = + [{ipv6, recvpktinfo}, + {ipv6, flowinfo}, + {ipv6, recvhoplimit}, + {ipv6, hoplimit}] ++ + case os:type() of + {win32, nt} -> + []; + _ -> + [{ipv6, recvtclass}, + {ipv6, tclass}] + end, + case is_any_options_supported(Opts) of true -> ok; false -> @@ -22755,20 +23708,28 @@ api_opt_ipv6_mopts_udp6(_Config) when is_list(_Config) -> [] end end ++ - case socket:is_supported(options, ipv6, recvtclass) of - true -> - [{ipv6, recvtclass, tclass, 42}]; - false -> - case socket:is_supported(options, ipv6, tclass) of - true -> - [{ipv6, tclass, tclass, 42}]; - false -> - [] - end + case os:type() of + {win32, nt} -> + []; + _ -> + case socket:is_supported(options, + ipv6, recvtclass) of + true -> + [{ipv6, recvtclass, tclass, 42}]; + false -> + case socket:is_supported(options, + ipv6, tclass) of + true -> + [{ipv6, tclass, tclass, 42}]; + false -> + [] + end + end end, Enable = fun(Sock, Level, Opt) -> - ?SEV_IPRINT("try enable [~w] ~p", [Level, Opt]), + ?SEV_IPRINT("try enable [~w] ~p", + [Level, Opt]), socket:setopt(Sock, Level, Opt, true) end, Send = fun(Sock, Data, Dest, []) -> @@ -22777,12 +23738,12 @@ api_opt_ipv6_mopts_udp6(_Config) when is_list(_Config) -> socket:sendmsg(Sock, Msg); (Sock, Data, Dest, Hdrs) when is_list(Hdrs) -> CMsgs = [#{level => Level, - type => Type, - data => Val} || - {Level, Type, Val} <- Hdrs], + type => Type, + data => Val} || + {Level, Type, Val} <- Hdrs], Msg = #{addr => Dest, - ctrl => CMsgs, - iov => [Data]}, + ctrl => CMsgs, + iov => [Data]}, socket:sendmsg(Sock, Msg) end, Recv = fun(Sock) -> @@ -23293,8 +24254,11 @@ api_opt_tcp_cork_tcp(InitState) -> api_opt_tcp_maxseg_tcp4(_Config) when is_list(_Config) -> ?TT(?SECS(5)), - tc_try(api_opt_tcp_maxseg_tcp4, - fun() -> has_support_ipv4(), has_support_tcp_maxseg() end, + tc_try(?FUNCTION_NAME, + fun() -> + has_support_ipv4(), + has_support_tcp_maxseg() + end, fun() -> Set = fun(Sock, Value) when is_integer(Value) -> socket:setopt(Sock, tcp, maxseg, Value) @@ -23353,6 +24317,8 @@ api_opt_tcp_maxseg_tcp(InitState) -> {ok, DefMaxSeg} -> ?SEV_IPRINT("maxseg default: ~p", [DefMaxSeg]), {ok, State#{def_maxseg => DefMaxSeg}}; + {error, enoprotoopt = Reason} -> + {skip, Reason}; {error, _} = ERROR -> ERROR end @@ -31638,10 +32604,12 @@ sc_lc_receive_response_tcp(InitState) -> sc_lc_recvfrom_response_udp4(_Config) when is_list(_Config) -> ?TT(?SECS(30)), - tc_try(sc_lc_recvfrom_response_udp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> - Recv = fun(Sock, To) -> socket:recvfrom(Sock, [], To) end, + Recv = fun(Sock, To) -> + socket:recvfrom(Sock, [], To) + end, InitState = #{domain => inet, protocol => udp, recv => Recv}, @@ -31656,10 +32624,12 @@ sc_lc_recvfrom_response_udp4(_Config) when is_list(_Config) -> sc_lc_recvfrom_response_udp6(_Config) when is_list(_Config) -> ?TT(?SECS(30)), - tc_try(sc_lc_recvfrom_response_udp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> - Recv = fun(Sock, To) -> socket:recvfrom(Sock, [], To) end, + Recv = fun(Sock, To) -> + socket:recvfrom(Sock, [], To) + end, InitState = #{domain => inet6, protocol => udp, recv => Recv}, @@ -31674,7 +32644,7 @@ sc_lc_recvfrom_response_udp6(_Config) when is_list(_Config) -> sc_lc_recvfrom_response_udpL(_Config) when is_list(_Config) -> ?TT(?SECS(30)), - tc_try(sc_lc_recvfrom_response_udpL, + tc_try(?FUNCTION_NAME, fun() -> has_support_unix_domain_socket() end, fun() -> Recv = fun(Sock, To) -> @@ -31713,10 +32683,24 @@ sc_lc_receive_response_udp(InitState) -> #{desc => "open socket", cmd => fun(#{domain := Domain, protocol := Proto} = State) -> Sock = sock_open(Domain, dgram, Proto), - %% SA = sock_sockname(Sock), + {ok, State#{sock => Sock}} + end}, + #{desc => "bind socket", + cmd => fun(#{sock := Sock, local_sa := LSA}) -> + case sock_bind(Sock, LSA) of + ok -> + ?SEV_IPRINT("src bound"), + ok; + {error, Reason} = ERROR -> + ?SEV_EPRINT("src bind failed: ~p", [Reason]), + ERROR + end + end}, + #{desc => "socket name", + cmd => fun(#{sock := Sock} = State) -> case socket:sockname(Sock) of {ok, SA} -> - {ok, State#{sock => Sock, sa => SA}}; + {ok, State#{sa => SA}}; {error, eafnosupport = Reason} -> ?SEV_IPRINT("Failed get socket name: " "~n ~p", [Reason]), @@ -31728,17 +32712,6 @@ sc_lc_receive_response_udp(InitState) -> ERROR end end}, - #{desc => "bind socket", - cmd => fun(#{sock := Sock, local_sa := LSA}) -> - case sock_bind(Sock, LSA) of - ok -> - ?SEV_IPRINT("src bound"), - ok; - {error, Reason} = ERROR -> - ?SEV_EPRINT("src bind failed: ~p", [Reason]), - ERROR - end - end}, #{desc => "announce ready (init)", cmd => fun(#{tester := Tester, sock := Sock}) -> ?SEV_ANNOUNCE_READY(Tester, init, Sock), @@ -32099,8 +33072,11 @@ sc_lc_receive_response_udp(InitState) -> sc_lc_recvmsg_response_tcp4(_Config) when is_list(_Config) -> ?TT(?SECS(10)), - tc_try(sc_lc_recvmsg_response_tcp4, - fun() -> has_support_ipv4() end, + tc_try(?FUNCTION_NAME, + fun() -> + is_not_windows(), + has_support_ipv4() + end, fun() -> Recv = fun(Sock) -> socket:recvmsg(Sock) end, InitState = #{domain => inet, @@ -32117,8 +33093,11 @@ sc_lc_recvmsg_response_tcp4(_Config) when is_list(_Config) -> sc_lc_recvmsg_response_tcp6(_Config) when is_list(_Config) -> ?TT(?SECS(10)), - tc_try(sc_recvmsg_response_tcp6, - fun() -> has_support_ipv6() end, + tc_try(?FUNCTION_NAME, + fun() -> + is_not_windows(), + has_support_ipv6() + end, fun() -> Recv = fun(Sock) -> socket:recvmsg(Sock) end, InitState = #{domain => inet6, @@ -32671,7 +33650,7 @@ sc_lc_acceptor_response_tcp(InitState) -> sc_rc_recv_response_tcp4(_Config) when is_list(_Config) -> ?TT(?SECS(30)), - tc_try(sc_rc_recv_response_tcp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> Recv = fun(Sock) -> socket:recv(Sock) end, @@ -32689,7 +33668,7 @@ sc_rc_recv_response_tcp4(_Config) when is_list(_Config) -> sc_rc_recv_response_tcp6(_Config) when is_list(_Config) -> ?TT(?SECS(30)), - tc_try(sc_rc_recv_response_tcp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> Recv = fun(Sock) -> socket:recv(Sock) end, @@ -32707,7 +33686,7 @@ sc_rc_recv_response_tcp6(_Config) when is_list(_Config) -> sc_rc_recv_response_tcpL(_Config) when is_list(_Config) -> ?TT(?SECS(30)), - tc_try(sc_rc_recv_response_tcpL, + tc_try(?FUNCTION_NAME, fun() -> has_support_unix_domain_socket() end, fun() -> Recv = fun(Sock) -> socket:recv(Sock) end, @@ -32865,6 +33844,8 @@ sc_rc_receive_response_tcp(InitState) -> ?SEV_ANNOUNCE_READY(Tester, accept), ok end}, + + #{desc => "await continue (recv)", cmd => fun(#{tester := Tester} = _State) -> ?SEV_AWAIT_CONTINUE(Tester, tester, recv) @@ -32885,19 +33866,31 @@ sc_rc_receive_response_tcp(InitState) -> ok end}, #{desc => "await ready from handler 1 (recv)", - cmd => fun(#{tester := Tester, handler1 := Pid} = _State) -> - case ?SEV_AWAIT_READY(Pid, handler1, recv, - [{tester, Tester}]) of + cmd => fun(#{tester := Tester, + handler1 := Pid1, + handler2 := Pid2, + handler3 := Pid3} = _State) -> + case ?SEV_AWAIT_READY(Pid1, handler1, recv, + [{tester, Tester}, + {handler2, Pid2}, + {handler3, Pid3}]) of {ok, Result} -> Result; - {error, _} = ERROR -> + {error, Reason} = ERROR -> + ?SEV_EPRINT("Unexpected failure: " + "~n ~p", [Reason]), ERROR end end}, #{desc => "await ready from handler 2 (recv)", - cmd => fun(#{tester := Tester, handler2 := Pid} = _State) -> - case ?SEV_AWAIT_READY(Pid, handler2, recv, - [{tester, Tester}]) of + cmd => fun(#{tester := Tester, + handler1 := Pid1, + handler2 := Pid2, + handler3 := Pid3} = _State) -> + case ?SEV_AWAIT_READY(Pid2, handler2, recv, + [{tester, Tester}, + {handler1, Pid1}, + {handler3, Pid3}]) of {ok, Result} -> Result; {error, _} = ERROR -> @@ -32905,9 +33898,14 @@ sc_rc_receive_response_tcp(InitState) -> end end}, #{desc => "await ready from handler 3 (recv)", - cmd => fun(#{tester := Tester, handler3 := Pid} = _State) -> - case ?SEV_AWAIT_READY(Pid, handler3, recv, - [{tester, Tester}]) of + cmd => fun(#{tester := Tester, + handler1 := Pid1, + handler2 := Pid2, + handler3 := Pid3} = _State) -> + case ?SEV_AWAIT_READY(Pid3, handler3, recv, + [{tester, Tester}, + {handler1, Pid1}, + {handler2, Pid2}]) of {ok, Result} -> Result; {error, _} = ERROR -> @@ -33464,8 +34462,8 @@ sc_rc_receive_response_tcp(InitState) -> i("await evaluator"), ok = ?SEV_AWAIT_FINISH([Server, - Client1, Client2, Client3, - Tester]). + Client1, Client2, Client3, + Tester]). sc_rc_tcp_client_start(Node) -> @@ -33608,14 +34606,20 @@ sc_rc_tcp_handler_recv(Recv, Sock) -> try Recv(Sock) of {error, closed} -> ok; - {ok, _} -> - ?SEV_IPRINT("unexpected success"), + {ok, Data} -> + ?SEV_IPRINT("unexpected success: " + "~n (Unexp) Data: ~p" + "~n Socket Info: ~p", [Data, socket:info(Sock)]), {error, unexpected_success}; {error, Reason} = ERROR -> ?SEV_IPRINT("receive error: " "~n ~p", [Reason]), ERROR catch + error:notsup = Error:Stack -> + ?SEV_IPRINT("receive ~w error: skip" + "~n Stack: ~p", [Error, Stack]), + exit({skip, Error}); C:E:S -> ?SEV_IPRINT("receive failure: " "~n Class: ~p" @@ -33699,7 +34703,7 @@ sc_rc_recvmsg_response_tcpL(_Config) when is_list(_Config) -> sc_rs_recv_send_shutdown_receive_tcp4(_Config) when is_list(_Config) -> ?TT(?SECS(30)), - tc_try(sc_rs_recv_send_shutdown_receive_tcp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> MsgData = ?DATA, @@ -33726,7 +34730,7 @@ sc_rs_recv_send_shutdown_receive_tcp4(_Config) when is_list(_Config) -> %% Socket is IPv6. sc_rs_recv_send_shutdown_receive_tcp6(_Config) when is_list(_Config) -> - tc_try(sc_rs_recv_send_shutdown_receive_tcp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> ?TT(?SECS(10)), @@ -33755,7 +34759,7 @@ sc_rs_recv_send_shutdown_receive_tcp6(_Config) when is_list(_Config) -> sc_rs_recv_send_shutdown_receive_tcpL(_Config) when is_list(_Config) -> ?TT(?SECS(10)), - tc_try(sc_rs_recv_send_shutdown_receive_tcpL, + tc_try(?FUNCTION_NAME, fun() -> has_support_unix_domain_socket() end, fun() -> MsgData = ?DATA, @@ -34480,11 +35484,14 @@ sc_rs_tcp_client_connect(Sock, ServerSA) -> sc_rs_tcp_client_send(Sock, Send, Data) -> i("sc_rs_tcp_client_send -> entry"), - case Send(Sock, Data) of + try Send(Sock, Data) of ok -> ok; {error, Reason} -> exit({send, Reason}) + catch + error : notsup = Reason : _ -> + exit({skip, Reason}) end. sc_rs_tcp_client_shutdown(Sock) -> @@ -34568,6 +35575,8 @@ sc_rs_tcp_handler_recv(Recv, Sock, First) -> "~n ~p", [Reason]), ERROR catch + error : notsup = Reason : _ -> + exit({skip, Reason}); C:E:S -> ?SEV_IPRINT("receive failure: " "~n Class: ~p" @@ -34590,7 +35599,7 @@ sc_rs_tcp_handler_announce_ready(Parent, Slogan, Result) -> %% Socket is IPv4. sc_rs_recvmsg_send_shutdown_receive_tcp4(_Config) when is_list(_Config) -> - tc_try(sc_rs_recvmsg_send_shutdown_receive_tcp4, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> ?TT(?SECS(30)), @@ -34626,7 +35635,7 @@ sc_rs_recvmsg_send_shutdown_receive_tcp4(_Config) when is_list(_Config) -> %% Socket is IPv6. sc_rs_recvmsg_send_shutdown_receive_tcp6(_Config) when is_list(_Config) -> - tc_try(sc_rs_recvmsg_send_shutdown_receive_tcp6, + tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> ?TT(?SECS(10)), @@ -34663,7 +35672,7 @@ sc_rs_recvmsg_send_shutdown_receive_tcp6(_Config) when is_list(_Config) -> sc_rs_recvmsg_send_shutdown_receive_tcpL(_Config) when is_list(_Config) -> ?TT(?SECS(10)), - tc_try(sc_rs_recvmsg_send_shutdown_receive_tcpL, + tc_try(?FUNCTION_NAME, fun() -> has_support_unix_domain_socket() end, fun() -> {ok, CWD} = file:get_cwd(), @@ -35587,7 +36596,10 @@ traffic_send_and_recv_counters_tcpL(_Config) when is_list(_Config) -> traffic_sendmsg_and_recvmsg_counters_tcp4(_Config) when is_list(_Config) -> ?TT(?SECS(15)), tc_try(traffic_sendmsg_and_recvmsg_counters_tcp4, - fun() -> has_support_ipv4() end, + fun() -> + is_not_windows(), + has_support_ipv4() + end, fun() -> InitState = #{domain => inet, proto => tcp, @@ -35616,7 +36628,10 @@ traffic_sendmsg_and_recvmsg_counters_tcp4(_Config) when is_list(_Config) -> traffic_sendmsg_and_recvmsg_counters_tcp6(_Config) when is_list(_Config) -> ?TT(?SECS(15)), tc_try(traffic_sendmsg_and_recvmsg_counters_tcp6, - fun() -> has_support_ipv6() end, + fun() -> + is_not_windows(), + has_support_ipv6() + end, fun() -> InitState = #{domain => inet6, proto => tcp, @@ -39199,7 +40214,10 @@ traffic_ping_pong_small_sendmsg_and_recvmsg_tcp4(Config) when is_list(Config) -> Msg = l2b(?TPP_SMALL), Num = ?TPP_NUM(Config, ?TPP_SMALL_NUM), tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_tcp4, - fun() -> has_support_ipv4() end, + fun() -> + is_not_windows(), + has_support_ipv4() + end, fun() -> ?TT(?SECS(20)), InitState = #{domain => inet, @@ -39223,7 +40241,10 @@ traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6(Config) when is_list(Config) -> Msg = l2b(?TPP_SMALL), Num = ?TPP_NUM(Config, ?TPP_SMALL_NUM), tc_try(traffic_ping_pong_small_sendmsg_and_recvmsg_tcp6, - fun() -> has_support_ipv6() end, + fun() -> + is_not_windows(), + has_support_ipv6() + end, fun() -> ?TT(?SECS(20)), InitState = #{domain => inet6, @@ -39271,7 +40292,10 @@ traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp4(Config) when is_list(Config) - Msg = l2b(?TPP_MEDIUM), Num = ?TPP_NUM(Config, ?TPP_MEDIUM_NUM), tc_try(traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp4, - fun() -> has_support_ipv4() end, + fun() -> + is_not_windows(), + has_support_ipv4() + end, fun() -> ?TT(?SECS(30)), InitState = #{domain => inet, @@ -39295,7 +40319,10 @@ traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6(Config) when is_list(Config) - Msg = l2b(?TPP_MEDIUM), Num = ?TPP_NUM(Config, ?TPP_MEDIUM_NUM), tc_try(traffic_ping_pong_medium_sendmsg_and_recvmsg_tcp6, - fun() -> has_support_ipv6() end, + fun() -> + is_not_windows(), + has_support_ipv6() + end, fun() -> ?TT(?SECS(30)), InitState = #{domain => inet6, @@ -39343,7 +40370,11 @@ traffic_ping_pong_large_sendmsg_and_recvmsg_tcp4(Config) when is_list(Config) -> Msg = l2b(?TPP_LARGE), Num = ?TPP_NUM(Config, ?TPP_LARGE_NUM), tc_try(traffic_ping_pong_large_sendmsg_and_recvmsg_tcp4, - fun() -> has_support_ipv4(), traffic_ping_pong_large_sendmsg_and_recvmsg_cond() end, + fun() -> + is_not_windows(), + has_support_ipv4(), + traffic_ping_pong_large_sendmsg_and_recvmsg_cond() + end, fun() -> ?TT(?SECS(60)), InitState = #{domain => inet, @@ -39378,6 +40409,7 @@ traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6(Config) when is_list(Config) -> Num = ?TPP_NUM(Config, ?TPP_LARGE_NUM), tc_try(traffic_ping_pong_large_sendmsg_and_recvmsg_tcp6, fun() -> + is_not_windows(), has_support_ipv6(), traffic_ping_pong_large_sendmsg_and_recvmsg_cond() end, @@ -39661,7 +40693,12 @@ traffic_ping_pong_send_and_receive_tcp(#{msg := Msg} = InitState) -> true -> ok end, - ok = socket:setopt(Sock, otp, rcvbuf, {12, 1024}) + case os:type() of + {win32, nt} -> + ok = socket:setopt(Sock, otp, rcvbuf, 12*1024); + _ -> + ok = socket:setopt(Sock, otp, rcvbuf, {12, 1024}) + end end, traffic_ping_pong_send_and_receive_tcp2(InitState#{buf_init => Fun}). @@ -40178,36 +41215,63 @@ traffic_ping_pong_send_and_receive_tcp2(InitState) -> {CSent, CReceived, _, CStart, CStop} = CRes, STime = tdiff(SStart, SStop), CTime = tdiff(CStart, CStop), - %% Note that the sizes we are counting is only - %% the "data" part of the messages. There is also - %% fixed header for each message, which of course - %% is small for the large messages, but comparatively - %% big for the small messages! - ?SEV_IPRINT("Results: ~w messages exchanged" - "~n Server: ~w msec" - "~n ~.2f msec/message (roundtrip)" - "~n ~.2f messages/msec (roundtrip)" - "~n ~w bytes/msec sent" - "~n ~w bytes/msec received" - "~n Client: ~w msec" - "~n ~.2f msec/message (roundtrip)" - "~n ~.2f messages/msec (roundtrip)" - "~n ~w bytes/msec sent" - "~n ~w bytes/msec received", + ?SEV_IPRINT("process result data:" + "~n Num: ~p" + "~n Server Sent: ~p" + "~n Server Recv: ~p" + "~n Server Start: ~p" + "~n Server Stop: ~p" + "~n Server Time: ~p" + "~n Client Sent: ~p" + "~n Client Recv: ~p" + "~n Client Start: ~p" + "~n Client Stop: ~p" + "~n Client Time: ~p", [Num, + SSent, SReceived, SStart, SStop, STime, - STime / Num, - Num / STime, - SSent div STime, - SReceived div STime, - CTime, - CTime / Num, - Num / CTime, - CSent div CTime, - CReceived div CTime]), - State1 = maps:remove(server_result, State), - State2 = maps:remove(client_result, State1), - {ok, State2} + CSent, CReceived, CStart, CStop, + CTime]), + if + (STime =:= 0) orelse + (CTime =:= 0) -> + {skip, + ?F("Invalid exec time(s): ~w , ~w", + [STime, CTime])}; + true -> + %% Note that the sizes we are counting is + %% only the "data" part of the messages. + %% There is also fixed header for each + %% message, which of course is small for + %% the large messages, but comparatively + %% big for the small messages! + ?SEV_IPRINT( + "Results: ~w messages exchanged" + "~n Server: ~w msec" + "~n ~.2f msec/message (roundtrip)" + "~n ~.2f messages/msec (roundtrip)" + "~n ~w bytes/msec sent" + "~n ~w bytes/msec received" + "~n Client: ~w msec" + "~n ~.2f msec/message (roundtrip)" + "~n ~.2f messages/msec (roundtrip)" + "~n ~w bytes/msec sent" + "~n ~w bytes/msec received", + [Num, + STime, + STime / Num, + Num / STime, + SSent div STime, + SReceived div STime, + CTime, + CTime / Num, + Num / CTime, + CSent div CTime, + CReceived div CTime]), + State1 = maps:remove(server_result, State), + State2 = maps:remove(client_result, State1), + {ok, State2} + end end}, %% Terminations @@ -40582,14 +41646,6 @@ tpp_tcp_send_msg(Sock, Send, Msg, AccSz) when is_binary(Msg) -> %% size_of_iovec([B|IOVec], Sz) -> %% size_of_iovec(IOVec, Sz+size(B)). -mq() -> - mq(self()). - -mq(Pid) when is_pid(Pid) -> - Tag = messages, - {Tag, Msgs} = process_info(Pid, Tag), - Msgs. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -41098,25 +42154,33 @@ traffic_ping_pong_send_and_receive_udp2(InitState) -> num := Num} = State) -> {CSent, CReceived, CStart, CStop} = CRes, CTime = tdiff(CStart, CStop), - %% Note that the sizes we are counting is only - %% the "data" part of the messages. There is also - %% fixed header for each message, which of course - %% is small for the large messages, but comparatively - %% big for the small messages! - ?SEV_IPRINT("Results: ~w messages exchanged" - "~n Client: ~w msec" - "~n ~.2f msec/message (roundtrip)" - "~n ~.2f messages/msec (roundtrip)" - "~n ~w bytes/msec sent" - "~n ~w bytes/msec received", - [Num, - CTime, - CTime / Num, - Num / CTime, - CSent div CTime, - CReceived div CTime]), - State1 = maps:remove(client_result, State), - {ok, State1} + if + (CTime =:= 0) -> + {skip, + ?F("Invalid exec time: ~w ", [CTime])}; + true -> + %% Note that the sizes we are counting is + %% only the "data" part of the messages. + %% There is also fixed header for each + %% message, which of course is small for + %% the large messages, but comparatively + %% big for the small messages! + ?SEV_IPRINT( + "Results: ~w messages exchanged" + "~n Client: ~w msec" + "~n ~.2f msec/message (roundtrip)" + "~n ~.2f messages/msec (roundtrip)" + "~n ~w bytes/msec sent" + "~n ~w bytes/msec received", + [Num, + CTime, + CTime / Num, + Num / CTime, + CSent div CTime, + CReceived div CTime]), + State1 = maps:remove(client_result, State), + {ok, State1} + end end}, %% Terminations @@ -47877,7 +48941,7 @@ otp16359_maccept_tcp(InitState) -> %% This test case is to verify that we do not leak monitors. otp18240_accept_mon_leak_tcp4(Config) when is_list(Config) -> - ?TT(?SECS(10)), + ?TT(?SECS(30)), tc_try(?FUNCTION_NAME, fun() -> has_support_ipv4() end, fun() -> @@ -47892,7 +48956,7 @@ otp18240_accept_mon_leak_tcp4(Config) when is_list(Config) -> %% This test case is to verify that we do not leak monitors. otp18240_accept_mon_leak_tcp6(Config) when is_list(Config) -> - ?TT(?SECS(10)), + ?TT(?SECS(30)), tc_try(?FUNCTION_NAME, fun() -> has_support_ipv6() end, fun() -> @@ -47918,34 +48982,54 @@ otp18240_accept_tcp(#{domain := Domain, otp18240_await_acceptor(Pid, Mon) -> receive - {'DOWN', Mon, process, Pid, Info} -> - i("acceptor terminated: " - "~n ~p", [Info]) + {'DOWN', Mon, process, Pid, ok} -> + i("acceptor successfully terminated"), + ok; + {'DOWN', Mon, process, Pid, {skip, _} = SKIP} -> + i("acceptor successfully terminated"), + exit(SKIP); + {'DOWN', Mon, process, Pid, Info} -> + i("acceptor unexpected termination: " + "~n ~p", [Info]), + exit({unexpected_result, Info}) after 5000 -> - i("acceptor info" + i("acceptor process (~p) info" "~n Refs: ~p" "~n Info: ~p", - [monitored_by(Pid), erlang:process_info(Pid)]), + [Pid, monitored_by(Pid), erlang:process_info(Pid)]), otp18240_await_acceptor(Pid, Mon) end. otp18240_acceptor(Parent, Domain, Proto, NumSocks) -> i("[acceptor] begin with: " + "~n Parent: ~p" "~n Domain: ~p" - "~n Protocol: ~p", [Domain, Proto]), + "~n Protocol: ~p", [Parent, Domain, Proto]), MonitoredBy0 = monitored_by(), - {ok, LSock} = socket:open(Domain, stream, Proto, - #{use_registry => false}), - ok = socket:bind(LSock, #{family => Domain, port => 0, addr => any}), + ?SLEEP(?SECS(5)), + Addr = case ?LIB:which_local_host_info(Domain) of + {ok, #{addr := A}} -> + A; + {error, Reason} -> + exit({skip, Reason}) + end, + {ok, LSock} = socket:open(Domain, stream, Proto, + #{use_registry => false}), + ok = socket:bind(LSock, #{family => Domain, addr => Addr, port => 0}), ok = socket:listen(LSock, NumSocks), + ?SLEEP(?SECS(5)), MonitoredBy1 = monitored_by(), - [LSockMon] = MonitoredBy1 -- MonitoredBy0, i("[acceptor]: listen socket created" - "~n Montored By before listen socket: ~p" - "~n Montored By after listen socket: ~p" - "~n Listen Socket Monitor: ~p" - "~n Listen Socket info: ~p", - [MonitoredBy0, MonitoredBy1, LSockMon, socket:info(LSock)]), + "~n 'Montored By' before listen socket: ~p" + "~n 'Montored By' after listen socket: ~p", + [MonitoredBy0, MonitoredBy1]), + + [LSockMon] = MonitoredBy1 -- MonitoredBy0, + + i("[acceptor]: " + "~n Listen Socket Monitor: ~p" + "~n Listen Socket info: ~p", + [LSockMon, socket:info(LSock)]), {ok, #{port := Port}} = socket:sockname(LSock), @@ -47953,7 +49037,7 @@ otp18240_acceptor(Parent, Domain, Proto, NumSocks) -> _Clients = [spawn_link(fun() -> otp18240_client(CID, Domain, Proto, - Port) + Addr, Port) end) || CID <- lists:seq(1, NumSocks)], i("[acceptor] accept ~w connections", [NumSocks]), @@ -47987,26 +49071,49 @@ otp18240_acceptor(Parent, Domain, Proto, NumSocks) -> end. -otp18240_client(ID, Domain, Proto, PortNo) -> +otp18240_client(ID, Domain, Proto, Addr, PortNo) -> i("[connector ~w] try create connector socket", [ID]), {ok, Sock} = socket:open(Domain, stream, Proto, #{use_registry => false}), - ok = socket:bind(Sock, #{family => Domain, port => 0, addr => any}), + ok = socket:bind(Sock, #{family => Domain, addr => Addr, port => 0}), %% ok = socket:setopt(Sock, otp, debug, true), i("[connector ~w] try connect", [ID]), - ok = socket:connect(Sock, #{family => Domain, addr => any, port => PortNo}), - i("[connector ~w] connected - now try recv", [ID]), - case socket:recv(Sock) of - {ok, Data} -> - i("[connector ~w] received unexpected data: " - "~n ~p", [ID, Data]), - (catch socket:close(Sock)), - exit('unexpected data'); - {error, closed} -> - i("[connector ~w] expected socket close", [ID]); - {error, Reason} -> - i("[connector ~w] unexpected error when reading: " - "~n ~p", [ID, Reason]), - (catch socket:close(Sock)) + case socket:connect(Sock, + #{family => Domain, addr => Addr, port => PortNo}) of + ok -> + i("[connector ~w] connected - now try recv", [ID]), + case socket:recv(Sock) of + {ok, Data} -> + i("[connector ~w] received unexpected data: " + "~n ~p", [ID, Data]), + (catch socket:close(Sock)), + exit('unexpected data'); + {error, closed} -> + i("[connector ~w] expected socket close", [ID]); + {error, Reason} -> + i("[connector ~w] unexpected error when reading: " + "~n ~p", [ID, Reason]), + (catch socket:close(Sock)) + end; + {error, {completion_status, #{info := invalid_netname = R} = Reason}} -> + i("[connector ~w] failed connecting: " + "~n ~p", [ID, Reason]), + (catch socket:close(Sock)), + exit({skip, R}); + {error, {completion_status, invalid_netname = Reason}} -> + i("[connector ~w] failed connecting: " + "~n ~p", [ID, Reason]), + (catch socket:close(Sock)), + exit({skip, Reason}); + {error, enetunreach = Reason} -> + i("[connector ~w] failed connecting: " + "~n ~p", [ID, Reason]), + (catch socket:close(Sock)), + exit({skip, Reason}); + + {error, Reason} -> + i("[connector ~w] failed connecting: " + "~n ~p", [ID, Reason]), + (catch socket:close(Sock)) end, i("[connector ~w] done", [ID]), ok. @@ -48477,11 +49584,19 @@ is_not_netbsd() -> is_not_darwin() -> is_not_platform(darwin, "Darwin"). +is_not_windows() -> + case os:type() of + {win32, nt} -> + skip("This does not work on Windows"); + _ -> + ok + end. + is_not_platform(Platform, PlatformStr) when is_atom(Platform) andalso is_list(PlatformStr) -> case os:type() of - {unix, Platform} -> - skip("This does not work on " ++ PlatformStr); + {unix, Platform} -> + skip("This does not work on " ++ PlatformStr); _ -> ok end. @@ -48859,6 +49974,16 @@ start_node(Name, Timeout) when is_integer(Timeout) andalso (Timeout > 0) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +mq() -> + mq(self()). + +mq(Pid) when is_pid(Pid) -> + {messages, MQ} = process_info(Pid, messages), + MQ. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + nowait(Config) -> case lists:member({select_handle, true}, Config) of true -> diff --git a/lib/kernel/test/socket_test_evaluator.erl b/lib/kernel/test/socket_test_evaluator.erl index c2bd9d44b8..49b529461f 100644 --- a/lib/kernel/test/socket_test_evaluator.erl +++ b/lib/kernel/test/socket_test_evaluator.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2022. All Rights Reserved. +%% Copyright Ericsson AB 2018-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -134,6 +134,11 @@ loop(ID, [#{desc := Desc, "~n ~p", [ID, Reason]), exit({command_failed, ID, Reason, State}) catch + error:notsup = Reason:Stack -> + ?SEV_IPRINT("command ~w skip: " + "~n ~p" + "~n ~p", [ID, Reason, Stack]), + exit({skip, Reason}); C:{skip, command} = E:_ when ((C =:= throw) orelse (C =:= exit)) -> %% Secondary skip exit(E); @@ -176,14 +181,14 @@ await_finish(Evs, OK, Fails) -> %% The evaluator can skip the test case: {'DOWN', _MRef, process, Pid, {skip, Reason}} -> - %% ?SEV_IPRINT("await_finish -> skip (down) received: " - %% "~n Pid: ~p" - %% "~n Reason: ~p", [Pid, Reason]), + ?SEV_IPRINT("await_finish -> skip (down) received: " + "~n Pid: ~p" + "~n Reason: ~p", [Pid, Reason]), await_finish_skip(Pid, Reason, Evs, OK); {'EXIT', Pid, {skip, Reason}} -> - %% ?SEV_IPRINT("await_finish -> skip (exit) received: " - %% "~n Pid: ~p" - %% "~n Reason: ~p", [Pid, Reason]), + ?SEV_IPRINT("await_finish -> skip (exit) received: " + "~n Pid: ~p" + "~n Reason: ~p", [Pid, Reason]), await_finish_skip(Pid, Reason, Evs, OK); %% Evaluator failed @@ -242,7 +247,9 @@ await_finish_skip(Pid, Reason, Evs, OK) -> end, Evs end, + ?SEV_IPRINT("ensure (~w) evaluator(s) are terminated", [length(Evs)]), await_evs_terminated(Evs2), + ?SEV_IPRINT("issue skip"), ?LIB:skip(Reason). await_evs_terminated(Evs) -> @@ -576,7 +583,7 @@ await(ExpPid, Name, Announcement, Slogan, OtherPids) {'DOWN', _, process, Pid, {skip, SkipReason}} when (Pid =:= ExpPid) -> iprint("Unexpected SKIP from ~w (~p): " "~n ~p", [Name, Pid, SkipReason]), - ?LIB:skip({Name, SkipReason}); + ?LIB:skip(SkipReason); {'DOWN', _, process, Pid, Reason} when (Pid =:= ExpPid) -> eprint("Unexpected DOWN from ~w (~p): " "~n ~p", [Name, Pid, Reason]), @@ -590,10 +597,16 @@ await(ExpPid, Name, Announcement, Slogan, OtherPids) "~n OtherPids: " "~n ~p", [OtherPid, Reason, OtherPids]), await(ExpPid, Name, Announcement, Slogan, OtherPids); + {skip, SkipName, SkipReason} -> + iprint("Unexpected other SKIP from ~w (~p): " + "~n ~p", [SkipName, OtherPid, SkipReason]), + ?LIB:skip(SkipReason); {error, _} = ERROR -> ERROR end - after infinity -> % For easy debugging, just change to some valid time (5000) + + %% For easy debugging, just change to some valid time (5000) + after infinity -> iprint("await -> timeout for msg from ~p (~w): " "~n Announcement: ~p" "~n Slogan: ~p" @@ -613,9 +626,14 @@ pi(Pid, Item) -> check_down(Pid, DownReason, Pids) -> case lists:keysearch(Pid, 2, Pids) of {value, {Name, _}} -> - eprint("Unexpected DOWN from ~w (~p): " - "~n ~p", [Name, Pid, DownReason]), - {error, {unexpected_exit, Name, DownReason}}; + case DownReason of + {skip, Reason} -> + {skip, Name, Reason}; + _ -> + eprint("Unexpected DOWN from ~w (~p): " + "~n ~p", [Name, Pid, DownReason]), + {error, {unexpected_exit, Name, DownReason}} + end; false -> ok end. diff --git a/lib/kernel/test/socket_test_lib.erl b/lib/kernel/test/socket_test_lib.erl index e7028dab3b..da36943461 100644 --- a/lib/kernel/test/socket_test_lib.erl +++ b/lib/kernel/test/socket_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2022. All Rights Reserved. +%% Copyright Ericsson AB 2018-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -133,73 +133,79 @@ has_support_ipv4() -> end. has_support_ipv6() -> - case socket:is_supported(ipv6) of - true -> - ok; - false -> - skip("IPv6 Not Supported") - end, - Domain = inet6, - LocalAddr = - case which_local_addr(Domain) of - {ok, Addr} -> - Addr; - {error, R1} -> - skip(f("Local Address eval failed: ~p", [R1])) - end, - ServerSock = - case socket:open(Domain, dgram, udp) of - {ok, SS} -> - SS; - {error, R2} -> - skip(f("(server) socket open failed: ~p", [R2])) - end, - LocalSA = #{family => Domain, addr => LocalAddr}, - ServerPort = - case socket:bind(ServerSock, LocalSA) of - ok -> - {ok, #{port := P1}} = socket:sockname(ServerSock), - P1; - {error, R3} -> - socket:close(ServerSock), - skip(f("(server) socket bind failed: ~p", [R3])) - end, - ServerSA = LocalSA#{port => ServerPort}, - ClientSock = - case socket:open(Domain, dgram, udp) of - {ok, CS} -> - CS; - {error, R4} -> - skip(f("(client) socket open failed: ~p", [R4])) - end, - case socket:bind(ClientSock, LocalSA) of - ok -> - ok; - {error, R5} -> - socket:close(ServerSock), - socket:close(ClientSock), - skip(f("(client) socket bind failed: ~p", [R5])) - end, - case socket:sendto(ClientSock, <<"hejsan">>, ServerSA) of - ok -> - ok; - {error, R6} -> - socket:close(ServerSock), - socket:close(ClientSock), - skip(f("failed socket sendto test: ~p", [R6])) - end, - case socket:recvfrom(ServerSock) of - {ok, {_, <<"hejsan">>}} -> - socket:close(ServerSock), - socket:close(ClientSock), - ok; - {error, R7} -> - socket:close(ServerSock), - socket:close(ClientSock), - skip(f("failed socket recvfrom test: ~p", [R7])) - end. - - + try + begin + case socket:is_supported(ipv6) of + true -> + ok; + false -> + skip("IPv6 Not Supported") + end, + Domain = inet6, + LocalAddr = + case which_local_addr(Domain) of + {ok, Addr} -> + Addr; + {error, R1} -> + skip(f("Local Address eval failed: ~p", [R1])) + end, + ServerSock = + case socket:open(Domain, dgram, udp) of + {ok, SS} -> + SS; + {error, R2} -> + skip(f("(server) socket open failed: ~p", [R2])) + end, + LocalSA = #{family => Domain, addr => LocalAddr}, + ServerPort = + case socket:bind(ServerSock, LocalSA) of + ok -> + {ok, #{port := P1}} = socket:sockname(ServerSock), + P1; + {error, R3} -> + socket:close(ServerSock), + skip(f("(server) socket bind failed: ~p", [R3])) + end, + ServerSA = LocalSA#{port => ServerPort}, + ClientSock = + case socket:open(Domain, dgram, udp) of + {ok, CS} -> + CS; + {error, R4} -> + skip(f("(client) socket open failed: ~p", [R4])) + end, + case socket:bind(ClientSock, LocalSA) of + ok -> + ok; + {error, R5} -> + socket:close(ServerSock), + socket:close(ClientSock), + skip(f("(client) socket bind failed: ~p", [R5])) + end, + case socket:sendto(ClientSock, <<"hejsan">>, ServerSA) of + ok -> + ok; + {error, R6} -> + socket:close(ServerSock), + socket:close(ClientSock), + skip(f("failed socket sendto test: ~p", [R6])) + end, + case socket:recvfrom(ServerSock) of + {ok, {_, <<"hejsan">>}} -> + socket:close(ServerSock), + socket:close(ClientSock), + ok; + {error, R7} -> + socket:close(ServerSock), + socket:close(ClientSock), + skip(f("failed socket recvfrom test: ~p", [R7])) + end + end + catch + error : notsup -> + skip("Not supported: socket") + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -312,7 +318,7 @@ not_yet_implemented() -> skip("not yet implemented"). skip(Reason) -> - throw({skip, Reason}). + exit({skip, Reason}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/kernel/test/socket_test_ttest_tcp_socket.erl b/lib/kernel/test/socket_test_ttest_tcp_socket.erl index 07be4740e6..7a084a445d 100644 --- a/lib/kernel/test/socket_test_ttest_tcp_socket.erl +++ b/lib/kernel/test/socket_test_ttest_tcp_socket.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2018-2022. All Rights Reserved. +%% Copyright Ericsson AB 2018-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -55,6 +55,15 @@ Reason}). +-define(SELECT_INFO(TAG, REF), {select_info, TAG, REF}). +-define(COMPLETION_INFO(TAG, REF), {completion_info, TAG, REF}). + +-define(SELECT_MSG(SOCK, REF), + {'$socket', (SOCK), select, (REF)}). +-define(COMPLETION_MSG(SOCK, REF, STATUS), + {'$socket', (SOCK), completion, {(REF), (STATUS)}}). + + %% ========================================================================== %% This does not really work. Its just a placeholder for the time being... @@ -371,8 +380,9 @@ reader_init(ControllingProcess, Sock, Async, Active, Method) reader_loop(#{ctrl_proc => ControllingProcess, ctrl_proc_mref => MRef, async => Async, - select_info => undefined, - select_num => 0, % Count the number of select messages + asynch_info => undefined, + %% Count the number of select|completion messages + asynch_num => 0, active => Active, sock => Sock, method => Method}). @@ -452,13 +462,16 @@ reader_loop(#{active := once, end; reader_loop(#{active := once, async := true, - select_info := undefined, + asynch_info := undefined, sock := Sock, method := Method, ctrl_proc := Pid} = State) -> case do_recv(Method, Sock, nowait) of {select, SelectInfo} -> - reader_loop(State#{select_info => SelectInfo}); + reader_loop(State#{asynch_info => SelectInfo}); + {completion, CompletionInfo} -> + reader_loop(State#{asynch_info => CompletionInfo}); + {ok, Data} -> Pid ! ?DATA_MSG(Sock, Method, Data), reader_loop(State#{active => false}); @@ -473,11 +486,17 @@ reader_loop(#{active := once, end; reader_loop(#{active := once, async := true, - select_info := {select_info, _, Ref}, - select_num := N, + asynch_info := AsynchInfo, + asynch_num := N, sock := Sock, method := Method, - ctrl_proc := Pid} = State) -> + ctrl_proc := Pid} = State) when (AsynchInfo =/= undefined) -> + Ref = case AsynchInfo of + ?SELECT_INFO(_, SR) -> + SR; + ?COMPLETION_INFO(_, CR) -> + CR + end, receive {?MODULE, stop} -> reader_exit(State, stop); @@ -501,18 +520,42 @@ reader_loop(#{active := once, reader_loop(State) end; - {'$socket', Sock, select, Ref} -> + ?SELECT_MSG(Sock, Ref) -> case do_recv(Method, Sock, nowait) of {ok, Data} when is_binary(Data) -> Pid ! ?DATA_MSG(Sock, Method, Data), reader_loop(State#{active => false, - select_info => undefined, - select_num => N+1}); - + asynch_info => undefined, + asynch_num => N+1}); + {error, closed} = E1 -> Pid ! ?CLOSED_MSG(Sock, Method), reader_exit(State, E1); - + + {error, Reason} = E2 -> + Pid ! ?ERROR_MSG(Sock, Method, Reason), + reader_exit(State, E2) + end; + + ?COMPLETION_MSG(Sock, Ref, Result) -> + %% Note that *Windows* does not support sendmsg/recvmsg + %% but we assume we can get it. Just to be future proof + case Result of + {ok, Data} when is_binary(Data) -> + Pid ! ?DATA_MSG(Sock, Method, Data), + reader_loop(State#{active => false, + asynch_info => undefined, + asynch_num => N+1}); + {ok, #{iov := [Data]}} when is_binary(Data) -> + Pid ! ?DATA_MSG(Sock, Method, Data), + reader_loop(State#{active => false, + asynch_info => undefined, + asynch_num => N+1}); + + {error, closed} = E1 -> + Pid ! ?CLOSED_MSG(Sock, Method), + reader_exit(State, E1); + {error, Reason} = E2 -> Pid ! ?ERROR_MSG(Sock, Method, Reason), reader_exit(State, E2) @@ -566,13 +609,16 @@ reader_loop(#{active := true, end; reader_loop(#{active := true, async := true, - select_info := undefined, + asynch_info := undefined, sock := Sock, method := Method, ctrl_proc := Pid} = State) -> case do_recv(Method, Sock) of {select, SelectInfo} -> - reader_loop(State#{select_info => SelectInfo}); + reader_loop(State#{asynch_info => SelectInfo}); + {completion, CompletionInfo} -> + reader_loop(State#{asynch_info => CompletionInfo}); + {ok, Data} -> Pid ! ?DATA_MSG(Sock, Method, Data), reader_loop(State); @@ -587,11 +633,17 @@ reader_loop(#{active := true, end; reader_loop(#{active := true, async := true, - select_info := {select_info, _, Ref}, - select_num := N, + asynch_info := AsynchInfo, + asynch_num := N, sock := Sock, method := Method, - ctrl_proc := Pid} = State) -> + ctrl_proc := Pid} = State) when (AsynchInfo =/= undefined) -> + Ref = case AsynchInfo of + ?SELECT_INFO(_, SR) -> + SR; + ?COMPLETION_INFO(_, CR) -> + CR + end, receive {?MODULE, stop} -> reader_exit(State, stop); @@ -615,12 +667,12 @@ reader_loop(#{active := true, reader_loop(State) end; - {'$socket', Sock, select, Ref} -> + ?SELECT_MSG(Sock, Ref) -> case do_recv(Method, Sock, nowait) of {ok, Data} when is_binary(Data) -> Pid ! ?DATA_MSG(Sock, Method, Data), - reader_loop(State#{select_info => undefined, - select_num => N+1}); + reader_loop(State#{asynch_info => undefined, + asynch_num => N+1}); {error, closed} = E1 -> Pid ! ?CLOSED_MSG(Sock, Method), @@ -629,6 +681,30 @@ reader_loop(#{active := true, {error, Reason} = E2 -> Pid ! ?ERROR_MSG(Sock, Method, Reason), reader_exit(State, E2) + end; + + ?COMPLETION_MSG(Sock, Ref, Result) -> + %% Note that *Windows* does not support sendmsg/recvmsg + %% but we assume we can get it. Just to be future proof + case Result of + {ok, Data} when is_binary(Data) -> + Pid ! ?DATA_MSG(Sock, Method, Data), + reader_loop(State#{active => false, + asynch_info => undefined, + asynch_num => N+1}); + {ok, #{iov := [Data]}} when is_binary(Data) -> + Pid ! ?DATA_MSG(Sock, Method, Data), + reader_loop(State#{active => false, + asynch_info => undefined, + asynch_num => N+1}); + + {error, closed} = E1 -> + Pid ! ?CLOSED_MSG(Sock, Method), + reader_exit(State, E1); + + {error, Reason} = E2 -> + Pid ! ?ERROR_MSG(Sock, Method, Reason), + reader_exit(State, E2) end end. @@ -644,6 +720,8 @@ do_recv(msg, Sock, Timeout) -> {ok, Bin}; {select, _} = SELECT -> SELECT; + {completion, _} = COMPLETION -> + COMPLETION; {error, _} = ERROR -> ERROR end. @@ -654,55 +732,55 @@ reader_exit(#{async := false, active := Active}, stop) -> exit(normal); reader_exit(#{async := true, active := Active, - select_info := SelectInfo, - select_num := N}, stop) -> + asynch_info := AsynchInfo, + asynch_num := N}, stop) -> vp("reader stopped when active: ~w" - "~n Current select info: ~p" - "~n Number of select messages: ~p", [Active, SelectInfo, N]), + "~n Current asynch info: ~p" + "~n Number of asynch messages: ~p", [Active, AsynchInfo, N]), exit(normal); reader_exit(#{async := false, active := Active}, {ctrl_exit, normal}) -> vp("reader ctrl exit when active: ~w", [Active]), exit(normal); reader_exit(#{async := true, active := Active, - select_info := SelectInfo, - select_num := N}, {ctrl_exit, normal}) -> + asynch_info := AsynchInfo, + asynch_num := N}, {ctrl_exit, normal}) -> vp("reader ctrl exit when active: ~w" - "~n Current select info: ~p" - "~n Number of select messages: ~p", [Active, SelectInfo, N]), + "~n Current asynch info: ~p" + "~n Number of asynch messages: ~p", [Active, AsynchInfo, N]), exit(normal); reader_exit(#{async := false, active := Active}, {ctrl_exit, Reason}) -> vp("reader exit when ctrl crash when active: ~w", [Active]), exit({controlling_process, Reason}); reader_exit(#{async := true, active := Active, - select_info := SelectInfo, - select_num := N}, {ctrl_exit, Reason}) -> + asynch_info := AsynchInfo, + asynch_num := N}, {ctrl_exit, Reason}) -> vp("reader exit when ctrl crash when active: ~w" - "~n Current select info: ~p" - "~n Number of select messages: ~p", [Active, SelectInfo, N]), + "~n Current asynch info: ~p" + "~n Number of asynch messages: ~p", [Active, AsynchInfo, N]), exit({controlling_process, Reason}); reader_exit(#{async := false, active := Active}, {error, closed}) -> vp("reader exit when socket closed when active: ~w", [Active]), exit(normal); reader_exit(#{async := true, active := Active, - select_info := SelectInfo, - select_num := N}, {error, closed}) -> + asynch_info := AsynchInfo, + asynch_num := N}, {error, closed}) -> vp("reader exit when socket closed when active: ~w " - "~n Current select info: ~p" - "~n Number of select messages: ~p", [Active, SelectInfo, N]), + "~n Current asynch info: ~p" + "~n Number of asynch messages: ~p", [Active, AsynchInfo, N]), exit(normal); reader_exit(#{async := false, active := Active}, {error, Reason}) -> vp("reader exit when socket error when active: ~w", [Active]), exit(Reason); reader_exit(#{async := true, active := Active, - select_info := SelectInfo, - select_num := N}, {error, Reason}) -> + asynch_info := AsynchInfo, + asynch_num := N}, {error, Reason}) -> vp("reader exit when socket error when active: ~w: " - "~n Current select info: ~p" - "~n Number of select messages: ~p", [Active, SelectInfo, N]), + "~n Current asynch info: ~p" + "~n Number of asynch messages: ~p", [Active, AsynchInfo, N]), exit(Reason). diff --git a/lib/kernel/test/standard_error_SUITE.erl b/lib/kernel/test/standard_error_SUITE.erl index 1d9026dc58..792d086847 100644 --- a/lib/kernel/test/standard_error_SUITE.erl +++ b/lib/kernel/test/standard_error_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014-2016. All Rights Reserved. +%% Copyright Ericsson AB 2014-2023. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,8 +34,10 @@ badarg(Config) when is_list(Config) -> true = erlang:is_process_alive(whereis(standard_error)), ok. +%% Check that standard_out and standard_error have the same encoding getopts(Config) when is_list(Config) -> - [{encoding,latin1}] = io:getopts(standard_error), + Encoding = proplists:get_value(encoding, io:getopts(user)), + Encoding = proplists:get_value(encoding, io:getopts(standard_error)), ok. %% Test that writing a lot of output to standard_error does not cause the |