%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
%%
%% http://www.apache.org/licenses/LICENSE-2.0
%%
%% Unless required by applicable law or agreed to in writing, software
%% distributed under the License is distributed on an "AS IS" BASIS,
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
%% %CopyrightEnd%
%%
-module(diameter_util).
%%
%% Utility functions.
%%
%% generic
-export([name/1,
consult/2,
run/1,
fold/3,
foldl/3,
scramble/1,
unique_string/0,
have_sctp/0,
ip4/0]).
%% diameter-specific
-export([lport/2,
listen/2, listen/3,
connect/3, connect/4,
disconnect/4,
info/0]).
%% common_test-specific
-export([write_priv/3,
read_priv/2,
map_priv/3]).
-define(L, atom_to_list).
%% ---------------------------------------------------------------------------
%% name/2
%%
%% Contruct and deconstruct lists of atoms as atoms to work around
%% group names in common_test being restricted to atoms.
name(Names)
when is_list(Names) ->
list_to_atom(string:join([atom_to_list(A) || A <- Names], ","));
name(A)
when is_atom(A) ->
[list_to_atom(S) || S <- string:tokens(atom_to_list(A), ",")].
%% ---------------------------------------------------------------------------
%% consult/2
%%
%% Extract info from the app/appup file (presumably) of the named
%% application.
consult(Name, Suf)
when is_atom(Name), is_atom(Suf) ->
case code:lib_dir(Name, ebin) of
{error = E, Reason} ->
{E, {Name, Reason}};
Dir ->
consult(filename:join([Dir, ?L(Name) ++ "." ++ ?L(Suf)]))
end.
consult(Path) ->
case file:consult(Path) of
{ok, Terms} ->
Terms;
{error, Reason} ->
{error, {Path, Reason}}
end.
%% Name/Path in the return value distinguish the errors and allow for
%% a useful badmatch.
%% ---------------------------------------------------------------------------
%% run/1
%%
%% Evaluate functions in parallel and return a list of those that
%% failed to return. The fun takes a boolean (did the function return
%% or not), the function that was evaluated, the return value or exit
%% reason and the prevailing accumulator.
run(L) ->
fold(fun cons/4, [], L).
cons(true, _, _, Acc) ->
Acc;
cons(false, F, RC, Acc) ->
[{F, RC} | Acc].
%% ---------------------------------------------------------------------------
%% fold/3
%%
%% Parallel fold. Results are folded in the order received.
fold(Fun, Acc0, L)
when is_function(Fun, 4) ->
Ref = make_ref(),
%% Spawn a middleman to collect down messages from processes
%% spawned for each function so as not to assume that all DOWN
%% messages are ours.
MRef = run1([fun fold/4, Ref, Fun, Acc0, L], Ref),
{Ref, RC} = down(MRef),
RC.
fold(Ref, Fun, Acc0, L) ->
recv(run(Ref, L), Ref, Fun, Acc0).
run(Ref, L) ->
[{run1(F, Ref), F} || F <- L].
run1(F, Ref) ->
{_, MRef} = spawn_monitor(fun() -> exit({Ref, eval(F)}) end),
MRef.
recv([], _, _, Acc) ->
Acc;
recv(L, Ref, Fun, Acc) ->
{MRef, R} = down(),
{MRef, F} = lists:keyfind(MRef, 1, L),
recv(lists:keydelete(MRef, 1, L),
Ref,
Fun,
acc(R, Ref, F, Fun, Acc)).
acc({Ref, RC}, Ref, F, Fun, Acc) ->
Fun(true, F, RC, Acc);
acc(Reason, _, F, Fun, Acc) ->
Fun(false, F, Reason, Acc).
down(MRef) ->
receive {'DOWN', MRef, process, _, Reason} -> Reason end.
down() ->
receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end.
%% ---------------------------------------------------------------------------
%% foldl/3
%%
%% Parallel fold. Results are folded in order of the function list.
foldl(Fun, Acc0, L)
when is_function(Fun, 4) ->
Ref = make_ref(),
recvl(run(Ref, L), Ref, Fun, Acc0).
recvl([], _, _, Acc) ->
Acc;
recvl([{MRef, F} | L], Ref, Fun, Acc) ->
R = down(MRef),
recvl(L, Ref, Fun, acc(R, Ref, F, Fun, Acc)).
%% ---------------------------------------------------------------------------
%% scramble/1
%%
%% Sort a list into random order.
scramble(L) ->
[X || {_,X} <- lists:sort([{rand:uniform(), T} || T <- L])].
%% ---------------------------------------------------------------------------
%% unique_string/0
unique_string() ->
integer_to_list(erlang:unique_integer()).
%% ---------------------------------------------------------------------------
%% have_sctp/0
have_sctp() ->
case gen_sctp:open() of
{ok, Sock} ->
RC = gen_sctp:connect(Sock, ip4(), 3868, []),
gen_sctp:close(Sock),
%% Connect has been seen to return eafnosupport on at least
%% one SunOS 10 Sparc host, for reasons unknown.
RC /= {error, eafnosupport};
{error, E} when E == eprotonosupport;
E == esocktnosupport -> %% fail on any other reason
false
end.
%% ---------------------------------------------------------------------------
%% eval/1
%%
%% Evaluate a function in one of a number of forms.
eval({M,[F|A]})
when is_atom(F) ->
apply(M,F,A);
eval({M,F,A}) ->
apply(M,F,A);
eval([F|A])
when is_function(F) ->
apply(F,A);
eval(L)
when is_list(L) ->
run(L);
eval(F)
when is_function(F,0) ->
F().
%% ---------------------------------------------------------------------------
%% write_priv/3
%%
%% Write an arbitrary term to a named file.
write_priv(Config, Name, Term) ->
write(path(Config, Name), Term).
write(Path, Term) ->
ok = file:write_file(Path, term_to_binary(Term)).
%% read_priv/2
%%
%% Read a term from a file.
read_priv(Config, Name) ->
read(path(Config, Name)).
read(Path) ->
{ok, Bin} = file:read_file(Path),
binary_to_term(Bin).
%% map_priv/3
%%
%% Modify a term in a file and return both old and new values.
map_priv(Config, Name, Fun1) ->
map(path(Config, Name), Fun1).
map(Path, Fun1) ->
T0 = read(Path),
T1 = Fun1(T0),
write(Path, T1),
{T0, T1}.
path(Config, Name)
when is_atom(Name) ->
path(Config, ?L(Name));
path(Config, Name) ->
Dir = proplists:get_value(priv_dir, Config),
filename:join([Dir, Name]).
%% ---------------------------------------------------------------------------
%% lport/2
%%
%% Lookup the port number of a tcp/sctp listening transport.
lport(Prot, {Node, Ref}) ->
rpc:call(Node, ?MODULE, lport, [Prot, Ref]);
lport(Prot, Ref) ->
[_] = diameter_reg:wait({'_', listener, {Ref, '_'}}),
[N || M <- tmod(Prot), {listen, N, _} <- M:ports(Ref)].
%% ---------------------------------------------------------------------------
%% listen/2-3
%%
%% Add a listening transport on the loopback address and a free port.
listen(SvcName, Prot) ->
listen(SvcName, Prot, []).
listen(SvcName, Prot, Opts) ->
SvcName = diameter:service_info(SvcName, name), %% assert
Ref = add_transport(SvcName, {listen, opts(Prot, listen) ++ Opts}),
true = transport(SvcName, Ref), %% assert
Ref.
%% ---------------------------------------------------------------------------
%% connect/2-3
%%
%% Add a connecting transport on and connect to a listening transport
%% with the specified reference.
connect(Client, Prot, LRef) ->
connect(Client, Prot, LRef, []).
connect(Client, ProtOpts, LRef, Opts) ->
Prot = head(ProtOpts),
[PortNr] = lport(Prot, LRef),
Client = diameter:service_info(Client, name), %% assert
true = diameter:subscribe(Client),
Ref = add_transport(Client, {connect, opts(ProtOpts, PortNr) ++ Opts}),
true = transport(Client, Ref), %% assert
diameter_lib:for_n(fun(_) -> ok = up(Client, Ref, Prot, PortNr) end,
proplists:get_value(pool_size, Opts, 1)),
Ref.
head([T|_]) ->
T;
head(T) ->
T.
up(Client, Ref, Prot, PortNr) ->
receive
{diameter_event, Client, {up, Ref, _, _, _}} -> ok
after 10000 ->
{Client, Prot, PortNr, process_info(self(), messages)}
end.
transport(SvcName, Ref) ->
[Ref] == [R || [{ref, R} | _] <- diameter:service_info(SvcName, transport),
R == Ref].
%% ---------------------------------------------------------------------------
%% disconnect/4
%%
%% Remove the client transport and expect the server transport to go
%% down.
disconnect(Client, Ref, Server, LRef) ->
true = diameter:subscribe(Server),
ok = diameter:remove_transport(Client, Ref),
receive
{diameter_event, Server, {down, LRef, _, _}} ->
ok
after 10000 ->
{Client, Ref, Server, LRef, process_info(self(), messages)}
end.
%% ---------------------------------------------------------------------------
-define(ADDR, {127,0,0,1}).
add_transport(SvcName, T) ->
{ok, Ref} = diameter:add_transport(SvcName, T),
Ref.
tmod(tcp) ->
[diameter_tcp];
tmod(sctp) ->
[diameter_sctp];
tmod(any) ->
[diameter_sctp, diameter_tcp].
opts([Prot | Opts], T) ->
tmo(T, lists:append([[{transport_module, M}, {transport_config, C ++ Opts}]
|| M <- tmod(Prot),
C <- [buf(M,T) ++ [{ip, addr(M)}, {port, 0}]
++ remote(M,T)]]));
opts(Prot, T) ->
opts([Prot], T).
tmo(listen, Opts) ->
Opts;
tmo(_, Opts) ->
tmo(Opts).
%% Timeout on all but the last alternative.
tmo([_,_] = Opts) ->
Opts;
tmo([M, C | Opts]) ->
{transport_config = K, Cfg} = C,
[M, {K, Cfg, 5000} | tmo(Opts)].
%% Listening SCTP socket need larger-than-default buffers to avoid
%% resends on some platforms (eg. SLES 11).
buf(diameter_sctp, listen) ->
[{recbuf, 1 bsl 16}, {sndbuf, 1 bsl 16}];
buf(_, _) ->
[].
addr(diameter_tcp) ->
{127,0,0,1};
addr(diameter_sctp) ->
ip4().
remote(_, listen) ->
[{accept, M} || M <- [{256,0,0,1}, ["256.0.0.1", ["^.+$"]]]];
remote(Mod, PortNr) ->
[{raddr, addr(Mod)}, {rport, PortNr}].
%% Try to use something other than the loopback address where this
%% address is known to be problematic for gen_sctp.
ip4() ->
try
"sparc-sun-solaris2.10" = erlang:system_info(system_architecture),
{ok, List} = inet:getifaddrs(),
hd(lists:flatmap(fun ip4/1, List))
catch
error:_ ->
?ADDR
end.
ip4({_, Opts}) ->
{flags, Flags} = lists:keyfind(flags, 1, Opts),
[A || lists:member(up, Flags),
not lists:member(loopback, Flags),
{addr, {_,_,_,_} = A} <- Opts].
%% ---------------------------------------------------------------------------
%% info/0
info() ->
[_|_] = Svcs = diameter:services(), %% assert
run([[fun info/1, S] || S <- Svcs]).
info(S) ->
[_|_] = Keys = diameter:service_info(S, keys),
[] = run([[fun info/2, K, S] || K <- Keys]).
info(Key, SvcName) ->
[{Key, _}] = diameter:service_info(SvcName, [Key]).
