Initial commit of the diameter application.

The application provides an implementation of the Diameter protocol
as defined in RFC 3588.

1 files changed, 551 insertions, 0 deletions

diff --git a/lib/diameter/test/diameter_test_server.erl b/lib/diameter/test/diameter_test_server.erl
new file mode 100644
index 0000000000..e2ff73fb8e
--- /dev/null
+++ b/lib/diameter/test/diameter_test_server.erl
@@ -0,0 +1,551 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+%%----------------------------------------------------------------------
+%% Purpose: Lightweight test server
+%%----------------------------------------------------------------------
+
+-module(diameter_test_server).
+
+-export([
+	 t/1, t/2,
+
+	 init_per_testcase/2, 
+	 fin_per_testcase/2
+	]).
+
+-include("diameter_test_lib.hrl").
+
+
+-define(GLOGGER, diameter_global_logger).
+
+
+%% ----------------------------------------------------------------
+%%
+
+t([Case]) when is_atom(Case) ->
+    t(Case);
+t(Case) ->
+    process_flag(trap_exit, true),
+    MEM = fun() -> case (catch erlang:memory()) of
+			{'EXIT', _} ->
+			    [];
+			Res ->
+			    Res
+		    end
+	  end,
+    Alloc1 = diameter_test_lib:alloc_info(),
+    Mem1   = MEM(),
+    Res    = lists:flatten(t(Case, default_config())),
+    Alloc2 = diameter_test_lib:alloc_info(),
+    Mem2   = MEM(),
+    %% io:format("Res: ~p~n", [Res]),
+    display_result(Res, Alloc1, Mem1, Alloc2, Mem2),
+    Res.
+
+
+groups(Mod) when is_atom(Mod) ->
+    try Mod:groups() of
+        Groups when is_list(Groups) ->
+            Groups;
+        BadGroups ->
+            exit({bad_groups, Mod, BadGroups})
+    catch
+        _:_ ->
+            []
+    end.
+
+init_suite(Mod, Config) ->
+    io:format("~w:init_suite -> entry with"
+	      "~n   Mod:    ~p"
+	      "~n   Config: ~p"
+	      "~n", [?MODULE, Mod, Config]),
+    Mod:init_per_suite(Config).
+
+end_suite(Mod, Config) ->
+    Mod:end_per_suite(Config).
+
+init_group(Mod, Group, Config) ->
+    Mod:init_per_group(Group, Config).
+
+end_group(Mod, Group, Config) ->
+    Mod:init_per_group(Group, Config).
+
+%% This is for sub-SUITEs
+t({_Mod, {NewMod, all}, _Groups}, _Config) when is_atom(NewMod) ->
+    io:format("~w:t(all) -> entry with"
+	      "~n   NewMod: ~p"
+	      "~n", [?MODULE, NewMod]),
+    t(NewMod);
+t({Mod, {group, Name} = Group, Groups}, Config)
+  when is_atom(Mod) andalso is_atom(Name) andalso is_list(Groups) ->
+    io:format("~w:t(group) -> entry with"
+	      "~n   Mod:    ~p"
+	      "~n   Name:   ~p"
+	      "~n   Groups: ~p"
+	      "~n   Config: ~p"
+	      "~n", [?MODULE, Mod, Name, Groups, Config]),
+    case lists:keysearch(Name, 1, Groups) of
+        {value, {Name, _Props, GroupsAndCases}} ->
+            try init_group(Mod, Name, Config) of
+                Config2 when is_list(Config2) ->
+                    Res = [t({Mod, Case, Groups}, Config2) ||
+                              Case <- GroupsAndCases],
+                    (catch end_group(Mod, Name, Config2)),
+                    Res;
+                Error ->
+                    io:format(" => group (~w) init failed: ~p~n",
+                              [Name, Error]),
+                    [{failed, {Mod, Group}, Error}]
+            catch
+                exit:{skipped, SkipReason} ->
+                    io:format(" => skipping group: ~p~n", [SkipReason]),
+                    [{skipped, {Mod, Group}, SkipReason, 0}];
+                exit:{undef, _} ->
+                    [t({Mod, Case, Groups}, Config) ||
+			Case <- GroupsAndCases];
+                T:E ->
+                    [{failed, {Mod, Group}, {T,E}, 0}]
+            end;
+        false ->
+            exit({unknown_group, Mod, Name, Groups})
+    end;
+t({Mod, Fun, _}, Config)
+  when is_atom(Mod) andalso is_atom(Fun) ->
+    io:format("~w:t -> entry with"
+	      "~n   Mod:    ~p"
+	      "~n   Fun:    ~p"
+	      "~n   Config: ~p"
+	      "~n", [?MODULE, Mod, Fun, Config]),
+    case catch apply(Mod, Fun, [suite]) of
+        [] ->
+            io:format("Eval:   ~p:", [{Mod, Fun}]),
+            Res = eval(Mod, Fun, Config),
+            {R, _, _, _} = Res,
+            io:format(" ~p~n", [R]),
+            Res;
+
+        Cases when is_list(Cases) ->
+            io:format("Expand: ~p ...~n", [{Mod, Fun}]),
+            Map = fun(Case) when is_atom(Case) -> {Mod, Case};
+                     (Case) -> Case
+                  end,
+            t(lists:map(Map, Cases), Config);
+
+        {'EXIT', {undef, _}} ->
+            io:format("Undefined:   ~p~n", [{Mod, Fun}]),
+            [{nyi, {Mod, Fun}, ok, 0}];
+
+        Error ->
+            io:format("Ignoring:   ~p: ~p~n", [{Mod, Fun}, Error]),
+            [{failed, {Mod, Fun}, Error, 0}]
+    end;
+t(Mod, Config) when is_atom(Mod) ->
+    io:format("~w:t -> entry with"
+	      "~n   Mod:    ~p"
+	      "~n   Config: ~p"
+	      "~n", [?MODULE, Mod, Config]),
+    %% This is assumed to be a test suite, so we start by calling
+    %% the top test suite function(s) (all/0 and groups/0).
+    case (catch Mod:all()) of
+        Cases when is_list(Cases) ->
+            %% The list may contain atoms (actual test cases) and
+            %% group-tuples (a tuple naming a group of test cases).
+            %% A group is defined by the (optional) groups/0 function.
+	    io:format("~w:t -> suite all ok"
+		      "~n   Cases: ~p"
+		      "~n", [?MODULE, Cases]),
+            Groups = groups(Mod),
+	    io:format("~w:t -> "
+		      "~n   Groups: ~p"
+		      "~n", [?MODULE, Groups]),
+            try init_suite(Mod, Config) of
+                Config2 when is_list(Config2) ->
+		    io:format("~w:t -> suite init ok"
+			      "~n   Config2: ~p"
+			      "~n", [?MODULE, Config2]),
+                    Res = [t({Mod, Case, Groups}, Config2) || Case <- Cases],
+                    (catch end_suite(Mod, Config2)),
+                    Res;
+                Error ->
+                    io:format(" => suite init failed: ~p~n", [Error]),
+                    [{failed, {Mod, init_per_suite}, Error}]
+            catch
+                exit:{skipped, SkipReason} ->
+                    io:format(" => skipping suite: ~p~n", [SkipReason]),
+                    [{skipped, {Mod, init_per_suite}, SkipReason, 0}];
+                exit:{undef, _} ->
+                    io:format("~w:t -> suite init failed. exit undef(1)~n", [?MODULE]),
+                    [t({Mod, Case, Groups}, Config) || Case <- Cases];
+                exit:undef ->
+                    io:format("~w:t -> suite init failed. exit undef(2)~n", [?MODULE]),
+                    [t({Mod, Case, Groups}, Config) || Case <- Cases];
+                T:E ->
+                    io:format("~w:t -> suite init failed. "
+			      "~n   T: ~p"
+			      "~n   E: ~p"
+			      "~n", [?MODULE, T,E]),
+                    [{failed, {Mod, init_per_suite}, {T,E}, 0}]
+            end;
+        {'EXIT', {undef, _}} ->
+            io:format("Undefined:   ~p~n", [{Mod, all}]),
+            [{nyi, {Mod, all}, ok, 0}];
+
+        Crap ->
+	    io:format("~w:t -> suite all failed: "
+		      "~n   Crap: ~p"
+		      "~n", [?MODULE, Crap]),
+            Crap
+    end;
+t(Bad, _Config) ->
+    io:format("~w:t -> entry with"
+	      "~n   Bad: ~p"
+	      "~n", [?MODULE, Bad]),
+    [{badarg, Bad, ok, 0}].
+
+eval(Mod, Fun, Config) ->
+    TestCase = {?MODULE, Mod, Fun},
+    Label = lists:concat(["TEST CASE: ", Fun]),
+    ?REPORT_VERBOSE(Label ++ " started", [TestCase, Config]),
+    global:register_name(diameter_test_case_sup, self()),
+    Flag = process_flag(trap_exit, true),
+    put(diameter_test_server, true),
+    Config2 = Mod:init_per_testcase(Fun, Config),
+    Self = self(), 
+    Pid = spawn_link(fun() -> do_eval(Self, Mod, Fun, Config2) end),
+    R = wait_for_evaluator(Pid, Mod, Fun, Config2, []),
+    Mod:fin_per_testcase(Fun, Config2),
+    erase(diameter_test_server),    
+    global:unregister_name(diameter_test_case_sup),
+    process_flag(trap_exit, Flag),
+    R.
+
+wait_for_evaluator(Pid, Mod, Fun, Config, Errors) ->
+    wait_for_evaluator(Pid, Mod, Fun, Config, Errors, 0).
+wait_for_evaluator(Pid, Mod, Fun, Config, Errors, AccTime) ->
+    TestCase = {?MODULE, Mod, Fun},
+    Label = lists:concat(["TEST CASE: ", Fun]),
+    receive
+	{done, Pid, ok, Time} when Errors =:= [] ->
+	    ?REPORT_VERBOSE(Label ++ " ok", 
+			    [{test_case, TestCase}, {config, Config}]),
+	    {ok, {Mod, Fun}, Errors, Time};
+	{done, Pid, ok, Time} ->
+	    ?REPORT_VERBOSE(Label ++ " failed", 
+			    [{test_case, TestCase}, {config, Config}]),
+	    {failed, {Mod, Fun}, Errors, Time};
+	{done, Pid, {ok, _}, Time} when Errors =:= [] ->
+	    ?REPORT_VERBOSE(Label ++ " ok",
+			    [{test_case, TestCase}, {config, Config}]),
+	    {ok, {Mod, Fun}, Errors, Time};
+	{done, Pid, {ok, _}, Time} ->
+	    ?REPORT_VERBOSE(Label ++ " failed",
+			    [{test_case, TestCase}, {config, Config}]),
+	    {failed, {Mod, Fun}, Errors, Time};
+	{done, Pid, Fail, Time} ->
+	    ?REPORT_IMPORTANT(Label ++ " failed",
+			      [{test_case, TestCase}, 
+			       {config,    Config}, 
+			       {return,    Fail}, 
+			       {errors,    Errors}]),
+	    {failed, {Mod, Fun}, Fail, Time};
+	{'EXIT', Pid, {skipped, Reason}, Time} -> 
+	    ?REPORT_IMPORTANT(Label ++ " skipped",
+			      [{test_case, TestCase}, 
+			       {config,    Config}, 
+			       {skipped,   Reason}]),
+	    {skipped, {Mod, Fun}, Errors, Time};
+	{'EXIT', Pid, Reason, Time} -> 
+	    ?REPORT_IMPORTANT(Label ++ " crashed",
+			      [{test_case, TestCase}, 
+			       {config,    Config}, 
+			       {'EXIT',    Reason}]),
+	    {crashed, {Mod, Fun}, [{'EXIT', Reason} | Errors], Time};
+	{fail, Pid, Reason, Time} ->
+	    wait_for_evaluator(Pid, Mod, Fun, Config, 
+			       Errors ++ [Reason], AccTime + Time)
+    end.
+
+do_eval(ReplyTo, Mod, Fun, Config) ->
+    diameter_test_lib:display_system_info("before", Mod, Fun),
+    case timer:tc(Mod, Fun, [Config]) of
+	{Time, {'EXIT', {skipped, Reason}}} ->
+	    display_tc_time(Time),
+	    diameter_test_lib:display_system_info("after (skipped)", Mod, Fun),
+	    ReplyTo ! {'EXIT', self(), {skipped, Reason}, Time};
+	{Time, {'EXIT', Reason}} ->
+	    display_tc_time(Time),
+	    diameter_test_lib:display_system_info("after (crashed)", Mod, Fun),
+	    ReplyTo ! {'EXIT', self(), Reason, Time};
+	{Time, Other} ->
+	    display_tc_time(Time),
+	    diameter_test_lib:display_system_info("after", Mod, Fun),
+	    ReplyTo ! {done, self(), Other, Time}
+    end,
+    unlink(ReplyTo),
+    exit(shutdown).
+
+
+display_tc_time(Time) ->
+    io:format("~n"
+	      "~n*********************************************"
+	      "~n"
+	      "~nTest case completion time: ~.3f sec (~w)"
+	      "~n", [(Time / 1000000), Time]),
+    ok.
+
+
+display_result(Res, Alloc1, Mem1, Alloc2, Mem2) ->
+    io:format("~nAllocator info: ~n", []),
+    display_alloc(Alloc1, Alloc2),
+    io:format("~nMemory info: ~n", []),
+    display_memory(Mem1, Mem2),
+    display_result(Res).
+
+display_alloc([], []) ->
+    io:format("-~n", []),
+    ok;
+display_alloc(A1, A2) ->
+    do_display_alloc(A1, A2).
+
+do_display_alloc([], _) ->
+    ok;
+do_display_alloc([{Alloc, Mem1}|AllocInfo1], AllocInfo2) ->
+    Mem2 = 
+	case lists:keysearch(Alloc, 1, AllocInfo2) of
+	    {value, {_, Val}} ->
+		Val;
+	    false ->
+		undefined
+	end,
+    io:format("~15w: ~10w -> ~w~n", [Alloc, Mem1, Mem2]),
+    do_display_alloc(AllocInfo1, AllocInfo2).
+
+display_memory([], []) ->
+    io:format("-~n", []),
+    ok;
+display_memory(Mem1, Mem2) ->
+    do_display_memory(Mem1, Mem2).
+
+
+do_display_memory([], _) ->
+    ok;
+do_display_memory([{Key, Mem1}|MemInfo1], MemInfo2) ->
+    Mem2 = 
+	case lists:keysearch(Key, 1, MemInfo2) of
+	    {value, {_, Val}} ->
+		Val;
+	    false ->
+		undefined
+	end,
+    io:format("~15w: ~10w -> ~w~n", [Key, Mem1, Mem2]),
+    do_display_memory(MemInfo1, MemInfo2).
+
+display_result([]) ->    
+    io:format("OK~n", []);
+display_result(Res) when is_list(Res) ->
+    Ok      = [{MF, Time} || {ok,  MF, _, Time}  <- Res],
+    Nyi     = [MF || {nyi, MF, _, _Time} <- Res],
+    Skipped = [{MF, Reason} || {skipped, MF, Reason, _Time} <- Res],
+    Failed  = [{MF, Reason} || {failed,  MF, Reason, _Time} <- Res],
+    Crashed = [{MF, Reason} || {crashed, MF, Reason, _Time} <- Res],
+    display_summery(Ok, Nyi, Skipped, Failed, Crashed),
+    display_ok(Ok),
+    display_skipped(Skipped),
+    display_failed(Failed),
+    display_crashed(Crashed).
+
+display_summery(Ok, Nyi, Skipped, Failed, Crashed) ->
+    io:format("~nTest case summery:~n", []),
+    display_summery(Ok,      "successfull"),
+    display_summery(Nyi,     "not yet implemented"),
+    display_summery(Skipped, "skipped"),
+    display_summery(Failed,  "failed"),
+    display_summery(Crashed, "crashed"),
+    io:format("~n", []).
+   
+display_summery(Res, Info) ->
+    io:format("  ~w test cases ~s~n", [length(Res), Info]).
+    
+display_ok([]) ->
+    ok;
+display_ok(Ok) ->
+    io:format("Ok test cases:~n", []),
+    F = fun({{M, F}, Time}) -> 
+		io:format("  ~w : ~w => ~.2f sec~n", [M, F, Time / 1000000]) 
+	end,
+    lists:foreach(F, Ok),
+    io:format("~n", []).
+
+display_skipped([]) ->
+    ok;
+display_skipped(Skipped) ->
+    io:format("Skipped test cases:~n", []),
+    F = fun({MF, Reason}) -> io:format("  ~p => ~p~n", [MF, Reason]) end,
+    lists:foreach(F, Skipped),
+    io:format("~n", []).
+
+
+display_failed([]) ->
+    ok;
+display_failed(Failed) ->
+    io:format("Failed test cases:~n", []),
+    F = fun({MF, Reason}) -> io:format("  ~p => ~p~n", [MF, Reason]) end,
+    lists:foreach(F, Failed),
+    io:format("~n", []).
+
+display_crashed([]) ->
+    ok;
+display_crashed(Crashed) ->
+    io:format("Crashed test cases:~n", []),
+    F = fun({MF, Reason}) -> io:format("  ~p => ~p~n", [MF, Reason]) end,
+    lists:foreach(F, Crashed),
+    io:format("~n", []).
+        
+    
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Test server callbacks
+init_per_testcase(_Case, Config) ->
+    Pid = group_leader(),
+    Name = ?GLOGGER, 
+    case global:whereis_name(Name) of
+	undefined ->
+	    global:register_name(?GLOGGER, Pid);
+	Pid ->
+	    io:format("~w:init_per_testcase -> "
+		      "already registered to ~p~n", [?MODULE, Pid]),
+	    ok;
+	OtherPid when is_pid(OtherPid) ->
+	    io:format("~w:init_per_testcase -> "
+		      "already registered to other ~p (~p)~n", 
+		      [?MODULE, OtherPid, Pid]),
+	    exit({already_registered, {?GLOGGER, OtherPid, Pid}})
+    end,
+    set_kill_timer(Config).
+
+fin_per_testcase(_Case, Config) ->
+    Name = ?GLOGGER, 
+    case global:whereis_name(Name) of
+	undefined ->
+	    io:format("~w:fin_per_testcase -> already un-registered~n", 
+		      [?MODULE]),
+	    ok;
+	Pid when is_pid(Pid) ->
+	    global:unregister_name(?GLOGGER),
+	    ok
+    end,
+    reset_kill_timer(Config).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Set kill timer
+
+set_kill_timer(Config) ->
+    case init:get_argument(diameter_test_timeout) of
+	{ok, _} -> 
+	    Config;
+	_ ->
+	    Time = 
+		case lookup_config(tc_timeout, Config) of
+		    [] ->
+			timer:minutes(5);
+		    ConfigTime when is_integer(ConfigTime) ->
+			ConfigTime
+		end,
+	    Dog = 
+		case get(diameter_test_server) of
+		    true ->
+			Self = self(), 
+			spawn_link(fun() -> watchdog(Self, Time) end);
+		    _ ->
+			test_server:timetrap(Time)
+		end,
+	    [{kill_timer, Dog}|Config]
+		    
+	    
+    end.
+
+reset_kill_timer(Config) ->
+    DogKiller = 
+	case get(diameter_test_server) of
+	    true ->
+		fun(P) when is_pid(P) -> P ! stop;
+		   (_) -> ok 
+		end;
+	    _ ->
+		fun(Ref) -> test_server:timetrap_cancel(Ref) end
+	end,
+    case lists:keysearch(kill_timer, 1, Config) of
+	{value, {kill_timer, Dog}} ->
+	    DogKiller(Dog), 
+	    lists:keydelete(kill_timer, 1, Config);
+	_ ->
+	    Config
+    end.
+
+watchdog(Pid, Time) ->
+    erlang:now(),
+    receive
+	stop ->
+	    ok
+    after Time ->
+	    case (catch process_info(Pid)) of
+		undefined ->
+		    ok;
+		Info ->
+		    ?LOG("<ERROR> Watchdog in test case timed out "
+			"for ~p after ~p min"
+			 "~n~p"
+			 "~n",
+		    [Pid, Time div (1000*60), Info]),
+		    exit(Pid, kill)
+	    end
+    end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+lookup_config(Key, Config) ->
+    diameter_test_lib:lookup_config(Key, Config).
+
+default_config() ->
+    [{nodes, default_nodes()}, {ts, diameter}].
+
+default_nodes() ->    
+    mk_nodes(2, []).
+
+mk_nodes(0, Nodes) ->
+    Nodes;
+mk_nodes(N, []) ->
+    mk_nodes(N - 1, [node()]);
+mk_nodes(N, Nodes) when N > 0 ->
+    Head = hd(Nodes),
+    [Name, Host] = node_to_name_and_host(Head),
+    Nodes ++ [mk_node(I, Name, Host) || I <- lists:seq(1, N)].
+
+mk_node(N, Name, Host) ->
+    list_to_atom(lists:concat([Name ++ integer_to_list(N) ++ "@" ++ Host])).
+    
+%% Returns [Name, Host]    
+node_to_name_and_host(Node) ->
+    string:tokens(atom_to_list(Node), [$@]).
+
+
+
+