Skip to content

Commit

Permalink
erl_call: Add -R option for dynamic node name
Browse files Browse the repository at this point in the history
  • Loading branch information
sverker committed Mar 19, 2020
1 parent ff7d384 commit 3a57ed2
Show file tree
Hide file tree
Showing 3 changed files with 93 additions and 23 deletions.
13 changes: 10 additions & 3 deletions lib/erl_interface/doc/src/erl_call_cmd.xml
Original file line number Diff line number Diff line change
Expand Up @@ -82,7 +82,7 @@
<item>
<p>(One of <c>-n</c>, <c>-name</c>, <c>-sname</c> or
<c>-address</c> is required.) <c>Hostname</c> is the
hostname of the machine that is running the node that
hostname of the machine that is running the peer node that
<c>erl_call</c> shall communicate with. The default
hostname is the hostname of the local machine. <c>Port</c>
is the port number of the node that <c>erl_call</c> shall
Expand Down Expand Up @@ -137,7 +137,7 @@
<item>
<p>(One of <c>-n</c>, <c>-name</c>, <c>-sname</c> or
<c>-address</c> is required.)
<c>Node</c> is the name of the node to be
<c>Node</c> is the name of the peer node to be
started or communicated with. It is assumed that
<c>Node</c> is started with
<c>erl -name</c>, which means that fully
Expand All @@ -155,6 +155,13 @@
<p>(<em>Optional.</em>) Generates a random name of the hidden node
that <c>erl_call</c> represents.</p>
</item>
<tag><c>-R</c></tag>
<item>
<p>(<em>Optional.</em>) Request a dynamic random name, of the hidden node
that <c>erl_call</c> represents, from the peer node. Supported
since OTP 23. Prefer <c>-R</c> over <c>-r</c> when doing repeated
requests toward the same peer node.</p>
</item>
<tag><c>-s</c></tag>
<item>
<p>(<em>Optional.</em>) Starts a distributed Erlang node if
Expand All @@ -169,7 +176,7 @@
<item>
<p>(One of <c>-n</c>, <c>-name</c>, <c>-sname</c> or
<c>-address</c> is required.)
<c>Node</c> is the name of the node to be started
<c>Node</c> is the name of the peer node to be started
or communicated with. It is assumed that <c>Node</c>
is started with <c>erl -sname</c>, which means that
short node names are used. If option <c>-s</c> is
Expand Down
30 changes: 18 additions & 12 deletions lib/erl_interface/src/prog/erl_call.c
Original file line number Diff line number Diff line change
Expand Up @@ -71,18 +71,14 @@
#include "ei_resolve.h"
#include "erl_start.h" /* FIXME remove dependency */

/*
* Some nice global variables
* (I don't think "nice" is the right word actually... -gordon)
*/
/* FIXME problem for threaded ? */

struct call_flags {
int startp;
int cookiep;
int modp;
int evalp;
int randomp;
int dynamic_name;
int use_long_name; /* indicates if -name was used, else -sname or -n */
int debugp;
int verbosep;
Expand Down Expand Up @@ -202,6 +198,9 @@ int main(int argc, char *argv[])
case 'r':
flags.randomp = 1;
break;
case 'R':
flags.dynamic_name = 1;
break;
case 'e':
flags.evalp = 1;
break;
Expand Down Expand Up @@ -299,7 +298,7 @@ int main(int argc, char *argv[])

creation = time(NULL) + 1; /* "random" */

if (flags.hidden == NULL) {
if (flags.hidden == NULL && !flags.dynamic_name) {
/* As default we are c17@gethostname */
i = flags.randomp ? (time(NULL) % 997) : 17;
flags.hidden = (char *) ei_chk_malloc(10 + 2 ); /* c17 or cXYZ */
Expand All @@ -309,8 +308,9 @@ int main(int argc, char *argv[])
{
/* A name for our hidden node was specified */
char h_hostname[EI_MAXHOSTNAMELEN+1];
char h_nodename[MAXNODELEN+1];
char *h_alivename=flags.hidden;
char h_nodename_buf[MAXNODELEN+1];
char *h_nodename = h_nodename_buf;
char *h_alivename = flags.hidden;
struct in_addr h_ipadr;
char* ct;

Expand All @@ -330,11 +330,17 @@ int main(int argc, char *argv[])
strncpy(h_hostname, hp->h_name, EI_MAXHOSTNAMELEN);
h_hostname[EI_MAXHOSTNAMELEN] = '\0';
memcpy(&h_ipadr.s_addr, *hp->h_addr_list, sizeof(struct in_addr));
if (strlen(h_alivename) + strlen(h_hostname) + 2 > sizeof(h_nodename)) {
fprintf(stderr,"erl_call: hostname too long: %s\n", h_hostname);
exit(1);
if (h_alivename) {
if (strlen(h_alivename) + strlen(h_hostname) + 2 > sizeof(h_nodename_buf)) {
fprintf(stderr,"erl_call: hostname too long: %s\n", h_hostname);
exit(1);
}
sprintf(h_nodename, "%s@%s", h_alivename, h_hostname);
}
else {
/* dynamic node name */
h_nodename = NULL;
}
sprintf(h_nodename, "%s@%s", h_alivename, h_hostname);

if (ei_connect_xinit(&ec, h_hostname, h_alivename, h_nodename,
(Erl_IpAddr)&h_ipadr, flags.cookie,
Expand Down
73 changes: 65 additions & 8 deletions lib/erl_interface/test/erl_call_SUITE.erl
Original file line number Diff line number Diff line change
Expand Up @@ -23,10 +23,13 @@

-include_lib("common_test/include/ct.hrl").

-export([all/0, smoke/1, test_connect_to_host_port/1]).
-export([all/0, smoke/1,
random_cnode_name/1,
test_connect_to_host_port/1]).

all() ->
[smoke,
random_cnode_name,
test_connect_to_host_port].

smoke(Config) when is_list(Config) ->
Expand All @@ -44,10 +47,55 @@ smoke(Config) when is_list(Config) ->
ok.


random_cnode_name(Config) when is_list(Config) ->
Name = atom_to_list(?MODULE)
++ "-"
++ integer_to_list(erlang:system_time(microsecond)),

try
CNodeName = start_node_and_get_c_node_name(Name, []),
[_, Hostname] = string:lexemes(atom_to_list(node()), "@"),
DefaultName = list_to_atom("c17@" ++ Hostname),
check_eq(CNodeName, DefaultName),

CNodeName_r = start_node_and_get_c_node_name(Name, ["-r"]),
[CNode_r, Hostname] = string:lexemes(atom_to_list(CNodeName_r), "@"),
check_regex(CNode_r, "^c[0-9]+$"),

CNodeName_R = start_node_and_get_c_node_name(Name, ["-R"]),
[CNode_R, Hostname] = string:lexemes(atom_to_list(CNodeName_R), "@"),
check_regex(CNode_R, "^[0-9A-Z]+$"),

%% we should get the same recycled node name again
CNodeName_R2 = start_node_and_get_c_node_name(Name, ["-R"]),
check_eq(CNodeName_R, CNodeName_R2)

after
halt_node(Name)
end,
ok.

check_eq(X,Y) ->
{Y,X} = {X,Y}.

check_regex(String, Regex) ->
{ok, RE} = re:compile(Regex),
{{match,[{0,_}]}, _} = {re:run(String, RE), String},
true.

test_connect_to_host_port(Config) when is_list(Config) ->
Name = atom_to_list(?MODULE)
++ "-"
++ integer_to_list(erlang:system_time(microsecond)),
try
test_connect_to_host_port_do(Name)
after
halt_node(Name)
end,
ok.


test_connect_to_host_port_do(Name) ->
Port = start_node_and_get_port(Name),
AddressCaller =
fun(Address) ->
Expand All @@ -65,7 +113,6 @@ test_connect_to_host_port(Config) when is_list(Config) ->
nomatch -> ct:fail("Incorrect error message");
_ -> ok
end,
halt_node(Name),
ok.

%
Expand All @@ -81,19 +128,29 @@ halt_node(Name) ->
pong = net_adm:ping(NodeName),
rpc:cast(NodeName, erlang, halt, []).


start_node_and_get_node_name(Name) ->
string:trim(start_node_and_apply(Name, "erlang node", []),
both,
"'").

start_node_and_get_c_node_name(Name, Opts) ->
Str = start_node_and_apply(Name, "erlang nodes [hidden]", Opts),
{ok, [{'[',_}, {atom, _, CNode}, {']',_}], _} = erl_scan:string(Str),
CNode.

start_node_and_apply(Name, MfaStr, Opts) ->
NameSwitch = case net_kernel:longnames() of
true ->
"-name";
false ->
"-sname"
end,
string:trim(get_erl_call_result(["-s",
NameSwitch,
Name, "-a",
"erlang node"]),
both,
"'").
get_erl_call_result(Opts ++
["-s",
NameSwitch,
Name, "-a",
MfaStr]).

start_node_and_get_port(Name) ->
start_node_and_get_node_name(Name),
Expand Down

0 comments on commit 3a57ed2

Please sign in to comment.