From 270dd088e9e29ca8880ae7f0fd02bfe2b7a27d92 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 17:25:45 +0200 Subject: Move diameter_exprecs to compiler directory --- lib/diameter/src/app/Makefile | 2 - lib/diameter/src/app/diameter_exprecs.erl | 301 ------------------------- lib/diameter/src/app/modules.mk | 1 - lib/diameter/src/compiler/diameter_exprecs.erl | 301 +++++++++++++++++++++++++ lib/diameter/src/compiler/modules.mk | 1 + 5 files changed, 302 insertions(+), 304 deletions(-) delete mode 100644 lib/diameter/src/app/diameter_exprecs.erl create mode 100644 lib/diameter/src/compiler/diameter_exprecs.erl (limited to 'lib/diameter') diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile index b2efc42a69..38af3cbe37 100644 --- a/lib/diameter/src/app/Makefile +++ b/lib/diameter/src/app/Makefile @@ -185,8 +185,6 @@ release_docs_spec: # Dependencies # ---------------------------------------------------- -$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): $(EBIN)/diameter_exprecs.$(EMULATOR) - diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ $(EBIN)/diameter_gen_base_rfc3588.beam diff --git a/lib/diameter/src/app/diameter_exprecs.erl b/lib/diameter/src/app/diameter_exprecs.erl deleted file mode 100644 index 5e120d6f44..0000000000 --- a/lib/diameter/src/app/diameter_exprecs.erl +++ /dev/null @@ -1,301 +0,0 @@ -%% -%% %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% -%% - -%% -%% Parse transform for generating record access functions -%% -%% This parse transform can be used to reduce compile-time -%% dependencies in large systems. -%% -%% In the old days, before records, Erlang programmers often wrote -%% access functions for tuple data. This was tedious and error-prone. -%% The record syntax made this easier, but since records were implemented -%% fully in the pre-processor, a nasty compile-time dependency was -%% introduced. -%% -%% This module automates the generation of access functions for -%% records. While this method cannot fully replace the utility of -%% pattern matching, it does allow a fair bit of functionality on -%% records without the need for compile-time dependencies. -%% -%% Whenever record definitions need to be exported from a module, -%% inserting a compiler attribute, -%% -%% export_records([RecName, ...]) -%% -%% causes this transform to lay out access functions for the exported -%% records: -%% -%% -module(foo) -%% -compile({parse_transform, diameter_exprecs}). -%% -%% -record(r, {a, b, c}). -%% -export_records([a]). -%% -%% -export(['#info-'/1, '#info-'/2, -%% '#new-'/1, '#new-'/2, -%% '#get-'/2, '#set-'/2, -%% '#new-a'/0, '#new-a'/1, -%% '#get-a'/2, '#set-a'/2, -%% '#info-a'/1]). -%% -%% '#info-'(RecName) -> -%% '#info-'(RecName, fields). -%% -%% '#info-'(r, Info) -> -%% '#info-r'(Info). -%% -%% '#new-'(r) -> #r{}. -%% '#new-'(r, Vals) -> '#new-r'(Vals) -%% -%% '#new-r'() -> #r{}. -%% '#new-r'(Vals) -> '#set-r'(Vals, #r{}). -%% -%% '#get-'(Attrs, #r{} = Rec) -> -%% '#get-r'(Attrs, Rec). -%% -%% '#get-r'(Attrs, Rec) when is_list(Attrs) -> -%% ['#get-r'(A, Rec) || A <- Attrs]; -%% '#get-r'(a, Rec) -> Rec#r.a; -%% '#get-r'(b, Rec) -> Rec#r.b; -%% '#get-r'(c, Rec) -> Rec#r.c. -%% -%% '#set-'(Vals, #r{} = Rec) -> -%% '#set-r'(Vals, Rec). -%% -%% '#set-r'(Vals, Rec) when is_list(Vals) -> -%% lists:foldl(fun '#set-r'/2, Rec, Vals); -%% '#set-r'({a,V}, Rec) -> Rec#r{a = V}; -%% '#set-r'({b,V}, Rec) -> Rec#r{b = V}; -%% '#set-r'({c,V}, Rec) -> Rec#r{c = V}. -%% -%% '#info-r'(fields) -> record_info(fields, r); -%% '#info-r'(size) -> record_info(size, r); -%% '#info-r'({index, a}) -> 1; -%% '#info-r'({index, b}) -> 2; -%% '#info-r'({index, c}) -> 3; -%% - --module(diameter_exprecs). - --export([parse_transform/2]). - -%% Form tag with line number. --define(F(T), T, ?LINE). -%% Yes, that's right. The replacement is to the first unmatched ')'. - --define(attribute, ?F(attribute)). --define(clause, ?F(clause)). --define(function, ?F(function)). --define(call, ?F(call)). --define('fun', ?F('fun')). --define(generate, ?F(generate)). --define(lc, ?F(lc)). --define(match, ?F(match)). --define(remote, ?F(remote)). --define(record, ?F(record)). --define(record_field, ?F(record_field)). --define(record_index, ?F(record_index)). --define(tuple, ?F(tuple)). - --define(ATOM(T), {atom, ?LINE, T}). --define(VAR(V), {var, ?LINE, V}). - --define(CALL(F,A), {?call, ?ATOM(F), A}). --define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). - -%% parse_transform/2 - -parse_transform(Forms, _Options) -> - Rs = [R || {attribute, _, record, R} <- Forms], - case lists:append([E || {attribute, _, export_records, E} <- Forms]) of - [] -> - Forms; - Es -> - {H,T} = lists:splitwith(fun is_head/1, Forms), - H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T - end. - -is_head(T) -> - not lists:member(element(1,T), [function, eof]). - -%% a_export/1 - -a_export(Exports) -> - {?attribute, export, [{fname(info), 1}, - {fname(info), 2}, - {fname(new), 1}, - {fname(new), 2}, - {fname(get), 2}, - {fname(set), 2} - | lists:flatmap(fun export/1, Exports)]}. - -export(Rname) -> - New = fname(new, Rname), - [{New, 0}, - {New, 1}, - {fname(get, Rname), 2}, - {fname(set, Rname), 2}, - {fname(info, Rname), 1}]. - -%% f_accessors/2 - -f_accessors(Es, Rs) -> - ['#info-/1'(), - '#info-/2'(Es), - '#new-/1'(Es), - '#new-/2'(Es), - '#get-/2'(Es), - '#set-/2'(Es) - | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)]. - -accessors(Rname, Fields) -> - ['#new-X/0'(Rname), - '#new-X/1'(Rname), - '#get-X/2'(Rname, Fields), - '#set-X/2'(Rname, Fields), - '#info-X/1'(Rname, Fields)]. - -fields(Rname, Recs) -> - {Rname, Fields} = lists:keyfind(Rname, 1, Recs), - lists:map(fun({record_field, _, {atom, _, N}}) -> N; - ({record_field, _, {atom, _, N}, _}) -> N - end, - Fields). - -fname_prefix(Op) -> - "#" ++ atom_to_list(Op) ++ "-". - -fname(Op) -> - list_to_atom(fname_prefix(Op)). - -fname(Op, Rname) -> - Prefix = fname_prefix(Op), - list_to_atom(Prefix ++ atom_to_list(Rname)). - -%% Generated functions. - -'#info-/1'() -> - Fname = fname(info), - {?function, Fname, 1, - [{?clause, [?VAR('RecName')], - [], - [?CALL(Fname, [?VAR('RecName'), ?ATOM(fields)])]}]}. - -'#info-/2'(Exports) -> - {?function, fname(info), 2, - lists:map(fun 'info-'/1, Exports)}. - -'info-'(R) -> - {?clause, [?ATOM(R), ?VAR('Info')], - [], - [?CALL(fname(info, R), [?VAR('Info')])]}. - -'#new-/1'(Exports) -> - {?function, fname(new), 1, - lists:map(fun 'new-'/1, Exports)}. - -'new-'(R) -> - {?clause, [?ATOM(R)], - [], - [{?record, R, []}]}. - -'#new-/2'(Exports) -> - {?function, fname(new), 2, - lists:map(fun 'new--'/1, Exports)}. - -'new--'(R) -> - {?clause, [?ATOM(R), ?VAR('Vals')], - [], - [?CALL(fname(new, R), [?VAR('Vals')])]}. - -'#get-/2'(Exports) -> - {?function, fname(get), 2, - lists:map(fun 'get-'/1, Exports)}. - -'get-'(R) -> - {?clause, [?VAR('Attrs'), - {?match, {?record, R, []}, ?VAR('Rec')}], - [], - [?CALL(fname(get, R), [?VAR('Attrs'), ?VAR('Rec')])]}. - -'#set-/2'(Exports) -> - {?function, fname(set), 2, - lists:map(fun 'set-'/1, Exports)}. - -'set-'(R) -> - {?clause, [?VAR('Vals'), {?match, {?record, R, []}, ?VAR('Rec')}], - [], - [?CALL(fname(set, R), [?VAR('Vals'), ?VAR('Rec')])]}. - -'#new-X/0'(Rname) -> - {?function, fname(new, Rname), 0, - [{?clause, [], - [], - [{?record, Rname, []}]}]}. - -'#new-X/1'(Rname) -> - {?function, fname(new, Rname), 1, - [{?clause, [?VAR('Vals')], - [], - [?CALL(fname(set, Rname), [?VAR('Vals'), {?record, Rname, []}])]}]}. - -'#set-X/2'(Rname, Fields) -> - {?function, fname(set, Rname), 2, - [{?clause, [?VAR('Vals'), ?VAR('Rec')], - [[?CALL(is_list, [?VAR('Vals')])]], - [?APPLY(lists, foldl, [{?'fun', {function, fname(set, Rname), 2}}, - ?VAR('Rec'), - ?VAR('Vals')])]} - | lists:map(fun(A) -> 'set-X'(Rname, A) end, Fields)]}. - -'set-X'(Rname, Attr) -> - {?clause, [{?tuple, [?ATOM(Attr), ?VAR('V')]}, ?VAR('Rec')], - [], - [{?record, ?VAR('Rec'), Rname, - [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}. - -'#get-X/2'(Rname, Fields) -> - FName = fname(get, Rname), - {?function, FName, 2, - [{?clause, [?VAR('Attrs'), ?VAR('Rec')], - [[?CALL(is_list, [?VAR('Attrs')])]], - [{?lc, ?CALL(FName, [?VAR('A'), ?VAR('Rec')]), - [{?generate, ?VAR('A'), ?VAR('Attrs')}]}]} - | lists:map(fun(A) -> 'get-X'(Rname, A) end, Fields)]}. - -'get-X'(Rname, Attr) -> - {?clause, [?ATOM(Attr), ?VAR('Rec')], - [], - [{?record_field, ?VAR('Rec'), Rname, ?ATOM(Attr)}]}. - -'#info-X/1'(Rname, Fields) -> - {?function, fname(info, Rname), 1, - [{?clause, [?ATOM(fields)], - [], - [?CALL(record_info, [?ATOM(fields), ?ATOM(Rname)])]}, - {?clause, [?ATOM(size)], - [], - [?CALL(record_info, [?ATOM(size), ?ATOM(Rname)])]} - | lists:map(fun(A) -> 'info-X'(Rname, A) end, Fields)]}. - -'info-X'(Rname, Attr) -> - {?clause, [{?tuple, [?ATOM(index), ?ATOM(Attr)]}], - [], - [{?record_index, Rname, ?ATOM(Attr)}]}. diff --git a/lib/diameter/src/app/modules.mk b/lib/diameter/src/app/modules.mk index ea4c58bfd7..2b602cd713 100644 --- a/lib/diameter/src/app/modules.mk +++ b/lib/diameter/src/app/modules.mk @@ -47,7 +47,6 @@ RUNTIME_MODULES = \ HELP_MODULES = \ diameter_callback \ - diameter_exprecs \ diameter_dbg \ diameter_info diff --git a/lib/diameter/src/compiler/diameter_exprecs.erl b/lib/diameter/src/compiler/diameter_exprecs.erl new file mode 100644 index 0000000000..5e120d6f44 --- /dev/null +++ b/lib/diameter/src/compiler/diameter_exprecs.erl @@ -0,0 +1,301 @@ +%% +%% %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% +%% + +%% +%% Parse transform for generating record access functions +%% +%% This parse transform can be used to reduce compile-time +%% dependencies in large systems. +%% +%% In the old days, before records, Erlang programmers often wrote +%% access functions for tuple data. This was tedious and error-prone. +%% The record syntax made this easier, but since records were implemented +%% fully in the pre-processor, a nasty compile-time dependency was +%% introduced. +%% +%% This module automates the generation of access functions for +%% records. While this method cannot fully replace the utility of +%% pattern matching, it does allow a fair bit of functionality on +%% records without the need for compile-time dependencies. +%% +%% Whenever record definitions need to be exported from a module, +%% inserting a compiler attribute, +%% +%% export_records([RecName, ...]) +%% +%% causes this transform to lay out access functions for the exported +%% records: +%% +%% -module(foo) +%% -compile({parse_transform, diameter_exprecs}). +%% +%% -record(r, {a, b, c}). +%% -export_records([a]). +%% +%% -export(['#info-'/1, '#info-'/2, +%% '#new-'/1, '#new-'/2, +%% '#get-'/2, '#set-'/2, +%% '#new-a'/0, '#new-a'/1, +%% '#get-a'/2, '#set-a'/2, +%% '#info-a'/1]). +%% +%% '#info-'(RecName) -> +%% '#info-'(RecName, fields). +%% +%% '#info-'(r, Info) -> +%% '#info-r'(Info). +%% +%% '#new-'(r) -> #r{}. +%% '#new-'(r, Vals) -> '#new-r'(Vals) +%% +%% '#new-r'() -> #r{}. +%% '#new-r'(Vals) -> '#set-r'(Vals, #r{}). +%% +%% '#get-'(Attrs, #r{} = Rec) -> +%% '#get-r'(Attrs, Rec). +%% +%% '#get-r'(Attrs, Rec) when is_list(Attrs) -> +%% ['#get-r'(A, Rec) || A <- Attrs]; +%% '#get-r'(a, Rec) -> Rec#r.a; +%% '#get-r'(b, Rec) -> Rec#r.b; +%% '#get-r'(c, Rec) -> Rec#r.c. +%% +%% '#set-'(Vals, #r{} = Rec) -> +%% '#set-r'(Vals, Rec). +%% +%% '#set-r'(Vals, Rec) when is_list(Vals) -> +%% lists:foldl(fun '#set-r'/2, Rec, Vals); +%% '#set-r'({a,V}, Rec) -> Rec#r{a = V}; +%% '#set-r'({b,V}, Rec) -> Rec#r{b = V}; +%% '#set-r'({c,V}, Rec) -> Rec#r{c = V}. +%% +%% '#info-r'(fields) -> record_info(fields, r); +%% '#info-r'(size) -> record_info(size, r); +%% '#info-r'({index, a}) -> 1; +%% '#info-r'({index, b}) -> 2; +%% '#info-r'({index, c}) -> 3; +%% + +-module(diameter_exprecs). + +-export([parse_transform/2]). + +%% Form tag with line number. +-define(F(T), T, ?LINE). +%% Yes, that's right. The replacement is to the first unmatched ')'. + +-define(attribute, ?F(attribute)). +-define(clause, ?F(clause)). +-define(function, ?F(function)). +-define(call, ?F(call)). +-define('fun', ?F('fun')). +-define(generate, ?F(generate)). +-define(lc, ?F(lc)). +-define(match, ?F(match)). +-define(remote, ?F(remote)). +-define(record, ?F(record)). +-define(record_field, ?F(record_field)). +-define(record_index, ?F(record_index)). +-define(tuple, ?F(tuple)). + +-define(ATOM(T), {atom, ?LINE, T}). +-define(VAR(V), {var, ?LINE, V}). + +-define(CALL(F,A), {?call, ?ATOM(F), A}). +-define(APPLY(M,F,A), {?call, {?remote, ?ATOM(M), ?ATOM(F)}, A}). + +%% parse_transform/2 + +parse_transform(Forms, _Options) -> + Rs = [R || {attribute, _, record, R} <- Forms], + case lists:append([E || {attribute, _, export_records, E} <- Forms]) of + [] -> + Forms; + Es -> + {H,T} = lists:splitwith(fun is_head/1, Forms), + H ++ [a_export(Es) | f_accessors(Es, Rs)] ++ T + end. + +is_head(T) -> + not lists:member(element(1,T), [function, eof]). + +%% a_export/1 + +a_export(Exports) -> + {?attribute, export, [{fname(info), 1}, + {fname(info), 2}, + {fname(new), 1}, + {fname(new), 2}, + {fname(get), 2}, + {fname(set), 2} + | lists:flatmap(fun export/1, Exports)]}. + +export(Rname) -> + New = fname(new, Rname), + [{New, 0}, + {New, 1}, + {fname(get, Rname), 2}, + {fname(set, Rname), 2}, + {fname(info, Rname), 1}]. + +%% f_accessors/2 + +f_accessors(Es, Rs) -> + ['#info-/1'(), + '#info-/2'(Es), + '#new-/1'(Es), + '#new-/2'(Es), + '#get-/2'(Es), + '#set-/2'(Es) + | lists:flatmap(fun(N) -> accessors(N, fields(N, Rs)) end, Es)]. + +accessors(Rname, Fields) -> + ['#new-X/0'(Rname), + '#new-X/1'(Rname), + '#get-X/2'(Rname, Fields), + '#set-X/2'(Rname, Fields), + '#info-X/1'(Rname, Fields)]. + +fields(Rname, Recs) -> + {Rname, Fields} = lists:keyfind(Rname, 1, Recs), + lists:map(fun({record_field, _, {atom, _, N}}) -> N; + ({record_field, _, {atom, _, N}, _}) -> N + end, + Fields). + +fname_prefix(Op) -> + "#" ++ atom_to_list(Op) ++ "-". + +fname(Op) -> + list_to_atom(fname_prefix(Op)). + +fname(Op, Rname) -> + Prefix = fname_prefix(Op), + list_to_atom(Prefix ++ atom_to_list(Rname)). + +%% Generated functions. + +'#info-/1'() -> + Fname = fname(info), + {?function, Fname, 1, + [{?clause, [?VAR('RecName')], + [], + [?CALL(Fname, [?VAR('RecName'), ?ATOM(fields)])]}]}. + +'#info-/2'(Exports) -> + {?function, fname(info), 2, + lists:map(fun 'info-'/1, Exports)}. + +'info-'(R) -> + {?clause, [?ATOM(R), ?VAR('Info')], + [], + [?CALL(fname(info, R), [?VAR('Info')])]}. + +'#new-/1'(Exports) -> + {?function, fname(new), 1, + lists:map(fun 'new-'/1, Exports)}. + +'new-'(R) -> + {?clause, [?ATOM(R)], + [], + [{?record, R, []}]}. + +'#new-/2'(Exports) -> + {?function, fname(new), 2, + lists:map(fun 'new--'/1, Exports)}. + +'new--'(R) -> + {?clause, [?ATOM(R), ?VAR('Vals')], + [], + [?CALL(fname(new, R), [?VAR('Vals')])]}. + +'#get-/2'(Exports) -> + {?function, fname(get), 2, + lists:map(fun 'get-'/1, Exports)}. + +'get-'(R) -> + {?clause, [?VAR('Attrs'), + {?match, {?record, R, []}, ?VAR('Rec')}], + [], + [?CALL(fname(get, R), [?VAR('Attrs'), ?VAR('Rec')])]}. + +'#set-/2'(Exports) -> + {?function, fname(set), 2, + lists:map(fun 'set-'/1, Exports)}. + +'set-'(R) -> + {?clause, [?VAR('Vals'), {?match, {?record, R, []}, ?VAR('Rec')}], + [], + [?CALL(fname(set, R), [?VAR('Vals'), ?VAR('Rec')])]}. + +'#new-X/0'(Rname) -> + {?function, fname(new, Rname), 0, + [{?clause, [], + [], + [{?record, Rname, []}]}]}. + +'#new-X/1'(Rname) -> + {?function, fname(new, Rname), 1, + [{?clause, [?VAR('Vals')], + [], + [?CALL(fname(set, Rname), [?VAR('Vals'), {?record, Rname, []}])]}]}. + +'#set-X/2'(Rname, Fields) -> + {?function, fname(set, Rname), 2, + [{?clause, [?VAR('Vals'), ?VAR('Rec')], + [[?CALL(is_list, [?VAR('Vals')])]], + [?APPLY(lists, foldl, [{?'fun', {function, fname(set, Rname), 2}}, + ?VAR('Rec'), + ?VAR('Vals')])]} + | lists:map(fun(A) -> 'set-X'(Rname, A) end, Fields)]}. + +'set-X'(Rname, Attr) -> + {?clause, [{?tuple, [?ATOM(Attr), ?VAR('V')]}, ?VAR('Rec')], + [], + [{?record, ?VAR('Rec'), Rname, + [{?record_field, ?ATOM(Attr), ?VAR('V')}]}]}. + +'#get-X/2'(Rname, Fields) -> + FName = fname(get, Rname), + {?function, FName, 2, + [{?clause, [?VAR('Attrs'), ?VAR('Rec')], + [[?CALL(is_list, [?VAR('Attrs')])]], + [{?lc, ?CALL(FName, [?VAR('A'), ?VAR('Rec')]), + [{?generate, ?VAR('A'), ?VAR('Attrs')}]}]} + | lists:map(fun(A) -> 'get-X'(Rname, A) end, Fields)]}. + +'get-X'(Rname, Attr) -> + {?clause, [?ATOM(Attr), ?VAR('Rec')], + [], + [{?record_field, ?VAR('Rec'), Rname, ?ATOM(Attr)}]}. + +'#info-X/1'(Rname, Fields) -> + {?function, fname(info, Rname), 1, + [{?clause, [?ATOM(fields)], + [], + [?CALL(record_info, [?ATOM(fields), ?ATOM(Rname)])]}, + {?clause, [?ATOM(size)], + [], + [?CALL(record_info, [?ATOM(size), ?ATOM(Rname)])]} + | lists:map(fun(A) -> 'info-X'(Rname, A) end, Fields)]}. + +'info-X'(Rname, Attr) -> + {?clause, [{?tuple, [?ATOM(index), ?ATOM(Attr)]}], + [], + [{?record_index, Rname, ?ATOM(Attr)}]}. diff --git a/lib/diameter/src/compiler/modules.mk b/lib/diameter/src/compiler/modules.mk index 4b40e99a3e..6fbc8fa8d4 100644 --- a/lib/diameter/src/compiler/modules.mk +++ b/lib/diameter/src/compiler/modules.mk @@ -19,6 +19,7 @@ MODULES = \ diameter_codegen \ + diameter_exprecs \ diameter_spec_scan \ diameter_spec_util \ diameter_make -- cgit v1.2.3 From f4c38ecd803451280d0021bcfa7f2ad25b96cbcd Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 17:41:28 +0200 Subject: Remove app dependency on compiler to avoid forced recompilation --- lib/diameter/src/app/Makefile | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lib/diameter') diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile index 38af3cbe37..7752bb1798 100644 --- a/lib/diameter/src/app/Makefile +++ b/lib/diameter/src/app/Makefile @@ -148,6 +148,10 @@ $(APP_TARGET): $(APP_SRC) \ $(APPUP_TARGET): $(APPUP_SRC) ../../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ +# This isn't a dependency for $(DICT_ERL_FILES) $(DICT_HRL_FILES) +# since it would force recompilation: compiler must explicity be made +# first, which ../Makefile does. Should share a makefile for proper +# dependencies. (Aka, recursive make considered harmful.) compiler: $(MAKE) -C ../$@ @@ -188,8 +192,6 @@ release_docs_spec: diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ $(EBIN)/diameter_gen_base_rfc3588.beam -$(DICT_ERL_FILES) $(DICT_HRL_FILES): compiler - $(DICT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)): \ $(DIAMETER_TOP)/include/diameter.hrl \ $(DIAMETER_TOP)/include/diameter_gen.hrl -- cgit v1.2.3 From 14bf1dc855bbd973bb15578f418e37ab2d4f17fe Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 14 Oct 2011 19:40:29 +0200 Subject: One makefile for src build instead of recursion Simpler, no duplication of similar makefiles and makes for better dependencies. (Aka, recursive make considered harmful.) --- lib/diameter/configure.in | 1 - lib/diameter/src/.gitignore | 2 + lib/diameter/src/Makefile | 224 +- lib/diameter/src/app/.gitignore | 6 - lib/diameter/src/app/Makefile | 215 -- lib/diameter/src/app/depend.sed | 31 - lib/diameter/src/app/diameter.app.src | 28 - lib/diameter/src/app/diameter.appup.src | 47 - lib/diameter/src/app/diameter.erl | 190 -- lib/diameter/src/app/diameter.mk.in | 47 - lib/diameter/src/app/diameter_app.erl | 36 - lib/diameter/src/app/diameter_callback.erl | 91 - lib/diameter/src/app/diameter_capx.erl | 405 ---- lib/diameter/src/app/diameter_codec.erl | 561 ----- lib/diameter/src/app/diameter_config.erl | 676 ------ lib/diameter/src/app/diameter_dbg.erl | 516 ---- lib/diameter/src/app/diameter_dict.erl | 153 -- lib/diameter/src/app/diameter_info.erl | 869 ------- lib/diameter/src/app/diameter_internal.hrl | 80 - lib/diameter/src/app/diameter_lib.erl | 272 --- lib/diameter/src/app/diameter_misc_sup.erl | 58 - lib/diameter/src/app/diameter_peer.erl | 225 -- lib/diameter/src/app/diameter_peer_fsm.erl | 777 ------ lib/diameter/src/app/diameter_peer_fsm_sup.erl | 63 - lib/diameter/src/app/diameter_reg.erl | 327 --- lib/diameter/src/app/diameter_service.erl | 2903 ----------------------- lib/diameter/src/app/diameter_service_sup.erl | 64 - lib/diameter/src/app/diameter_session.erl | 172 -- lib/diameter/src/app/diameter_stats.erl | 342 --- lib/diameter/src/app/diameter_sup.erl | 101 - lib/diameter/src/app/diameter_sync.erl | 550 ----- lib/diameter/src/app/diameter_types.erl | 537 ----- lib/diameter/src/app/diameter_types.hrl | 139 -- lib/diameter/src/app/diameter_watchdog.erl | 571 ----- lib/diameter/src/app/diameter_watchdog_sup.erl | 60 - lib/diameter/src/app/modules.mk | 69 - lib/diameter/src/base/diameter.app.src | 28 + lib/diameter/src/base/diameter.appup.src | 47 + lib/diameter/src/base/diameter.erl | 190 ++ lib/diameter/src/base/diameter_app.erl | 36 + lib/diameter/src/base/diameter_callback.erl | 91 + lib/diameter/src/base/diameter_capx.erl | 405 ++++ lib/diameter/src/base/diameter_codec.erl | 561 +++++ lib/diameter/src/base/diameter_config.erl | 676 ++++++ lib/diameter/src/base/diameter_dbg.erl | 516 ++++ lib/diameter/src/base/diameter_dict.erl | 153 ++ lib/diameter/src/base/diameter_info.erl | 869 +++++++ lib/diameter/src/base/diameter_internal.hrl | 80 + lib/diameter/src/base/diameter_lib.erl | 272 +++ lib/diameter/src/base/diameter_misc_sup.erl | 58 + lib/diameter/src/base/diameter_peer.erl | 225 ++ lib/diameter/src/base/diameter_peer_fsm.erl | 777 ++++++ lib/diameter/src/base/diameter_peer_fsm_sup.erl | 63 + lib/diameter/src/base/diameter_reg.erl | 327 +++ lib/diameter/src/base/diameter_service.erl | 2903 +++++++++++++++++++++++ lib/diameter/src/base/diameter_service_sup.erl | 64 + lib/diameter/src/base/diameter_session.erl | 172 ++ lib/diameter/src/base/diameter_stats.erl | 342 +++ lib/diameter/src/base/diameter_sup.erl | 101 + lib/diameter/src/base/diameter_sync.erl | 550 +++++ lib/diameter/src/base/diameter_types.erl | 537 +++++ lib/diameter/src/base/diameter_types.hrl | 139 ++ lib/diameter/src/base/diameter_watchdog.erl | 571 +++++ lib/diameter/src/base/diameter_watchdog_sup.erl | 60 + lib/diameter/src/compiler/.gitignore | 3 - lib/diameter/src/compiler/Makefile | 131 - lib/diameter/src/compiler/modules.mk | 29 - lib/diameter/src/depend.sed | 51 + lib/diameter/src/gen/.gitignore | 2 + lib/diameter/src/modules.mk | 93 + lib/diameter/src/subdirs.mk | 21 - lib/diameter/src/transport/.gitignore | 3 - lib/diameter/src/transport/Makefile | 141 -- lib/diameter/src/transport/modules.mk | 29 - lib/diameter/test/Makefile | 23 +- 75 files changed, 11185 insertions(+), 11562 deletions(-) create mode 100644 lib/diameter/src/.gitignore delete mode 100644 lib/diameter/src/app/.gitignore delete mode 100644 lib/diameter/src/app/Makefile delete mode 100644 lib/diameter/src/app/depend.sed delete mode 100644 lib/diameter/src/app/diameter.app.src delete mode 100644 lib/diameter/src/app/diameter.appup.src delete mode 100644 lib/diameter/src/app/diameter.erl delete mode 100644 lib/diameter/src/app/diameter.mk.in delete mode 100644 lib/diameter/src/app/diameter_app.erl delete mode 100644 lib/diameter/src/app/diameter_callback.erl delete mode 100644 lib/diameter/src/app/diameter_capx.erl delete mode 100644 lib/diameter/src/app/diameter_codec.erl delete mode 100644 lib/diameter/src/app/diameter_config.erl delete mode 100644 lib/diameter/src/app/diameter_dbg.erl delete mode 100644 lib/diameter/src/app/diameter_dict.erl delete mode 100644 lib/diameter/src/app/diameter_info.erl delete mode 100644 lib/diameter/src/app/diameter_internal.hrl delete mode 100644 lib/diameter/src/app/diameter_lib.erl delete mode 100644 lib/diameter/src/app/diameter_misc_sup.erl delete mode 100644 lib/diameter/src/app/diameter_peer.erl delete mode 100644 lib/diameter/src/app/diameter_peer_fsm.erl delete mode 100644 lib/diameter/src/app/diameter_peer_fsm_sup.erl delete mode 100644 lib/diameter/src/app/diameter_reg.erl delete mode 100644 lib/diameter/src/app/diameter_service.erl delete mode 100644 lib/diameter/src/app/diameter_service_sup.erl delete mode 100644 lib/diameter/src/app/diameter_session.erl delete mode 100644 lib/diameter/src/app/diameter_stats.erl delete mode 100644 lib/diameter/src/app/diameter_sup.erl delete mode 100644 lib/diameter/src/app/diameter_sync.erl delete mode 100644 lib/diameter/src/app/diameter_types.erl delete mode 100644 lib/diameter/src/app/diameter_types.hrl delete mode 100644 lib/diameter/src/app/diameter_watchdog.erl delete mode 100644 lib/diameter/src/app/diameter_watchdog_sup.erl delete mode 100644 lib/diameter/src/app/modules.mk create mode 100644 lib/diameter/src/base/diameter.app.src create mode 100644 lib/diameter/src/base/diameter.appup.src create mode 100644 lib/diameter/src/base/diameter.erl create mode 100644 lib/diameter/src/base/diameter_app.erl create mode 100644 lib/diameter/src/base/diameter_callback.erl create mode 100644 lib/diameter/src/base/diameter_capx.erl create mode 100644 lib/diameter/src/base/diameter_codec.erl create mode 100644 lib/diameter/src/base/diameter_config.erl create mode 100644 lib/diameter/src/base/diameter_dbg.erl create mode 100644 lib/diameter/src/base/diameter_dict.erl create mode 100644 lib/diameter/src/base/diameter_info.erl create mode 100644 lib/diameter/src/base/diameter_internal.hrl create mode 100644 lib/diameter/src/base/diameter_lib.erl create mode 100644 lib/diameter/src/base/diameter_misc_sup.erl create mode 100644 lib/diameter/src/base/diameter_peer.erl create mode 100644 lib/diameter/src/base/diameter_peer_fsm.erl create mode 100644 lib/diameter/src/base/diameter_peer_fsm_sup.erl create mode 100644 lib/diameter/src/base/diameter_reg.erl create mode 100644 lib/diameter/src/base/diameter_service.erl create mode 100644 lib/diameter/src/base/diameter_service_sup.erl create mode 100644 lib/diameter/src/base/diameter_session.erl create mode 100644 lib/diameter/src/base/diameter_stats.erl create mode 100644 lib/diameter/src/base/diameter_sup.erl create mode 100644 lib/diameter/src/base/diameter_sync.erl create mode 100644 lib/diameter/src/base/diameter_types.erl create mode 100644 lib/diameter/src/base/diameter_types.hrl create mode 100644 lib/diameter/src/base/diameter_watchdog.erl create mode 100644 lib/diameter/src/base/diameter_watchdog_sup.erl delete mode 100644 lib/diameter/src/compiler/.gitignore delete mode 100644 lib/diameter/src/compiler/Makefile delete mode 100644 lib/diameter/src/compiler/modules.mk create mode 100644 lib/diameter/src/depend.sed create mode 100644 lib/diameter/src/gen/.gitignore create mode 100644 lib/diameter/src/modules.mk delete mode 100644 lib/diameter/src/subdirs.mk delete mode 100644 lib/diameter/src/transport/.gitignore delete mode 100644 lib/diameter/src/transport/Makefile delete mode 100644 lib/diameter/src/transport/modules.mk (limited to 'lib/diameter') diff --git a/lib/diameter/configure.in b/lib/diameter/configure.in index 9aca3859c5..8acfb28fed 100644 --- a/lib/diameter/configure.in +++ b/lib/diameter/configure.in @@ -132,7 +132,6 @@ dnl AC_OUTPUT( Makefile:Makefile.in - src/app/diameter.mk:src/app/diameter.mk.in make/$host/rules.mk:make/rules.mk.in ) diff --git a/lib/diameter/src/.gitignore b/lib/diameter/src/.gitignore new file mode 100644 index 0000000000..feeb378fd8 --- /dev/null +++ b/lib/diameter/src/.gitignore @@ -0,0 +1,2 @@ + +/depend.mk diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 6935eb053e..a72bf4420b 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -16,28 +16,228 @@ # # %CopyrightEnd% -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else +ifeq ($(ERL_TOP),) include $(DIAMETER_TOP)/make/target.mk include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk +else +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk endif # ---------------------------------------------------- -# Common Macros +# Application version +# ---------------------------------------------------- + +include ../vsn.mk + +VSN = $(DIAMETER_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- + +RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) + +# Where to put/find things. +EBIN = ../ebin +INCDIR = ../include + +# Where make should look for dependencies. +VPATH = .:base:compiler:transport:gen + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +include modules.mk + +DICT_FILES = $(RT_DICTS:%=dict/%.dia) +DICT_MODULES = $(RT_DICTS:%=gen/diameter_gen_%) +DICT_ERL_FILES = $(DICT_MODULES:%=%.erl) +DICT_HRL_FILES = $(DICT_MODULES:%=%.hrl) + +# Modules to build before compiling dictionaries. +COMPILER_MODULES = $(filter compiler/%, $(CT_MODULES)) + +# All handwritten modules. +MODULES = \ + $(RT_MODULES) \ + $(CT_MODULES) + +# Modules whose names are inserted into the app file. +APP_MODULES = \ + $(RT_MODULES) \ + $(DICT_MODULES) + +# Modules for which to build beams. +TARGET_MODULES = \ + $(APP_MODULES) \ + $(CT_MODULES) + +# What to build for the 'opt' target. +TARGET_FILES = \ + $(patsubst %,$(EBIN)/%.$(EMULATOR),$(notdir $(TARGET_MODULES))) \ + $(APP_TARGET) \ + $(APPUP_TARGET) + +# Subdirectories of src to release modules into. +TARGET_DIRS = $(sort $(dir $(TARGET_MODULES))) + +APP_FILE = diameter.app +APP_SRC = $(APP_FILE).src +APP_TARGET = $(EBIN)/$(APP_FILE) + +APPUP_FILE = diameter.appup +APPUP_SRC = $(APPUP_FILE).src +APPUP_TARGET = $(EBIN)/$(APPUP_FILE) + +EXAMPLE_FILES = $(EXAMPLES:%=../examples/%) +BIN_FILES = $(BINS:%=../bin/%) + +# ---------------------------------------------------- +# FLAGS # ---------------------------------------------------- -include subdirs.mk +ifeq ($(TYPE),debug) +ERL_COMPILE_FLAGS += -Ddebug +endif -SPECIAL_TARGETS = +ERL_COMPILE_FLAGS += \ + +'{parse_transform,sys_pre_attributes}' \ + +'{attribute,insert,app_vsn,$(APP_VSN)}' \ + +warn_unused_vars \ + -pa $(EBIN) \ + -I $(INCDIR) \ + -I gen # ---------------------------------------------------- -# Default Subdir Targets +# Targets # ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_subdir.mk + +debug: + @$(MAKE) TYPE=debug opt + +opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) $(DICT_ERL_FILES) $(DICT_HRL_FILES) + rm -f $(APP_TARGET) $(APPUP_TARGET) + rm -f errs core *~ gen/diameter_gen_*.forms gen/diameter_gen_*.spec + rm -f depend.mk + +docs: + +list = echo $(1):; echo $($(1)) | tr ' ' '\n' | sort | sed 's@^@ @' + +info: + @echo ======================================== + @$(call list,RT_DICTS) + @echo + @$(call list,RT_MODULES) + @echo + @$(call list,CT_MODULES) + @echo + @$(call list,TARGET_MODULES) + @echo + @$(call list,TARGET_DIRS) + @echo + @$(call list,EXTERNAL_HRL_FILES) + @echo + @$(call list,INTERNAL_HRL_FILES) + @echo + @$(call list,EXAMPLE_FILES) + @echo + @$(call list,BIN_FILES) + @echo ======================================== + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +# erl/hrl from dictionary file. +gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia + ../bin/diameterc -o gen -i $(EBIN) $< + +# Generate the app file. +$(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk + M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ + sed -e 's;%VSN%;$(VSN);' \ + -e "s;%MODULES%;$$M;" \ + $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +app: $(APP_TARGET) $(APPUP_TARGET) +dict: $(DICT_ERL_FILES) + +# Make the modules from a subdirectory. +$(TARGET_DIRS:%/=%): + $(MAKE) \ + $(patsubst $@/%,$(EBIN)/%.$(EMULATOR),$(filter $@/%,$(TARGET_MODULES))) + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- + +ifeq ($(ERL_TOP),) +include $(DIAMETER_TOP)/make/release_targets.mk else -include $(DIAMETER_TOP)/make/subdir.mk +include $(ERL_TOP)/make/otp_release_targets.mk endif -#include ../make/subdir.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/bin \ + $(RELSYSDIR)/ebin \ + $(RELSYSDIR)/src/dict \ + $(TARGET_DIRS:%=$(RELSYSDIR)/src/%) \ + $(RELSYSDIR)/include \ + $(RELSYSDIR)/examples + $(INSTALL_SCRIPT) $(BIN_FILES) $(RELSYSDIR)/bin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(DICT_FILES) $(RELSYSDIR)/src/dict + $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) \ + $(RELSYSDIR)/include + $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples + for dir in $(TARGET_DIRS); do \ + $(MAKE) release_subdir SRCDIR=$$dir; \ + done + +release_subdir: + [ -d "$(SRCDIR)" ] + $(INSTALL_DATA) $(filter $(SRCDIR)%,$(TARGET_MODULES:%=%.erl) \ + $(INTERNAL_HRL_FILES)) \ + $(RELSYSDIR)/src/$(SRCDIR) + +release_docs_spec: + +# ---------------------------------------------------- +# Dependencies +# ---------------------------------------------------- + +gen/diameter_gen_base_accounting.erl gen/diameter_gen_relay.erl \ +gen/diameter_gen_base_accounting.hrl gen/diameter_gen_relay.hrl: \ + $(EBIN)/diameter_gen_base_rfc3588.$(EMULATOR) + +gen/diameter_gen_base_rfc3588.erl gen/diameter_gen_base_rfc3588.hrl: \ + $(COMPILER_MODULES:compiler/%=$(EBIN)/%.$(EMULATOR)) + +$(DICT_MODULES:%=$(EBIN)/%.$(EMULATOR)): \ + $(INCDIR)/diameter.hrl \ + $(INCDIR)/diameter_gen.hrl + +depend: depend.mk + +# Generate dependencies makefile. +depend.mk: depend.sed $(MODULES:%=%.erl) Makefile + (for f in $(MODULES); do \ + (echo $$f; cat $$f.erl) | sed -f $<; \ + done) \ + > $@ + +-include depend.mk + +.PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) +.PHONY: app clean depend dict info release_subdir +.PHONY: debug opt release_docs_spec release_spec +.PHONY: $(TARGET_DIRS:%/=%) diff --git a/lib/diameter/src/app/.gitignore b/lib/diameter/src/app/.gitignore deleted file mode 100644 index d388e61877..0000000000 --- a/lib/diameter/src/app/.gitignore +++ /dev/null @@ -1,6 +0,0 @@ - -/diameter_gen_*.erl -/diameter_gen_*.hrl -/depend.mk -/diameter.mk - diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile deleted file mode 100644 index 7752bb1798..0000000000 --- a/lib/diameter/src/app/Makefile +++ /dev/null @@ -1,215 +0,0 @@ -# -# %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% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- - -include ../../vsn.mk - -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -DICT_FILES = $(DICTIONARIES:%=../dict/%.dia) -DICT_MODULES = $(DICTIONARIES:%=diameter_gen_%) -DICT_ERL_FILES = $(DICT_MODULES:%=%.erl) -DICT_HRL_FILES = $(DICT_MODULES:%=%.hrl) - -MODULES = \ - $(RUNTIME_MODULES) \ - $(HELP_MODULES) - -APP_MODULES = \ - $(RUNTIME_MODULES) \ - $(DICT_MODULES) - -TARGET_MODULES = \ - $(APP_MODULES) \ - $(HELP_MODULES) - -TARGET_FILES = \ - $(TARGET_MODULES:%=$(EBIN)/%.$(EMULATOR)) \ - $(APP_TARGET) \ - $(APPUP_TARGET) - -ESCRIPT_FILES = \ - ../../bin/diameterc - -APP_FILE = diameter.app -APP_SRC = $(APP_FILE).src -APP_TARGET = $(EBIN)/$(APP_FILE) - -APPUP_FILE = diameter.appup -APPUP_SRC = $(APPUP_FILE).src -APPUP_TARGET = $(EBIN)/$(APPUP_FILE) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @$(MAKE) TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) $(DICT_ERL_FILES) $(DICT_HRL_FILES) - rm -f $(APP_TARGET) $(APPUP_TARGET) - rm -f errs core *~ diameter_gen_*.forms diameter_gen_*.spec - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "DICTIONARIES = $(DICTIONARIES)" - @echo "MODULES = $(MODULES)" - @echo "" - @echo "EXTERNAL_HRL_FILES = $(EXTERNAL_HRL_FILES)" - @echo "INTERNAL_HRL_FILES = $(INTERNAL_HRL_FILES)" - @echo "" - @echo "EXAMPLE_FILES = $(EXAMPLE_FILES)" - @echo "" - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# erl/hrl from application spec -diameter_gen_%.erl diameter_gen_%.hrl: ../dict/%.dia - ../../bin/diameterc -i $(EBIN) $< - -# Generate the app file and then modules into in. This shouldn't know -# about ../transport but good enough for now. -$(APP_TARGET): $(APP_SRC) \ - ../../vsn.mk \ - modules.mk \ - ../transport/modules.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - M=`echo $(APP_MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ - echo "/%APP_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ - | ed -s $@ - $(MAKE) -C ../transport $(APP_TARGET) APP_TARGET=$(APP_TARGET) - -$(APPUP_TARGET): $(APPUP_SRC) ../../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -# This isn't a dependency for $(DICT_ERL_FILES) $(DICT_HRL_FILES) -# since it would force recompilation: compiler must explicity be made -# first, which ../Makefile does. Should share a makefile for proper -# dependencies. (Aka, recursive make considered harmful.) -compiler: - $(MAKE) -C ../$@ - -app: $(APP_TARGET) $(APPUP_TARGET) -dict: $(DICT_ERL_FILES) - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/bin - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src/app - $(INSTALL_DIR) $(RELSYSDIR)/src/dict - $(INSTALL_DIR) $(RELSYSDIR)/include - $(INSTALL_DIR) $(RELSYSDIR)/examples - $(INSTALL_SCRIPT) $(ESCRIPT_FILES) $(RELSYSDIR)/bin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(MODULES:%=%.erl) $(DICT_ERL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(DICT_FILES) $(RELSYSDIR)/src/dict - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src/app - $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) $(RELSYSDIR)/include - $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples - -release_docs_spec: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -diameter_gen_base_accounting.erl diameter_gen_relay.erl: \ - $(EBIN)/diameter_gen_base_rfc3588.beam - -$(DICT_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)): \ - $(DIAMETER_TOP)/include/diameter.hrl \ - $(DIAMETER_TOP)/include/diameter_gen.hrl - -depend: depend.mk - -# Generate dependencies makefile. It's assumed that the compile target -# has already been made since it's currently not smart enough to not -# force a rebuild of those beams dependent on generated hrls, and this -# is a no-no at make release. -depend.mk: depend.sed $(MODULES:%=%.erl) Makefile - (for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done) \ - > $@ - --include depend.mk - -.PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) -.PHONY: app clean debug depend info opt compiler dict -.PHONY: release_spec release_docs_spec diff --git a/lib/diameter/src/app/depend.sed b/lib/diameter/src/app/depend.sed deleted file mode 100644 index 9df0133960..0000000000 --- a/lib/diameter/src/app/depend.sed +++ /dev/null @@ -1,31 +0,0 @@ -# -# %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% -# - -# -# Extract include dependencies from .erl files. The output is massaged -# further in Makefile. -# - -/^-include/!d -/"diameter/!d - -s@^-include_lib("[^/]*@$(DIAMETER_TOP)@ -s@^-include("@@ -s@".*@@ -s@^@$(EBIN)/.$(EMULATOR): @ diff --git a/lib/diameter/src/app/diameter.app.src b/lib/diameter/src/app/diameter.app.src deleted file mode 100644 index a806b5c78a..0000000000 --- a/lib/diameter/src/app/diameter.app.src +++ /dev/null @@ -1,28 +0,0 @@ -%% -%% %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% -%% - -{application, diameter, - [{description, "Diameter protocol"}, - {vsn, "%VSN%"}, - {modules, [%APP_MODULES%,%TRANSPORT_MODULES%]}, - {registered, []}, - {applications, [stdlib, kernel]}, - {env, []}, - {mod, {diameter_app, []}} - ]}. diff --git a/lib/diameter/src/app/diameter.appup.src b/lib/diameter/src/app/diameter.appup.src deleted file mode 100644 index 6d8ceadb92..0000000000 --- a/lib/diameter/src/app/diameter.appup.src +++ /dev/null @@ -1,47 +0,0 @@ -%% This is an -*- erlang -*- file. -%% -%% %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% -%% - -{"%VSN%", - [ - {"0.9", - [ - {load_module, diameter, soft_purge, soft_purge, []}, - {load_module, diameter_capx, soft_purge, soft_purge, []}, - {load_module, diameter_codec, soft_purge, soft_purge, [diameter_lib]}, - {load_module, diameter_lib, soft_purge, soft_purge, []}, - {load_module, diameter_types, soft_purge, soft_purge, []}, - {load_module, diameter_gen_base_accounting, soft_purge, soft_purge, []}, - {load_module, diameter_gen_base_rfc3588, soft_purge, soft_purge, []}, - {load_module, diameter_gen_relay, soft_purge, soft_purge, []}, - {update, diameter_service, soft, soft_purge, soft_purge, [diameter_lib]}, - {update, diameter_config, soft, soft_purge, soft_purge, []}, - {update, diameter_peer, soft, soft_purge, soft_purge, []}, - {update, diameter_peer_fsm, soft, soft_purge, soft_purge, [diameter_lib]}, - {update, diameter_reg, soft, soft_purge, soft_purge, []}, - {update, diameter_sctp, soft, soft_purge, soft_purge, []}, - {update, diameter_stats, soft, soft_purge, soft_purge, []}, - {update, diameter_sync, soft, soft_purge, soft_purge, []}, - {update, diameter_watchdog, soft, soft_purge, soft_purge, [diameter_lib]} - ] - } - ], - [ - ] -}. diff --git a/lib/diameter/src/app/diameter.erl b/lib/diameter/src/app/diameter.erl deleted file mode 100644 index 2f721421d8..0000000000 --- a/lib/diameter/src/app/diameter.erl +++ /dev/null @@ -1,190 +0,0 @@ -%% -%% %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% -%% - --module(diameter). - -%% Configuration. --export([start_service/2, - stop_service/1, - add_transport/2, - remove_transport/2, - subscribe/1, - unsubscribe/1]). - -%% Traffic. --export([session_id/1, - origin_state_id/0, - call/3, - call/4]). - -%% Information. --export([services/0, - service_info/2]). - -%% Start/stop the application. In a "real" application this should -%% typically be a consequence of specifying diameter in a release file -%% rather than by calling start/stop explicitly. --export([start/0, - stop/0]). - --include("diameter_internal.hrl"). --include("diameter_types.hrl"). - -%%% -------------------------------------------------------------------------- -%%% start/0 -%%% -------------------------------------------------------------------------- - --spec start() - -> ok - | {error, term()}. - -start() -> - application:start(?APPLICATION). - -%%% -------------------------------------------------------------------------- -%%% stop/0 -%%% -------------------------------------------------------------------------- - --spec stop() - -> ok - | {error, term()}. - -stop() -> - application:stop(?APPLICATION). - -%%% -------------------------------------------------------------------------- -%%% start_service/2 -%%% -------------------------------------------------------------------------- - --spec start_service(service_name(), [service_opt()]) - -> ok - | {error, term()}. - -start_service(SvcName, Opts) - when is_list(Opts) -> - diameter_config:start_service(SvcName, Opts). - -%%% -------------------------------------------------------------------------- -%%% stop_service/1 -%%% -------------------------------------------------------------------------- - --spec stop_service(service_name()) - -> ok - | {error, term()}. - -stop_service(SvcName) -> - diameter_config:stop_service(SvcName). - -%%% -------------------------------------------------------------------------- -%%% services/0 -%%% -------------------------------------------------------------------------- - --spec services() - -> [service_name()]. - -services() -> - [Name || {Name, _} <- diameter_service:services()]. - -%%% -------------------------------------------------------------------------- -%%% service_info/2 -%%% -------------------------------------------------------------------------- - --spec service_info(service_name(), atom() | [atom()]) - -> any(). - -service_info(SvcName, Option) -> - diameter_service:info(SvcName, Option). - -%%% -------------------------------------------------------------------------- -%%% add_transport/3 -%%% -------------------------------------------------------------------------- - --spec add_transport(service_name(), {listen|connect, [transport_opt()]}) - -> {ok, transport_ref()} - | {error, term()}. - -add_transport(SvcName, {T, Opts} = Cfg) - when is_list(Opts), (T == connect orelse T == listen) -> - diameter_config:add_transport(SvcName, Cfg). - -%%% -------------------------------------------------------------------------- -%%% remove_transport/2 -%%% -------------------------------------------------------------------------- - --spec remove_transport(service_name(), transport_pred()) - -> ok | {error, term()}. - -remove_transport(SvcName, Pred) -> - diameter_config:remove_transport(SvcName, Pred). - -%%% -------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% -%%% Description: Subscribe to #diameter_event{} messages for the specified -%%% service. -%%% -------------------------------------------------------------------------- - --spec subscribe(service_name()) - -> true. - -subscribe(SvcName) -> - diameter_service:subscribe(SvcName). - -%%% -------------------------------------------------------------------------- -%%% # unsubscribe(SvcName) -%%% -------------------------------------------------------------------------- - --spec unsubscribe(service_name()) - -> true. - -unsubscribe(SvcName) -> - diameter_service:unsubscribe(SvcName). - -%%% ---------------------------------------------------------- -%%% # session_id/1 -%%% ---------------------------------------------------------- - --spec session_id('DiameterIdentity'()) - -> 'OctetString'(). - -session_id(Ident) -> - diameter_session:session_id(Ident). - -%%% ---------------------------------------------------------- -%%% # origin_state_id/0 -%%% ---------------------------------------------------------- - --spec origin_state_id() - -> 'Unsigned32'(). - -origin_state_id() -> - diameter_session:origin_state_id(). - -%%% -------------------------------------------------------------------------- -%%% # call/[34] -%%% -------------------------------------------------------------------------- - --spec call(service_name(), app_alias(), any(), [call_opt()]) - -> any(). - -call(SvcName, App, Message, Options) -> - diameter_service:call(SvcName, {alias, App}, Message, Options). - -call(SvcName, App, Message) -> - call(SvcName, App, Message, []). diff --git a/lib/diameter/src/app/diameter.mk.in b/lib/diameter/src/app/diameter.mk.in deleted file mode 100644 index c161064303..0000000000 --- a/lib/diameter/src/app/diameter.mk.in +++ /dev/null @@ -1,47 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -DIAMETER_TOP = @DIAMETER_TOP@ - -# ifneq ($(PREFIX),) -# ifeq ($(TESTROOT),) -# TESTROOT = $(PREFIX) -# endif -# endif - -ifeq ($(USE_DIAMETER_TEST_CODE), true) -ERL_COMPILE_FLAGS += -DDIAMETER_TEST_CODE=mona_lisa_spelar_doom -endif - -ifeq ($(USE_DIAMETER_HIPE), true) -ERL_COMPILE_FLAGS += +native -endif - -ifeq ($(WARN_UNUSED_WARS), true) -ERL_COMPILE_FLAGS += +warn_unused_vars -endif - -DIAMETER_APP_VSN_COMPILE_FLAGS = \ - +'{parse_transform,sys_pre_attributes}' \ - +'{attribute,insert,app_vsn,$(APP_VSN)}' - -DIAMETER_ERL_COMPILE_FLAGS += \ - -pa $(DIAMETER_TOP)/ebin \ - $(DIAMETER_APP_VSN_COMPILE_FLAGS) - diff --git a/lib/diameter/src/app/diameter_app.erl b/lib/diameter/src/app/diameter_app.erl deleted file mode 100644 index 600f7ff04d..0000000000 --- a/lib/diameter/src/app/diameter_app.erl +++ /dev/null @@ -1,36 +0,0 @@ -%% -%% %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% -%% - --module(diameter_app). - --behaviour(application). - -%% application callbacks --export([start/2, - stop/1]). - -%% start/2 - -start(_Type, _Args) -> - diameter_sup:start_link(). - -%% stop/1 - -stop(_) -> - ok. diff --git a/lib/diameter/src/app/diameter_callback.erl b/lib/diameter/src/app/diameter_callback.erl deleted file mode 100644 index 6d5c8cdca1..0000000000 --- a/lib/diameter/src/app/diameter_callback.erl +++ /dev/null @@ -1,91 +0,0 @@ -%% -%% %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% -%% - -%% -%% A minimal application callback module. -%% - --module(diameter_callback). - --export([peer_up/3, - peer_down/3, - pick_peer/4, - prepare_request/3, - prepare_retransmit/3, - handle_request/3, - handle_answer/4, - handle_error/4]). - --include_lib("diameter/include/diameter.hrl"). - -%%% ---------------------------------------------------------- -%%% # peer_up/3 -%%% ---------------------------------------------------------- - -peer_up(_Svc, _Peer, State) -> - State. - -%%% ---------------------------------------------------------- -%%% # peer_down/3 -%%% ---------------------------------------------------------- - -peer_down(_SvcName, _Peer, State) -> - State. - -%%% ---------------------------------------------------------- -%%% # pick_peer/4 -%%% ---------------------------------------------------------- - -pick_peer([Peer|_], _, _SvcName, _State) -> - {ok, Peer}. - -%%% ---------------------------------------------------------- -%%% # prepare_request/3 -%%% ---------------------------------------------------------- - -prepare_request(Pkt, _SvcName, _Peer) -> - {send, Pkt}. - -%%% ---------------------------------------------------------- -%%% # prepare_retransmit/3 -%%% ---------------------------------------------------------- - -prepare_retransmit(Pkt, _SvcName, _Peer) -> - {send, Pkt}. - -%%% ---------------------------------------------------------- -%%% # handle_request/3 -%%% ---------------------------------------------------------- - -handle_request(_Pkt, _SvcName, _Peer) -> - {protocol_error, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED - -%%% ---------------------------------------------------------- -%%% # handle_answer/4 -%%% ---------------------------------------------------------- - -handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) -> - Ans. - -%%% --------------------------------------------------------------------------- -%%% # handle_error/4 -%%% --------------------------------------------------------------------------- - -handle_error(Reason, _Req, _SvcName, _Peer) -> - {error, Reason}. diff --git a/lib/diameter/src/app/diameter_capx.erl b/lib/diameter/src/app/diameter_capx.erl deleted file mode 100644 index 138e76411e..0000000000 --- a/lib/diameter/src/app/diameter_capx.erl +++ /dev/null @@ -1,405 +0,0 @@ -%% -%% %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% -%% - -%% -%% This module builds CER and CEA records for use during capabilities -%% exchange. All of a CER/CEA is built from AVP values configured on -%% the service in question but values for Supported-Vendor-Id, -%% Vendor-Specific-Application-Id, Auth-Application-Id and -%% Acct-Application-id are also obtained using an older method that -%% remains only for backwards compatibility. With this method, each -%% dictionary module was required to export a cer/0 that returned a -%% diameter_base_CER record (or corresponding list, although the list -%% is also a later addition). Each returned CER contributes its member -%% values for the aforementioned four AVPs to the resulting CER, with -%% remaining AVP's either unspecified or identical to those configured -%% on the service. Auth-Application-Id and Acct-Application-id were -%% originally treated a little differently, each callback being -%% required to return either no value of the same value as the other -%% callbacks, but this coupled the callback modules unnecessarily. (A -%% union is backwards compatible to boot.) -%% -%% Values obtained from the service and callbacks are all included -%% when building a CER. Older code with only callback can continue to -%% use them, newer code should probably stick to service configuration -%% (since this is more explicit) or mix at their own peril. -%% -%% The cer/0 callback is now undocumented (despite never being fully -%% documented to begin with) and should be considered deprecated even -%% by those poor souls still using it. -%% - --module(diameter_capx). - --export([build_CER/1, - recv_CER/2, - recv_CEA/2, - make_caps/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). --include("diameter_gen_base_rfc3588.hrl"). - --define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). --define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION'). --define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). - --define(NO_INBAND_SECURITY, 0). --define(TLS, 1). - -%% =========================================================================== - --type tried(T) :: {ok, T} | {error, {term(), list()}}. - --spec build_CER(#diameter_caps{}) - -> tried(#diameter_base_CER{}). - -build_CER(Caps) -> - try_it([fun bCER/1, Caps]). - --spec recv_CER(#diameter_base_CER{}, #diameter_service{}) - -> tried({['Unsigned32'()], #diameter_caps{}, #diameter_base_CEA{}}). - -recv_CER(CER, Svc) -> - try_it([fun rCER/2, CER, Svc]). - --spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) - -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). - -recv_CEA(CEA, Svc) -> - try_it([fun rCEA/2, CEA, Svc]). - -make_caps(Caps, Opts) -> - try_it([fun mk_caps/2, Caps, Opts]). - -%% =========================================================================== -%% =========================================================================== - -try_it([Fun | Args]) -> - try apply(Fun, Args) of - T -> {ok, T} - catch - throw: ?FAILURE(Reason) -> {error, {Reason, Args}} - end. - -%% mk_caps/2 - -mk_caps(Caps0, Opts) -> - {Caps, _} = lists:foldl(fun set_cap/2, - {Caps0, #diameter_caps{_ = false}}, - Opts), - Caps. - --define(SC(K,F), - set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) -> - {Caps#diameter_caps{F = cap(K, Val)}, C#diameter_caps{F = true}}). - -?SC('Origin-Host', origin_host); -?SC('Origin-Realm', origin_realm); -?SC('Host-IP-Address', host_ip_address); -?SC('Vendor-Id', vendor_id); -?SC('Product-Name', product_name); -?SC('Origin-State-Id', origin_state_id); -?SC('Supported-Vendor-Id', supported_vendor_id); -?SC('Auth-Application-Id', auth_application_id); -?SC('Inband-Security-Id', inband_security_id); -?SC('Acct-Application-Id', acct_application_id); -?SC('Vendor-Specific-Application-Id', vendor_specific_application_id); -?SC('Firmware-Revision', firmware_revision); - -set_cap({Key, _}, _) -> - ?THROW({duplicate, Key}). - -cap(K, V) - when K == 'Origin-Host'; - K == 'Origin-Realm'; - K == 'Vendor-Id'; - K == 'Product-Name' -> - V; - -cap('Host-IP-Address', Vs) - when is_list(Vs) -> - lists:map(fun ipaddr/1, Vs); - -cap('Firmware-Revision', V) -> - [V]; - -cap(_, Vs) - when is_list(Vs) -> - Vs; - -cap(K, V) -> - ?THROW({invalid, K, V}). - -ipaddr(A) -> - try - diameter_lib:ipaddr(A) - catch - error: {invalid_address, _} = T -> - ?THROW(T) - end. - -%% bCER/1 -%% -%% Build a CER record to send to a remote peer. - -%% Use the fact that diameter_caps has the same field names as CER. -bCER(#diameter_caps{} = Rec) -> - #diameter_base_CER{} - = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). - -%% rCER/2 -%% -%% Build a CEA record to send to a remote peer in response to an -%% incoming CER. RFC 3588 gives no guidance on what should be sent -%% here: should we advertise applications that the peer hasn't sent in -%% its CER (aside from the relay application) or not? If we send -%% applications that the peer hasn't advertised then the peer may have -%% to be aware of the possibility. If we don't then we just look like -%% a server that supports a subset (possibly) of what the client -%% advertised, so this feels like the path of least incompatibility. -%% However, the current draft standard (draft-ietf-dime-rfc3588bis-26, -%% expires 24 July 2011) says this in section 5.3, Capabilities -%% Exchange: -%% -%% The receiver of the Capabilities-Exchange-Request (CER) MUST -%% determine common applications by computing the intersection of its -%% own set of supported Application Id against all of the application -%% identifier AVPs (Auth-Application-Id, Acct-Application-Id and Vendor- -%% Specific-Application-Id) present in the CER. The value of the -%% Vendor-Id AVP in the Vendor-Specific-Application-Id MUST NOT be used -%% during computation. The sender of the Capabilities-Exchange-Answer -%% (CEA) SHOULD include all of its supported applications as a hint to -%% the receiver regarding all of its application capabilities. -%% -%% Both RFC and the draft also say this: -%% -%% The receiver only issues commands to its peers that have advertised -%% support for the Diameter application that defines the command. A -%% Diameter node MUST cache the supported applications in order to -%% ensure that unrecognized commands and/or AVPs are not unnecessarily -%% sent to a peer. -%% -%% That is, each side sends all of its capabilities and is responsible for -%% not sending commands that the peer doesn't support. - -%% 6.10. Inband-Security-Id AVP -%% -%% NO_INBAND_SECURITY 0 -%% This peer does not support TLS. This is the default value, if the -%% AVP is omitted. -%% -%% TLS 1 -%% This node supports TLS security, as defined by [TLS]. - -rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> - #diameter_base_CEA{} - = CEA - = cea_from_cer(bCER(LCaps)), - - RCaps = capx_to_caps(CER), - SApps = common_applications(LCaps, RCaps, Svc), - - {SApps, - RCaps, - build_CEA(SApps, - LCaps, - RCaps, - CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. - -%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION -%% in the CEA and SHOULD disconnect the transport. However, we have -%% no way to guarantee the send before disconnecting. - -build_CEA([], _, _, CEA) -> - CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; - -build_CEA(_, LCaps, RCaps, CEA) -> - case common_security(LCaps, RCaps) of - [] -> - CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; - [_] = IS -> - CEA#diameter_base_CEA{'Inband-Security-Id' = IS} - end. - -%% common_security/2 - -common_security(#diameter_caps{inband_security_id = LS}, - #diameter_caps{inband_security_id = RS}) -> - cs(LS, RS). - -%% Unspecified is equivalent to NO_INBAND_SECURITY. -cs([], RS) -> - cs([?NO_INBAND_SECURITY], RS); -cs(LS, []) -> - cs(LS, [?NO_INBAND_SECURITY]); - -%% Agree on TLS if both parties support it. When sending CEA, this is -%% to ensure the peer is clear that we will be expecting a TLS -%% handshake since there is no ssl:maybe_accept that would allow the -%% peer to choose between TLS or not upon reception of our CEA. When -%% receiving CEA it deals with a server that isn't explicit about its choice. -%% TODO: Make the choice configurable. -cs(LS, RS) -> - Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS), - ordsets:from_list(RS))), - case lists:member(?TLS, Is) of - true -> - [?TLS]; - false when [] == Is -> - Is; - false -> - [hd(Is)] %% probably NO_INBAND_SECURITY - end. -%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and -%% TLS but don't enforce this. In theory this allows some other -%% security mechanism we don't have to know about, although in -%% practice something there may be a need for more synchronization -%% than notification by way of an event subscription offers. - -%% cea_from_cer/1 - -%% CER is a subset of CEA, the latter adding Result-Code and a few -%% more AVP's. -cea_from_cer(#diameter_base_CER{} = CER) -> - lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, - #diameter_base_CEA{}, - record_info(fields, diameter_base_CER)). - -to_cea(CER, Field, CEA) -> - try ?BASE:'#get-'(Field, CER) of - V -> ?BASE:'#set-'({Field, V}, CEA) - catch - error: _ -> CEA - end. - -%% rCEA/2 - -rCEA(#diameter_base_CEA{'Result-Code' = RC} - = CEA, - #diameter_service{capabilities = LCaps} - = Svc) -> - RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), - - RCaps = capx_to_caps(CEA), - SApps = common_applications(LCaps, RCaps, Svc), - - [] == SApps andalso ?THROW(no_common_applications), - - IS = common_security(LCaps, RCaps), - - [] == IS andalso ?THROW(no_common_security), - - {SApps, IS, RCaps}; - -rCEA(CEA, _Svc) -> - ?THROW({invalid, CEA}). - -%% capx_to_caps/1 - -capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, - 'Origin-Realm' = OR, - 'Host-IP-Address' = IP, - 'Vendor-Id' = VId, - 'Product-Name' = PN, - 'Origin-State-Id' = OSI, - 'Supported-Vendor-Id' = SV, - 'Auth-Application-Id' = Auth, - 'Inband-Security-Id' = IS, - 'Acct-Application-Id' = Acct, - 'Vendor-Specific-Application-Id' = VSA, - 'Firmware-Revision' = FR, - 'AVP' = X}) -> - #diameter_caps{origin_host = OH, - origin_realm = OR, - vendor_id = VId, - product_name = PN, - origin_state_id = OSI, - host_ip_address = IP, - supported_vendor_id = SV, - auth_application_id = Auth, - inband_security_id = IS, - acct_application_id = Acct, - vendor_specific_application_id = VSA, - firmware_revision = FR, - avp = X}; - -capx_to_caps(#diameter_base_CER{} = CER) -> - capx_to_caps(cea_from_cer(CER)). - -%% --------------------------------------------------------------------------- -%% --------------------------------------------------------------------------- - -%% common_applications/3 -%% -%% Identify the (local) applications to be supported on the connection -%% in question. - -common_applications(LCaps, RCaps, #diameter_service{applications = Apps}) -> - LA = app_union(LCaps), - RA = app_union(RCaps), - - lists:foldl(fun(I,A) -> ca(I, Apps, RA, A) end, [], LA). - -ca(Id, Apps, RA, Acc) -> - Relay = lists:member(?APP_ID_RELAY, RA), - #diameter_app{alias = Alias} = find_app(Id, Apps), - tcons(Relay %% peer is a relay - orelse ?APP_ID_RELAY == Id %% we're a relay - orelse lists:member(Id, RA), %% app is supported by the peer - Id, - Alias, - Acc). -%% 5.3 of the RFC states that a peer advertising itself as a relay must -%% be interpreted as having common applications. - -%% Extract the list of all application identifiers from Auth-Application-Id, -%% Acct-Application-Id and Vendor-Specific-Application-Id. -app_union(#diameter_caps{auth_application_id = U, - acct_application_id = C, - vendor_specific_application_id = V}) -> - set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)). - -vsa_apps(#'diameter_base_Vendor-Specific-Application-Id' - {'Auth-Application-Id' = U, - 'Acct-Application-Id' = C}) -> - U ++ C; -vsa_apps(L) -> - Rec = ?BASE:'#new-'('diameter_base_Vendor-Specific-Application-Id', L), - vsa_apps(Rec). - -%% It's a configuration error for a locally advertised application not -%% to be represented in Apps. Don't just match on lists:keyfind/3 in -%% order to generate a more helpful error. -find_app(Id, Apps) -> - case lists:keyfind(Id, #diameter_app.id, Apps) of - #diameter_app{} = A -> - A; - false -> - ?THROW({app_not_configured, Id}) - end. - -set_list(L) -> - sets:to_list(sets:from_list(L)). - -tcons(true, K, V, Acc) -> - [{K,V} | Acc]; -tcons(false, _, _, Acc) -> - Acc. diff --git a/lib/diameter/src/app/diameter_codec.erl b/lib/diameter/src/app/diameter_codec.erl deleted file mode 100644 index d88f42fb7c..0000000000 --- a/lib/diameter/src/app/diameter_codec.erl +++ /dev/null @@ -1,561 +0,0 @@ -%% -%% %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% -%% - --module(diameter_codec). - --export([encode/2, - decode/2, - decode/3, - collect_avps/1, - decode_header/1, - sequence_numbers/1, - hop_by_hop_id/2, - msg_name/1, - msg_id/1]). - -%% Towards generated encoders (from diameter_gen.hrl). --export([pack_avp/1, - pack_avp/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(MASK(N,I), ((I) band (1 bsl (N)))). - -%% 0 1 2 3 -%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Version | Message Length | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | command flags | Command-Code | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Application-ID | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Hop-by-Hop Identifier | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | End-to-End Identifier | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | AVPs ... -%% +-+-+-+-+-+-+-+-+-+-+-+-+- - -%%% --------------------------------------------------------------------------- -%%% # encode/[2-4] -%%% --------------------------------------------------------------------------- - -encode(Mod, #diameter_packet{} = Pkt) -> - try - e(Mod, Pkt) - catch - error: Reason -> - %% Be verbose rather than letting the emulator truncate the - %% error report. - X = {Reason, ?STACK}, - diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}), - exit(X) - end; - -encode(Mod, Msg) -> - Seq = diameter_session:sequence(), - Hdr = #diameter_header{version = ?DIAMETER_VERSION, - end_to_end_id = Seq, - hop_by_hop_id = Seq}, - encode(Mod, #diameter_packet{header = Hdr, - msg = Msg}). - -e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> - Avps = encode_avps(As), - Length = size(Avps) + 20, - - #diameter_header{version = Vsn, - cmd_code = Code, - application_id = Aid, - hop_by_hop_id = Hid, - end_to_end_id = Eid} - = Hdr, - - Flags = make_flags(0, Hdr), - - Pkt#diameter_packet{bin = <>}; - -e(Mod0, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> - #diameter_header{version = Vsn, - hop_by_hop_id = Hid, - end_to_end_id = Eid} - = Hdr, - - {Mod, MsgName} = rec2msg(Mod0, Msg), - {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), - Flags = make_flags(Flags0, Hdr), - - Avps = encode_avps(Mod, MsgName, values(Msg)), - Length = size(Avps) + 20, - - Pkt#diameter_packet{header = Hdr#diameter_header - {length = Length, - cmd_code = Code, - application_id = Aid, - is_request = 0 /= ?MASK(7, Flags), - is_proxiable = 0 /= ?MASK(6, Flags), - is_error = 0 /= ?MASK(5, Flags), - is_retransmitted = 0 /= ?MASK(4, Flags)}, - bin = <>}. - -%% make_flags/2 - -make_flags(Flags0, #diameter_header{is_request = R, - is_proxiable = P, - is_error = E, - is_retransmitted = T}) -> - {Flags, 3} = lists:foldl(fun(B,{F,N}) -> {mf(B,F,N), N-1} end, - {Flags0, 7}, - [R,P,E,T]), - Flags. - -mf(undefined, F, _) -> - F; -mf(B, F, N) -> %% reset the affected bit - (F bxor (F band (1 bsl N))) bor bit(B, N). - -bit(true, N) -> 1 bsl N; -bit(false, _) -> 0. - -%% values/1 - -values([H|T]) - when is_atom(H) -> - T; -values(Avps) -> - Avps. - -%% encode_avps/3 - -%% Specifying values as a #diameter_avp list bypasses arity and other -%% checks: the values are expected to be already encoded and the AVP's -%% presented are simply sent. This is needed for relay agents, since -%% these have to be able to resend whatever comes. - -%% Message as a list of #diameter_avp{} ... -encode_avps(_, _, [#diameter_avp{} | _] = Avps) -> - encode_avps(reorder(Avps, [], Avps)); - -%% ... or as a tuple list or record. -encode_avps(Mod, MsgName, Values) -> - Mod:encode_avps(MsgName, Values). - -%% reorder/1 - -reorder([#diameter_avp{index = 0} | _] = Avps, Acc, _) -> - Avps ++ Acc; - -reorder([#diameter_avp{index = N} = A | Avps], Acc, _) - when is_integer(N) -> - lists:reverse(Avps, [A | Acc]); - -reorder([H | T], Acc, Avps) -> - reorder(T, [H | Acc], Avps); - -reorder([], Acc, _) -> - Acc. - -%% encode_avps/1 - -encode_avps(Avps) -> - list_to_binary(lists:map(fun pack_avp/1, Avps)). - -%% msg_header/3 - -msg_header(Mod, MsgName, Header) -> - {Code, Flags, ApplId} = h(Mod, MsgName, Header), - {Code, p(Flags, Header), ApplId}. - -%% 6.2 of 3588 requires the same 'P' bit on an answer as on the -%% request. - -p(Flags, #diameter_header{is_request = true, - is_proxiable = P}) -> - Flags band (2#10110000 bor choose(P, 2#01000000, 0)); -p(Flags, _) -> - Flags. - -h(Mod, 'answer-message' = MsgName, Header) -> - ?BASE = Mod, - #diameter_header{cmd_code = Code} = Header, - {_, Flags, ApplId} = ?BASE:msg_header(MsgName), - {Code, Flags, ApplId}; - -h(Mod, MsgName, _) -> - Mod:msg_header(MsgName). - -%% rec2msg/2 - -rec2msg(_, ['answer-message' = M | _]) -> - {?BASE, M}; - -rec2msg(Mod, [MsgName|_]) - when is_atom(MsgName) -> - {Mod, MsgName}; - -rec2msg(Mod, Rec) -> - R = element(1, Rec), - A = 'answer-message', - case ?BASE:msg2rec(A) of - R -> - {?BASE, A}; - _ -> - {Mod, Mod:rec2msg(R)} - end. - -%%% --------------------------------------------------------------------------- -%%% # decode/2 -%%% --------------------------------------------------------------------------- - -%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. - -decode(Mod, Pkt) -> - decode(Mod:id(), Mod, Pkt). - -%% If we're a relay application then just extract the avp's without -%% any decoding of their data since we don't know the application in -%% question. -decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> - case collect_avps(Pkt) of - {Bs, As} -> - Pkt#diameter_packet{avps = As, - errors = [Bs]}; - As -> - Pkt#diameter_packet{avps = As} - end; - -%% Otherwise decode using the dictionary. -decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) - when is_atom(Mod) -> - #diameter_header{cmd_code = CmdCode, - is_request = IsRequest, - is_error = IsError} - = Hdr, - - {M, MsgName} = if IsError andalso not IsRequest -> - {?BASE, 'answer-message'}; - true -> - {Mod, Mod:msg_name(CmdCode, IsRequest)} - end, - - decode_avps(MsgName, M, Pkt, collect_avps(Pkt)); - -decode(Id, Mod, Bin) - when is_bitstring(Bin) -> - decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). - -decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ... - ?LOG(invalid, Pkt#diameter_packet.bin), - #diameter_packet{errors = Failed} - = P - = decode_avps(MsgName, Mod, Pkt, Avps), - P#diameter_packet{errors = [Bs | Failed]}; - -decode_avps('', Mod, Pkt, Avps) -> %% unknown message ... - ?LOG(unknown, {Mod, Pkt#diameter_packet.header}), - Pkt#diameter_packet{avps = lists:reverse(Avps), - errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED -%% msg = undefined identifies this case. - -decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not - {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps), - ?LOGC([] /= Failed, failed, {Mod, Failed}), - Pkt#diameter_packet{msg = Rec, - errors = Failed, - avps = As}. - -%%% --------------------------------------------------------------------------- -%%% # decode_header/1 -%%% --------------------------------------------------------------------------- - -decode_header(<>) -> - <> - = CmdFlags, - %% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored - %% by the receiver. - - %% The RFC is quite unclear about the order of the bits in this - %% case. It writes - %% - %% 0 1 2 3 4 5 6 7 - %% +-+-+-+-+-+-+-+-+ - %% |R P E T r r r r| - %% +-+-+-+-+-+-+-+-+ - %% - %% in defining these but the scale refers to the (big endian) - %% transmission order, first to last, not the bit order. That is, - %% R is the high order bit. It's odd that a standard reserves - %% low-order bit rather than high-order ones. - - #diameter_header{version = Version, - length = MsgLength, - cmd_code = CmdCode, - application_id = ApplicationId, - hop_by_hop_id = HopByHopId, - end_to_end_id = EndToEndId, - is_request = 1 == R, - is_proxiable = 1 == P, - is_error = 1 == E, - is_retransmitted = 1 == T}; - -decode_header(_) -> - false. - -%%% --------------------------------------------------------------------------- -%%% # sequence_numbers/1 -%%% --------------------------------------------------------------------------- - -%% The End-To-End identifier must be unique for at least 4 minutes. We -%% maintain a 24-bit wraparound counter, and add an 8-bit persistent -%% wraparound counter. The 8-bit counter is incremented each time the -%% system is restarted. - -sequence_numbers(#diameter_packet{bin = Bin}) - when is_binary(Bin) -> - sequence_numbers(Bin); - -sequence_numbers(#diameter_packet{header = #diameter_header{} = H}) -> - sequence_numbers(H); - -sequence_numbers(#diameter_header{hop_by_hop_id = H, - end_to_end_id = E}) -> - {H,E}; - -sequence_numbers(<<_:12/binary, H:32, E:32, _/binary>>) -> - {H,E}. - -%%% --------------------------------------------------------------------------- -%%% # hop_by_hop_id/2 -%%% --------------------------------------------------------------------------- - -hop_by_hop_id(Id, <>) -> - <>. - -%%% --------------------------------------------------------------------------- -%%% # msg_name/1 -%%% --------------------------------------------------------------------------- - -msg_name(#diameter_header{application_id = ?APP_ID_COMMON, - cmd_code = C, - is_request = R}) -> - ?BASE:msg_name(C,R); - -msg_name(Hdr) -> - msg_id(Hdr). - -%% Note that messages in different applications could have the same -%% name. - -%%% --------------------------------------------------------------------------- -%%% # msg_id/1 -%%% --------------------------------------------------------------------------- - -msg_id(#diameter_packet{msg = [#diameter_header{} = Hdr | _]}) -> - msg_id(Hdr); - -msg_id(#diameter_packet{header = #diameter_header{} = Hdr}) -> - msg_id(Hdr); - -msg_id(#diameter_header{application_id = A, - cmd_code = C, - is_request = R}) -> - {A, C, if R -> 1; true -> 0 end}; - -msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> - {ApplId, CmdCode, Rbit}. - -%%% --------------------------------------------------------------------------- -%%% # collect_avps/1 -%%% --------------------------------------------------------------------------- - -%% Note that the returned list of AVP's is reversed relative to their -%% order in the binary. Note also that grouped avp's aren't unraveled, -%% only those at the top level. - -collect_avps(#diameter_packet{bin = Bin}) -> - <<_:20/binary, Avps/bitstring>> = Bin, - collect_avps(Avps); - -collect_avps(Bin) -> - collect_avps(Bin, 0, []). - -collect_avps(<<>>, _, Acc) -> - Acc; -collect_avps(Bin, N, Acc) -> - try split_avp(Bin) of - {Rest, AVP} -> - collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc]) - catch - ?FAILURE(_) -> - {Bin, Acc} - end. - -%% 0 1 2 3 -%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | AVP Code | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% |V M P r r r r r| AVP Length | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Vendor-ID (opt) | -%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ -%% | Data ... -%% +-+-+-+-+-+-+-+-+ - -%% split_avp/1 - -split_avp(Bin) -> - 8 =< size(Bin) orelse ?THROW(truncated_header), - - <> - = Bin, - - DataSize = Length - 8, % size(Code+Flags+Length) = 8 octets - PadSize = (4 - (DataSize rem 4)) rem 4, - - DataSize + PadSize =< size(Rest) - orelse ?THROW(truncated_data), - - <> - = Rest, - <> - = Flags, - - 0 == Vbit orelse 4 =< size(Data) - orelse ?THROW(truncated_vendor_id), - - {Vid, D} = vid(Vbit, Data), - {R, #diameter_avp{code = Code, - vendor_id = Vid, - is_mandatory = 1 == Mbit, - need_encryption = 1 == Pbit, - data = D}}. - -%% The RFC is a little misleading when stating that OctetString is -%% padded to a 32-bit boundary while other types align naturally. All -%% other types are already multiples of 32 bits so there's no need to -%% distinguish between types here. Any invalid lengths will result in -%% decode error in diameter_types. - -vid(1, <>) -> - {Vid, Data}; -vid(0, Data) -> - {undefined, Data}. - -%%% --------------------------------------------------------------------------- -%%% # pack_avp/1 -%%% --------------------------------------------------------------------------- - -%% The normal case here is data as an #diameter_avp{} list or an -%% iolist, which are the cases that generated codec modules use. The -%% other case is as a convenience in the relay case in which the -%% dictionary doesn't know about specific AVP's. - -%% Grouped AVP whose components need packing ... -pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) -> - pack_avp(A#diameter_avp{data = encode_avps(Avps)}); - -%% ... data as a type/value tuple, possibly with header data, ... -pack_avp(#diameter_avp{data = {Type, Value}} = A) - when is_atom(Type) -> - pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)}); -pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) -> - pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value))); -pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}}) - when is_binary(Bin) -> - pack_avp(T, Bin); -pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> - {Code, _Flags, Vid} = Hdr = Dict:avp_header(Name), - {Name, Type} = Dict:avp_name(Code, Vid), - pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); - -%% ... or as an iolist. -pack_avp(#diameter_avp{code = Code, - vendor_id = V, - is_mandatory = M, - need_encryption = P, - data = Data}) -> - Flags = lists:foldl(fun flag_avp/2, 0, [{V /= undefined, 2#10000000}, - {M, 2#01000000}, - {P, 2#00100000}]), - pack_avp({Code, Flags, V}, iolist_to_binary(Data)). - -flag_avp({true, B}, F) -> - F bor B; -flag_avp({false, _}, F) -> - F. - -%%% --------------------------------------------------------------------------- -%%% # pack_avp/2 -%%% --------------------------------------------------------------------------- - -pack_avp({Code, Flags, VendorId}, Bin) - when is_binary(Bin) -> - Sz = size(Bin), - pack_avp(Code, Flags, VendorId, Sz, pad(Sz rem 4, Bin)). - -pad(0, Bin) -> - Bin; -pad(N, Bin) -> - P = 8*(4-N), - <>. -%% Note that padding is not included in the length field as mandated by -%% the RFC. - -%% pack_avp/5 -%% -%% Prepend the vendor id as required. - -pack_avp(Code, Flags, Vid, Sz, Bin) - when 0 == Flags band 2#10000000 -> - undefined = Vid, %% sanity check - pack_avp(Code, Flags, Sz, Bin); - -pack_avp(Code, Flags, Vid, Sz, Bin) -> - pack_avp(Code, Flags, Sz+4, <>). - -%% pack_avp/4 - -pack_avp(Code, Flags, Sz, Bin) -> - Length = Sz + 8, - <>. - -%% =========================================================================== - -choose(true, X, _) -> X; -choose(false, _, X) -> X. diff --git a/lib/diameter/src/app/diameter_config.erl b/lib/diameter/src/app/diameter_config.erl deleted file mode 100644 index a6b48fe65b..0000000000 --- a/lib/diameter/src/app/diameter_config.erl +++ /dev/null @@ -1,676 +0,0 @@ -%% -%% %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% -%% - -%% -%% This module writes service/transport configuration to the table -%% diameter_config, so that the config will survive service process -%% death, and then turns it into calls towards diameter_service. It -%% also restarts services upon their death. -%% -%% The table diameter_config is only written here while -%% diameter_service reads. This is all somewhat after the fact. Once -%% upon a time the config was only stored in the service process, -%% causing much grief if these processes died (which they did with -%% some regularity) and one was forced to reconfigure. This module was -%% then inserted into the service start in order to keep a more -%% permanent record of the config. That said, service processes are -%% now much more robust than they once were and crashing is a thing of -%% the past. -%% - --module(diameter_config). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([start_service/2, - stop_service/1, - add_transport/2, - remove_transport/2, - have_transport/2, - lookup/1]). - -%% child server start --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% diameter_sync requests. --export([sync/1]). - -%% debug --export([state/0, - uptime/0]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - -%% Server state. --record(state, {id = now()}). - -%% Registered name of the server. --define(SERVER, ?MODULE). - -%% Table config is written to. --define(TABLE, ?MODULE). - -%% Workaround for dialyzer's lack of understanding of match specs. --type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - -%% Configuration records in ?TABLE. - --record(service, - {name, - rec :: match(#diameter_service{}), - options :: match(list())}). - --record(transport, - {service, %% name - ref = make_ref() :: match(reference()), - type :: match(connect | listen), - options :: match(list())}). - -%% Monitor entry in ?TABLE. --record(monitor, {mref = make_ref() :: reference(), - service}). %% name - -%% Time to lay low before restarting a dead service. --define(RESTART_SLEEP, 2000). - -%% A minimal diameter_caps for checking for valid capabilities values. --define(EXAMPLE_CAPS, - #diameter_caps{origin_host = "TheHost", - origin_realm = "TheRealm", - host_ip_address = [{127,0,0,1}], - vendor_id = 42, - product_name = "TheProduct"}). - --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -%%% The return values below assume the server diameter_config is started. -%%% The functions will exit if it isn't. - -%% -------------------------------------------------------------------------- -%% # start_service(SvcName, Opts) -%% -%% Output: ok | {error, Reason} -%% -------------------------------------------------------------------------- - -start_service(SvcName, Opts) - when is_list(Opts) -> - start_rc(sync(SvcName, {start_service, SvcName, Opts})). - -start_rc({ok = T, _Pid}) -> - T; -start_rc({error, _} = No) -> - No; -start_rc(timeout) -> - {error, application_not_started}. - -%% -------------------------------------------------------------------------- -%% # stop_service(SvcName) -%% -%% Output: ok -%% -------------------------------------------------------------------------- - -stop_service(SvcName) -> - sync(SvcName, {stop_service, SvcName}). - -%% -------------------------------------------------------------------------- -%% # add_transport(SvcName, {Type, Opts}) -%% -%% Input: Type = connect | listen -%% -%% Output: {ok, Ref} | {error, Reason} -%% -------------------------------------------------------------------------- - -add_transport(SvcName, {T, Opts}) - when is_list(Opts), (T == connect orelse T == listen) -> - sync(SvcName, {add, SvcName, T, Opts}). - -%% -------------------------------------------------------------------------- -%% # remove_transport(SvcName, Pred) -%% -%% Input: Pred = arity 3 fun on transport ref, connect|listen and Opts, -%% returning true if the transport is to be removed, false if -%% not -%% | arity 2 fun on Ref and Opts only -%% | arity 1 fun on Opts only -%% | Opts matching all transports that have all of the specified -%% options -%% | Ref matching only the transport with this reference. -%% | {M,F,A} applied to Ref, connect|listen and Opts -%% | boolean() -%% -%% Output: ok | {error, Reason} -%% -------------------------------------------------------------------------- - -remove_transport(SvcName, Pred) -> - try - sync(SvcName, {remove, SvcName, pred(Pred)}) - catch - ?FAILURE(Reason) -> - {error, Reason} - end. - -pred(Pred) - when is_function(Pred, 3) -> - Pred; -pred(Pred) - when is_function(Pred, 2) -> - fun(R,_,O) -> Pred(R,O) end; -pred(Pred) - when is_function(Pred, 1) -> - fun(_,_,O) -> Pred(O) end; -pred(Opts) - when is_list(Opts) -> - fun(_,_,O) -> [] == Opts -- O end; -pred(Ref) - when is_reference(Ref) -> - fun(R,_,_) -> R == Ref end; -pred({M,F,A}) - when is_atom(M), is_atom(F), is_list(A) -> - fun(R,T,O) -> apply(M,F,[R,T,O|A]) end; -pred({Type, Pred}) -> %% backwards compatibility - P = pred(Pred), - fun(R,T,O) -> T == Type andalso P(R,T,O) end; -pred(B) - when is_boolean(B) -> - fun(_,_,_) -> B end; -pred(_) -> - ?THROW(pred). - -%% -------------------------------------------------------------------------- -%% # have_transport/2 -%% -%% Output: true | false -%% -------------------------------------------------------------------------- - -have_transport(SvcName, Ref) -> - member([{#transport{service = '$1', - ref = '$2', - _ = '_'}, - [{'andalso', {'=:=', '$1', {const, SvcName}}, - {'=:=', '$2', {const, Ref}}}], - [true]}]). - -%% -------------------------------------------------------------------------- -%% # lookup/1 -%% -------------------------------------------------------------------------- - -lookup(SvcName) -> - select([{#service{name = '$1', rec = '$2', options = '$3'}, - [{'=:=', '$1', {const, SvcName}}], - [{{'$1', '$2', '$3'}}]}, - {#transport{service = '$1', - ref = '$2', - type = '$3', - options = '$4'}, - [{'=:=', '$1', {const, SvcName}}], - [{{'$2', '$3', '$4'}}]}]). - -%% --------------------------------------------------------- -%% EXPORTED INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init/1 -%%% ---------------------------------------------------------- - -init([]) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call/2 -%%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - Reply = {error, {bad_request, Req}}, - {reply, Reply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast/2 -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info/2 -%%% ---------------------------------------------------------- - -%% A service process has died. This is most likely a consequence of -%% stop_service, in which case the restart will find no config for the -%% service and do nothing. The entry keyed on the monitor ref is only -%% removed as a result of the 'DOWN' notification however. -handle_info({'DOWN', MRef, process, _, Reason}, State) -> - [#monitor{service = SvcName} = T] = select([{#monitor{mref = MRef, - _ = '_'}, - [], - ['$_']}]), - queue_restart(Reason, SvcName), - delete_object(T), - {noreply, State}; - -handle_info({monitor, SvcName, Pid}, State) -> - monitor(Pid, SvcName), - {noreply, State}; - -handle_info({restart, SvcName}, State) -> - restart(SvcName), - {noreply, State}; - -handle_info(restart, State) -> - restart(), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%%-------------------------------------------------------------------- -%% # terminate/2 -%%-------------------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%%% ---------------------------------------------------------- -%%% # code_change/3 -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -insert(T) -> - ets:insert(?TABLE, T). - -%% ?TABLE is a bag: check only for a service entry. -have_service(SvcName) -> - member([{#service{name = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - [true]}]). - -member(MatchSpec) -> - '$end_of_table' =/= ets:select(?TABLE, MatchSpec, 1). - -delete_object(T) -> - ets:delete_object(?TABLE, T). - -delete(Key) -> - ets:delete(?TABLE, Key). - -select(MatchSpec) -> - ets:select(?TABLE, MatchSpec). - -select_delete(MatchSpec) -> - ets:select_delete(?TABLE, MatchSpec). - -%% sync/2 -%% -%% Interface functions used to be implemented as calls to ?SERVER but -%% now serialize things per service instead since stopping a service -%% can take time if the server doesn't answer DPR. A caller who wants -%% to stop multiple services can then improve performance by spawning -%% processes to stop them concurrently. - -sync(SvcName, T) -> - diameter_sync:call({?MODULE, SvcName}, - {?MODULE, sync, [T]}, - infinity, - infinity). - -%% sync/1 - -sync({restart, SvcName}) -> - have_service(SvcName) andalso start(SvcName); - -sync({start_service, SvcName, Opts}) -> - try - start(have_service(SvcName), SvcName, Opts) - catch - ?FAILURE(Reason) -> {error, Reason} - end; - -sync({stop_service, SvcName}) -> - stop(SvcName); - -sync({add, SvcName, Type, Opts}) -> - try - add(SvcName, Type, Opts) - catch - ?FAILURE(Reason) -> {error, Reason} - end; - -sync({remove, SvcName, Pred}) -> - remove(select([{#transport{service = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - ['$_']}]), - SvcName, - Pred). - -%% start/3 - -start(true, _, _) -> - {error, already_started}; -start(false, SvcName, Opts) -> - insert(make_config(SvcName, Opts)), - start(SvcName). - -%% start/1 - -start(SvcName) -> - RC = diameter_service:start(SvcName), - startmon(SvcName, RC), - RC. - -startmon(SvcName, {ok, Pid}) -> - ?SERVER ! {monitor, SvcName, Pid}; -startmon(_, {error, _}) -> - ok. - -monitor(Pid, SvcName) -> - MRef = erlang:monitor(process, Pid), - insert(#monitor{mref = MRef, service = SvcName}). - -%% queue_restart/2 - -%% Service has gone down on monitor death. Note that all service-related -%% config is deleted. -queue_restart({shutdown, {monitor, _}}, SvcName) -> - delete(SvcName); - -%% Application shutdown: ignore. -queue_restart(shutdown, _) -> - ok; - -%% Or not. -queue_restart(_, SvcName) -> - erlang:send_after(?RESTART_SLEEP, self(), {restart, SvcName}). - -%% restart/1 - -restart(SvcName) -> - sync(SvcName, {restart, SvcName}). - -%% restart/0 -%% -%% Start anything configured as required. Bang 'restart' to the server -%% to kick things into gear manually. (Not that it should be required -%% but it's been useful for test.) - -restart() -> - MatchSpec = [{#service{name = '$1', _ = '_'}, - [], - ['$1']}], - lists:foreach(fun restart/1, select(MatchSpec)). - -%% stop/1 - -stop(SvcName) -> - %% If the call to the service returns error for any reason other - %% than the process not being alive then deleting the config from - %% under it will surely bring it down. - diameter_service:stop(SvcName), - %% Delete only the service entry, not everything keyed on the name, - select_delete([{#service{name = '$1', _ = '_'}, - [{'=:=', '$1', {const, SvcName}}], - [true]}]), - ok. -%% Note that a transport has to be removed for its statistics to be -%% deleted. - -%% add/3 - -add(SvcName, Type, Opts) -> - %% Ensure usable capabilities. diameter_service:merge_service/2 - %% depends on this. - lists:foreach(fun(Os) -> - is_list(Os) orelse ?THROW({capabilities, Os}), - ok = encode_CER(Os) - end, - [Os || {capabilities, Os} <- Opts, is_list(Os)]), - - Ref = make_ref(), - T = {Ref, Type, Opts}, - %% The call to the service returns error if the service isn't - %% started yet, which is harmless. The transport will be started - %% when the service is in that case. - case start_transport(SvcName, T) of - ok -> - insert(#transport{service = SvcName, - ref = Ref, - type = Type, - options = Opts}), - {ok, Ref}; - {error, _} = No -> - No - end. - -start_transport(SvcName, T) -> - case diameter_service:start_transport(SvcName, T) of - {ok, _Pid} -> - ok; - {error, no_service} -> - ok; - {error, _} = No -> - No - end. - -%% remove/3 - -remove(L, SvcName, Pred) -> - rm(SvcName, lists:filter(fun(#transport{ref = R, type = T, options = O}) -> - Pred(R,T,O) - end, - L)). - -rm(_, []) -> - ok; -rm(SvcName, L) -> - Refs = lists:map(fun(#transport{ref = R}) -> R end, L), - case stop_transport(SvcName, Refs) of - ok -> - lists:foreach(fun delete_object/1, L); - {error, _} = No -> - No - end. - -stop_transport(SvcName, Refs) -> - case diameter_service:stop_transport(SvcName, Refs) of - ok -> - ok; - {error, no_service} -> - ok; - {error, _} = No -> - No - end. - -%% make_config/2 - -make_config(SvcName, Opts) -> - Apps = init_apps(Opts), - [] == Apps andalso ?THROW(no_apps), - - %% Use the fact that diameter_caps has the same field names as CER. - Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER) -- ['AVP'], - - COpts = [T || {K,_} = T <- Opts, lists:member(K, Fields)], - Caps = make_caps(#diameter_caps{}, COpts), - - ok = encode_CER(COpts), - - Os = split(Opts, [{[fun erlang:is_boolean/1], false, share_peers}, - {[fun erlang:is_boolean/1], false, use_shared_peers}, - {[fun erlang:is_pid/1, false], false, monitor}]), - %% share_peers and use_shared_peers are currently undocumented. - - #service{name = SvcName, - rec = #diameter_service{applications = Apps, - capabilities = Caps}, - options = Os}. - -make_caps(Caps, Opts) -> - case diameter_capx:make_caps(Caps, Opts) of - {ok, T} -> - T; - {error, {Reason, _}} -> - ?THROW(Reason) - end. - -%% Validate types by encoding a CER. -encode_CER(Opts) -> - {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts)), - - Hdr = #diameter_header{version = ?DIAMETER_VERSION, - end_to_end_id = 0, - hop_by_hop_id = 0}, - - try - diameter_codec:encode(?BASE, #diameter_packet{header = Hdr, - msg = CER}), - ok - catch - exit: Reason -> - ?THROW(Reason) - end. - -init_apps(Opts) -> - lists:foldl(fun app_acc/2, [], lists:reverse(Opts)). - -app_acc({application, Opts}, Acc) -> - is_list(Opts) orelse ?THROW({application, Opts}), - - [Dict, Mod] = get_opt([dictionary, module], Opts), - Alias = get_opt(alias, Opts, Dict), - ModS = get_opt(state, Opts, Alias), - M = get_opt(call_mutates_state, Opts, false), - A = get_opt(answer_errors, Opts, report), - [#diameter_app{alias = Alias, - dictionary = Dict, - id = cb(Dict, id), - module = init_mod(Mod), - init_state = ModS, - mutable = init_mutable(M), - answer_errors = init_answers(A)} - | Acc]; -app_acc(_, Acc) -> - Acc. - -init_mod(M) - when is_atom(M) -> - [M]; -init_mod([M|_] = L) - when is_atom(M) -> - L; -init_mod(M) -> - ?THROW({module, M}). - -init_mutable(M) - when M == true; - M == false -> - M; -init_mutable(M) -> - ?THROW({call_mutates_state, M}). - -init_answers(A) - when callback == A; - report == A; - discard == A -> - A; -init_answers(A) -> - ?THROW({answer_errors, A}). - -%% Get a single value at the specified key. -get_opt(Keys, List) - when is_list(Keys) -> - [get_opt(K, List) || K <- Keys]; -get_opt(Key, List) -> - case [V || {K,V} <- List, K == Key] of - [V] -> V; - _ -> ?THROW({arity, Key}) - end. - -%% Get an optional value at the specified key. -get_opt(Key, List, Def) -> - case [V || {K,V} <- List, K == Key] of - [] -> Def; - [V] -> V; - _ -> ?THROW({arity, Key}) - end. - -split(Opts, Defs) -> - [{K, value(D, Opts)} || {_,_,K} = D <- Defs]. - -value({Preds, Def, Key}, Opts) -> - V = get_opt(Key, Opts, Def), - lists:any(fun(P) -> pred(P,V) end, Preds) - orelse ?THROW({value, Key}), - V. - -pred(F, V) - when is_function(F) -> - F(V); -pred(T, V) -> - T == V. - -cb(M,F) -> - try M:F() of - V -> V - catch - E: Reason -> - ?THROW({callback, E, Reason, ?STACK}) - end. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_dbg.erl b/lib/diameter/src/app/diameter_dbg.erl deleted file mode 100644 index 5b0ac3a3b6..0000000000 --- a/lib/diameter/src/app/diameter_dbg.erl +++ /dev/null @@ -1,516 +0,0 @@ -%% -%% %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% -%% - --module(diameter_dbg). - --export([table/1, - tables/0, - fields/1, - help/0, - modules/0, - versions/0, - version_info/0, - compiled/0, - procs/0, - latest/0, - nl/0, - log/4]). - --export([diameter_config/0, - diameter_peer/0, - diameter_reg/0, - diameter_request/0, - diameter_sequence/0, - diameter_service/0, - diameter_stats/0]). - --export([pp/1, - subscriptions/0, - children/0]). - -%% Trace help. --export([tracer/0, tracer/1, - p/0, p/1, - stop/0, - tpl/1, - tp/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - - --define(INFO, diameter_info). --define(SEP(), ?INFO:sep()). - --define(LOCAL, [diameter_config, - diameter_peer, - diameter_reg, - diameter_request, - diameter_sequence, - diameter_service, - diameter_stats]). - --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -log(_Slogan, _Mod, _Line, _Details) -> - ok. - -%%% ---------------------------------------------------------- -%%% # help() -%%% ---------------------------------------------------------- - -help() -> - not_yet_implemented. - -%%% ---------------------------------------------------------- -%%% # table(TableName) -%%% -%%% Input: TableName = diameter table containing record entries. -%%% -%%% Output: Count | undefined -%%% ---------------------------------------------------------- - -table(T) - when (T == diameter_peer) orelse (T == diameter_reg) -> - ?INFO:format(collect(T), fields(T), fun ?INFO:split/2); - -table(Table) - when is_atom(Table) -> - case fields(Table) of - undefined = No -> - No; - Fields -> - ?INFO:format(Table, Fields, fun split/2) - end. - -split([started, name | Fs], [S, N | Vs]) -> - {name, [started | Fs], N, [S | Vs]}; -split([[F|FT]|Fs], [Rec|Vs]) -> - [_, V | VT] = tuple_to_list(Rec), - {F, FT ++ Fs, V, VT ++ Vs}; -split([F|Fs], [V|Vs]) -> - {F, Fs, V, Vs}. - -%%% ---------------------------------------------------------- -%%% # TableName() -%%% ---------------------------------------------------------- - --define(TABLE(Name), Name() -> table(Name)). - -?TABLE(diameter_config). -?TABLE(diameter_peer). -?TABLE(diameter_reg). -?TABLE(diameter_request). -?TABLE(diameter_sequence). -?TABLE(diameter_service). -?TABLE(diameter_stats). - -%%% ---------------------------------------------------------- -%%% # tables() -%%% -%%% Output: Number of records output. -%%% -%%% Description: Pretty-print records in diameter tables from all nodes. -%%% ---------------------------------------------------------- - -tables() -> - ?INFO:format(field(?LOCAL), fun split/3, fun collect/1). - -field(Tables) -> - lists:map(fun(T) -> {T, fields(T)} end, lists:sort(Tables)). - -split(_, Fs, Vs) -> - split(Fs, Vs). - -%%% ---------------------------------------------------------- -%%% # modules() -%%% ---------------------------------------------------------- - -modules() -> - Path = filename:join([appdir(), atom_to_list(?APPLICATION) ++ ".app"]), - {ok, [{application, ?APPLICATION, Attrs}]} = file:consult(Path), - {modules, Mods} = lists:keyfind(modules, 1, Attrs), - Mods. - -appdir() -> - [_|_] = code:lib_dir(?APPLICATION, ebin). - -%%% ---------------------------------------------------------- -%%% # versions() -%%% ---------------------------------------------------------- - -versions() -> - ?INFO:versions(modules()). - -%%% ---------------------------------------------------------- -%%% # versions() -%%% ---------------------------------------------------------- - -version_info() -> - ?INFO:version_info(modules()). - -%%% ---------------------------------------------------------- -%%% # compiled() -%%% ---------------------------------------------------------- - -compiled() -> - ?INFO:compiled(modules()). - -%%% ---------------------------------------------------------- -%%% procs() -%%% ---------------------------------------------------------- - -procs() -> - ?INFO:procs(?APPLICATION). - -%%% ---------------------------------------------------------- -%%% # latest() -%%% ---------------------------------------------------------- - -latest() -> - ?INFO:latest(modules()). - -%%% ---------------------------------------------------------- -%%% # nl() -%%% ---------------------------------------------------------- - -nl() -> - lists:foreach(fun(M) -> abcast = c:nl(M) end, modules()). - -%%% ---------------------------------------------------------- -%%% # pp(Bin) -%%% -%%% Description: Pretty-print a message binary. -%%% ---------------------------------------------------------- - -%% Network byte order = big endian. - -pp(<>) -> - ?SEP(), - ppp(["Version", - "Message length", - "[Actual length]", - "R(equest)", - "P(roxiable)", - "E(rror)", - "T(Potential retrans)", - "Reserved bits", - "Command code", - "Application id", - "Hop by hop id", - "End to end id"], - [Version, MsgLength, size(AVPs) + 20, - Rbit, Pbit, Ebit, Tbit, Reserved, - CmdCode, - ApplId, - HbHid, - E2Eid]), - N = avp_loop({AVPs, MsgLength - 20}, 0), - ?SEP(), - N; - -pp(<<_Version:8, MsgLength:24, _/binary>> = Bin) -> - {bad_message_length, MsgLength, size(Bin)}; - -pp(Bin) - when is_binary(Bin) -> - {truncated_binary, size(Bin)}; - -pp(_) -> - not_binary. - -%% avp_loop/2 - -avp_loop({Bin, Size}, N) -> - avp_loop(avp(Bin, Size), N+1); -avp_loop(ok, N) -> - N; -avp_loop([_E, _Rest] = L, N) -> - io:format("! ~s: ~p~n", L), - N; -avp_loop([E, Rest, Fmt | Values], N) - when is_binary(Rest) -> - io:format("! ~s (" ++ Fmt ++ "): ~p~n", [E|Values] ++ [Rest]), - N. - -%% avp/2 - -avp(<<>>, 0) -> - ok; -avp(<>, - Size) -> - avp(Code, Flags, Length, Rest, Size); -avp(Bin, _) -> - ["truncated AVP header", Bin]. - -%% avp/5 - -avp(Code, Flags, Length, Rest, Size) -> - <> - = Flags, - b(), - ppp(["AVP Code", - "V(endor)", - "M(andatory)", - "P(Security)", - "R(eserved)", - "Length"], - [Code, V, M, P, Res, Length]), - avp(V, Rest, Length - 8, Size - 8). - -%% avp/4 - -avp(1, <>, Length, Size) -> - ppp({"Vendor-ID", V}), - data(Data, Length - 4, Size - 4); -avp(1, Bin, _, _) -> - ["truncated Vendor-ID", Bin]; -avp(0, Data, Length, Size) -> - data(Data, Length, Size). - -data(Bin, Length, Size) - when size(Bin) >= Length -> - <> = Bin, - ppp({"Data", AVP}), - unpad(Rest, Size - Length, Length rem 4); - -data(Bin, _, _) -> - ["truncated AVP data", Bin]. - -%% Remove padding bytes up to the next word boundary. -unpad(Bin, Size, 0) -> - {Bin, Size}; -unpad(Bin, Size, N) -> - un(Bin, Size, 4 - N). - -un(Bin, Size, N) - when size(Bin) >= N -> - ppp({"Padding bytes", N}), - <> = Bin, - Bits = N*8, - case Pad of - <<0:Bits>> -> - {Rest, Size - N}; - _ -> - ["non-zero padding", Bin, "~p", N] - end; - -un(Bin, _, _) -> - ["truncated padding", Bin]. - -b() -> - io:format("#~n"). - -ppp(Fields, Values) -> - lists:foreach(fun ppp/1, lists:zip(Fields, Values)). - -ppp({Field, Value}) -> - io:format(": ~-22s : ~p~n", [Field, Value]). - -%%% ---------------------------------------------------------- -%%% # subscriptions() -%%% -%%% Output: list of {SvcName, Pid} -%%% ---------------------------------------------------------- - -subscriptions() -> - diameter_service:subscriptions(). - -%%% ---------------------------------------------------------- -%%% # children() -%%% ---------------------------------------------------------- - -children() -> - diameter_sup:tree(). - -%%% ---------------------------------------------------------- - -%% tracer/[12] - -tracer(Port) - when is_integer(Port) -> - dbg:tracer(port, dbg:trace_port(ip, Port)); - -tracer(Path) - when is_list(Path) -> - dbg:tracer(port, dbg:trace_port(file, Path)). - -tracer() -> - dbg:tracer(process, {fun p/2, ok}). - -p(T,_) -> - io:format("+ ~p~n", [T]). - -%% p/[01] - -p() -> - p([c,timestamp]). - -p(T) -> - dbg:p(all,T). - -%% stop/0 - -stop() -> - dbg:ctp(), - dbg:stop_clear(). - -%% tpl/1 -%% tp/1 - -tpl(T) -> - dbg(tpl, T). - -tp(T) -> - dbg(tp, T). - -%% dbg/2 - -dbg(F, L) - when is_list(L) -> - [dbg(F, X) || X <- L]; - -dbg(F, M) - when is_atom(M) -> - apply(dbg, F, [M, x]); - -dbg(F, T) - when is_tuple(T) -> - apply(dbg, F, tuple_to_list(T)). - -%% =========================================================================== -%% =========================================================================== - -%% collect/1 - -collect(diameter_peer) -> - lists:flatmap(fun peers/1, diameter:services()); - -collect(diameter_reg) -> - diameter_reg:terms(); - -collect(Name) -> - c(ets:info(Name), Name). - -c(undefined, _) -> - []; -c(_, Name) -> - ets:tab2list(Name). - -%% peers/1 - -peers(Name) -> - peers(Name, diameter:service_info(Name, transport)). - -peers(_, undefined) -> - []; -peers(Name, Ts) -> - lists:flatmap(fun(T) -> mk_peers(Name, T) end, Ts). - -mk_peers(Name, [_, {type, connect} | _] = Ts) -> - [[Name | mk_peer(Ts)]]; -mk_peers(Name, [R, {type, listen}, O, {accept = A, As}]) -> - [[Name | mk_peer([R, {type, A}, O | Ts])] || Ts <- As]. -%% This is a bit lame: service_info works to build this list and out -%% of something like what we want here and then we take it apart. - -mk_peer(Vs) -> - [Type, Ref, State, Opts, WPid, TPid, SApps, Caps] - = get_values(Vs, [type,ref,state,options,watchdog,peer,apps,caps]), - [Ref, State, [{type, Type} | Opts], s(WPid), s(TPid), SApps, Caps]. - -get_values(Vs, Ks) -> - [proplists:get_value(K, Vs) || K <- Ks]. - -s(undefined = T) -> - T; -s({Pid, _Started, _State}) -> - state(Pid); -s({Pid, _Started}) -> - state(Pid). - -%% Collect states from watchdog/transport pids. -state(Pid) -> - MRef = erlang:monitor(process, Pid), - Pid ! {state, self()}, - receive - {'DOWN', MRef, process, _, _} -> - Pid; - {Pid, _} = T -> - erlang:demonitor(MRef, [flush]), - T - end. - -%% fields/1 - --define(FIELDS(Table), fields(Table) -> record_info(fields, Table)). - -fields(diameter_config) -> - []; - -fields(T) - when T == diameter_request; - T == diameter_sequence -> - fun kv/1; - -fields(diameter_stats) -> - fun({Ctr, N}) when not is_pid(Ctr) -> - {[counter, value], [Ctr, N]}; - (_) -> - [] - end; - -fields(diameter_service) -> - [started, - name, - record_info(fields, diameter_service), - peerT, - connT, - share_peers, - use_shared_peers, - shared_peers, - local_peers, - monitor]; - -?FIELDS(diameter_event); -?FIELDS(diameter_uri); -?FIELDS(diameter_avp); -?FIELDS(diameter_header); -?FIELDS(diameter_packet); -?FIELDS(diameter_app); -?FIELDS(diameter_caps); - -fields(diameter_peer) -> - [service, ref, state, options, watchdog, peer, applications, capabilities]; - -fields(diameter_reg) -> - [property, pids]; - -fields(_) -> - undefined. - -kv({_,_}) -> - [key, value]; -kv(_) -> - []. diff --git a/lib/diameter/src/app/diameter_dict.erl b/lib/diameter/src/app/diameter_dict.erl deleted file mode 100644 index 3b9ba00a3f..0000000000 --- a/lib/diameter/src/app/diameter_dict.erl +++ /dev/null @@ -1,153 +0,0 @@ -%% -%% %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% -%% - -%% -%% This module provide OTP's dict interface built on top of ets. -%% -%% Note that while the interface is the same as dict the semantics -%% aren't quite. A Dict here is just a table identifier (although -%% this fact can't be used if you want dict/ets-based implementations -%% to be interchangeable) so changes made to the Dict modify the -%% underlying table. For merge/3, the first argument table is modified. -%% -%% The underlying ets table implementing a dict is deleted when the -%% process from which new() was invoked exits and the dict is only -%% writable from this process. -%% -%% The reason for this is to be able to swap dict/ets-based -%% implementations: the former is easier to debug, the latter is -%% faster for larger tables. It's also just a nice interface even -%% when there's no need for swapability. -%% - --module(diameter_dict). - --export([append/3, - append_list/3, - erase/2, - fetch/2, - fetch_keys/1, - filter/2, - find/2, - fold/3, - from_list/1, - is_key/2, - map/2, - merge/3, - new/0, - store/3, - to_list/1, - update/3, - update/4, - update_counter/3]). - -%%% ---------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% ---------------------------------------------------------- - -append(Key, Value, Dict) -> - append_list(Key, [Value], Dict). - -append_list(Key, ValueList, Dict) - when is_list(ValueList) -> - update(Key, fun(V) -> V ++ ValueList end, ValueList, Dict). - -erase(Key, Dict) -> - ets:delete(Dict, Key), - Dict. - -fetch(Key, Dict) -> - {ok, V} = find(Key, Dict), - V. - -fetch_keys(Dict) -> - ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). - -filter(Pred, Dict) -> - lists:foreach(fun({K,V}) -> filter(Pred(K,V), K, Dict) end, to_list(Dict)), - Dict. - -find(Key, Dict) -> - case ets:lookup(Dict, Key) of - [{Key, V}] -> - {ok, V}; - [] -> - error - end. - -fold(Fun, Acc0, Dict) -> - ets:foldl(fun({K,V}, Acc) -> Fun(K, V, Acc) end, Acc0, Dict). - -from_list(List) -> - lists:foldl(fun store/2, new(), List). - -is_key(Key, Dict) -> - ets:member(Dict, Key). - -map(Fun, Dict) -> - lists:foreach(fun({K,V}) -> store(K, Fun(K,V), Dict) end, to_list(Dict)), - Dict. - -merge(Fun, Dict1, Dict2) -> - fold(fun(K2,V2,_) -> - update(K2, fun(V1) -> Fun(K2, V1, V2) end, V2, Dict1) - end, - Dict1, - Dict2). - -new() -> - ets:new(?MODULE, [set]). - -store(Key, Value, Dict) -> - store({Key, Value}, Dict). - -to_list(Dict) -> - ets:tab2list(Dict). - -update(Key, Fun, Dict) -> - store(Key, Fun(fetch(Key, Dict)), Dict). - -update(Key, Fun, Initial, Dict) -> - store(Key, map(Key, Fun, Dict, Initial), Dict). - -update_counter(Key, Increment, Dict) - when is_integer(Increment) -> - update(Key, fun(V) -> V + Increment end, Increment, Dict). - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -store({_,_} = T, Dict) -> - ets:insert(Dict, T), - Dict. - -filter(true, _, _) -> - ok; -filter(false, K, Dict) -> - erase(K, Dict). - -map(Key, Fun, Dict, Error) -> - case find(Key, Dict) of - {ok, V} -> - Fun(V); - error -> - Error - end. - diff --git a/lib/diameter/src/app/diameter_info.erl b/lib/diameter/src/app/diameter_info.erl deleted file mode 100644 index 39d32d07cd..0000000000 --- a/lib/diameter/src/app/diameter_info.erl +++ /dev/null @@ -1,869 +0,0 @@ -%% -%% %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% -%% - --module(diameter_info). - --export([usage/1, - format/1, - format/2, - format/3, - format/4, - table/2, - tables/1, - tables/2, - split/2, - split/3, - tab2list/1, - modules/1, - versions/1, - version_info/1, - attrs/2, - compiled/1, - procs/1, - latest/1, - list/1]). - -%% Support for rolling your own. --export([sep/0, - sep/1, - widest/1, - p/1, - p/3]). - --compile({no_auto_import,[max/2]}). - --export([collect/2]). - --define(LONG_TIMEOUT, 30000). --define(VALUES(Rec), tl(tuple_to_list(Rec))). - -%%% ---------------------------------------------------------- -%%% # usage(String) -%%% ---------------------------------------------------------- - -usage(Usage) -> - sep($+), - io:format("+ ~p~n", [?MODULE]), - io:format("~n~s~n~n", [compact(Usage)]), - sep($+). - -%%% -%%% The function format/3, for pretty-printing tables, comes in -%%% several flavours. -%%% - -%%% ---------------------------------------------------------- -%%% # format(TableName, Fields, SplitFun) -%%% -%%% Input: TableName = atom() name of table. -%%% -%%% Fields = List of field names for the records maintained -%%% in the specified table. Can be empty, in which -%%% case entries are listed unadorned of field names -%%% and SplitFun is unused. -%%% | Integer, equivalent to a list with this many '' atoms. -%%% | Arity 1 fun mapping a table entry to a Fields list -%%% or a tuple {Fields, Values} of lists of the same -%%% length. -%%% -%%% If Fields is a list then its length must be the same -%%% as or one less than the size of the tuples contained -%%% in the table. (The values printed then being those -%%% in the tuple or record in question.) -%%% -%%% SplitFun = Arity 3 fun applied as -%%% -%%% SplitFun(TableName, Fields, Values) -%%% -%%% in order to obtain a tuple -%%% -%%% {Field, RestFields, Value, RestValues} -%%% -%%% for which Field/Value will be formatted on -%%% STDOUT. (This is to allow a value to be -%%% transformed before being output by returning a -%%% new value and/or replacing the remainder of -%%% the list.) The returned lists must have the -%%% same length and Field here is an atom, '' causing -%%% a value to be listed unadorned of the field name. -%%% -%%% Field can also be list of field names, in -%%% which case Value must be a record of the -%%% corresponding type. -%%% -%%% | Arity 2 fun applied as SplitFun(Fields, Values). -%%% -%%% Output: Count | undefined -%%% -%%% Count = Number of entries output. -%%% -%%% Description: Pretty-print records in a named table. -%%% ---------------------------------------------------------- - -format(Table, Fields, SFun) - when is_atom(Table), is_function(SFun, 2) -> - ft(ets:info(Table), Table, SFun, Fields); - -format(Table, Fields, SFun) - when is_atom(Table), is_function(SFun, 3) -> - format(Table, Fields, fun(Fs,Vs) -> SFun(Table, Fs, Vs) end); - -%%% ---------------------------------------------------------- -%%% # format(Recs, Fields, SplitFun) -%%% -%%% Input: Recs = list of records/tuples -%%% Fields = As for format(Table, Fields, SplitFun), a table -%%% entry there being a member of Recs. -%%% SplitFun = Arity 3 fun applied as above but with the TableName -%%% replaced by the first element of the records in -%%% question. -%%% | Arity 2 fun as for format/3. -%%% -%%% Output: length(Recs) -%%% -%%% Description: Pretty print records/tuples. -%%% ---------------------------------------------------------- - -format(Recs, Fields, SFun) - when is_list(Recs), is_function(SFun, 3) -> - lists:foldl(fun(R,A) -> f(recsplit(SFun, R), 0, Fields, R, A) end, - 0, - Recs); - -format(Recs, Fields, SFun) - when is_list(Recs), is_function(SFun, 2) -> - lists:foldl(fun(R,A) -> f(SFun, 0, Fields, R, A) end, - 0, - Recs); - -%%% ---------------------------------------------------------- -%%% # format(Tables, SplitFun, CollectFun) -%%% -%%% Input: Tables = list of {TableName, Fields}. -%%% SplitFun = As for format(Table, Fields, SplitFun). -%%% CollectFun = arity 1 fun mapping a table name to a list -%%% of elements. A non-list can be returned to indicate -%%% that the table in question doesn't exist. -%%% -%%% Output: Number of entries output. -%%% -%%% Description: Pretty-print records in a named tables as collected -%%% from known nodes. Each table listing is preceeded by -%%% a banner. -%%% ---------------------------------------------------------- - -format(Tables, SFun, CFun) - when is_list(Tables), is_function(CFun, 1) -> - format_remote(Tables, - SFun, - rpc:multicall(nodes(known), - ?MODULE, - collect, - [CFun, lists:map(fun({T,_}) -> T end, Tables)], - ?LONG_TIMEOUT)); - -%%% ---------------------------------------------------------- -%%% # format(LocalTables, RemoteTables, SplitFun, CollectFun) -%%% # format(LocalTables, RemoteTables, SplitFun) -%%% -%%% Input: LocalTables = list of {TableName, Fields}. -%%% | list of {TableName, Recs, Fields} -%%% RemoteTable = list of {TableName, Fields}. -%%% SplitFun, CollectFun = As for format(Table, CollectFun, SplitFun). -%%% -%%% Output: Number of entries output. -%%% -%%% Description: Pretty-print records in a named tables as collected -%%% from local and remote nodes. Each table listing is -%%% preceeded by a banner. -%%% ---------------------------------------------------------- - -format(Local, Remote, SFun) -> - format(Local, Remote, SFun, fun tab2list/1). - -format(Local, Remote, SFun, CFun) - when is_list(Local), is_list(Remote), is_function(CFun, 1) -> - format_local(Local, SFun) + format(Remote, SFun, CFun). - -%%% ---------------------------------------------------------- -%%% # format(Tables, SplitFun) -%%% ---------------------------------------------------------- - -format(Tables, SFun) - when is_list(Tables), (is_function(SFun, 2) or is_function(SFun, 3)) -> - format(Tables, SFun, fun tab2list/1); - -format(Tables, CFun) - when is_list(Tables), is_function(CFun, 1) -> - format(Tables, fun split/2, CFun). - -%%% ---------------------------------------------------------- -%%% # format(Table|Tables) -%%% ---------------------------------------------------------- - -format(Table) - when is_atom(Table) -> - format(Table, [], fun split/2); - -format(Tables) - when is_list(Tables) -> - format(Tables, fun split/2, fun tab2list/1). - -%%% ---------------------------------------------------------- -%%% # split(TableName, Fields, Values) -%%% -%%% Description: format/3 SplitFun that does nothing special. -%%% ---------------------------------------------------------- - -split([F|FT], [V|VT]) -> - {F, FT, V, VT}. - -split(_, Fs, Vs) -> - split(Fs, Vs). - -%%% ---------------------------------------------------------- -%%% # tab2list(TableName) -%%% -%%% Description: format/4 CollectFun that extracts records from an -%%% existing ets table. -%%% ---------------------------------------------------------- - -tab2list(Table) -> - case ets:info(Table) of - undefined = No -> - No; - _ -> - ets:tab2list(Table) - end. - -list(Table) -> - l(tab2list(Table)). - -l(undefined = No) -> - No; -l(List) - when is_list(List) -> - io:format("~p~n", [List]), - length(List). - -%%% ---------------------------------------------------------- -%%% # table(TableName, Fields) -%%% ---------------------------------------------------------- - -table(Table, Fields) -> - format(Table, Fields, fun split/2). - -%%% ---------------------------------------------------------- -%%% # tables(LocalTables, RemoteTables) -%%% ---------------------------------------------------------- - -tables(Local, Remote) -> - format(Local, Remote, fun split/2). - -%%% ---------------------------------------------------------- -%%% # tables(Tables) -%%% ---------------------------------------------------------- - -tables(Tables) -> - format(Tables, fun split/2). - -%%% ---------------------------------------------------------- -%%% # modules(Prefix|Prefixes) -%%% -%%% Input: Prefix = atom() -%%% -%%% Description: Return the list of all loaded modules with the -%%% specified prefix. -%%% ---------------------------------------------------------- - -modules(Prefix) - when is_atom(Prefix) -> - lists:sort(mods(Prefix)); - -modules(Prefixes) - when is_list(Prefixes) -> - lists:sort(lists:flatmap(fun modules/1, Prefixes)). - -mods(Prefix) -> - P = atom_to_list(Prefix), - lists:filter(fun(M) -> - lists:prefix(P, atom_to_list(M)) - end, - erlang:loaded()). - -%%% ---------------------------------------------------------- -%%% # versions(Modules|Prefix) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List the versions of the specified modules. -%%% ---------------------------------------------------------- - -versions(Modules) -> - {SysInfo, OsInfo, ModInfo} = version_info(Modules), - sep(), - print_sys_info(SysInfo), - sep(), - print_os_info(OsInfo), - sep(), - print_mod_info(ModInfo), - sep(). - -%%% ---------------------------------------------------------- -%%% # attrs(Modules|Prefix, Attr|FormatFun) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List an attribute from module_info. -%%% ---------------------------------------------------------- - -attrs(Modules, Attr) - when is_atom(Attr) -> - attrs(Modules, fun(W,M) -> attr(W, M, Attr, fun attr/1) end); - -attrs(Modules, Fun) - when is_list(Modules) -> - sep(), - W = 2 + widest(Modules), - N = lists:foldl(fun(M,A) -> Fun(W,M), A+1 end, 0, Modules), - sep(), - N; - -attrs(Prefix, Fun) -> - attrs(modules(Prefix), Fun). - -%% attr/1 - -attr(T) when is_atom(T) -> - atom_to_list(T); -attr(N) when is_integer(N) -> - integer_to_list(N); -attr(V) -> - case is_list(V) andalso lists:all(fun is_char/1, V) of - true -> %% string - V; - false -> - io_lib:format("~p", [V]) - end. - -is_char(C) -> - 0 =< C andalso C < 256. - -%% attr/4 - -attr(Width, Mod, Attr, VFun) -> - io:format(": ~*s~s~n", [-Width, Mod, attr(Mod, Attr, VFun)]). - -attr(Mod, Attr, VFun) -> - Key = key(Attr), - try - VFun(val(Attr, keyfetch(Attr, Mod:module_info(Key)))) - catch - _:_ -> - "-" - end. - -attr(Mod, Attr) -> - attr(Mod, Attr, fun attr/1). - -key(time) -> compile; -key(_) -> attributes. - -val(time, {_,_,_,_,_,_} = T) -> - lists:flatten(io_lib:format("~p-~2..0B-~2..0B ~2..0B:~2..0B:~2..0B", - tuple_to_list(T))); -val(_, [V]) -> - V. - -%%% ---------------------------------------------------------- -%%% # compiled(Modules|Prefix) -%%% -%%% Output: Number of modules listed. -%%% -%%% Description: List the compile times of the specified modules. -%%% ---------------------------------------------------------- - -compiled(Modules) - when is_list(Modules) -> - attrs(Modules, fun compiled/2); - -compiled(Prefix) -> - compiled(modules(Prefix)). - -compiled(Width, Mod) -> - io:format(": ~*s~19s ~s~n", [-Width, - Mod, - attr(Mod, time), - opt(attr(Mod, date))]). - -opt("-") -> - ""; -opt(D) -> - "(" ++ D ++ ")". - -%%% ---------------------------------------------------------- -%%% # procs(Pred|Prefix|Prefixes|Pid|Pids) -%%% -%%% Input: Pred = arity 2 fun returning true|false when applied to a -%%% pid and its process info. -%%% -%%% Output: Number of processes listed. -%%% -%%% Description: List process info for all local processes that test -%%% true with the specified predicate. With the prefix -%%% form, those processes that are either currently -%%% executing in, started executing in, or have a -%%% registered name with a specified prefix are listed. -%%% With the pid forms, only those process that are local -%%% are listed and those that are dead list only the pid -%%% itself. -%%% ---------------------------------------------------------- - -procs(Pred) - when is_function(Pred, 2) -> - procs(Pred, erlang:processes()); - -procs([]) -> - 0; - -procs(Prefix) - when is_atom(Prefix) -> - procs(fun(_,I) -> info(fun pre1/2, I, atom_to_list(Prefix)) end); - -procs(Prefixes) - when is_atom(hd(Prefixes)) -> - procs(fun(_,I) -> info(fun pre/2, I, Prefixes) end); - -procs(Pid) - when is_pid(Pid) -> - procs(fun true2/2, [Pid]); - -procs(Pids) - when is_list(Pids) -> - procs(fun true2/2, Pids). - -true2(_,_) -> - true. - -%% procs/2 - -procs(Pred, Pids) -> - Procs = lists:foldl(fun(P,A) -> - procs_acc(Pred, P, catch process_info(P), A) - end, - [], - Pids), - sep(0 < length(Procs)), - lists:foldl(fun(T,N) -> p(T), sep(), N+1 end, 0, Procs). - -procs_acc(_, Pid, undefined, Acc) -> %% dead - [[{pid, Pid}] | Acc]; -procs_acc(Pred, Pid, Info, Acc) - when is_list(Info) -> - p_acc(Pred(Pid, Info), Pid, Info, Acc); -procs_acc(_, _, _, Acc) -> - Acc. - -p_acc(true, Pid, Info, Acc) -> - [[{pid, Pid} | Info] | Acc]; -p_acc(false, _, _, Acc) -> - Acc. - -%% info/3 - -info(Pred, Info, T) -> - lists:any(fun(I) -> i(Pred, I, T) end, Info). - -i(Pred, {K, {M,_,_}}, T) - when K == current_function; - K == initial_call -> - Pred(M,T); -i(Pred, {registered_name, N}, T) -> - Pred(N,T); -i(_,_,_) -> - false. - -pre1(A, Pre) -> - lists:prefix(Pre, atom_to_list(A)). - -pre(A, Prefixes) -> - lists:any(fun(P) -> pre1(A, atom_to_list(P)) end, Prefixes). - -%%% ---------------------------------------------------------- -%%% # latest(Modules|Prefix) -%%% -%%% Output: {Mod, {Y,M,D,HH,MM,SS}, Version} -%%% -%%% Description: Return the compile time of the most recently compiled -%%% module from the specified non-empty list. The modules -%%% are assumed to exist. -%%% ---------------------------------------------------------- - -latest(Prefix) - when is_atom(Prefix) -> - latest(modules(Prefix)); - -latest([_|_] = Modules) -> - {Mod, T} - = hd(lists:sort(fun latest/2, lists:map(fun compile_time/1, Modules))), - {Mod, T, app_vsn(Mod)}. - -app_vsn(Mod) -> - keyfetch(app_vsn, Mod:module_info(attributes)). - -compile_time(Mod) -> - T = keyfetch(time, Mod:module_info(compile)), - {Mod, T}. - -latest({_,T1},{_,T2}) -> - T1 > T2. - -%%% ---------------------------------------------------------- -%%% version_info(Modules|Prefix) -%%% -%%% Output: {SysInfo, OSInfo, [ModInfo]} -%%% -%%% SysInfo = {Arch, Vers} -%%% OSInfo = {Vers, {Fam, Name}} -%%% ModInfo = {Vsn, AppVsn, Time, CompilerVsn} -%%% ---------------------------------------------------------- - -version_info(Prefix) - when is_atom(Prefix) -> - version_info(modules(Prefix)); - -version_info(Mods) - when is_list(Mods) -> - {sys_info(), os_info(), [{M, mod_version_info(M)} || M <- Mods]}. - -mod_version_info(Mod) -> - try - Info = Mod:module_info(), - [[Vsn], AppVsn] = get_values(attributes, [vsn, app_vsn], Info), - [Ver, Time] = get_values(compile, [version, time], Info), - [Vsn, AppVsn, Ver, Time] - catch - _:_ -> - [] - end. - -get_values(Attr, Keys, Info) -> - As = proplists:get_value(Attr, Info), - [proplists:get_value(K, As, "?") || K <- Keys]. - -sys_info() -> - [A,V] = [chomp(erlang:system_info(K)) || K <- [system_architecture, - system_version]], - {A,V}. - -os_info() -> - {os:version(), case os:type() of - {_Fam, _Name} = T -> - T; - Fam -> - {Fam, ""} - end}. - -chomp(S) -> - string:strip(S, right, $\n). - -print_sys_info({Arch, Ver}) -> - io:format("System info:~n" - " architecture : ~s~n" - " version : ~s~n", - [Arch, Ver]). - -print_os_info({Vsn, {Fam, Name}}) -> - io:format("OS info:~n" - " family : ~s ~s~n" - " version : ~s~n", - [str(Fam), bkt(str(Name)), vsn(Vsn)]). - -print_mod_info(Mods) -> - io:format("Module info:~n", []), - lists:foreach(fun print_mod/1, Mods). - -print_mod({Mod, []}) -> - io:format(" ~w:~n", [Mod]); -print_mod({Mod, [Vsn, AppVsn, Ver, {Year, Month, Day, Hour, Min, Sec}]}) -> - Time = io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", - [Year, Month, Day, Hour, Min, Sec]), - io:format(" ~w:~n" - " vsn : ~s~n" - " app_vsn : ~s~n" - " compiled : ~s~n" - " compiler : ~s~n", - [Mod, str(Vsn), str(AppVsn), Time, Ver]). - -str(A) - when is_atom(A) -> - atom_to_list(A); -str(S) - when is_list(S) -> - S; -str(T) -> - io_lib:format("~p", [T]). - -bkt("" = S) -> - S; -bkt(S) -> - [$[, S, $]]. - -vsn(T) when is_tuple(T) -> - case [[$., integer_to_list(N)] || N <- tuple_to_list(T)] of - [[$.,S] | Rest] -> - [S | Rest]; - [] = S -> - S - end; -vsn(T) -> - str(T). - -%%% ---------------------------------------------------------- -%%% ---------------------------------------------------------- - -%% p/1 - -p(Info) -> - W = 2 + widest([K || {K,_} <- Info]), - lists:foreach(fun({K,V}) -> p(W,K,V) end, Info). - -p(Width, Key, Value) -> - io:format(": ~*s: ~p~n", [-Width, Key, Value]). - -%% sep/[01] - -sep() -> - sep($#). - -sep(true) -> - sep(); -sep(false) -> - ok; - -sep(Ch) -> - io:format("~c~65c~n", [Ch, $-]). - -%% widest/1 - -widest(List) -> - lists:foldl(fun widest/2, 0, List). - -widest(T, Max) - when is_atom(T) -> - widest(atom_to_list(T), Max); - -widest(T, Max) - when is_integer(T) -> - widest(integer_to_list(T), Max); - -widest(T, Max) - when is_list(T) -> %% string - max(length(T), Max). - -pt(T) -> - io:format(": ~p~n", [T]). - -recsplit(SFun, Rec) -> - fun(Fs,Vs) -> SFun(element(1, Rec), Fs, Vs) end. - -max(A, B) -> - if A > B -> A; true -> B end. - -keyfetch(Key, List) -> - {Key,V} = lists:keyfind(Key, 1, List), - V. - -%% ft/4 - -ft(undefined = No, _, _, _) -> - No; - -ft(_, Table, SFun, Fields) -> - ets:foldl(fun(R,A) -> - f(SFun, 0, Fields, R, A) - end, - 0, - Table). - -%% f/5 - -f(SFun, Width, Fields, Rec, Count) -> - ff(SFun, Width, fields(Fields, Rec), Rec, Count). - -ff(SFun, Width, Fields, Rec, Count) -> - sep(0 == Count), - f(SFun, Width, Fields, Rec), - sep(), - Count+1. - -fields(N, _) - when is_integer(N), N >= 0 -> - lists:duplicate(N, ''); %% list values unadorned -fields(Fields, R) - when is_function(Fields, 1) -> - fields(Fields(R), R); -fields({Fields, Values} = T, _) - when length(Fields) == length(Values) -> - T; -fields(Fields, _) - when is_list(Fields) -> - Fields. %% list field/value pairs, or tuples if [] - -%% f/4 - -%% Empty fields list: just print the entry. -f(_, _, [], Rec) - when is_tuple(Rec) -> - pt(Rec); - -%% Otherwise list field names/values. -f(SFun, Width, {Fields, Values}, _) -> - f(SFun, Width, Fields, Values); - -f(SFun, Width, Fields, Rec) - when is_tuple(Rec) -> - f(SFun, Width, Fields, values(Fields, Rec)); - -f(_, _, [], []) -> - ok; - -f(SFun, Width, [HF | _] = Fields, Values) -> - {F, FT, V, VT} = SFun(Fields, Values), - if is_list(F) -> %% V is a record - break($>, HF), - f(SFun, Width, F, values(F,V)), - break($<, HF), - f(SFun, Width, FT, VT); - F == '' -> %% no field name: just list value - pt(V), - f(SFun, Width, FT, VT); - true -> %% list field/value. - W = max(Width, 1 + widest(Fields)), - p(W, F, V), - f(SFun, W, FT, VT) - end. - -values(Fields, Rec) - when length(Fields) == size(Rec) - 1 -> - ?VALUES(Rec); -values(Fields, T) - when length(Fields) == size(T) -> - tuple_to_list(T). - -%% format_local/2 - -format_local(Tables, SFun) -> - lists:foldl(fun(T,A) -> fl(SFun, T, A) end, 0, Tables). - -fl(SFun, {Table, Recs, Fields}, Count) -> - sep(), - io:format("# ~p~n", [Table]), - N = fmt(Recs, Fields, SFun), - sep(0 == N), - Count + N; - -fl(SFun, {Table, Fields}, Count) -> - fl(SFun, {Table, Table, Fields}, Count). - -%% fmt/3 - -fmt(T, Fields, SFun) -> - case format(T, Fields, SFun) of - undefined -> - 0; - N -> - N - end. - -%% break/2 - -break(C, T) -> - io:format("~c ~p~n", [C, T]). - -%% collect/2 -%% -%% Output: {[{TableName, Recs}, ...], node()} - -collect(CFun, TableNames) -> - {lists:foldl(fun(N,A) -> c(CFun, N, A) end, [], TableNames), node()}. - -c(CFun, TableName, Acc) -> - case CFun(TableName) of - Recs when is_list(Recs) -> - [{TableName, Recs} | Acc]; - _ -> - Acc - end. - -%% format_remote/3 - -format_remote(Tables, SFun, {Replies, BadNodes}) -> - N = lists:foldl(fun(T,A) -> fr(Tables, SFun, T, A) end, - 0, - Replies), - sep(0 == N andalso [] /= BadNodes), - lists:foreach(fun(Node) -> io:format("# no reply from ~p~n", [Node]) end, - BadNodes), - sep([] /= BadNodes), - N. - -fr(Tables, SFun, {List, Node}, Count) - when is_list(List) -> %% guard against {badrpc, Reason} - lists:foldl(fun({T,Recs}, C) -> fr(Tables, SFun, Node, T, Recs,C) end, - Count, - List); -fr(_, _, _, Count) -> - Count. - -fr(Tables, SFun, Node, Table, Recs, Count) -> - Fields = keyfetch(Table, Tables), - sep(), - io:format("# ~p@~p~n", [Table, Node]), - N = format(Recs, Fields, tblsplit(SFun, Table)), - sep(0 == N), - Count + N. - -tblsplit(SFun, Table) - when is_function(SFun, 3) -> - fun(Fs,Vs) -> SFun(Table, Fs, Vs) end; -tblsplit(SFun, _) - when is_function(SFun, 2) -> - SFun. - -%% compact/1 -%% -%% Strip whitespace from both ends of a string. - -compact(Str) -> - compact(Str, true). - -compact([Ch|Rest], B) - when Ch == $\n; - Ch == $ ; - Ch == $\t; - Ch == $\v; - Ch == $\r -> - compact(Rest, B); - -compact(Str, false) -> - Str; - -compact(Str, true) -> - lists:reverse(compact(lists:reverse(Str), false)). diff --git a/lib/diameter/src/app/diameter_internal.hrl b/lib/diameter/src/app/diameter_internal.hrl deleted file mode 100644 index 63b35550a8..0000000000 --- a/lib/diameter/src/app/diameter_internal.hrl +++ /dev/null @@ -1,80 +0,0 @@ -%% -%% %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% -%% - -%% Our Erlang application. --define(APPLICATION, diameter). - -%% The one and only. --define(DIAMETER_VERSION, 1). - -%% Exception for use within a module with decent protection against -%% catching something we haven't thrown. Not foolproof but close -%% enough. ?MODULE is rudmentary protection against catching across -%% module boundaries, a root of much evil: always catch ?FAILURE(X), -%% never X. --define(FAILURE(Reason), {{?MODULE}, {Reason}}). --define(THROW(Reason), throw(?FAILURE(Reason))). - -%% A corresponding error when failure is the best option. --define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). - -%% Failure reports always get a stack trace. --define(STACK, erlang:get_stacktrace()). - -%% Warning report for unexpected messages in various processes. --define(UNEXPECTED(F,A), - diameter_lib:warning_report(unexpected, {?MODULE, F, A})). --define(UNEXPECTED(A), ?UNEXPECTED(?FUNC, A)). - -%% Something to trace on. --define(LOG(Slogan, Details), - diameter_lib:log(Slogan, ?MODULE, ?LINE, Details)). --define(LOGC(Bool, Slogan, Details), ((Bool) andalso ?LOG(Slogan, Details))). - -%% Compensate for no builtin ?FUNC for use in log reports. --define(FUNC, element(2, element(2, process_info(self(), current_function)))). - -%% Disjunctive match spec condition. 'false' is to ensure that there's at -%% least one condition. --define(ORCOND(List), list_to_tuple(['orelse', false | List])). - -%% 3588, 2.4: --define(APP_ID_COMMON, 0). --define(APP_ID_RELAY, 16#FFFFFFFF). - --define(BASE, diameter_gen_base_rfc3588). - -%%% --------------------------------------------------------- - -%%% RFC 3588, ch 2.6 Peer table --record(diameter_peer, - {host_id, - statusT, - is_dynamic, - expiration, - tls_enabled}). - -%%% RFC 3588, ch 2.7 Realm-based routing table --record(diameter_realm, - {name, - app_id, - local_action, % LOCAL | RELAY | PROXY | REDIRECT - server_id, - is_dynamic, - expiration}). diff --git a/lib/diameter/src/app/diameter_lib.erl b/lib/diameter/src/app/diameter_lib.erl deleted file mode 100644 index 362d593b24..0000000000 --- a/lib/diameter/src/app/diameter_lib.erl +++ /dev/null @@ -1,272 +0,0 @@ -%% -%% %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% -%% - --module(diameter_lib). - --export([report/2, info_report/2, - error_report/2, - warning_report/2, - now_diff/1, - time/1, - eval/1, - ip4address/1, - ip6address/1, - ipaddr/1, - spawn_opts/2, - wait/1, - fold_tuple/3, - log/4]). - --include("diameter_internal.hrl"). - -%% --------------------------------------------------------------------------- -%% # info_report(Reason, MFA) -%% -%% Input: Reason = Arbitrary term indicating the reason for the report. -%% MFA = {Module, Function, Args} to report. -%% -%% Output: true -%% --------------------------------------------------------------------------- - -report(Reason, MFA) -> - info_report(Reason, MFA). - -info_report(Reason, MFA) -> - report(fun error_logger:info_report/1, Reason, MFA), - true. - -%%% --------------------------------------------------------------------------- -%%% # error_report(Reason, MFA) -%%% # warning_report(Reason, MFA) -%%% -%%% Output: false -%%% --------------------------------------------------------------------------- - -error_report(Reason, MFA) -> - report(fun error_logger:error_report/1, Reason, MFA). - -warning_report(Reason, MFA) -> - report(fun error_logger:warning_report/1, Reason, MFA). - -report(Fun, Reason, MFA) -> - Fun([{why, Reason}, {who, self()}, {what, MFA}]), - false. - -%%% --------------------------------------------------------------------------- -%%% # now_diff(Time) -%%% -%%% Description: Return timer:now_diff(now(), Time) as an {H, M, S, MicroS} -%%% tuple instead of as integer microseconds. -%%% --------------------------------------------------------------------------- - -now_diff({_,_,_} = Time) -> - time(timer:now_diff(erlang:now(), Time)). - -%%% --------------------------------------------------------------------------- -%%% # time(Time) -%%% -%%% Input: Time = {MegaSec, Sec, MicroSec} -%%% | MicroSec -%%% -%%% Output: {H, M, S, MicroS} -%%% --------------------------------------------------------------------------- - -time({_,_,_} = Time) -> %% time of day - %% 24 hours = 24*60*60*1000000 = 86400000000 microsec - time(timer:now_diff(Time, {0,0,0}) rem 86400000000); - -time(Micro) -> %% elapsed time - Seconds = Micro div 1000000, - H = Seconds div 3600, - M = (Seconds rem 3600) div 60, - S = Seconds rem 60, - {H, M, S, Micro rem 1000000}. - -%%% --------------------------------------------------------------------------- -%%% # eval(Func) -%%% --------------------------------------------------------------------------- - -eval({M,F,A}) -> - apply(M,F,A); - -eval([{M,F,A} | X]) -> - apply(M, F, X ++ A); - -eval([[F|A] | X]) -> - eval([F | X ++ A]); - -eval([F|A]) -> - apply(F,A); - -eval({F}) -> - eval(F); - -eval(F) -> - F(). - -%%% --------------------------------------------------------------------------- -%%% # ip4address(Addr) -%%% -%%% Input: string() (eg. "10.0.0.1") -%%% | list of integer() -%%% | tuple of integer() -%%% -%%% Output: {_,_,_,_} of integer -%%% -%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - -ip4address([_,_,_,_] = Addr) -> %% Length 4 string can't be an address. - ipaddr(list_to_tuple(Addr)); - -%% Be brutal. -ip4address(Addr) -> - try - {_,_,_,_} = ipaddr(Addr) - catch - error: _ -> - erlang:error({invalid_address, Addr, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # ip6address(Addr) -%%% -%%% Input: string() (eg. "1080::8:800:200C:417A") -%%% | list of integer() -%%% | tuple of integer() -%%% -%%% Output: {_,_,_,_,_,_,_,_} of integer -%%% -%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - -ip6address([_,_,_,_,_,_,_,_] = Addr) -> %% Length 8 string can't be an address. - ipaddr(list_to_tuple(Addr)); - -%% Be brutal. -ip6address(Addr) -> - try - {_,_,_,_,_,_,_,_} = ipaddr(Addr) - catch - error: _ -> - erlang:error({invalid_address, Addr, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # ipaddr(Addr) -%%% -%%% Input: string() | tuple of integer() -%%% -%%% Output: {_,_,_,_} | {_,_,_,_,_,_,_,_} -%%% -%%% Exceptions: error: {invalid_address, erlang:get_stacktrace()} -%%% --------------------------------------------------------------------------- - --spec ipaddr(string() | tuple()) - -> inet:ip_address(). - -%% Don't convert lists of integers since a length 8 list like -%% [$1,$0,$.,$0,$.,$0,$.,$1] is ambiguous: is it "10.0.0.1" or -%% "49:48:46:48:46:48:46:49"? -%% -%% RFC 2373 defines the format parsed for v6 addresses. - -%% Be brutal. -ipaddr(Addr) -> - try - ip(Addr) - catch - error: _ -> - erlang:error({invalid_address, ?STACK}) - end. - -%% Already a tuple: ensure non-negative integers of the right size. -ip(T) - when size(T) == 4; - size(T) == 8 -> - Bs = 2*size(T), - [] = lists:filter(fun(N) when 0 =< N -> 0 < N bsr Bs end, - tuple_to_list(T)), - T; - -%% Or not: convert from '.'/':'-separated decimal/hex. -ip(Addr) -> - {ok, A} = inet_parse:address(Addr), %% documented in inet(3) - A. - -%%% --------------------------------------------------------------------------- -%%% # spawn_opts(Type, Opts) -%%% --------------------------------------------------------------------------- - -%% TODO: config variables. - -spawn_opts(server, Opts) -> - opts(75000, Opts); -spawn_opts(worker, Opts) -> - opts(5000, Opts). - -opts(HeapSize, Opts) -> - [{min_heap_size, HeapSize} | lists:keydelete(min_heap_size, 1, Opts)]. - -%%% --------------------------------------------------------------------------- -%%% # wait(MRefs) -%%% --------------------------------------------------------------------------- - -wait(L) -> - w([erlang:monitor(process, P) || P <- L]). - -w([]) -> - ok; -w(L) -> - receive - {'DOWN', MRef, process, _, _} -> - w(lists:delete(MRef, L)) - end. - -%%% --------------------------------------------------------------------------- -%%% # fold_tuple(N, T0, T) -%%% --------------------------------------------------------------------------- - -%% Replace fields in T0 by those of T starting at index N, unless the -%% new value is 'undefined'. -%% -%% eg. fold_tuple(2, Hdr, #diameter_header{end_to_end_id = 42}) - -fold_tuple(_, T, undefined) -> - T; - -fold_tuple(N, T0, T1) -> - {_, T} = lists:foldl(fun(V, {I,_} = IT) -> {I+1, ft(V, IT)} end, - {N, T0}, - lists:nthtail(N-1, tuple_to_list(T1))), - T. - -ft(undefined, {_, T}) -> - T; -ft(Value, {Idx, T}) -> - setelement(Idx, T, Value). - -%%% ---------------------------------------------------------- -%%% # log(Slogan, Mod, Line, Details) -%%% -%%% Called to have something to trace on for happenings of interest. -%%% ---------------------------------------------------------- - -log(_, _, _, _) -> - ok. diff --git a/lib/diameter/src/app/diameter_misc_sup.erl b/lib/diameter/src/app/diameter_misc_sup.erl deleted file mode 100644 index 4e40476f14..0000000000 --- a/lib/diameter/src/app/diameter_misc_sup.erl +++ /dev/null @@ -1,58 +0,0 @@ -%% -%% %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% -%% - -%% -%% The supervisor of the static server processes. -%% - --module(diameter_misc_sup). - --behaviour(supervisor). - --export([start_link/0]). %% supervisor start - -%% supervisor callback --export([init/1]). - --define(CHILDREN, [diameter_sync, %% serialization - diameter_stats, %% statistics counter management - diameter_reg, %% service/property publishing - diameter_peer, %% remote peer manager - diameter_config]). %% configuration/restart - -%% start_link/0 - -start_link() -> - SupName = {local, ?MODULE}, - supervisor:start_link(SupName, ?MODULE, []). - -%% init/1 - -init([]) -> - Flags = {one_for_one, 1, 5}, - Workers = lists:map(fun spec/1, ?CHILDREN), - {ok, {Flags, Workers}}. - -spec(Mod) -> - {Mod, - {Mod, start_link, []}, - permanent, - 1000, - worker, - [Mod]}. diff --git a/lib/diameter/src/app/diameter_peer.erl b/lib/diameter/src/app/diameter_peer.erl deleted file mode 100644 index 3e78c4caef..0000000000 --- a/lib/diameter/src/app/diameter_peer.erl +++ /dev/null @@ -1,225 +0,0 @@ -%% -%% %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% -%% - --module(diameter_peer). - --behaviour(gen_server). - -%% Interface towards transport modules ... --export([recv/2, - up/1, - up/2]). - -%% ... and the stack. --export([start/3, - send/2, - close/1, - abort/1, - notify/2]). - -%% Server start. --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% debug --export([state/0, - uptime/0]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - -%% Registered name of the server. --define(SERVER, ?MODULE). - -%% Server state. --record(state, {id = now()}). - -%%% --------------------------------------------------------------------------- -%%% # notify/2 -%%% --------------------------------------------------------------------------- - -notify(SvcName, T) -> - rpc:abcast(nodes(), ?SERVER, {notify, SvcName, T}). - -%%% --------------------------------------------------------------------------- -%%% # start/3 -%%% --------------------------------------------------------------------------- - -start(T, Opts, #diameter_service{} = Svc) -> - {Mod, Cfg} = split_transport(Opts), - apply(Mod, start, [T, Svc, Cfg]). - -%%% --------------------------------------------------------------------------- -%%% # up/[12] -%%% --------------------------------------------------------------------------- - -up(Pid) -> %% accepting transport - ifc_send(Pid, {self(), connected}). - -up(Pid, Remote) -> %% connecting transport - ifc_send(Pid, {self(), connected, Remote}). - -%%% --------------------------------------------------------------------------- -%%% # recv/2 -%%% --------------------------------------------------------------------------- - -recv(Pid, Pkt) -> - ifc_send(Pid, {recv, Pkt}). - -%%% --------------------------------------------------------------------------- -%%% # send/2 -%%% --------------------------------------------------------------------------- - -send(Pid, #diameter_packet{transport_data = undefined, - bin = Bin}) -> - send(Pid, Bin); - -send(Pid, Pkt) -> - ifc_send(Pid, {send, Pkt}). - -%%% --------------------------------------------------------------------------- -%%% # close/1 -%%% --------------------------------------------------------------------------- - -close(Pid) -> - ifc_send(Pid, {close, self()}). - -%%% --------------------------------------------------------------------------- -%%% # abort/1 -%%% --------------------------------------------------------------------------- - -abort(Pid) -> - exit(Pid, shutdown). - -%% --------------------------------------------------------------------------- -%% --------------------------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init(Role) -%%% ---------------------------------------------------------- - -init([]) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info(Request, State) -%%% ---------------------------------------------------------- - -%% Remote service is distributing a message. -handle_info({notify, SvcName, T}, S) -> - bang(diameter_service:whois(SvcName), T), - {noreply, S}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% terminate(Reason, State) -%% ---------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%% ---------------------------------------------------------- -%% code_change(OldVsn, State, Extra) -%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -%% ifc_send/2 -%% -%% Send something over the transport interface. - -ifc_send(Pid, T) -> - Pid ! {diameter, T}. - -%% bang/2 - -bang(undefined = No, _) -> - No; -bang(Pid, T) -> - Pid ! T. - -%% split_transport/1 -%% -%% Split options into transport module, transport config and -%% remaining options. - -split_transport(Opts) -> - {[M,C], _} = proplists:split(Opts, [transport_module, - transport_config]), - {value(M, diameter_tcp), value(C, [])}. - -value([{_,V}], _) -> - V; -value([], V) -> - V. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_peer_fsm.erl b/lib/diameter/src/app/diameter_peer_fsm.erl deleted file mode 100644 index 282fa2742f..0000000000 --- a/lib/diameter/src/app/diameter_peer_fsm.erl +++ /dev/null @@ -1,777 +0,0 @@ -%% -%% %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% -%% - -%% -%% This module implements (as a process) the RFC 3588 Peer State -%% Machine modulo the necessity of adapting the peer election to the -%% fact that we don't know the identity of a peer until we've -%% received a CER/CEA from it. -%% - --module(diameter_peer_fsm). --behaviour(gen_server). - -%% Interface towards diameter_watchdog. --export([start/3]). - -%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% diameter_peer_fsm_sup callback --export([start_link/1]). - -%% internal callbacks --export([match/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). --include("diameter_gen_base_rfc3588.hrl"). - --define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). --define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). - --define(NO_INBAND_SECURITY, 0). --define(TLS, 1). - --define(LOOP_TIMEOUT, 2000). - -%% RFC 3588: -%% -%% Timeout An application-defined timer has expired while waiting -%% for some event. -%% --define(EVENT_TIMEOUT, 10000). - -%% How long to wait for a DPA in response to DPR before simply -%% aborting. Used to distinguish between shutdown and not but there's -%% not really any need. Stopping a service will require a timeout if -%% the peer doesn't answer DPR so the value should be short-ish. --define(DPA_TIMEOUT, 1000). - --record(state, - {state = 'Wait-Conn-Ack' %% state of RFC 3588 Peer State Machine - :: 'Wait-Conn-Ack' | recv_CER | 'Wait-CEA' | 'Open', - mode :: accept | connect | {connect, reference()}, - parent :: pid(), - transport :: pid(), - service :: #diameter_service{}, - dpr = false :: false | {'Unsigned32'(), 'Unsigned32'()}}). - %% | hop by hop and end to end identifiers - -%% There are non-3588 states possible as a consequence of 5.6.1 of the -%% standard and the corresponding problem for incoming CEA's: we don't -%% know who we're talking to until either a CER or CEA has been -%% received. The CEA problem in particular makes it impossible to -%% follow the state machine exactly as documented in 3588: there can -%% be no election until the CEA arrives and we have an Origin-Host to -%% elect. - -%% -%% Once upon a time start/2 started a process akin to that started by -%% start/3 below, which in turn started a watchdog/transport process -%% with the result that the watchdog could send DWR/DWA regardless of -%% whether or not the corresponding Peer State Machine was in its open -%% state; that is, before capabilities exchange had taken place. This -%% is not what RFC's 3588 and 3539 say (albeit not very clearly). -%% Watchdog messages are only exchanged on *open* connections, so the -%% 3539 state machine is more naturally placed on top of the 3588 Peer -%% State Machine rather than closer to the transport. This is what we -%% now do below: connect/accept call diameter_watchdog and return the -%% pid of the watchdog process, and the watchdog in turn calls start/3 -%% below to start the process implementing the Peer State Machine. The -%% former is a "peer" in diameter_service while the latter is a -%% "conn". In a sense, diameter_service sees the watchdog as -%% implementing the Peer State Machine and the process implemented -%% here as being the transport, not being aware of the watchdog at -%% all. -%% - -%%% --------------------------------------------------------------------------- -%%% # start({connect|accept, Ref}, Opts, Service) -%%% -%%% Output: Pid -%%% --------------------------------------------------------------------------- - -%% diameter_config requires a non-empty list of applications on the -%% service but diameter_service then constrains the list to any -%% specified on the transport in question. Check here that the list is -%% still non-empty. - -start({_, Ref} = Type, Opts, #diameter_service{applications = Apps} = Svc) -> - [] /= Apps orelse ?ERROR({no_apps, Type, Opts}), - T = {self(), Type, Opts, Svc}, - {ok, Pid} = diameter_peer_fsm_sup:start_child(T), - diameter_stats:reg(Pid, Ref), - Pid. - -start_link(T) -> - {ok, _} = proc_lib:start_link(?MODULE, - init, - [T], - infinity, - diameter_lib:spawn_opts(server, [])). - -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- - -%% init/1 - -init(T) -> - proc_lib:init_ack({ok, self()}), - gen_server:enter_loop(?MODULE, [], i(T)). - -i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> - putr(dwa, dwa(Caps)), - {ok, TPid, Svc} = start_transport(T, Opts, Svc0), - erlang:monitor(process, TPid), - erlang:monitor(process, WPid), - #state{parent = WPid, - transport = TPid, - mode = M, - service = Svc}. -%% The transport returns its local ip addresses so that different -%% transports on the same service can use different local addresses. -%% The local addresses are put into Host-IP-Address avps here when -%% sending capabilities exchange messages. -%% -%% Invalid transport config may cause us to crash but note that the -%% watchdog start (start/2) succeeds regardless so as not to crash the -%% service. - -start_transport(T, Opts, Svc) -> - case diameter_peer:start(T, Opts, Svc) of - {ok, TPid} -> - {ok, TPid, Svc}; - {ok, TPid, [_|_] = Addrs} -> - #diameter_service{capabilities = Caps0} = Svc, - Caps = Caps0#diameter_caps{host_ip_address = Addrs}, - {ok, TPid, Svc#diameter_service{capabilities = Caps}}; - No -> - exit({shutdown, No}) - end. - -%% handle_call/3 - -handle_call(_, _, State) -> - {reply, nok, State}. - -%% handle_cast/2 - -handle_cast(_, State) -> - {noreply, State}. - -%% handle_info/1 - -handle_info(T, #state{} = State) -> - try transition(T, State) of - ok -> - {noreply, State}; - #state{state = X} = S -> - ?LOGC(X =/= State#state.state, transition, X), - {noreply, S}; - {stop, Reason} -> - ?LOG(stop, Reason), - x(Reason, State); - stop -> - ?LOG(stop, T), - x(T, State) - catch - throw: {?MODULE, Tag, Reason} -> - ?LOG(Tag, {Reason, T}), - {stop, {shutdown, Reason}, State} - end. - -x(Reason, #state{} = S) -> - close_wd(Reason, S), - {stop, {shutdown, Reason}, S}. - -%% terminate/2 - -terminate(_, _) -> - ok. - -%% code_change/3 - -code_change(_, State, _) -> - {ok, State}. - -%%% --------------------------------------------------------------------------- -%%% --------------------------------------------------------------------------- - -putr(Key, Val) -> - put({?MODULE, Key}, Val). - -getr(Key) -> - get({?MODULE, Key}). - -%% transition/2 - -%% Connection to peer. -transition({diameter, {TPid, connected, Remote}}, - #state{state = PS, - mode = M} - = S) -> - 'Wait-Conn-Ack' = PS, %% assert - connect = M, %% - send_CER(S#state{mode = {M, Remote}, - transport = TPid}); - -%% Connection from peer. -transition({diameter, {TPid, connected}}, - #state{state = PS, - mode = M, - parent = Pid} - = S) -> - 'Wait-Conn-Ack' = PS, %% assert - accept = M, %% - Pid ! {accepted, self()}, - start_timer(S#state{state = recv_CER, - transport = TPid}); - -%% Incoming message from the transport. -transition({diameter, {recv, Pkt}}, S) -> - recv(Pkt, S); - -%% Timeout when still in the same state ... -transition({timeout, PS}, #state{state = PS}) -> - stop; - -%% ... or not. -transition({timeout, _}, _) -> - ok; - -%% Outgoing message. -transition({send, Msg}, #state{transport = TPid}) -> - send(TPid, Msg), - ok; - -%% Request for graceful shutdown. -transition({shutdown, Pid}, #state{parent = Pid, dpr = false} = S) -> - dpr(?GOAWAY, S); -transition({shutdown, Pid}, #state{parent = Pid}) -> - ok; - -%% Application shutdown. -transition(shutdown, #state{dpr = false} = S) -> - dpr(?REBOOT, S); -transition(shutdown, _) -> %% DPR already send: ensure expected timeout - dpa_timer(), - ok; - -%% Request to close the transport connection. -transition({close = T, Pid}, #state{parent = Pid, - transport = TPid}) -> - diameter_peer:close(TPid), - {stop, T}; - -%% DPA reception has timed out. -transition(dpa_timeout, _) -> - stop; - -%% Someone wants to know a resolved port: forward to the transport process. -transition({resolve_port, _Pid} = T, #state{transport = TPid}) -> - TPid ! T, - ok; - -%% Parent or transport has died. -transition({'DOWN', _, process, P, _}, - #state{parent = Pid, - transport = TPid}) - when P == Pid; - P == TPid -> - stop; - -%% State query. -transition({state, Pid}, #state{state = S, transport = TPid}) -> - Pid ! {self(), [S, TPid]}, - ok. - -%% Crash on anything unexpected. - -%% send_CER/1 - -send_CER(#state{mode = {connect, Remote}, - service = #diameter_service{capabilities = Caps}, - transport = TPid} - = S) -> - req_send_CER(Caps#diameter_caps.origin_host, Remote) - orelse - close(connected, S), - CER = build_CER(S), - ?LOG(send, 'CER'), - send(TPid, encode(CER)), - start_timer(S#state{state = 'Wait-CEA'}). - -%% Register ourselves as connecting to the remote endpoint in -%% question. This isn't strictly necessary since a peer implementing -%% the 3588 Peer State Machine should reject duplicate connection's -%% from the same peer but there's little point in us setting up a -%% duplicate connection in the first place. This could also include -%% the transport protocol being used but since we're blind to -%% transport just avoid duplicate connections to the same host/port. -req_send_CER(OriginHost, Remote) -> - register_everywhere({?MODULE, connection, OriginHost, {remote, Remote}}). - -%% start_timer/1 - -start_timer(#state{state = PS} = S) -> - erlang:send_after(?EVENT_TIMEOUT, self(), {timeout, PS}), - S. - -%% build_CER/1 - -build_CER(#state{service = #diameter_service{capabilities = Caps}}) -> - {ok, CER} = diameter_capx:build_CER(Caps), - CER. - -%% encode/1 - -encode(Rec) -> - #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Rec), - Bin. - -%% recv/2 - -%% RFC 3588 has result code 5015 for an invalid length but if a -%% transport is detecting message boundaries using the length header -%% then a length error will likely lead to further errors. - -recv(#diameter_packet{header = #diameter_header{length = Len} - = Hdr, - bin = Bin}, - S) - when Len < 20; - (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) -> - discard(invalid_message_length, recv, [size(Bin), - bit_size(Bin) rem 8, - Hdr, - S]); - -recv(#diameter_packet{header = #diameter_header{} = Hdr} - = Pkt, - #state{parent = Pid} - = S) -> - Name = diameter_codec:msg_name(Hdr), - Pid ! {recv, self(), Name, Pkt}, - diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received - rcv(Name, Pkt, S); - -recv(#diameter_packet{header = undefined, - bin = Bin} - = Pkt, - S) -> - recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S); - -recv(Bin, S) - when is_binary(Bin) -> - recv(#diameter_packet{bin = Bin}, S); - -recv(#diameter_packet{header = false} = Pkt, S) -> - discard(truncated_header, recv, [Pkt, S]). - -msg_id({_,_,_} = T, _) -> - T; -msg_id(_, Hdr) -> - diameter_codec:msg_id(Hdr). - -%% Treat invalid length as a transport error and die. Especially in -%% the TCP case, in which there's no telling where the next message -%% begins in the incoming byte stream, keeping a crippled connection -%% alive may just make things worse. - -discard(Reason, F, A) -> - diameter_stats:incr(Reason), - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - throw({?MODULE, abort, Reason}). - -%% rcv/3 - -%% Incoming CEA. -rcv('CEA', Pkt, #state{state = 'Wait-CEA'} = S) -> - handle_CEA(Pkt, S); - -%% Incoming CER -rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> - handle_request(N, Pkt, S); - -%% Anything but CER/CEA in a non-Open state is an error, as is -%% CER/CEA in anything but recv_CER/Wait-CEA. -rcv(Name, _, #state{state = PS}) - when PS /= 'Open'; - Name == 'CER'; - Name == 'CEA' -> - {stop, {Name, PS}}; - -rcv(N, Pkt, S) - when N == 'DWR'; - N == 'DPR' -> - handle_request(N, Pkt, S); - -%% DPA even though we haven't sent DPR: ignore. -rcv('DPA', _Pkt, #state{dpr = false}) -> - ok; - -%% DPA in response to DPR. We could check the sequence numbers but -%% don't bother, just close. -rcv('DPA' = N, _Pkt, #state{transport = TPid}) -> - diameter_peer:close(TPid), - {stop, N}; - -rcv(_, _, _) -> - ok. - -%% send/2 - -%% Msg here could be a #diameter_packet or a binary depending on who's -%% sending. In particular, the watchdog will send DWR as a binary -%% while messages coming from clients will be in a #diameter_packet. -send(Pid, Msg) -> - diameter_stats:incr({diameter_codec:msg_id(Msg), send}), - diameter_peer:send(Pid, Msg). - -%% handle_request/3 - -handle_request(Type, #diameter_packet{} = Pkt, S) -> - ?LOG(recv, Type), - send_answer(Type, diameter_codec:decode(?BASE, Pkt), S). - -%% send_answer/3 - -send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> - #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, - transport_data = TD} - = ReqPkt, - - {Answer, PostF} = build_answer(Type, V, ReqPkt, S), - - Pkt = #diameter_packet{header = #diameter_header{version = V, - end_to_end_id = Eid, - hop_by_hop_id = Hid, - is_proxiable = P}, - msg = Answer, - transport_data = TD}, - - send(TPid, diameter_codec:encode(?BASE, Pkt)), - eval(PostF, S). - -eval([F|A], S) -> - apply(F, A ++ [S]); -eval(ok, S) -> - S. - -%% build_answer/4 - -build_answer('CER', - ?DIAMETER_VERSION, - #diameter_packet{msg = CER, - header = #diameter_header{is_error = false}, - errors = []} - = Pkt, - #state{service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH}} - = Svc, - - {SupportedApps, - #diameter_caps{origin_host = DH} = RCaps, - #diameter_base_CEA{'Result-Code' = RC} - = CEA} - = recv_CER(CER, S), - - try - 2001 == RC %% DIAMETER_SUCCESS - orelse ?THROW({sent_CEA, RC}), - register_everywhere({?MODULE, connection, OH, DH}) - orelse ?THROW({election_lost, 4003}), - #diameter_base_CEA{'Inband-Security-Id' = [IS]} - = CEA, - {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]} - catch - ?FAILURE({Reason, RC}) -> - {answer('CER', S) ++ [{'Result-Code', RC}], - [fun close/2, {'CER', Reason, DH}]} - end; - -%% The error checks below are similar to those in diameter_service for -%% other messages. Should factor out the commonality. - -build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) -> - FailedAvp = failed_avp([A || {_,A} <- Es]), - Ans = answer(answer(Type, S), V, H, Es), - {set(Ans, FailedAvp), if 'CER' == Type -> - [fun close/2, {Type, V, Pkt}]; - true -> - ok - end}. - -failed_avp([] = No) -> - No; -failed_avp(Avps) -> - [{'Failed-AVP', [[{'AVP', Avps}]]}]. - -set(Ans, []) -> - Ans; -set(['answer-message' | _] = Ans, FailedAvp) -> - Ans ++ [{'AVP', [FailedAvp]}]; -set([_|_] = Ans, FailedAvp) -> - Ans ++ FailedAvp. - -answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) -> - ['answer-message', OH, OR, {'Result-Code', 3008}]; - -answer([_, OH, OR | _], _, _, [Bs|_]) - when is_bitstring(Bs) -> - ['answer-message', OH, OR, {'Result-Code', 3009}]; - -answer(Ans, ?DIAMETER_VERSION, _, Es) -> - Ans ++ [{'Result-Code', rc(Es)}]; - -answer(Ans, _, _, _) -> - Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION - -rc([]) -> - 2001; %% DIAMETER_SUCCESS -rc([{RC,_}|_]) -> - RC; -rc([RC|_]) -> - RC. - -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. - -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. - -%% ELECTION_LOST 4003 -%% The peer has determined that it has lost the election process and -%% has therefore disconnected the transport connection. - -%% DIAMETER_NO_COMMON_APPLICATION 5010 -%% This error is returned when a CER message is received, and there -%% are no common applications supported between the peers. - -%% DIAMETER_UNSUPPORTED_VERSION 5011 -%% This error is returned when a request was received, whose version -%% number is unsupported. - -%% answer/2 - -answer('DWR', _) -> - getr(dwa); - -answer(Name, #state{service = #diameter_service{capabilities = Caps}}) -> - a(Name, Caps). - -a('CER', #diameter_caps{vendor_id = Vid, - origin_host = Host, - origin_realm = Realm, - host_ip_address = Addrs, - product_name = Name}) -> - ['CEA', {'Origin-Host', Host}, - {'Origin-Realm', Realm}, - {'Host-IP-Address', Addrs}, - {'Vendor-Id', Vid}, - {'Product-Name', Name}]; - -a('DPR', #diameter_caps{origin_host = Host, - origin_realm = Realm}) -> - ['DPA', {'Origin-Host', Host}, - {'Origin-Realm', Realm}]. - -%% recv_CER/2 - -recv_CER(CER, #state{service = Svc}) -> - {ok, T} = diameter_capx:recv_CER(CER, Svc), - T. - -%% handle_CEA/1 - -handle_CEA(#diameter_packet{header = #diameter_header{version = V}, - bin = Bin} - = Pkt, - #state{service = #diameter_service{capabilities = LCaps}} - = S) - when is_binary(Bin) -> - ?LOG(recv, 'CEA'), - - ?DIAMETER_VERSION == V orelse close({version, V}, S), - - #diameter_packet{msg = CEA, errors = Errors} - = DPkt - = diameter_codec:decode(?BASE, Pkt), - - [] == Errors orelse close({errors, Errors}, S), - - {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps} - = recv_CEA(CEA, S), - - #diameter_caps{origin_host = OH} - = LCaps, - - %% Ensure that we don't already have a connection to the peer in - %% question. This isn't the peer election of 3588 except in the - %% sense that, since we don't know who we're talking to until we - %% receive a CER/CEA, the first that arrives wins the right to a - %% connection with the peer. - - register_everywhere({?MODULE, connection, OH, DH}) - orelse close({'CEA', DH}, S), - - open(DPkt, SApps, RCaps, {connect, IS}, S). - -%% recv_CEA/2 - -recv_CEA(CEA, #state{service = Svc} = S) -> - case diameter_capx:recv_CEA(CEA, Svc) of - {ok, {_,_}} -> %% return from old code - close({'CEA', update}, S); - {ok, {[], _, _}} -> - close({'CEA', no_common_application}, S); - {ok, {_, [], _}} -> - close({'CEA', no_common_security}, S); - {ok, {_,_,_} = T} -> - T; - {error, Reason} -> - close({'CEA', Reason}, S) - end. - -%% open/5 - -open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid, - service = Svc} - = S) -> - #diameter_service{capabilities = #diameter_caps{origin_host = OH, - inband_security_id = LS} - = LCaps} - = Svc, - #diameter_caps{origin_host = DH} - = RCaps, - - tls_ack(lists:member(?TLS, LS), Type, IS, S), - Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, - - S#state{state = 'Open'}. - -%% We've advertised TLS support: tell the transport the result -%% and expect a reply when the handshake is complete. -tls_ack(true, Type, IS, #state{transport = TPid} = S) -> - Ref = make_ref(), - MRef = erlang:monitor(process, TPid), - TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, - receive - {diameter, {tls, Ref}} -> - erlang:demonitor(MRef, [flush]); - {'DOWN', MRef, process, _, _} = T -> - close({tls_ack, T}, S) - end; - -%% Or not. Don't send anything to the transport so that transports -%% not supporting TLS work as before without modification. -tls_ack(false, _, _, _) -> - ok. - -capz(#diameter_caps{} = L, #diameter_caps{} = R) -> - #diameter_caps{} - = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), - tl(tuple_to_list(R)))]). - -%% close/2 - -%% Tell the watchdog that our death isn't due to transport failure. -close(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid), - throw({?MODULE, close, Reason}). - -%% close_wd/2 - -%% Ensure the watchdog dies if DPR has been sent ... -close_wd(_, #state{dpr = false}) -> - ok; -close_wd(Reason, #state{parent = Pid}) -> - close_wd(Reason, Pid); - -%% ... or otherwise -close_wd(Reason, Pid) -> - Pid ! {close, self(), Reason}. - -%% dwa/1 - -dwa(#diameter_caps{origin_host = OH, - origin_realm = OR, - origin_state_id = OSI}) -> - ['DWA', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Origin-State-Id', OSI}]. - -%% dpr/2 - -dpr(Cause, #state{transport = TPid, - service = #diameter_service{capabilities = Caps}} - = S) -> - #diameter_caps{origin_host = OH, - origin_realm = OR} - = Caps, - - Bin = encode(['DPR', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Disconnect-Cause', Cause}]), - send(TPid, Bin), - dpa_timer(), - ?LOG(send, 'DPR'), - S#state{dpr = diameter_codec:sequence_numbers(Bin)}. - -dpa_timer() -> - erlang:send_after(?DPA_TIMEOUT, self(), dpa_timeout). - -%% register_everywhere/1 -%% -%% Register a term and ensure it's not registered elsewhere. Note that -%% two process that simultaneously register the same term may well -%% both fail to do so this isn't foolproof. - -register_everywhere(T) -> - diameter_reg:add_new(T) - andalso unregistered(T). - -unregistered(T) -> - {ResL, _} = rpc:multicall(?MODULE, match, [{node(), T}]), - lists:all(fun(L) -> [] == L end, ResL). - -match({Node, _}) - when Node == node() -> - []; -match({_, T}) -> - try - diameter_reg:match(T) - catch - _:_ -> [] - end. diff --git a/lib/diameter/src/app/diameter_peer_fsm_sup.erl b/lib/diameter/src/app/diameter_peer_fsm_sup.erl deleted file mode 100644 index 995eaf74d0..0000000000 --- a/lib/diameter/src/app/diameter_peer_fsm_sup.erl +++ /dev/null @@ -1,63 +0,0 @@ -%% -%% %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% -%% - -%% -%% The supervisor of peer_fsm processes. -%% - --module(diameter_peer_fsm_sup). - --behaviour(supervisor). - --define(NAME, ?MODULE). %% supervisor name - -%%----------------------------------------------------------------- -%% External exports -%%----------------------------------------------------------------- - --export([start_link/0, %% supervisor start - start_child/1]). %% peer fsm start - --export([init/1]). - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% Start a peer_fsm process. - -start_child(T) -> - supervisor:start_child(?NAME, [T]). - -%% init/1 - -init([]) -> - Mod = diameter_peer_fsm, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/diameter_reg.erl b/lib/diameter/src/app/diameter_reg.erl deleted file mode 100644 index 882b9da238..0000000000 --- a/lib/diameter/src/app/diameter_reg.erl +++ /dev/null @@ -1,327 +0,0 @@ -%% -%% %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% -%% - -%% -%% The module implements a simple term -> pid registry. -%% - --module(diameter_reg). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([add/1, - add_new/1, - del/1, - repl/2, - match/1]). - --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% test --export([pids/0, - terms/0]). - -%% debug --export([state/0, - uptime/0]). - --include("diameter_internal.hrl"). - --define(SERVER, ?MODULE). --define(TABLE, ?MODULE). - -%% Table entry used to keep from starting more than one monitor on the -%% same process. This isn't a problem but there's no point in starting -%% multiple monitors if we can avoid it. Note that we can't have a 2-tuple -%% keyed on Pid since a registered term can be anything. Want the entry -%% keyed on Pid so that lookup is fast. --define(MONITOR(Pid, MRef), {Pid, monitor, MRef}). - -%% Table entry containing the Term -> Pid mapping. --define(MAPPING(Term, Pid), {Term, Pid}). - --record(state, {id = now()}). - -%%% ---------------------------------------------------------- -%%% # add(T) -%%% -%%% Input: Term = term() -%%% -%%% Output: true -%%% -%%% Description: Associate the specified term with self(). The list of pids -%%% having this or other assocations can be retrieved using -%%% match/1. -%%% -%%% An association is removed when the calling process dies -%%% or as a result of calling del/1. Adding the same term -%%% more than once is equivalent to adding it exactly once. -%%% -%%% Note that since match/1 takes a pattern as argument, -%%% specifying a term that contains match variables is -%%% probably not a good idea -%%% ---------------------------------------------------------- - --spec add(any()) - -> true. - -add(T) -> - call({add, fun ets:insert/2, T, self()}). - -%%% ---------------------------------------------------------- -%%% # add_new(T) -%%% -%%% Input: T = term() -%%% -%%% Output: true | false -%%% -%%% Description: Like add/1 but only one process is allowed to have the -%%% the association, false being returned if an association -%%% already exists. -%%% ---------------------------------------------------------- - --spec add_new(any()) - -> boolean(). - -add_new(T) -> - call({add, fun insert_new/2, T, self()}). - -%%% ---------------------------------------------------------- -%%% # repl(T, NewT) -%%% -%%% Input: T, NewT = term() -%%% -%%% Output: true | false -%%% -%%% Description: Like add/1 but only replace an existing association on T, -%%% false being returned if it doesn't exist. -%%% ---------------------------------------------------------- - --spec repl(any(), any()) - -> boolean(). - -repl(T, U) -> - call({repl, T, U, self()}). - -%%% ---------------------------------------------------------- -%%% # del(Term) -%%% -%%% Input: Term = term() -%%% -%%% Output: true -%%% -%%% Description: Remove any existing association of Term with self(). -%%% ---------------------------------------------------------- - --spec del(any()) - -> true. - -del(T) -> - call({del, T, self()}). - -%%% ---------------------------------------------------------- -%%% # match(Pat) -%%% -%%% Input: Pat = pattern in the sense of ets:match_object/2. -%%% -%%% Output: list of {Term, Pid} -%%% -%%% Description: Return the list of associations whose Term, as specified -%%% to add/1 or add_new/1, matches the specified pattern. -%%% -%%% Note that there's no guarantee that the returned processes -%%% are still alive. (Although one that isn't will soon have -%%% its associations removed.) -%%% ---------------------------------------------------------- - --spec match(tuple()) - -> [{term(), pid()}]. - -match(Pat) -> - ets:match_object(?TABLE, ?MAPPING(Pat, '_')). - -%% --------------------------------------------------------- -%% EXPORTED INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, ?MODULE, [], Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%% pids/0 -%% -%% Output: list of {Pid, [Term, ...]} - -pids() -> - to_list(fun swap/1). - -to_list(Fun) -> - ets:foldl(fun(T,A) -> acc(Fun, T, A) end, orddict:new(), ?TABLE). - -acc(Fun, ?MAPPING(Term, Pid), Dict) -> - append(Fun({Term, Pid}), Dict); -acc(_, _, Dict) -> - Dict. - -append({K,V}, Dict) -> - orddict:append(K, V, Dict). - -id(T) -> T. - -%% terms/0 -%% -%% Output: list of {Term, [Pid, ...]} - -terms() -> - to_list(fun id/1). - -swap({X,Y}) -> {Y,X}. - -%%% ---------------------------------------------------------- -%%% # init(Role) -%%% -%%% Output: {ok, State} -%%% ---------------------------------------------------------- - -init(_) -> - ets:new(?TABLE, [bag, named_table]), - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -handle_call({add, Fun, Key, Pid}, _, State) -> - B = Fun(?TABLE, {Key, Pid}), - monitor(B andalso no_monitor(Pid), Pid), - {reply, B, State}; - -handle_call({del, Key, Pid}, _, State) -> - {reply, ets:delete_object(?TABLE, ?MAPPING(Key, Pid)), State}; - -handle_call({repl, T, U, Pid}, _, State) -> - MatchSpec = [{?MAPPING('$1', Pid), - [{'=:=', '$1', {const, T}}], - ['$_']}], - {reply, repl(ets:select(?TABLE, MatchSpec), U, Pid), State}; - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%%% ---------------------------------------------------------- -%%% # handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State)-> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # handle_info(Request, State) -%%% ---------------------------------------------------------- - -handle_info({'DOWN', MRef, process, Pid, _}, State) -> - ets:delete_object(?TABLE, ?MONITOR(Pid, MRef)), - ets:match_delete(?TABLE, ?MAPPING('_', Pid)), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% # terminate(Reason, State) -%%% ---------------------------------------------------------- - -terminate(_Reason, _State)-> - ok. - -%%% ---------------------------------------------------------- -%%% # code_change(OldVsn, State, Extra) -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -monitor(true, Pid) -> - ets:insert(?TABLE, ?MONITOR(Pid, erlang:monitor(process, Pid))); -monitor(false, _) -> - ok. - -%% Do we need a monitor for the specified Pid? -no_monitor(Pid) -> - [] == ets:match_object(?TABLE, ?MONITOR(Pid, '_')). - -%% insert_new/2 - -insert_new(?TABLE, {Key, _} = T) -> - flush(ets:lookup(?TABLE, Key)), - ets:insert_new(?TABLE, T). - -%% Remove any processes that are dead but for which we may not have -%% received 'DOWN' yet. This is to ensure that add_new can be used -%% to register a unique name each time a process restarts. -flush(List) -> - lists:foreach(fun({_,P} = T) -> - del(erlang:is_process_alive(P), T) - end, - List). - -del(Alive, T) -> - Alive orelse ets:delete_object(?TABLE, T). - -%% repl/3 - -repl([?MAPPING(_, Pid) = M], Key, Pid) -> - ets:delete_object(?TABLE, M), - true = ets:insert(?TABLE, ?MAPPING(Key, Pid)); -repl([], _, _) -> - false. - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_service.erl b/lib/diameter/src/app/diameter_service.erl deleted file mode 100644 index 421e36ccf5..0000000000 --- a/lib/diameter/src/app/diameter_service.erl +++ /dev/null @@ -1,2903 +0,0 @@ -%% -%% %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% -%% - -%% -%% Implements the process that represents a service. -%% - --module(diameter_service). --behaviour(gen_server). - --export([start/1, - stop/1, - start_transport/2, - stop_transport/2, - info/2, - call/4]). - -%% towards diameter_watchdog --export([receive_message/3]). - -%% service supervisor --export([start_link/1]). - --export([subscribe/1, - unsubscribe/1, - subscriptions/1, - subscriptions/0, - services/0, - services/1, - whois/1, - flush_stats/1]). - -%% test/debug --export([call_module/3, - state/1, - uptime/1]). - -%%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% Other callbacks. --export([send/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). --include("diameter_types.hrl"). - --define(STATE_UP, up). --define(STATE_DOWN, down). - --define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1 --define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests --define(RESTART_TC, 1000). %% if restart was this recent - -%% Used to be able to swap this with anything else dict-like but now -%% rely on the fact that a service's #state{} record does not change -%% in storing in it ?STATE table and not always going through the -%% service process. In particular, rely on the fact that operations on -%% a ?Dict don't change the handle to it. --define(Dict, diameter_dict). - -%% Table containing outgoing requests for which a reply has yet to be -%% received. --define(REQUEST_TABLE, diameter_request). - -%% Maintains state in a table. In contrast to previously, a service's -%% stat is not constant and is accessed outside of the service -%% process. --define(STATE_TABLE, ?MODULE). - -%% Workaround for dialyzer's lack of understanding of match specs. --type match(T) - :: T | '_' | '$1' | '$2' | '$3' | '$4'. - -%% State of service gen_server. --record(state, - {id = now(), - service_name, %% as passed to start_service/2, key in ?STATE_TABLE - service :: #diameter_service{}, - peerT = ets_new(peers) :: ets:tid(), %% #peer{} at start_fsm - connT = ets_new(conns) :: ets:tid(), %% #conn{} at connection_up - share_peers = false :: boolean(), %% broadcast peers to remote nodes? - use_shared_peers = false :: boolean(), %% use broadcasted peers? - shared_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] - local_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] - monitor = false :: false | pid()}). %% process to die with -%% shared_peers reflects the peers broadcast from remote nodes. Note -%% that the state term itself doesn't change, which is relevant for -%% the stateless application callbacks since the state is retrieved -%% from ?STATE_TABLE from outside the service process. The pid in the -%% service record is used to determine whether or not we need to call -%% the process for a pick_peer callback. - -%% Record representing a watchdog process. --record(peer, - {pid :: match(pid()), - type :: match(connect | accept), - ref :: match(reference()), %% key into diameter_config - options :: match([transport_opt()]), %% as passed to start_transport - op_state = ?STATE_DOWN :: match(?STATE_DOWN | ?STATE_UP), - started = now(), %% at process start - conn = false :: match(boolean() | pid())}). - %% true at accept, pid() at connection_up (connT key) - -%% Record representing a peer_fsm process. --record(conn, - {pid :: pid(), - apps :: [{0..16#FFFFFFFF, app_alias()}], %% {Id, Alias} - caps :: #diameter_caps{}, - started = now(), %% at process start - peer :: pid()}). %% key into peerT - -%% Record stored in diameter_request for each outgoing request. --record(request, - {from, %% arg 2 of handle_call/3 - handler :: match(pid()), %% request process - transport :: match(pid()), %% peer process - caps :: match(#diameter_caps{}), - app :: match(app_alias()), %% #diameter_app.alias - dictionary :: match(module()), %% #diameter_app.dictionary - module :: match(nonempty_improper_list(module(), list())), - %% #diameter_app.module - filter :: match(peer_filter()), - packet :: match(#diameter_packet{})}). - -%% Record call/4 options are parsed into. --record(options, - {filter = none :: peer_filter(), - extra = [] :: list(), - timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, - detach = false :: boolean()}). - -%% Since RFC 3588 requires that a Diameter agent not modify End-to-End -%% Identifiers, the possibility of explicitly setting an End-to-End -%% Identifier would be needed to be able to implement an agent in -%% which one side of the communication is not implemented on top of -%% diameter. For example, Diameter being sent or received encapsulated -%% in some other protocol, or even another Diameter stack in a -%% non-Erlang environment. (Not that this is likely to be a normal -%% case.) -%% -%% The implemented solution is not an option but to respect any header -%% values set in a diameter_header record returned from a -%% prepare_request callback. A call to diameter:call/4 can communicate -%% values to the callback using the 'extra' option if so desired. - -%%% --------------------------------------------------------------------------- -%%% # start(SvcName) -%%% --------------------------------------------------------------------------- - -start(SvcName) -> - diameter_service_sup:start_child(SvcName). - -start_link(SvcName) -> - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(?MODULE, [SvcName], Options). -%% Put the arbitrary term SvcName in a list in case we ever want to -%% send more than this and need to distinguish old from new. - -%%% --------------------------------------------------------------------------- -%%% # stop(SvcName) -%%% --------------------------------------------------------------------------- - -stop(SvcName) -> - case whois(SvcName) of - undefined -> - {error, not_started}; - Pid -> - stop(call_service(Pid, stop), Pid) - end. - -stop(ok, Pid) -> - MRef = erlang:monitor(process, Pid), - receive {'DOWN', MRef, process, _, _} -> ok end; -stop(No, _) -> - No. - -%%% --------------------------------------------------------------------------- -%%% # start_transport(SvcName, {Ref, Type, Opts}) -%%% --------------------------------------------------------------------------- - -start_transport(SvcName, {_,_,_} = T) -> - call_service_by_name(SvcName, {start, T}). - -%%% --------------------------------------------------------------------------- -%%% # stop_transport(SvcName, Refs) -%%% --------------------------------------------------------------------------- - -stop_transport(_, []) -> - ok; -stop_transport(SvcName, [_|_] = Refs) -> - call_service_by_name(SvcName, {stop, Refs}). - -%%% --------------------------------------------------------------------------- -%%% # info(SvcName, Item) -%%% --------------------------------------------------------------------------- - -info(SvcName, Item) -> - info_rc(call_service_by_name(SvcName, {info, Item})). - -info_rc({error, _}) -> - undefined; -info_rc(Info) -> - Info. - -%%% --------------------------------------------------------------------------- -%%% # receive_message(TPid, Pkt, MessageData) -%%% --------------------------------------------------------------------------- - -%% Handle an incoming message in the watchdog process. This used to -%% come through the service process but this avoids that becoming a -%% bottleneck. - -receive_message(TPid, Pkt, T) - when is_pid(TPid) -> - #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, - recv(R, (not R) andalso lookup_request(Pkt, TPid), TPid, Pkt, T). - -%% Incoming request ... -recv(true, false, TPid, Pkt, T) -> - try - spawn(fun() -> recv_request(TPid, Pkt, T) end) - catch - error: system_limit = E -> %% discard - ?LOG({error, E}, now()) - end; - -%% ... answer to known request ... -recv(false, #request{from = {_, Ref}, handler = Pid} = Req, _, Pkt, _) -> - Pid ! {answer, Ref, Req, Pkt}; -%% Note that failover could have happened prior to this message being -%% received and triggering failback. That is, both a failover message -%% and answer may be on their way to the handler process. In the worst -%% case the request process gets notification of the failover and -%% sends to the alternate peer before an answer arrives, so it's -%% always the case that we can receive more than one answer after -%% failover. The first answer received by the request process wins, -%% any others are discarded. - -%% ... or not. -recv(false, false, _, _, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # call(SvcName, App, Msg, Options) -%%% --------------------------------------------------------------------------- - -call(SvcName, App, Msg, Options) - when is_list(Options) -> - Rec = make_options(Options), - Ref = make_ref(), - Caller = {self(), Ref}, - Fun = fun() -> exit({Ref, call(SvcName, App, Msg, Rec, Caller)}) end, - try spawn_monitor(Fun) of - {_, MRef} -> - recv(MRef, Ref, Rec#options.detach, false) - catch - error: system_limit = E -> - {error, E} - end. - -%% Don't rely on gen_server:call/3 for the timeout handling since it -%% makes no guarantees about not leaving a reply message in the -%% mailbox if we catch its exit at timeout. It currently *can* do so, -%% which is also undocumented. - -recv(MRef, _, true, true) -> - erlang:demonitor(MRef, [flush]), - ok; - -recv(MRef, Ref, Detach, Sent) -> - receive - Ref -> %% send has been attempted - recv(MRef, Ref, Detach, true); - {'DOWN', MRef, process, _, Reason} -> - call_rc(Reason, Ref, Sent) - end. - -%% call/5 has returned ... -call_rc({Ref, Ans}, Ref, _) -> - Ans; - -%% ... or not. In this case failure/encode are documented. -call_rc(_, _, Sent) -> - {error, choose(Sent, failure, encode)}. - -%% call/5 -%% -%% In the process spawned for the outgoing request. - -call(SvcName, App, Msg, Opts, Caller) -> - c(ets:lookup(?STATE_TABLE, SvcName), App, Msg, Opts, Caller). - -c([#state{service_name = SvcName} = S], App, Msg, Opts, Caller) -> - case find_transport(App, Msg, Opts, S) of - {_,_,_} = T -> - send_request(T, Msg, Opts, Caller, SvcName); - false -> - {error, no_connection}; - {error, _} = No -> - No - end; - -c([], _, _, _, _) -> - {error, no_service}. - -%% make_options/1 - -make_options(Options) -> - lists:foldl(fun mo/2, #options{}, Options). - -mo({timeout, T}, Rec) - when is_integer(T), 0 =< T -> - Rec#options{timeout = T}; - -mo({filter, F}, #options{filter = none} = Rec) -> - Rec#options{filter = F}; -mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> - Rec#options{filter = {all, [F | Fs]}}; -mo({filter, F}, #options{filter = F0} = Rec) -> - Rec#options{filter = {all, [F0, F]}}; - -mo({extra, L}, #options{extra = X} = Rec) - when is_list(L) -> - Rec#options{extra = X ++ L}; - -mo(detach, Rec) -> - Rec#options{detach = true}; - -mo(T, _) -> - ?ERROR({invalid_option, T}). - -%%% --------------------------------------------------------------------------- -%%% # subscribe(SvcName) -%%% # unsubscribe(SvcName) -%%% --------------------------------------------------------------------------- - -subscribe(SvcName) -> - diameter_reg:add({?MODULE, subscriber, SvcName}). - -unsubscribe(SvcName) -> - diameter_reg:del({?MODULE, subscriber, SvcName}). - -subscriptions(Pat) -> - pmap(diameter_reg:match({?MODULE, subscriber, Pat})). - -subscriptions() -> - subscriptions('_'). - -pmap(Props) -> - lists:map(fun({{?MODULE, _, Name}, Pid}) -> {Name, Pid} end, Props). - -%%% --------------------------------------------------------------------------- -%%% # services(Pattern) -%%% --------------------------------------------------------------------------- - -services(Pat) -> - pmap(diameter_reg:match({?MODULE, service, Pat})). - -services() -> - services('_'). - -whois(SvcName) -> - case diameter_reg:match({?MODULE, service, SvcName}) of - [{_, Pid}] -> - Pid; - [] -> - undefined - end. - -%%% --------------------------------------------------------------------------- -%%% # flush_stats/1 -%%% -%%% Output: list of {{SvcName, Alias, Counter}, Value} -%%% --------------------------------------------------------------------------- - -flush_stats(TPid) -> - diameter_stats:flush(TPid). - -%% =========================================================================== -%% =========================================================================== - -state(Svc) -> - call_service(Svc, state). - -uptime(Svc) -> - call_service(Svc, uptime). - -%% call_module/3 - -call_module(Service, AppMod, Request) -> - call_service(Service, {call_module, AppMod, Request}). - -%%% --------------------------------------------------------------------------- -%%% # init([SvcName]) -%%% --------------------------------------------------------------------------- - -init([SvcName]) -> - process_flag(trap_exit, true), %% ensure terminate(shutdown, _) - i(SvcName, diameter_reg:add_new({?MODULE, service, SvcName})). - -i(SvcName, true) -> - {ok, i(SvcName)}; -i(_, false) -> - {stop, {shutdown, already_started}}. - -%%% --------------------------------------------------------------------------- -%%% # handle_call(Req, From, State) -%%% --------------------------------------------------------------------------- - -handle_call(state, _, S) -> - {reply, S, S}; - -handle_call(uptime, _, #state{id = T} = S) -> - {reply, diameter_lib:now_diff(T), S}; - -%% Start a transport. -handle_call({start, {Ref, Type, Opts}}, _From, S) -> - {reply, start(Ref, {Type, Opts}, S), S}; - -%% Stop transports. -handle_call({stop, Refs}, _From, S) -> - shutdown(Refs, S), - {reply, ok, S}; - -%% pick_peer with mutable state -handle_call({pick_peer, Local, Remote, App}, _From, S) -> - #diameter_app{mutable = true} = App, %% assert - {reply, pick_peer(Local, Remote, self(), S#state.service_name, App), S}; - -handle_call({call_module, AppMod, Req}, From, S) -> - call_module(AppMod, Req, From, S); - -handle_call({info, Item}, _From, S) -> - {reply, service_info(Item, S), S}; - -handle_call(stop, _From, S) -> - shutdown(S), - {stop, normal, ok, S}; -%% The server currently isn't guaranteed to be dead when the caller -%% gets the reply. We deal with this in the call to the server, -%% stating a monitor that waits for DOWN before returning. - -handle_call(Req, From, S) -> - unexpected(handle_call, [Req, From], S), - {reply, nok, S}. - -%%% --------------------------------------------------------------------------- -%%% # handle_cast(Req, State) -%%% --------------------------------------------------------------------------- - -handle_cast(Req, S) -> - unexpected(handle_cast, [Req], S), - {noreply, S}. - -%%% --------------------------------------------------------------------------- -%%% # handle_info(Req, State) -%%% --------------------------------------------------------------------------- - -handle_info(T,S) -> - case transition(T,S) of - ok -> - {noreply, S}; - #state{} = NS -> - {noreply, NS}; - {stop, Reason} -> - {stop, {shutdown, Reason}, S} - end. - -%% transition/2 - -%% Peer process is telling us to start a new accept process. -transition({accepted, Pid, TPid}, S) -> - accepted(Pid, TPid, S), - ok; - -%% Peer process has a new open connection. -transition({connection_up, Pid, T}, S) -> - connection_up(Pid, T, S); - -%% Peer process has left state open. -transition({connection_down, Pid}, S) -> - connection_down(Pid, S); - -%% Peer process has returned to state open. -transition({connection_up, Pid}, S) -> - connection_up(Pid, S); - -%% Accepting transport has lost connectivity. -transition({close, Pid}, S) -> - close(Pid, S), - ok; - -%% Connecting transport is being restarted by watchdog. -transition({reconnect, Pid}, S) -> - reconnect(Pid, S), - ok; - -%% Monitor process has died. Just die with a reason that tells -%% diameter_config about the happening. If a cleaner shutdown is -%% required then someone should stop us. -transition({'DOWN', MRef, process, _, Reason}, #state{monitor = MRef}) -> - {stop, {monitor, Reason}}; - -%% Local peer process has died. -transition({'DOWN', _, process, Pid, Reason}, S) - when node(Pid) == node() -> - peer_down(Pid, Reason, S); - -%% Remote service wants to know about shared transports. -transition({service, Pid}, S) -> - share_peers(Pid, S), - ok; - -%% Remote service is communicating a shared peer. -transition({peer, TPid, Aliases, Caps}, S) -> - remote_peer_up(TPid, Aliases, Caps, S); - -%% Remote peer process has died. -transition({'DOWN', _, process, TPid, _}, S) -> - remote_peer_down(TPid, S); - -%% Restart after tc expiry. -transition({tc_timeout, T}, S) -> - tc_timeout(T, S), - ok; - -%% Request process is telling us it may have missed a failover message -%% after a transport went down and the service process looked up -%% outstanding requests. -transition({failover, TRef, Seqs}, S) -> - failover(TRef, Seqs, S), - ok; - -transition(Req, S) -> - unexpected(handle_info, [Req], S), - ok. - -%%% --------------------------------------------------------------------------- -%%% # terminate(Reason, State) -%%% --------------------------------------------------------------------------- - -terminate(Reason, #state{service_name = Name} = S) -> - ets:delete(?STATE_TABLE, Name), - shutdown == Reason %% application shutdown - andalso shutdown(S). - -%%% --------------------------------------------------------------------------- -%%% # code_change(FromVsn, State, Extra) -%%% --------------------------------------------------------------------------- - -code_change(FromVsn, - #state{service_name = SvcName, - service = #diameter_service{applications = Apps}} - = S, - Extra) -> - lists:foreach(fun(A) -> - code_change(FromVsn, SvcName, Extra, A) - end, - Apps), - {ok, S}. - -code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> - {ok, S} = cb(A, code_change, [FromVsn, - mod_state(Alias), - Extra, - SvcName]), - mod_state(Alias, S). - -%% =========================================================================== -%% =========================================================================== - -unexpected(F, A, #state{service_name = Name}) -> - ?UNEXPECTED(F, A ++ [Name]). - -cb([_|_] = M, F, A) -> - eval(M, F, A); -cb(Rec, F, A) -> - {_, M} = app(Rec), - eval(M, F, A). - -app(#request{app = A, module = M}) -> - {A,M}; -app(#diameter_app{alias = A, module = M}) -> - {A,M}. - -eval([M|X], F, A) -> - apply(M, F, A ++ X). - -%% Callback with state. - -state_cb(#diameter_app{mutable = false, init_state = S}, {ModX, F, A}) -> - eval(ModX, F, A ++ [S]); - -state_cb(#diameter_app{mutable = true, alias = Alias}, {_,_,_} = MFA) -> - state_cb(MFA, Alias); - -state_cb({ModX,F,A}, Alias) - when is_list(ModX) -> - eval(ModX, F, A ++ [mod_state(Alias)]). - -choose(true, X, _) -> X; -choose(false, _, X) -> X. - -ets_new(Tbl) -> - ets:new(Tbl, [{keypos, 2}]). - -insert(Tbl, Rec) -> - ets:insert(Tbl, Rec), - Rec. - -monitor(Pid) -> - erlang:monitor(process, Pid), - Pid. - -%% Using the process dictionary for the callback state was initially -%% just a way to make what was horrendous trace (big state record and -%% much else everywhere) somewhat more readable. There's not as much -%% need for it now but it's no worse (except possibly that we don't -%% see the table identifier being passed around) than an ets table so -%% keep it. - -mod_state(Alias) -> - get({?MODULE, mod_state, Alias}). - -mod_state(Alias, ModS) -> - put({?MODULE, mod_state, Alias}, ModS). - -%% have_transport/2 - -have_transport(SvcName, Ref) -> - [] /= diameter_config:have_transport(SvcName, Ref). - -%%% --------------------------------------------------------------------------- -%%% # shutdown/2 -%%% --------------------------------------------------------------------------- - -shutdown(Refs, #state{peerT = PeerT}) -> - ets:foldl(fun(P,ok) -> s(P, Refs), ok end, ok, PeerT). - -s(#peer{ref = Ref, pid = Pid}, Refs) -> - s(lists:member(Ref, Refs), Pid); - -s(true, Pid) -> - Pid ! {shutdown, self()}; %% 'DOWN' will cleanup as usual -s(false, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # shutdown/1 -%%% --------------------------------------------------------------------------- - -shutdown(#state{peerT = PeerT}) -> - %% A transport might not be alive to receive the shutdown request - %% but give those that are a chance to shutdown gracefully. - wait(fun st/2, PeerT), - %% Kill the watchdogs explicitly in case there was no transport. - wait(fun sw/2, PeerT). - -wait(Fun, T) -> - diameter_lib:wait(ets:foldl(Fun, [], T)). - -st(#peer{conn = B}, Acc) - when is_boolean(B) -> - Acc; -st(#peer{conn = Pid}, Acc) -> - Pid ! shutdown, - [Pid | Acc]. - -sw(#peer{pid = Pid}, Acc) -> - exit(Pid, shutdown), - [Pid | Acc]. - -%%% --------------------------------------------------------------------------- -%%% # call_service/2 -%%% --------------------------------------------------------------------------- - -call_service(Pid, Req) - when is_pid(Pid) -> - cs(Pid, Req); -call_service(SvcName, Req) -> - call_service_by_name(SvcName, Req). - -call_service_by_name(SvcName, Req) -> - cs(whois(SvcName), Req). - -cs(Pid, Req) - when is_pid(Pid) -> - try - gen_server:call(Pid, Req, infinity) - catch - E: Reason when E == exit -> - {error, {E, Reason}} - end; - -cs(undefined, _) -> - {error, no_service}. - -%%% --------------------------------------------------------------------------- -%%% # i/1 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Intialize the state of a service gen_server. - -i(SvcName) -> - %% Split the config into a server state and a list of transports. - {#state{} = S, CL} = lists:foldl(fun cfg_acc/2, - {false, []}, - diameter_config:lookup(SvcName)), - - %% Publish the state in order to be able to access it outside of - %% the service process. Originally table identifiers were only - %% known to the service process but we now want to provide the - %% option of application callbacks being 'stateless' in order to - %% avoid having to go through a common process. (Eg. An agent that - %% sends a request for every incoming request.) - true = ets:insert_new(?STATE_TABLE, S), - - %% Start fsms for each transport. - lists:foreach(fun(T) -> start_fsm(T,S) end, CL), - - init_shared(S), - S. - -cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts}, - {false, Acc}) -> - lists:foreach(fun init_mod/1, Apps), - S = #state{service_name = SvcName, - service = Rec#diameter_service{pid = self()}, - share_peers = get_value(share_peers, Opts), - use_shared_peers = get_value(use_shared_peers, Opts), - monitor = mref(get_value(monitor, Opts))}, - {S, Acc}; - -cfg_acc({_Ref, Type, _Opts} = T, {S, Acc}) - when Type == connect; - Type == listen -> - {S, [T | Acc]}. - -mref(false = No) -> - No; -mref(P) -> - erlang:monitor(process, P). - -init_shared(#state{use_shared_peers = true, - service_name = Svc}) -> - diameter_peer:notify(Svc, {service, self()}); -init_shared(#state{use_shared_peers = false}) -> - ok. - -init_mod(#diameter_app{alias = Alias, - init_state = S}) -> - mod_state(Alias, S). - -start_fsm({Ref, Type, Opts}, S) -> - start(Ref, {Type, Opts}, S). - -get_value(Key, Vs) -> - {_, V} = lists:keyfind(Key, 1, Vs), - V. - -%%% --------------------------------------------------------------------------- -%%% # start/3 -%%% --------------------------------------------------------------------------- - -%% If the initial start/3 at service/transport start succeeds then -%% subsequent calls to start/4 on the same service will also succeed -%% since they involve the same call to merge_service/2. We merge here -%% rather than earlier since the service may not yet be configured -%% when the transport is configured. - -start(Ref, {T, Opts}, S) - when T == connect; - T == listen -> - try - {ok, start(Ref, type(T), Opts, S)} - catch - ?FAILURE(Reason) -> - {error, Reason} - end. -%% TODO: don't actually raise any errors yet - -%% There used to be a difference here between the handling of -%% configured listening and connecting transports but now we simply -%% tell the transport_module to start an accepting or connecting -%% process respectively, the transport implementation initiating -%% listening on a port as required. -type(listen) -> accept; -type(accept) -> listen; -type(connect = T) -> T. - -%% start/4 - -start(Ref, Type, Opts, #state{peerT = PeerT, - connT = ConnT, - service_name = SvcName, - service = Svc}) - when Type == connect; - Type == accept -> - Pid = monitor(s(Type, Ref, {ConnT, - Opts, - SvcName, - merge_service(Opts, Svc)})), - insert(PeerT, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts}), - Pid. - -%% Note that the service record passed into the watchdog is the merged -%% record so that each watchdog (and peer_fsm) may get a different -%% record. This record is what is passed back into application -%% callbacks. - -s(Type, Ref, T) -> - diameter_watchdog:start({Type, Ref}, T). - -%% merge_service/2 - -merge_service(Opts, Svc) -> - lists:foldl(fun ms/2, Svc, Opts). - -%% Limit the applications known to the fsm to those in the 'apps' -%% option. That this might be empty is checked by the fsm. It's not -%% checked at config-time since there's no requirement that the -%% service be configured first. (Which could be considered a bit odd.) -ms({applications, As}, #diameter_service{applications = Apps} = S) - when is_list(As) -> - S#diameter_service{applications - = [A || A <- Apps, - lists:member(A#diameter_app.alias, As)]}; - -%% The fact that all capabilities can be configured on the transports -%% means that the service doesn't necessarily represent a single -%% locally implemented Diameter peer as identified by Origin-Host: a -%% transport can configure its own Origin-Host. This means that the -%% service little more than a placeholder for default capabilities -%% plus a list of applications that individual transports can choose -%% to support (or not). -ms({capabilities, Opts}, #diameter_service{capabilities = Caps0} = Svc) - when is_list(Opts) -> - %% make_caps has already succeeded in diameter_config so it will succeed - %% again here. - {ok, Caps} = diameter_capx:make_caps(Caps0, Opts), - Svc#diameter_service{capabilities = Caps}; - -ms(_, Svc) -> - Svc. - -%%% --------------------------------------------------------------------------- -%%% # accepted/3 -%%% --------------------------------------------------------------------------- - -accepted(Pid, _TPid, #state{peerT = PeerT} = S) -> - #peer{ref = Ref, type = accept = T, conn = false, options = Opts} - = P - = fetch(PeerT, Pid), - insert(PeerT, P#peer{conn = true}), %% mark replacement transport started - start(Ref, T, Opts, S). %% start new peer - -fetch(Tid, Key) -> - [T] = ets:lookup(Tid, Key), - T. - -%%% --------------------------------------------------------------------------- -%%% # connection_up/3 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has reached the open state. - -connection_up(Pid, {TPid, {Caps, SApps, Pkt}}, #state{peerT = PeerT, - connT = ConnT} - = S) -> - P = fetch(PeerT, Pid), - C = #conn{pid = TPid, - apps = SApps, - caps = Caps, - peer = Pid}, - - insert(ConnT, C), - connection_up([Pkt], P#peer{conn = TPid}, C, S). - -%%% --------------------------------------------------------------------------- -%%% # connection_up/2 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has transitioned back into the open state. Note that there -%% has been no new capabilties exchange in this case. - -connection_up(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{conn = TPid} = P = fetch(PeerT, Pid), - C = fetch(ConnT, TPid), - connection_up([], P, C, S). - -%% connection_up/4 - -connection_up(T, P, C, #state{peerT = PeerT, - local_peers = LDict, - service_name = SvcName, - service - = #diameter_service{applications = Apps}} - = S) -> - #peer{conn = TPid, op_state = ?STATE_DOWN} - = P, - #conn{apps = SApps, caps = Caps} - = C, - - insert(PeerT, P#peer{op_state = ?STATE_UP}), - - request_peer_up(TPid), - report_status(up, P, C, S, T), - S#state{local_peers = insert_local_peer(SApps, - {{TPid, Caps}, {SvcName, Apps}}, - LDict)}. - -insert_local_peer(SApps, T, LDict) -> - lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). - -ilp({Id, Alias}, {TC, SA}, LDict) -> - init_conn(Id, Alias, TC, SA), - ?Dict:append(Alias, TC, LDict). - -init_conn(Id, Alias, TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert - = find_app(Alias, Apps), - - peer_cb({ModX, peer_up, [SvcName, TC]}, Alias). - -find_app(Alias, Apps) -> - lists:keyfind(Alias, #diameter_app.alias, Apps). - -%% A failing peer callback brings down the service. In the case of -%% peer_up we could just kill the transport and emit an error but for -%% peer_down we have no way to cleanup any state change that peer_up -%% may have introduced. -peer_cb(MFA, Alias) -> - try state_cb(MFA, Alias) of - ModS -> - mod_state(Alias, ModS) - catch - E: Reason -> - ?ERROR({E, Reason, MFA, ?STACK}) - end. - -%%% --------------------------------------------------------------------------- -%%% # connection_down/2 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has transitioned out of the open state. - -connection_down(Pid, #state{peerT = PeerT, - connT = ConnT} - = S) -> - #peer{conn = TPid} - = P - = fetch(PeerT, Pid), - - C = fetch(ConnT, TPid), - insert(PeerT, P#peer{op_state = ?STATE_DOWN}), - connection_down(P,C,S). - -%% connection_down/3 - -connection_down(#peer{conn = TPid, - op_state = ?STATE_UP} - = P, - #conn{caps = Caps, - apps = SApps} - = C, - #state{service_name = SvcName, - service = #diameter_service{applications = Apps}, - local_peers = LDict} - = S) -> - report_status(down, P, C, S, []), - NewS = S#state{local_peers - = remove_local_peer(SApps, - {{TPid, Caps}, {SvcName, Apps}}, - LDict)}, - request_peer_down(TPid, NewS), - NewS. - -remove_local_peer(SApps, T, LDict) -> - lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). - -rlp({Id, Alias}, {TC, SA}, LDict) -> - L = ?Dict:fetch(Alias, LDict), - down_conn(Id, Alias, TC, SA), - ?Dict:store(Alias, lists:delete(TC, L), LDict). - -down_conn(Id, Alias, TC, {SvcName, Apps}) -> - #diameter_app{module = ModX, - id = Id} %% assert - = find_app(Alias, Apps), - - peer_cb({ModX, peer_down, [SvcName, TC]}, Alias). - -%%% --------------------------------------------------------------------------- -%%% # peer_down/3 -%%% -%%% Output: #state{} -%%% --------------------------------------------------------------------------- - -%% Peer process has died. - -peer_down(Pid, _Reason, #state{peerT = PeerT} = S) -> - P = fetch(PeerT, Pid), - ets:delete_object(PeerT, P), - restart(P,S), - peer_down(P,S). - -%% peer_down/2 - -%% The peer has never come up ... -peer_down(#peer{conn = B}, S) - when is_boolean(B) -> - S; - -%% ... or it has. -peer_down(#peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts} - = P, - #state{service_name = SvcName, - connT = ConnT} - = S) -> - #conn{caps = Caps} - = C - = fetch(ConnT, TPid), - ets:delete_object(ConnT, C), - try - pd(P,C,S) - after - send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}}) - end. - -pd(#peer{op_state = ?STATE_DOWN}, _, S) -> - S; -pd(#peer{op_state = ?STATE_UP} = P, C, S) -> - connection_down(P,C,S). - -%% restart/2 - -restart(P,S) -> - q_restart(restart(P), S). - -%% restart/1 - -%% Always try to reconnect. -restart(#peer{ref = Ref, - type = connect = T, - options = Opts, - started = Time}) -> - {Time, {Ref, T, Opts}}; - -%% Transport connection hasn't yet been accepted ... -restart(#peer{ref = Ref, - type = accept = T, - options = Opts, - conn = false, - started = Time}) -> - {Time, {Ref, T, Opts}}; - -%% ... or it has: a replacement transport has already been spawned. -restart(#peer{type = accept}) -> - false. - -%% q_restart/2 - -%% Start the reconnect timer. -q_restart({Time, {_Ref, Type, Opts} = T}, S) -> - start_tc(tc(Time, default_tc(Type, Opts)), T, S); -q_restart(false, _) -> - ok. - -%% RFC 3588, 2.1: -%% -%% When no transport connection exists with a peer, an attempt to -%% connect SHOULD be periodically made. This behavior is handled via -%% the Tc timer, whose recommended value is 30 seconds. There are -%% certain exceptions to this rule, such as when a peer has terminated -%% the transport connection stating that it does not wish to -%% communicate. - -default_tc(connect, Opts) -> - proplists:get_value(reconnect_timer, Opts, ?DEFAULT_TC); -default_tc(accept, _) -> - 0. - -%% Bound tc below if the peer was restarted recently to avoid -%% continuous in case of faulty config or other problems. -tc(Time, Tc) -> - choose(Tc > ?RESTART_TC - orelse timer:now_diff(now(), Time) > 1000*?RESTART_TC, - Tc, - ?RESTART_TC). - -start_tc(0, T, S) -> - tc_timeout(T, S); -start_tc(Tc, T, _) -> - erlang:send_after(Tc, self(), {tc_timeout, T}). - -%% tc_timeout/2 - -tc_timeout({Ref, _Type, _Opts} = T, #state{service_name = SvcName} = S) -> - tc(have_transport(SvcName, Ref), T, S). - -tc(true, {Ref, Type, Opts}, #state{service_name = SvcName} - = S) -> - send_event(SvcName, {reconnect, Ref, Opts}), - start(Ref, Type, Opts, S); -tc(false = No, _, _) -> %% removed - No. - -%%% --------------------------------------------------------------------------- -%%% # close/2 -%%% --------------------------------------------------------------------------- - -%% The watchdog doesn't start a new fsm in the accept case, it -%% simply stays alive until someone tells it to die in order for -%% another watchdog to be able to detect that it should transition -%% from initial into reopen rather than okay. That someone is either -%% the accepting watchdog upon reception of a CER from the previously -%% connected peer, or us after reconnect_timer timeout. - -close(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{pid = Pid, - type = accept, - ref = Ref, - options = Opts} - = fetch(PeerT, Pid), - - c(Pid, have_transport(SvcName, Ref), Opts). - -%% Tell watchdog to (maybe) die later ... -c(Pid, true, Opts) -> - Tc = proplists:get_value(reconnect_timer, Opts, 2*?DEFAULT_TC), - erlang:send_after(Tc, Pid, close); - -%% ... or now. -c(Pid, false, _Opts) -> - Pid ! close. - -%% The RFC's only document the behaviour of Tc, our reconnect_timer, -%% for the establishment of connections but we also give -%% reconnect_timer semantics for a listener, being the time within -%% which a new connection attempt is expected of a connecting peer. -%% The value should be greater than the peer's Tc + jitter. - -%%% --------------------------------------------------------------------------- -%%% # reconnect/2 -%%% --------------------------------------------------------------------------- - -reconnect(Pid, #state{service_name = SvcName, - peerT = PeerT}) -> - #peer{ref = Ref, - type = connect, - options = Opts} - = fetch(PeerT, Pid), - send_event(SvcName, {reconnect, Ref, Opts}). - -%%% --------------------------------------------------------------------------- -%%% # call_module/4 -%%% --------------------------------------------------------------------------- - -%% Backwards compatibility and never documented/advertised. May be -%% removed. - -call_module(Mod, Req, From, #state{service - = #diameter_service{applications = Apps}, - service_name = Svc} - = S) -> - case cm([A || A <- Apps, Mod == hd(A#diameter_app.module)], - Req, - From, - Svc) - of - {reply = T, RC} -> - {T, RC, S}; - noreply = T -> - {T, S}; - Reason -> - {reply, {error, Reason}, S} - end. - -cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> - MFA = {ModX, handle_call, [Req, From, Svc]}, - - try state_cb(MFA, Alias) of - {noreply = T, ModS} -> - mod_state(Alias, ModS), - T; - {reply = T, RC, ModS} -> - mod_state(Alias, ModS), - {T, RC}; - T -> - diameter_lib:error_report({invalid, T}, MFA), - invalid - catch - E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA), - failure - end; - -cm([], _, _, _) -> - unknown; - -cm([_,_|_], _, _, _) -> - multiple. - -%%% --------------------------------------------------------------------------- -%%% # send_request/5 -%%% --------------------------------------------------------------------------- - -%% Send an outgoing request in its dedicated process. -%% -%% Note that both encode of the outgoing request and of the received -%% answer happens in this process. It's also this process that replies -%% to the caller. The service process only handles the state-retaining -%% callbacks. -%% -%% The mod field of the #diameter_app{} here includes any extra -%% arguments passed to diameter:call/2. - -send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> - #diameter_app{module = ModX} - = App, - - Pkt = make_packet(Msg), - - case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of - {send, P} -> - send_request(make_packet(P, Pkt), - TPid, - Caps, - App, - Opts, - Caller, - SvcName); - {discard, Reason} -> - {error, Reason}; - discard -> - {error, discarded}; - T -> - ?ERROR({invalid_return, prepare_request, App, T}) - end. - -%% make_packet/1 -%% -%% Turn an outgoing request as passed to call/4 into a diameter_packet -%% record in preparation for a prepare_request callback. - -make_packet(Bin) - when is_binary(Bin) -> - #diameter_packet{header = diameter_codec:decode_header(Bin), - bin = Bin}; - -make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) -> - Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]}; - -make_packet(#diameter_packet{header = Hdr} = Pkt) -> - Pkt#diameter_packet{header = make_header(Hdr)}; - -make_packet(Msg) -> - make_packet(#diameter_packet{msg = Msg}). - -%% make_header/1 - -make_header(undefined) -> - Seq = diameter_session:sequence(), - make_header(#diameter_header{end_to_end_id = Seq, - hop_by_hop_id = Seq}); - -make_header(#diameter_header{version = undefined} = Hdr) -> - make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); - -make_header(#diameter_header{end_to_end_id = undefined} = H) -> - Seq = diameter_session:sequence(), - make_header(H#diameter_header{end_to_end_id = Seq}); - -make_header(#diameter_header{hop_by_hop_id = undefined} = H) -> - Seq = diameter_session:sequence(), - make_header(H#diameter_header{hop_by_hop_id = Seq}); - -make_header(#diameter_header{} = Hdr) -> - Hdr; - -make_header(T) -> - ?ERROR({invalid_header, T}). - -%% make_packet/2 -%% -%% Reconstruct a diameter_packet from the return value of -%% prepare_request or prepare_retransmit callback. - -make_packet(Bin, _) - when is_binary(Bin) -> - make_packet(Bin); - -make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> - Pkt; - -%% Returning a diameter_packet with no header from a prepare_request -%% or prepare_retransmit callback retains the header passed into it. -%% This is primarily so that the end to end and hop by hop identifiers -%% are retained. -make_packet(#diameter_packet{header = Hdr} = Pkt, - #diameter_packet{header = Hdr0}) -> - Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; - -make_packet(Msg, Pkt) -> - Pkt#diameter_packet{msg = Msg}. - -%% fold_record/2 - -fold_record(undefined, R) -> - R; -fold_record(Rec, R) -> - diameter_lib:fold_tuple(2, Rec, R). - -%% send_request/7 - -send_request(Pkt, TPid, Caps, App, Opts, Caller, SvcName) -> - #diameter_app{alias = Alias, - dictionary = Dict, - module = ModX, - answer_errors = AE} - = App, - - EPkt = encode(Dict, Pkt), - - #options{filter = Filter, - timeout = Timeout} - = Opts, - - Req = #request{packet = Pkt, - from = Caller, - handler = self(), - transport = TPid, - caps = Caps, - app = Alias, - filter = Filter, - dictionary = Dict, - module = ModX}, - - try - TRef = send_request(TPid, EPkt, Req, Timeout), - ack(Caller), - handle_answer(SvcName, AE, recv_answer(Timeout, SvcName, {TRef, Req})) - after - erase_request(EPkt) - end. - -%% Tell caller a send has been attempted. -ack({Pid, Ref}) -> - Pid ! Ref. - -%% recv_answer/3 - -recv_answer(Timeout, - SvcName, - {TRef, #request{from = {_, Ref}, packet = RPkt} = Req} - = T) -> - - %% Matching on TRef below ensures we ignore messages that pertain - %% to a previous transport prior to failover. The answer message - %% includes the #request{} since it's not necessarily Req; that - %% is, from the last peer to which we've transmitted. - - receive - {answer = A, Ref, Rq, Pkt} -> %% Answer from peer - {A, Rq, Pkt}; - {timeout = Reason, TRef, _} -> %% No timely reply - {error, Req, Reason}; - {failover = Reason, TRef, false} -> %% No alternate peer - {error, Req, Reason}; - {failover, TRef, Transport} -> %% Resend to alternate peer - try_retransmit(Timeout, SvcName, Req, Transport); - {failover, TRef} -> %% May have missed failover notification - Seqs = diameter_codec:sequence_numbers(RPkt), - Pid = whois(SvcName), - is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}), - recv_answer(Timeout, SvcName, T) - end. -%% Note that failover starts a new timer and that expiry of an old -%% timer value is ignored. This means that an answer could be accepted -%% from a peer after timeout in the case of failover. - -try_retransmit(Timeout, SvcName, Req, Transport) -> - try retransmit(Transport, Req, SvcName, Timeout) of - T -> recv_answer(Timeout, SvcName, T) - catch - ?FAILURE(Reason) -> {error, Req, Reason} - end. - -%% handle_error/3 - -handle_error(Req, Reason, SvcName) -> - #request{module = ModX, - packet = Pkt, - transport = TPid, - caps = Caps} - = Req, - cb(ModX, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). - -msg(#diameter_packet{msg = undefined, bin = Bin}) -> - Bin; -msg(#diameter_packet{msg = Msg}) -> - Msg. - -%% encode/2 - -%% Note that prepare_request can return a diameter_packet containing -%% header or transport_data. Even allow the returned record to contain -%% an encoded binary. This isn't the usual case but could some in -%% handy, for test at least. (For example, to send garbage.) - -%% The normal case: encode the returned message. -encode(Dict, #diameter_packet{msg = Msg, bin = undefined} = Pkt) -> - D = pick_dictionary([Dict, ?BASE], Msg), - diameter_codec:encode(D, Pkt); - -%% Callback has returned an encoded binary: just send. -encode(_, #diameter_packet{} = Pkt) -> - Pkt. - -%% pick_dictionary/2 - -%% Pick the first dictionary that declares the application id in the -%% specified header. -pick_dictionary(Ds, [#diameter_header{application_id = Id} | _]) -> - pd(Ds, fun(D) -> Id = D:id() end); - -%% Pick the first dictionary that knows the specified message name. -pick_dictionary(Ds, [MsgName|_]) -> - pd(Ds, fun(D) -> D:msg2rec(MsgName) end); - -%% Pick the first dictionary that knows the name of the specified -%% message record. -pick_dictionary(Ds, Rec) -> - Name = element(1, Rec), - pd(Ds, fun(D) -> D:rec2msg(Name) end). - -pd([D|Ds], F) -> - try - F(D), - D - catch - error:_ -> - pd(Ds, F) - end; - -pd([], _) -> - ?ERROR(no_dictionary). - -%% send_request/4 - -send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout) - when node() == node(TPid) -> - %% Store the outgoing request before sending to avoid a race with - %% reply reception. - TRef = store_request(TPid, Bin, Req, Timeout), - send(TPid, Pkt), - TRef; - -%% Send using a remote transport: spawn a process on the remote node -%% to relay the answer. -send_request(TPid, #diameter_packet{} = Pkt, Req, Timeout) -> - TRef = erlang:start_timer(Timeout, self(), timeout), - T = {TPid, Pkt, Req, Timeout, TRef}, - spawn(node(TPid), ?MODULE, send, [T]), - TRef. - -%% send/1 - -send({TPid, Pkt, #request{handler = Pid} = Req, Timeout, TRef}) -> - Ref = send_request(TPid, Pkt, Req#request{handler = self()}, Timeout), - Pid ! reref(receive T -> T end, Ref, TRef). - -reref({T, Ref, R}, Ref, TRef) -> - {T, TRef, R}; -reref(T, _, _) -> - T. - -%% send/2 - -send(Pid, Pkt) -> - Pid ! {send, Pkt}. - -%% retransmit/4 - -retransmit({TPid, Caps, #diameter_app{alias = Alias} = App}, - #request{app = Alias, - packet = Pkt} - = Req, - SvcName, - Timeout) -> - have_request(Pkt, TPid) %% Don't failover to a peer we've - andalso ?THROW(timeout), %% already sent to. - - case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of - {send, P} -> - retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout); - {discard, Reason} -> - ?THROW(Reason); - discard -> - ?THROW(discarded); - T -> - ?ERROR({invalid_return, prepare_retransmit, App, T}) - end. - -%% retransmit/5 - -retransmit(Pkt, TPid, Caps, #request{dictionary = Dict} = Req, Timeout) -> - EPkt = encode(Dict, Pkt), - - NewReq = Req#request{transport = TPid, - packet = Pkt, - caps = Caps}, - - ?LOG(retransmission, NewReq), - TRef = send_request(TPid, EPkt, NewReq, Timeout), - {TRef, NewReq}. - -%% store_request/4 - -store_request(TPid, Bin, Req, Timeout) -> - Seqs = diameter_codec:sequence_numbers(Bin), - TRef = erlang:start_timer(Timeout, self(), timeout), - ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), - ets:member(?REQUEST_TABLE, TPid) - orelse (self() ! {failover, TRef}), %% possibly missed failover - TRef. - -%% lookup_request/2 - -lookup_request(Msg, TPid) - when is_pid(TPid) -> - lookup(Msg, TPid, '_'); - -lookup_request(Msg, TRef) - when is_reference(TRef) -> - lookup(Msg, '_', TRef). - -lookup(Msg, TPid, TRef) -> - Seqs = diameter_codec:sequence_numbers(Msg), - Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, TRef}, - [], - ['$_']}], - case ets:select(?REQUEST_TABLE, Spec) of - [{_, Req, _}] -> - Req; - [] -> - false - end. - -%% erase_request/1 - -erase_request(Pkt) -> - ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). - -%% match_requests/1 - -match_requests(TPid) -> - Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, - ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). - -%% have_request/2 - -have_request(Pkt, TPid) -> - Seqs = diameter_codec:sequence_numbers(Pkt), - Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, - '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). - -%% request_peer_up/1 - -request_peer_up(TPid) -> - ets:insert(?REQUEST_TABLE, {TPid}). - -%% request_peer_down/2 - -request_peer_down(TPid, S) -> - ets:delete(?REQUEST_TABLE, TPid), - lists:foreach(fun(T) -> failover(T,S) end, match_requests(TPid)). -%% Note that a request process can store its request after failover -%% notifications are sent here: store_request/4 sends the notification -%% in that case. Note also that we'll send as many notifications to a -%% given handler as there are peers its sent to. All but one of these -%% will be ignored. - -%%% --------------------------------------------------------------------------- -%%% recv_request/3 -%%% --------------------------------------------------------------------------- - -recv_request(TPid, Pkt, {ConnT, SvcName, Apps}) -> - try ets:lookup(ConnT, TPid) of - [C] -> - recv_request(C, TPid, Pkt, SvcName, Apps); - [] -> %% transport has gone down - ok - catch - error: badarg -> %% service has gone down (and taken table with it) - ok - end. - -%% recv_request/5 - -recv_request(#conn{apps = SApps, caps = Caps}, TPid, Pkt, SvcName, Apps) -> - #diameter_caps{origin_host = {OH,_}, - origin_realm = {OR,_}} - = Caps, - - #diameter_packet{header = #diameter_header{application_id = Id}} - = Pkt, - - recv_request(find_recv_app(Id, SApps), - {SvcName, OH, OR}, - TPid, - Apps, - Caps, - Pkt). - -%% find_recv_app/2 - -%% No one should be sending the relay identifier. -find_recv_app(?APP_ID_RELAY, _) -> - false; - -%% With any other id we either support it locally or as a relay. -find_recv_app(Id, SApps) -> - keyfind([Id, ?APP_ID_RELAY], 1, SApps). - -%% keyfind/3 - -keyfind([], _, _) -> - false; -keyfind([Key | Rest], Pos, L) -> - case lists:keyfind(Key, Pos, L) of - false -> - keyfind(Rest, Pos, L); - T -> - T - end. - -%% recv_request/6 - -recv_request({Id, Alias}, T, TPid, Apps, Caps, Pkt) -> - #diameter_app{dictionary = Dict} - = A - = find_app(Alias, Apps), - recv_request(T, {TPid, Caps}, A, diameter_codec:decode(Id, Dict, Pkt)); -%% Note that the decode is different depending on whether or not Id is -%% ?APP_ID_RELAY. - -%% DIAMETER_APPLICATION_UNSUPPORTED 3007 -%% A request was sent for an application that is not supported. - -recv_request(false, T, TPid, _, _, Pkt) -> - As = collect_avps(Pkt), - protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}). - -collect_avps(Pkt) -> - case diameter_codec:collect_avps(Pkt) of - {_Bs, As} -> - As; - As -> - As - end. - -%% recv_request/4 - -%% Wrong number of bits somewhere in the message: reply. -%% -%% DIAMETER_INVALID_AVP_BITS 3009 -%% A request was received that included an AVP whose flag bits are -%% set to an unrecognized value, or that is inconsistent with the -%% AVP's definition. -%% -recv_request(T, {TPid, _}, _, #diameter_packet{errors = [Bs | _]} = Pkt) - when is_bitstring(Bs) -> - protocol_error(3009, T, TPid, Pkt); - -%% Either we support this application but don't recognize the command -%% or we're a relay and the command isn't proxiable. -%% -%% DIAMETER_COMMAND_UNSUPPORTED 3001 -%% The Request contained a Command-Code that the receiver did not -%% recognize or support. This MUST be used when a Diameter node -%% receives an experimental command that it does not understand. -%% -recv_request(T, - {TPid, _}, - #diameter_app{id = Id}, - #diameter_packet{header = #diameter_header{is_proxiable = P}, - msg = M} - = Pkt) - when ?APP_ID_RELAY /= Id, undefined == M; - ?APP_ID_RELAY == Id, not P -> - protocol_error(3001, T, TPid, Pkt); - -%% Error bit was set on a request. -%% -%% DIAMETER_INVALID_HDR_BITS 3008 -%% A request was received whose bits in the Diameter header were -%% either set to an invalid combination, or to a value that is -%% inconsistent with the command code's definition. -%% -recv_request(T, - {TPid, _}, - _, - #diameter_packet{header = #diameter_header{is_error = true}} - = Pkt) -> - protocol_error(3008, T, TPid, Pkt); - -%% A message in a locally supported application or a proxiable message -%% in the relay application. Don't distinguish between the two since -%% each application has its own callback config. That is, the user can -%% easily distinguish between the two cases. -recv_request(T, TC, App, Pkt) -> - request_cb(T, TC, App, examine(Pkt)). - -%% Note that there may still be errors but these aren't protocol -%% (3xxx) errors that lead to an answer-message. - -request_cb({SvcName, _OH, _OR} = T, TC, App, Pkt) -> - request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), App, T, TC, Pkt). - -%% examine/1 -%% -%% Look for errors in a decoded message. Length errors result in -%% decode failure in diameter_codec. - -examine(#diameter_packet{header = #diameter_header{version - = ?DIAMETER_VERSION}} - = Pkt) -> - Pkt; - -%% DIAMETER_UNSUPPORTED_VERSION 5011 -%% This error is returned when a request was received, whose version -%% number is unsupported. - -examine(#diameter_packet{errors = Es} = Pkt) -> - Pkt#diameter_packet{errors = [5011 | Es]}. -%% It's odd/unfortunate that this isn't a protocol error. - -%% request_cb/5 - -%% A reply may be an answer-message, constructed either here or by -%% the handle_request callback. The header from the incoming request -%% is passed into the encode so that it can retrieve the relevant -%% command code in this case. It will also then ignore Dict and use -%% the base encoder. -request_cb({reply, Ans}, - #diameter_app{dictionary = Dict}, - _, - {TPid, _}, - Pkt) -> - reply(Ans, Dict, TPid, Pkt); - -%% An 3xxx result code, for which the E-bit is set in the header. -request_cb({protocol_error, RC}, _, T, {TPid, _}, Pkt) - when 3000 =< RC, RC < 4000 -> - protocol_error(RC, T, TPid, Pkt); - -%% RFC 3588 says we must reply 3001 to anything unrecognized or -%% unsupported. 'noreply' is undocumented (and inappropriately named) -%% backwards compatibility for this, protocol_error the documented -%% alternative. -request_cb(noreply, _, T, {TPid, _}, Pkt) -> - protocol_error(3001, T, TPid, Pkt); - -%% Relay a request to another peer. This is equivalent to doing an -%% explicit call/4 with the message in question except that (1) a loop -%% will be detected by examining Route-Record AVP's, (3) a -%% Route-Record AVP will be added to the outgoing request and (3) the -%% End-to-End Identifier will default to that in the -%% #diameter_header{} without the need for an end_to_end_identifier -%% option. -%% -%% relay and proxy are similar in that they require the same handling -%% with respect to Route-Record and End-to-End identifier. The -%% difference is that a proxy advertises specific applications, while -%% a relay advertises the relay application. If a callback doesn't -%% want to distinguish between the cases in the callback return value -%% then 'resend' is a neutral alternative. -%% -request_cb({A, Opts}, - #diameter_app{id = Id} - = App, - T, - TC, - Pkt) - when A == relay, Id == ?APP_ID_RELAY; - A == proxy, Id /= ?APP_ID_RELAY; - A == resend -> - resend(Opts, App, T, TC, Pkt); - -request_cb(discard, _, _, _, _) -> - ok; - -request_cb({eval, RC, F}, App, T, TC, Pkt) -> - request_cb(RC, App, T, TC, Pkt), - diameter_lib:eval(F). - -%% protocol_error/4 - -protocol_error(RC, {_, OH, OR}, TPid, #diameter_packet{avps = Avps} = Pkt) -> - ?LOG({error, RC}, Pkt), - reply(answer_message({OH, OR, RC}, Avps), ?BASE, TPid, Pkt). - -%% resend/5 -%% -%% Resend a message as a relay or proxy agent. - -resend(Opts, - #diameter_app{} = App, - {_SvcName, OH, _OR} = T, - {_TPid, _Caps} = TC, - #diameter_packet{avps = Avps} = Pkt) -> - {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'), - resend(is_loop(Code, Vid, OH, Avps), Opts, App, T, TC, Pkt). - -%% DIAMETER_LOOP_DETECTED 3005 -%% An agent detected a loop while trying to get the message to the -%% intended recipient. The message MAY be sent to an alternate peer, -%% if one is available, but the peer reporting the error has -%% identified a configuration problem. - -resend(true, _, _, T, {TPid, _}, Pkt) -> %% Route-Record loop - protocol_error(3005, T, TPid, Pkt); - -%% 6.1.8. Relaying and Proxying Requests -%% -%% A relay or proxy agent MUST append a Route-Record AVP to all requests -%% forwarded. The AVP contains the identity of the peer the request was -%% received from. - -resend(false, - Opts, - App, - {SvcName, _, _} = T, - {TPid, #diameter_caps{origin_host = {_, OH}}}, - #diameter_packet{header = Hdr0, - avps = Avps} - = Pkt) -> - Route = #diameter_avp{data = {?BASE, 'Route-Record', OH}}, - Seq = diameter_session:sequence(), - Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, - Msg = [Hdr, Route | Avps], - resend(call(SvcName, App, Msg, Opts), T, TPid, Pkt). -%% The incoming request is relayed with the addition of a -%% Route-Record. Note the requirement on the return from call/4 below, -%% which places a requirement on the value returned by the -%% handle_answer callback of the application module in question. -%% -%% Note that there's nothing stopping the request from being relayed -%% back to the sender. A pick_peer callback may want to avoid this but -%% a smart peer might recognize the potential loop and choose another -%% route. A less smart one will probably just relay the request back -%% again and force us to detect the loop. A pick_peer that wants to -%% avoid this can specify filter to avoid the possibility. -%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. -%% -%% RFC 6.3 says that a relay agent does not modify Origin-Host but -%% says nothing about a proxy. Assume it should behave the same way. - -%% resend/4 -%% -%% Relay a reply to a relayed request. - -%% Answer from the peer: reset the hop by hop identifier and send. -resend(#diameter_packet{bin = B} - = Pkt, - _, - TPid, - #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, - transport_data = TD}) -> - send(TPid, Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), - transport_data = TD}); -%% TODO: counters - -%% Or not: DIAMETER_UNABLE_TO_DELIVER. -resend(_, T, TPid, Pkt) -> - protocol_error(3002, T, TPid, Pkt). - -%% is_loop/4 -%% -%% Is there a Route-Record AVP with our Origin-Host? - -is_loop(Code, - Vid, - Bin, - [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> - true; - -is_loop(_, _, _, []) -> - false; - -is_loop(Code, Vid, OH, [_ | Avps]) - when is_binary(OH) -> - is_loop(Code, Vid, OH, Avps); - -is_loop(Code, Vid, OH, Avps) -> - is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps). - -%% reply/4 -%% -%% Send a locally originating reply. - -%% No errors or a diameter_header/avp list. -reply(Msg, Dict, TPid, #diameter_packet{errors = Es, - transport_data = TD} - = ReqPkt) - when [] == Es; - is_record(hd(Msg), diameter_header) -> - Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)), - incr(send, Pkt, Dict, TPid), %% count result codes in sent answers - send(TPid, Pkt#diameter_packet{transport_data = TD}); - -%% Or not: set Result-Code and Failed-AVP AVP's. -reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) -> - reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), - Dict, - TPid, - Pkt#diameter_packet{errors = []}). - -%% make_reply_packet/2 - -%% Binaries and header/avp lists are sent as-is. -make_reply_packet(Bin, _) - when is_binary(Bin) -> - #diameter_packet{bin = Bin}; -make_reply_packet([#diameter_header{} | _] = Msg, _) -> - #diameter_packet{msg = Msg}; - -%% Otherwise a reply message clears the R and T flags and retains the -%% P flag. The E flag will be set at encode. -make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) -> - Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, - is_request = false, - is_error = undefined, - is_retransmitted = false}, - #diameter_packet{header = Hdr, - msg = Msg}. - -%% rc/1 - -rc({RC, _}) -> - RC; -rc(RC) -> - RC. - -%% rc/4 - -rc(Rec, RC, Failed, Dict) - when is_integer(RC) -> - set(Rec, [{'Result-Code', RC} | failed_avp(Rec, Failed, Dict)], Dict). - -%% Reply as name and tuple list ... -set([_|_] = Ans, Avps, _) -> - Ans ++ Avps; %% Values nearer tail take precedence. - -%% ... or record. -set(Rec, Avps, Dict) -> - Dict:'#set-'(Avps, Rec). - -%% failed_avp/3 - -failed_avp(_, [] = No, _) -> - No; - -failed_avp(Rec, Failed, Dict) -> - [fa(Rec, [{'AVP', Failed}], Dict)]. - -%% Reply as name and tuple list ... -fa([MsgName | Values], FailedAvp, Dict) -> - R = Dict:msg2rec(MsgName), - try - Dict:'#info-'(R, {index, 'Failed-AVP'}), - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = proplists:get_value('AVP', Values, []), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end; - -%% ... or record. -fa(Rec, FailedAvp, Dict) -> - try - {'Failed-AVP', [FailedAvp]} - catch - error: _ -> - Avps = Dict:'get-'('AVP', Rec), - A = #diameter_avp{name = 'Failed-AVP', - value = FailedAvp}, - {'AVP', [A|Avps]} - end. - -%% 3. Diameter Header -%% -%% E(rror) - If set, the message contains a protocol error, -%% and the message will not conform to the ABNF -%% described for this command. Messages with the 'E' -%% bit set are commonly referred to as error -%% messages. This bit MUST NOT be set in request -%% messages. See Section 7.2. - -%% 3.2. Command Code ABNF specification -%% -%% e-bit = ", ERR" -%% ; If present, the 'E' bit in the Command -%% ; Flags is set, indicating that the answer -%% ; message contains a Result-Code AVP in -%% ; the "protocol error" class. - -%% 7.1.3. Protocol Errors -%% -%% Errors that fall within the Protocol Error category SHOULD be treated -%% on a per-hop basis, and Diameter proxies MAY attempt to correct the -%% error, if it is possible. Note that these and only these errors MUST -%% only be used in answer messages whose 'E' bit is set. - -%% Thus, only construct answers to protocol errors. Other errors -%% require an message-specific answer and must be handled by the -%% application. - -%% 6.2. Diameter Answer Processing -%% -%% When a request is locally processed, the following procedures MUST be -%% applied to create the associated answer, in addition to any -%% additional procedures that MAY be discussed in the Diameter -%% application defining the command: -%% -%% - The same Hop-by-Hop identifier in the request is used in the -%% answer. -%% -%% - The local host's identity is encoded in the Origin-Host AVP. -%% -%% - The Destination-Host and Destination-Realm AVPs MUST NOT be -%% present in the answer message. -%% -%% - The Result-Code AVP is added with its value indicating success or -%% failure. -%% -%% - If the Session-Id is present in the request, it MUST be included -%% in the answer. -%% -%% - Any Proxy-Info AVPs in the request MUST be added to the answer -%% message, in the same order they were present in the request. -%% -%% - The 'P' bit is set to the same value as the one in the request. -%% -%% - The same End-to-End identifier in the request is used in the -%% answer. -%% -%% Note that the error messages (see Section 7.3) are also subjected to -%% the above processing rules. - -%% 7.3. Error-Message AVP -%% -%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY -%% accompany a Result-Code AVP as a human readable error message. The -%% Error-Message AVP is not intended to be useful in real-time, and -%% SHOULD NOT be expected to be parsed by network entities. - -%% answer_message/2 - -answer_message({OH, OR, RC}, Avps) -> - {Code, _, Vid} = ?BASE:avp_header('Session-Id'), - ['answer-message', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Result-Code', RC} - | session_id(Code, Vid, Avps)]. - -session_id(Code, Vid, Avps) - when is_list(Avps) -> - try - {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), - [{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}] - catch - error: _ -> - [] - end. - -%% find_avp/3 - -find_avp(Code, Vid, Avps) - when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> - find(fun(A) -> is_avp(Code, Vid, A) end, Avps). - -%% The final argument here could be a list of AVP's, depending on the case, -%% but we're only searching at the top level. -is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> - true; -is_avp(_, _, _) -> - false. - -find(_, []) -> - false; -find(Pred, [H|T]) -> - case Pred(H) of - true -> - {value, H}; - false -> - find(Pred, T) - end. - -%% 7. Error Handling -%% -%% There are certain Result-Code AVP application errors that require -%% additional AVPs to be present in the answer. In these cases, the -%% Diameter node that sets the Result-Code AVP to indicate the error -%% MUST add the AVPs. Examples are: -%% -%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) -%% set, causes an answer to be sent with the Result-Code AVP set to -%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the -%% offending AVP. -%% -%% - An AVP that is received with an unrecognized value causes an -%% answer to be returned with the Result-Code AVP set to -%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the -%% AVP causing the error. -%% -%% - A command is received with an AVP that is omitted, yet is -%% mandatory according to the command's ABNF. The receiver issues an -%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and -%% creates an AVP with the AVP Code and other fields set as expected -%% in the missing AVP. The created AVP is then added to the Failed- -%% AVP AVP. -%% -%% The Result-Code AVP describes the error that the Diameter node -%% encountered in its processing. In case there are multiple errors, -%% the Diameter node MUST report only the first error it encountered -%% (detected possibly in some implementation dependent order). The -%% specific errors that can be described by this AVP are described in -%% the following section. - -%% 7.5. Failed-AVP AVP -%% -%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides -%% debugging information in cases where a request is rejected or not -%% fully processed due to erroneous information in a specific AVP. The -%% value of the Result-Code AVP will provide information on the reason -%% for the Failed-AVP AVP. -%% -%% The possible reasons for this AVP are the presence of an improperly -%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP -%% value, the omission of a required AVP, the presence of an explicitly -%% excluded AVP (see tables in Section 10), or the presence of two or -%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 -%% occurrences. -%% -%% A Diameter message MAY contain one Failed-AVP AVP, containing the -%% entire AVP that could not be processed successfully. If the failure -%% reason is omission of a required AVP, an AVP with the missing AVP -%% code, the missing vendor id, and a zero filled payload of the minimum -%% required length for the omitted AVP will be added. - -%%% --------------------------------------------------------------------------- -%%% # handle_answer/3 -%%% --------------------------------------------------------------------------- - -%% Process an answer message in call-specific process. - -handle_answer(SvcName, _, {error, Req, Reason}) -> - handle_error(Req, Reason, SvcName); - -handle_answer(SvcName, - AnswerErrors, - {answer, #request{dictionary = Dict} = Req, Pkt}) -> - a(examine(diameter_codec:decode(Dict, Pkt)), - SvcName, - AnswerErrors, - Req). - -%% We don't really need to do a full decode if we're a relay and will -%% just resend with a new hop by hop identifier, but might a proxy -%% want to examine the answer? - -a(#diameter_packet{errors = []} - = Pkt, - SvcName, - AE, - #request{transport = TPid, - dictionary = Dict, - caps = Caps, - packet = P} - = Req) -> - try - incr(in, Pkt, Dict, TPid) - of - _ -> - cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]) - catch - exit: {invalid_error_bit, _} = E -> - e(Pkt#diameter_packet{errors = [E]}, SvcName, AE, Req) - end; - -a(#diameter_packet{} = Pkt, SvcName, AE, Req) -> - e(Pkt, SvcName, AE, Req). - -e(Pkt, SvcName, callback, #request{transport = TPid, - caps = Caps, - packet = Pkt} - = Req) -> - cb(Req, handle_answer, [Pkt, msg(Pkt), SvcName, {TPid, Caps}]); -e(Pkt, SvcName, report, Req) -> - x(errors, handle_answer, [SvcName, Req, Pkt]); -e(Pkt, SvcName, discard, Req) -> - x({errors, handle_answer, [SvcName, Req, Pkt]}). - -%% Note that we don't check that the application id in the answer's -%% header is what we expect. (TODO: Does the rfc says anything about -%% this?) - -%% incr/4 -%% -%% Increment a stats counter for an incoming or outgoing message. - -%% TODO: fix -incr(_, #diameter_packet{msg = undefined}, _, _) -> - ok; - -incr(Dir, Pkt, Dict, TPid) - when is_pid(TPid) -> - #diameter_packet{header = #diameter_header{is_error = E} - = Hdr, - msg = Rec} - = Pkt, - - D = choose(E, ?BASE, Dict), - RC = int(get_avp_value(D, 'Result-Code', Rec)), - PE = is_protocol_error(RC), - - %% Check that the E bit is set only for 3xxx result codes. - (not (E orelse PE)) - orelse (E andalso PE) - orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), - - Ctr = rc_counter(D, Rec, RC), - is_tuple(Ctr) - andalso incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). - -%% incr/2 - -incr(TPid, Counter) -> - diameter_stats:incr(Counter, TPid, 1). - -%% RFC 3588, 7.6: -%% -%% All Diameter answer messages defined in vendor-specific -%% applications MUST include either one Result-Code AVP or one -%% Experimental-Result AVP. -%% -%% Maintain statistics assuming one or the other, not both, which is -%% surely the intent of the RFC. - -rc_counter(_, _, RC) - when is_integer(RC) -> - {'Result-Code', RC}; -rc_counter(D, Rec, _) -> - rcc(get_avp_value(D, 'Experimental-Result', Rec)). - -%% Outgoing answers may be in any of the forms messages can be sent -%% in. Incoming messages will be records. We're assuming here that the -%% arity of the result code AVP's is 0 or 1. - -rcc([{_,_,RC} = T]) - when is_integer(RC) -> - T; -rcc({_,_,RC} = T) - when is_integer(RC) -> - T; -rcc(_) -> - undefined. - -int([N]) - when is_integer(N) -> - N; -int(N) - when is_integer(N) -> - N; -int(_) -> - undefined. - -is_protocol_error(RC) -> - 3000 =< RC andalso RC < 4000. - --spec x(any(), atom(), list()) -> no_return(). - -%% Warn and exit request process on errors in an incoming answer. -x(Reason, F, A) -> - diameter_lib:warning_report(Reason, {?MODULE, F, A}), - x(Reason). - -x(T) -> - exit(T). - -%%% --------------------------------------------------------------------------- -%%% # failover/[23] -%%% --------------------------------------------------------------------------- - -%% Failover as a consequence of request_peer_down/2. -failover({_, #request{handler = Pid} = Req, TRef}, S) -> - Pid ! {failover, TRef, rt(Req, S)}. - -%% Failover as a consequence of store_request/4. -failover(TRef, Seqs, S) - when is_reference(TRef) -> - case lookup_request(Seqs, TRef) of - #request{} = Req -> - failover({Seqs, Req, TRef}, S); - false -> - ok - end. - -%% prepare_request returned a binary ... -rt(#request{packet = #diameter_packet{msg = undefined}}, _) -> - false; %% TODO: Not what we should do. - -%% ... or not. -rt(#request{packet = #diameter_packet{msg = Msg}, dictionary = D} = Req, S) -> - find_transport(get_destination(Msg, D), Req, S). - -%%% --------------------------------------------------------------------------- -%%% # report_status/5 -%%% --------------------------------------------------------------------------- - -report_status(Status, - #peer{ref = Ref, - conn = TPid, - type = Type, - options = Opts}, - #conn{apps = [_|_] = As, - caps = Caps}, - #state{service_name = SvcName} - = S, - Extra) -> - share_peer(Status, Caps, As, TPid, S), - Info = [Status, Ref, {TPid, Caps}, {type(Type), Opts} | Extra], - send_event(SvcName, list_to_tuple(Info)). - -%% send_event/2 - -send_event(SvcName, Info) -> - send_event(#diameter_event{service = SvcName, - info = Info}). - -send_event(#diameter_event{service = SvcName} = E) -> - lists:foreach(fun({_, Pid}) -> Pid ! E end, subscriptions(SvcName)). - -%%% --------------------------------------------------------------------------- -%%% # share_peer/5 -%%% --------------------------------------------------------------------------- - -share_peer(up, Caps, Aliases, TPid, #state{share_peers = true, - service_name = Svc}) -> - diameter_peer:notify(Svc, {peer, TPid, Aliases, Caps}); - -share_peer(_, _, _, _, _) -> - ok. - -%%% --------------------------------------------------------------------------- -%%% # share_peers/2 -%%% --------------------------------------------------------------------------- - -share_peers(Pid, #state{share_peers = true, - local_peers = PDict}) -> - ?Dict:fold(fun(A,Ps,ok) -> sp(Pid, A, Ps), ok end, ok, PDict); - -share_peers(_, #state{share_peers = false}) -> - ok. - -sp(Pid, Alias, Peers) -> - lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers). - -%%% --------------------------------------------------------------------------- -%%% # remote_peer_up/4 -%%% --------------------------------------------------------------------------- - -remote_peer_up(Pid, Aliases, Caps, #state{use_shared_peers = true, - service = Svc, - shared_peers = PDict} - = S) -> - #diameter_service{applications = Apps} = Svc, - Update = lists:filter(fun(A) -> - lists:keymember(A, #diameter_app.alias, Apps) - end, - Aliases), - S#state{shared_peers = rpu(Pid, Caps, PDict, Update)}; - -remote_peer_up(_, _, _, #state{use_shared_peers = false} = S) -> - S. - -rpu(_, _, PDict, []) -> - PDict; -rpu(Pid, Caps, PDict, Aliases) -> - erlang:monitor(process, Pid), - T = {Pid, Caps}, - lists:foldl(fun(A,D) -> ?Dict:append(A, T, D) end, - PDict, - Aliases). - -%%% --------------------------------------------------------------------------- -%%% # remote_peer_down/2 -%%% --------------------------------------------------------------------------- - -remote_peer_down(Pid, #state{use_shared_peers = true, - shared_peers = PDict} - = S) -> - S#state{shared_peers = lists:foldl(fun(A,D) -> rpd(Pid, A, D) end, - PDict, - ?Dict:fetch_keys(PDict))}. - -rpd(Pid, Alias, PDict) -> - ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict). - -%%% --------------------------------------------------------------------------- -%%% find_transport/[34] -%%% -%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Initial call, from an arbitrary process. -find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) -> - #diameter_service{applications = Apps} = Svc, - ft(find_send_app(Alias, Apps), Msg, Opts, S); - -%% Relay or proxy send. -find_transport(#diameter_app{} = App, Msg, Opts, S) -> - ft(App, Msg, Opts, S). - -ft(#diameter_app{module = Mod, dictionary = D} = App, Msg, Opts, S) -> - #options{filter = Filter, - extra = Xtra} - = Opts, - pick_peer(App#diameter_app{module = Mod ++ Xtra}, - get_destination(Msg, D), - Filter, - S); -ft(false = No, _, _, _) -> - No. - -%% This can't be used if we're a relay and sending a message -%% in an application not known locally. (TODO) -find_send_app(Alias, Apps) -> - case lists:keyfind(Alias, #diameter_app.alias, Apps) of - #diameter_app{id = ?APP_ID_RELAY} -> - false; - T -> - T - end. - -%% Retransmission, in the service process. -find_transport([_,_] = RH, - Req, - #state{service = #diameter_service{pid = Pid, - applications = Apps}} - = S) - when self() == Pid -> - #request{app = Alias, - filter = Filter, - module = ModX} - = Req, - #diameter_app{} - = App - = lists:keyfind(Alias, #diameter_app.alias, Apps), - - pick_peer(App#diameter_app{module = ModX}, - RH, - Filter, - S). - -%% get_destination/2 - -get_destination(Msg, Dict) -> - [str(get_avp_value(Dict, 'Destination-Realm', Msg)), - str(get_avp_value(Dict, 'Destination-Host', Msg))]. - -%% This is not entirely correct. The avp could have an arity 1, in -%% which case an empty list is a DiameterIdentity of length 0 rather -%% than the list of no values we treat it as by mapping to undefined. -%% This behaviour is documented. -str([]) -> - undefined; -str(T) -> - T. - -%% get_avp_value/3 -%% -%% Find an AVP in a message of one of three forms: -%% -%% - a message record (as generated from a .dia spec) or -%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. -%% - a list of a #diameter_header{} followed by #diameter_avp{} records, -%% -%% In the first two forms a dictionary module is used at encode to -%% identify the type of the AVP and its arity in the message in -%% question. The third form allows messages to be sent as is, without -%% a dictionary, which is needed in the case of relay agents, for one. - -get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> - try - {Code, _, VId} = Dict:avp_header(Name), - [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> - C /= Code orelse V /= VId - end, - Avps), - avp_decode(Dict, Name, A) - catch - error: _ -> - undefined - end; - -get_avp_value(_, Name, [_MsgName | Avps]) -> - case lists:keyfind(Name, 1, Avps) of - {_, V} -> - V; - _ -> - undefined - end; - -%% Message is typically a record but not necessarily: diameter:call/4 -%% can be passed an arbitrary term. -get_avp_value(Dict, Name, Rec) -> - try - Dict:'#get-'(Name, Rec) - catch - error:_ -> - undefined - end. - -avp_decode(Dict, Name, #diameter_avp{value = undefined, - data = Bin}) -> - Dict:avp(decode, Bin, Name); -avp_decode(_, _, #diameter_avp{value = V}) -> - V. - -%%% --------------------------------------------------------------------------- -%%% # pick_peer(App, [DestRealm, DestHost], Filter, #state{}) -%%% -%%% Output: {TransportPid, #diameter_caps{}, App} -%%% | false -%%% | {error, Reason} -%%% --------------------------------------------------------------------------- - -%% Find transports to a given realm/host. - -pick_peer(#diameter_app{alias = Alias} - = App, - [_,_] = RH, - Filter, - #state{local_peers = L, - shared_peers = S, - service_name = SvcName, - service = #diameter_service{pid = Pid}}) -> - pick_peer(peers(Alias, RH, Filter, L), - peers(Alias, RH, Filter, S), - Pid, - SvcName, - App). - -%% pick_peer/5 - -pick_peer([], [], _, _, _) -> - false; - -%% App state is mutable but we're not in the service process: go there. -pick_peer(Local, Remote, Pid, _SvcName, #diameter_app{mutable = true} = App) - when self() /= Pid -> - call_service(Pid, {pick_peer, Local, Remote, App}); - -%% App state isn't mutable or it is and we're in the service process: -%% do the deed. -pick_peer(Local, - Remote, - _Pid, - SvcName, - #diameter_app{module = ModX, - alias = Alias, - init_state = S, - mutable = M} - = App) -> - MFA = {ModX, pick_peer, [Local, Remote, SvcName]}, - - try state_cb(App, MFA) of - {ok, {TPid, #diameter_caps{} = Caps}} when is_pid(TPid) -> - {TPid, Caps, App}; - {{TPid, #diameter_caps{} = Caps}, ModS} when is_pid(TPid), M -> - mod_state(Alias, ModS), - {TPid, Caps, App}; - {false = No, ModS} when M -> - mod_state(Alias, ModS), - No; - {ok, false = No} -> - No; - false = No -> - No; - {{TPid, #diameter_caps{} = Caps}, S} when is_pid(TPid) -> - {TPid, Caps, App}; %% Accept returned state in the immutable - {false = No, S} -> %% case as long it isn't changed. - No; - T -> - diameter_lib:error_report({invalid, T, App}, MFA) - catch - E: Reason -> - diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA) - end. - -%% peers/4 - -peers(Alias, RH, Filter, Peers) -> - case ?Dict:find(Alias, Peers) of - {ok, L} -> - ps(L, RH, Filter, {[],[]}); - error -> - [] - end. - -%% Place a peer whose Destination-Host/Realm matches those of the -%% request at the front of the result list. Could add some sort of -%% 'sort' option to allow more control. - -ps([], _, _, {Ys, Ns}) -> - lists:reverse(Ys, Ns); -ps([{_TPid, #diameter_caps{} = Caps} = TC | Rest], RH, Filter, Acc) -> - ps(Rest, RH, Filter, pacc(caps_filter(Caps, RH, Filter), - caps_filter(Caps, RH, {all, [host, realm]}), - TC, - Acc)). - -pacc(true, true, Peer, {Ts, Fs}) -> - {[Peer|Ts], Fs}; -pacc(true, false, Peer, {Ts, Fs}) -> - {Ts, [Peer|Fs]}; -pacc(_, _, _, Acc) -> - Acc. - -%% caps_filter/3 - -caps_filter(C, RH, {neg, F}) -> - not caps_filter(C, RH, F); - -caps_filter(C, RH, {all, L}) - when is_list(L) -> - lists:all(fun(F) -> caps_filter(C, RH, F) end, L); - -caps_filter(C, RH, {any, L}) - when is_list(L) -> - lists:any(fun(F) -> caps_filter(C, RH, F) end, L); - -caps_filter(#diameter_caps{origin_host = {_,OH}}, [_,DH], host) -> - eq(undefined, DH, OH); - -caps_filter(#diameter_caps{origin_realm = {_,OR}}, [DR,_], realm) -> - eq(undefined, DR, OR); - -caps_filter(C, _, Filter) -> - caps_filter(C, Filter). - -%% caps_filter/2 - -caps_filter(_, none) -> - true; - -caps_filter(#diameter_caps{origin_host = {_,OH}}, {host, H}) -> - eq(any, H, OH); - -caps_filter(#diameter_caps{origin_realm = {_,OR}}, {realm, R}) -> - eq(any, R, OR); - -%% Anything else is expected to be an eval filter. Filter failure is -%% documented as being equivalent to a non-matching filter. - -caps_filter(C, T) -> - try - {eval, F} = T, - diameter_lib:eval([F,C]) - catch - _:_ -> false - end. - -eq(Any, Id, PeerId) -> - Any == Id orelse try - iolist_to_binary(Id) == iolist_to_binary(PeerId) - catch - _:_ -> false - end. -%% OctetString() can be specified as an iolist() so test for string -%% rather then term equality. - -%% transports/1 - -transports(#state{peerT = PeerT}) -> - ets:select(PeerT, [{#peer{conn = '$1', _ = '_'}, - [{'is_pid', '$1'}], - ['$1']}]). - -%%% --------------------------------------------------------------------------- -%%% # service_info/2 -%%% --------------------------------------------------------------------------- - -%% The config passed to diameter:start_service/2. --define(CAP_INFO, ['Origin-Host', - 'Origin-Realm', - 'Vendor-Id', - 'Product-Name', - 'Origin-State-Id', - 'Host-IP-Address', - 'Supported-Vendor-Id', - 'Auth-Application-Id', - 'Inband-Security-Id', - 'Acct-Application-Id', - 'Vendor-Specific-Application-Id', - 'Firmware-Revision']). - --define(ALL_INFO, [capabilities, - applications, - transport, - pending, - statistics]). - -service_info(Items, S) - when is_list(Items) -> - [{complete(I), service_info(I,S)} || I <- Items]; -service_info(Item, S) - when is_atom(Item) -> - service_info(Item, S, true). - -service_info(Item, #state{service = Svc} = S, Complete) -> - case Item of - name -> - S#state.service_name; - 'Origin-Host' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_host; - 'Origin-Realm' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_realm; - 'Vendor-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.vendor_id; - 'Product-Name' -> - (Svc#diameter_service.capabilities) - #diameter_caps.product_name; - 'Origin-State-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.origin_state_id; - 'Host-IP-Address' -> - (Svc#diameter_service.capabilities) - #diameter_caps.host_ip_address; - 'Supported-Vendor-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.supported_vendor_id; - 'Auth-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.auth_application_id; - 'Inband-Security-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.inband_security_id; - 'Acct-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.acct_application_id; - 'Vendor-Specific-Application-Id' -> - (Svc#diameter_service.capabilities) - #diameter_caps.vendor_specific_application_id; - 'Firmware-Revision' -> - (Svc#diameter_service.capabilities) - #diameter_caps.firmware_revision; - capabilities -> service_info(?CAP_INFO, S); - applications -> info_apps(S); - transport -> info_transport(S); - pending -> info_pending(S); - statistics -> info_stats(S); - keys -> ?ALL_INFO ++ ?CAP_INFO; %% mostly for test - all -> service_info(?ALL_INFO, S); - _ when Complete -> service_info(complete(Item), S, false); - _ -> undefined - end. - -complete(Pre) -> - P = atom_to_list(Pre), - case [I || I <- [name | ?ALL_INFO] ++ ?CAP_INFO, - lists:prefix(P, atom_to_list(I))] - of - [I] -> I; - _ -> Pre - end. - -info_stats(#state{peerT = PeerT}) -> - Peers = ets:select(PeerT, [{#peer{ref = '$1', conn = '$2', _ = '_'}, - [{'is_pid', '$2'}], - [['$1', '$2']]}]), - diameter_stats:read(lists:append(Peers)). -%% TODO: include peer identities in return value - -info_transport(#state{peerT = PeerT, connT = ConnT}) -> - dict:fold(fun it/3, - [], - ets:foldl(fun(T,A) -> it_acc(ConnT, A, T) end, - dict:new(), - PeerT)). - -it(Ref, [[{type, connect} | _] = L], Acc) -> - [[{ref, Ref} | L] | Acc]; -it(Ref, [[{type, accept}, {options, Opts} | _] | _] = L, Acc) -> - [[{ref, Ref}, - {type, listen}, - {options, Opts}, - {accept, [lists:nthtail(2,A) || A <- L]}] - | Acc]. -%% Each entry has the same Opts. (TODO) - -it_acc(ConnT, Acc, #peer{pid = Pid, - type = Type, - ref = Ref, - options = Opts, - op_state = OS, - started = T, - conn = TPid}) -> - dict:append(Ref, - [{type, Type}, - {options, Opts}, - {watchdog, {Pid, T, OS}} - | info_conn(ConnT, TPid)], - Acc). - -info_conn(ConnT, TPid) -> - info_conn(ets:lookup(ConnT, TPid)). - -info_conn([#conn{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> - [{peer, {Pid, T}}, - {apps, SApps}, - {caps, info_caps(Caps)}]; -info_conn([] = No) -> - No. - -info_caps(#diameter_caps{} = C) -> - lists:zip(record_info(fields, diameter_caps), tl(tuple_to_list(C))). - -info_apps(#state{service = #diameter_service{applications = Apps}}) -> - lists:map(fun mk_app/1, Apps). - -mk_app(#diameter_app{alias = Alias, - dictionary = Dict, - module = ModX, - id = Id}) -> - [{alias, Alias}, - {dictionary, Dict}, - {module, ModX}, - {id, Id}]. - -info_pending(#state{} = S) -> - MatchSpec = [{{'$1', - #request{transport = '$2', - from = '$3', - app = '$4', - _ = '_'}, - '_'}, - [?ORCOND([{'==', T, '$2'} || T <- transports(S)])], - [{{'$1', [{{app, '$4'}}, - {{transport, '$2'}}, - {{from, '$3'}}]}}]}], - - ets:select(?REQUEST_TABLE, MatchSpec). diff --git a/lib/diameter/src/app/diameter_service_sup.erl b/lib/diameter/src/app/diameter_service_sup.erl deleted file mode 100644 index 153fff902f..0000000000 --- a/lib/diameter/src/app/diameter_service_sup.erl +++ /dev/null @@ -1,64 +0,0 @@ -%% -%% %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% -%% - -%% -%% The supervisor of service processes. -%% - --module(diameter_service_sup). - --behaviour(supervisor). - --export([start_link/0, %% supervisor start - start_child/1]). %% service start - -%% supervisor callback --export([init/1]). - --define(NAME, ?MODULE). %% supervisor name - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% A service and its related processes (transport, peer_fwm and -%% watchdog) are all temporary since they're all restarted in -%% application code. A Transport and peer_fsm is restarted by a -%% watchdog as required by the RFC 3539 state machine, a watchdog is -%% restarted by service, and services are restarted by diameter_config. - -start_child(ServiceName) -> - supervisor:start_child(?NAME, [ServiceName]). - -%% init/1 - -init([]) -> - Mod = diameter_service, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/diameter_session.erl b/lib/diameter/src/app/diameter_session.erl deleted file mode 100644 index bb91e97f39..0000000000 --- a/lib/diameter/src/app/diameter_session.erl +++ /dev/null @@ -1,172 +0,0 @@ -%% -%% %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% -%% - --module(diameter_session). - --export([sequence/0, - session_id/1, - origin_state_id/0]). - -%% towards diameter_sup --export([init/0]). - --include("diameter_types.hrl"). - --define(INT64, 16#FFFFFFFFFFFFFFFF). --define(INT32, 16#FFFFFFFF). - -%% --------------------------------------------------------------------------- -%% # sequence/0 -%% -%% Output: 32-bit -%% --------------------------------------------------------------------------- - -%% 3588, 3: -%% -%% Hop-by-Hop Identifier -%% The Hop-by-Hop Identifier is an unsigned 32-bit integer field (in -%% network byte order) and aids in matching requests and replies. -%% The sender MUST ensure that the Hop-by-Hop identifier in a request -%% is unique on a given connection at any given time, and MAY attempt -%% to ensure that the number is unique across reboots. The sender of -%% an Answer message MUST ensure that the Hop-by-Hop Identifier field -%% contains the same value that was found in the corresponding -%% request. The Hop-by-Hop identifier is normally a monotonically -%% increasing number, whose start value was randomly generated. An -%% answer message that is received with an unknown Hop-by-Hop -%% Identifier MUST be discarded. -%% -%% End-to-End Identifier -%% The End-to-End Identifier is an unsigned 32-bit integer field (in -%% network byte order) and is used to detect duplicate messages. -%% Upon reboot implementations MAY set the high order 12 bits to -%% contain the low order 12 bits of current time, and the low order -%% 20 bits to a random value. Senders of request messages MUST -%% insert a unique identifier on each message. The identifier MUST -%% remain locally unique for a period of at least 4 minutes, even -%% across reboots. The originator of an Answer message MUST ensure -%% that the End-to-End Identifier field contains the same value that -%% was found in the corresponding request. The End-to-End Identifier -%% MUST NOT be modified by Diameter agents of any kind. The -%% combination of the Origin-Host (see Section 6.3) and this field is -%% used to detect duplicates. Duplicate requests SHOULD cause the -%% same answer to be transmitted (modulo the hop-by-hop Identifier -%% field and any routing AVPs that may be present), and MUST NOT -%% affect any state that was set when the original request was -%% processed. Duplicate answer messages that are to be locally -%% consumed (see Section 6.2) SHOULD be silently discarded. - --spec sequence() - -> 'Unsigned32'(). - -sequence() -> - Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT32, _SetVal = 0}, - ets:update_counter(diameter_sequence, sequence, Instr). - -%% --------------------------------------------------------------------------- -%% # origin_state_id/0 -%% --------------------------------------------------------------------------- - -%% 3588, 8.16: -%% -%% The Origin-State-Id AVP (AVP Code 278), of type Unsigned32, is a -%% monotonically increasing value that is advanced whenever a Diameter -%% entity restarts with loss of previous state, for example upon reboot. -%% Origin-State-Id MAY be included in any Diameter message, including -%% CER. -%% -%% A Diameter entity issuing this AVP MUST create a higher value for -%% this AVP each time its state is reset. A Diameter entity MAY set -%% Origin-State-Id to the time of startup, or it MAY use an incrementing -%% counter retained in non-volatile memory across restarts. - --spec origin_state_id() - -> 'Unsigned32'(). - -origin_state_id() -> - ets:lookup_element(diameter_sequence, origin_state_id, 2). - -%% --------------------------------------------------------------------------- -%% # session_id/1 -%% --------------------------------------------------------------------------- - -%% 3588, 8.8: -%% -%% The Session-Id MUST begin with the sender's identity encoded in the -%% DiameterIdentity type (see Section 4.4). The remainder of the -%% Session-Id is delimited by a ";" character, and MAY be any sequence -%% that the client can guarantee to be eternally unique; however, the -%% following format is recommended, (square brackets [] indicate an -%% optional element): -%% -%% ;;[;] -%% -%% and are decimal representations of the -%% high and low 32 bits of a monotonically increasing 64-bit value. The -%% 64-bit value is rendered in two part to simplify formatting by 32-bit -%% processors. At startup, the high 32 bits of the 64-bit value MAY be -%% initialized to the time, and the low 32 bits MAY be initialized to -%% zero. This will for practical purposes eliminate the possibility of -%% overlapping Session-Ids after a reboot, assuming the reboot process -%% takes longer than a second. Alternatively, an implementation MAY -%% keep track of the increasing value in non-volatile memory. -%% -%% is implementation specific but may include a modem's -%% device Id, a layer 2 address, timestamp, etc. - --spec session_id('DiameterIdentity'()) - -> 'OctetString'(). -%% Note that Session-Id has type UTF8String and that any OctetString -%% is a UTF8String. - -session_id(Host) -> - Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT64, _Set = 0}, - N = ets:update_counter(diameter_sequence, session_base, Instr), - Hi = N bsr 32, - Lo = N band ?INT32, - [Host, ";", integer_to_list(Hi), - ";", integer_to_list(Lo), - ";", atom_to_list(node())]. - -%% --------------------------------------------------------------------------- -%% # init/0 -%% --------------------------------------------------------------------------- - -init() -> - Now = now(), - random:seed(Now), - Time = time32(Now), - Seq = (?INT32 band (Time bsl 20)) bor (random:uniform(1 bsl 20) - 1), - ets:insert(diameter_sequence, [{origin_state_id, Time}, - {session_base, Time bsl 32}, - {sequence, Seq}]), - Time. - -%% --------------------------------------------------------- -%% INTERNAL FUNCTIONS -%% --------------------------------------------------------- - -%% The minimum value represented by a Time value. (See diameter_types.) -%% 32 bits extends to 2104. --define(TIME0, 62105714048). %% {{1968,1,20},{3,14,8}} - -time32(Now) -> - Time = calendar:now_to_universal_time(Now), - Diff = calendar:datetime_to_gregorian_seconds(Time) - ?TIME0, - Diff band ?INT32. diff --git a/lib/diameter/src/app/diameter_stats.erl b/lib/diameter/src/app/diameter_stats.erl deleted file mode 100644 index 71479afa95..0000000000 --- a/lib/diameter/src/app/diameter_stats.erl +++ /dev/null @@ -1,342 +0,0 @@ -%% -%% %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% -%% - -%% -%% Statistics collector. -%% - --module(diameter_stats). --compile({no_auto_import, [monitor/2]}). - --behaviour(gen_server). - --export([reg/1, reg/2, - incr/1, incr/2, incr/3, - read/1, - flush/0, flush/1]). - -%% supervisor callback --export([start_link/0]). - -%% gen_server callbacks --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% debug --export([state/0, - uptime/0]). - --include("diameter_internal.hrl"). - -%% ets table containing stats. reg(Pid, Ref) inserts a {Pid, Ref}, -%% incr(Counter, X, N) updates the counter keyed at {Counter, X}, and -%% Pid death causes counters keyed on {Counter, Pid} to be deleted and -%% added to those keyed on {Counter, Ref}. --define(TABLE, ?MODULE). - -%% Name of registered server. --define(SERVER, ?MODULE). - -%% Entries in the table. --define(REC(Key, Value), {Key, Value}). - -%% Server state. --record(state, {id = now()}). - --type counter() :: any(). --type contrib() :: any(). - -%%% --------------------------------------------------------------------------- -%%% # reg(Pid, Contrib) -%%% -%%% Description: Register a process as a contributor of statistics -%%% associated with a specified term. Statistics can be -%%% contributed by specifying either Pid or Contrib as -%%% the second argument to incr/3. Statistics contributed -%%% by Pid are folded into the corresponding entry for -%%% Contrib when the process dies. -%%% -%%% Contrib can be any term but should not be a pid -%%% passed as the first argument to reg/2. Subsequent -%%% registrations for the same Pid overwrite the association -%%% --------------------------------------------------------------------------- - --spec reg(pid(), contrib()) - -> true. - -reg(Pid, Contrib) - when is_pid(Pid) -> - call({reg, Pid, Contrib}). - --spec reg(contrib()) - -> true. - -reg(Ref) -> - reg(self(), Ref). - -%%% --------------------------------------------------------------------------- -%%% # incr(Counter, Contrib, N) -%%% -%%% Description: Increment a counter for the specified contributor. -%%% -%%% Contrib will typically be an argument passed to reg/2 -%%% but there's nothing that requires this. In particular, -%%% if Contrib is a pid that hasn't been registered then -%%% counters are unaffected by the death of the process. -%%% --------------------------------------------------------------------------- - --spec incr(counter(), contrib(), integer()) - -> integer(). - -incr(Ctr, Contrib, N) -> - update_counter({Ctr, Contrib}, N). - -incr(Ctr, N) - when is_integer(N) -> - incr(Ctr, self(), N); - -incr(Ctr, Contrib) -> - incr(Ctr, Contrib, 1). - -incr(Ctr) -> - incr(Ctr, self(), 1). - -%%% --------------------------------------------------------------------------- -%%% # read(Contribs) -%%% -%%% Description: Retrieve counters for the specified contributors. -%%% --------------------------------------------------------------------------- - --spec read([contrib()]) - -> [{contrib(), [{counter(), integer()}]}]. - -read(Contribs) -> - lists:foldl(fun(?REC({T,C}, N), D) -> orddict:append(C, {T,N}, D) end, - orddict:new(), - ets:select(?TABLE, [{?REC({'_', '$1'}, '_'), - [?ORCOND([{'=:=', '$1', {const, C}} - || C <- Contribs])], - ['$_']}])). - -%%% --------------------------------------------------------------------------- -%%% # flush(Contrib) -%%% -%%% Description: Retrieve and delete statistics for the specified -%%% contributor. -%%% -%%% If Contrib is a pid registered with reg/2 then statistics -%%% for both and its associated contributor are retrieved. -%%% --------------------------------------------------------------------------- - --spec flush(contrib()) - -> [{counter(), integer()}]. - -flush(Contrib) -> - try - call({flush, Contrib}) - catch - exit: _ -> - [] - end. - -flush() -> - flush(self()). - -%%% --------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -state() -> - call(state). - -uptime() -> - call(uptime). - -%%% ---------------------------------------------------------- -%%% # init(_) -%%% -%%% Output: {ok, State} -%%% ---------------------------------------------------------- - -init([]) -> - ets:new(?TABLE, [named_table, ordered_set, public]), - {ok, #state{}}. - -%% ---------------------------------------------------------- -%% handle_call(Request, From, State) -%% ---------------------------------------------------------- - -handle_call(state, _, State) -> - {reply, State, State}; - -handle_call(uptime, _, #state{id = Time} = State) -> - {reply, diameter_lib:now_diff(Time), State}; - -handle_call({reg, Pid, Contrib}, _From, State) -> - monitor(not ets:member(?TABLE, Pid), Pid), - {reply, insert(?REC(Pid, Contrib)), State}; - -handle_call({flush, Contrib}, _From, State) -> - {reply, fetch(Contrib), State}; - -handle_call(Req, From, State) -> - ?UNEXPECTED([Req, From]), - {reply, nok, State}. - -%% ---------------------------------------------------------- -%% handle_cast(Request, State) -%% ---------------------------------------------------------- - -handle_cast({incr, Rec}, State) -> - update_counter(Rec), - {noreply, State}; - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% handle_info(Request, State) -%% ---------------------------------------------------------- - -handle_info({'DOWN', _MRef, process, Pid, _}, State) -> - down(Pid), - {noreply, State}; - -handle_info(Info, State) -> - ?UNEXPECTED([Info]), - {noreply, State}. - -%% ---------------------------------------------------------- -%% terminate(Reason, State) -%% ---------------------------------------------------------- - -terminate(_Reason, _State) -> - ok. - -%% ---------------------------------------------------------- -%% code_change(OldVsn, State, Extra) -%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -%% monitor/2 - -monitor(true, Pid) -> - erlang:monitor(process, Pid); -monitor(false = No, _) -> - No. - -%% down/1 - -down(Pid) -> - L = ets:match_object(?TABLE, ?REC({'_', Pid}, '_')), - [?REC(_, Ref) = T] = lookup(Pid), - fold(Ref, L), - delete_object(T), - delete(L). - -%% Fold Pid-based entries into Ref-based ones. -fold(Ref, L) -> - lists:foreach(fun(?REC({K, _}, V)) -> update_counter({{K, Ref}, V}) end, - L). - -delete(Objs) -> - lists:foreach(fun delete_object/1, Objs). - -%% fetch/1 - -fetch(X) -> - MatchSpec = [{?REC({'_', '$1'}, '_'), - [?ORCOND([{'==', '$1', {const, T}} || T <- [X | ref(X)]])], - ['$_']}], - L = ets:select(?TABLE, MatchSpec), - delete(L), - D = lists:foldl(fun sum/2, dict:new(), L), - dict:to_list(D). - -sum({{Ctr, _}, N}, Dict) -> - dict:update(Ctr, fun(V) -> V+N end, N, Dict). - -ref(Pid) - when is_pid(Pid) -> - ets:select(?TABLE, [{?REC(Pid, '$1'), [], ['$1']}]); -ref(_) -> - []. - -%% update_counter/2 -%% -%% From an arbitrary request process. Cast to the server process to -%% insert a new element if the counter doesn't exists so that two -%% processes don't do so simultaneously. - -update_counter(Key, N) -> - try - ets:update_counter(?TABLE, Key, N) - catch - error: badarg -> - cast({incr, ?REC(Key, N)}) - end. - -%% update_counter/1 -%% -%% From the server process. - -update_counter(?REC(Key, N) = T) -> - try - ets:update_counter(?TABLE, Key, N) - catch - error: badarg -> - insert(T) - end. - -insert(T) -> - ets:insert(?TABLE, T). - -lookup(Key) -> - ets:lookup(?TABLE, Key). - -delete_object(T) -> - ets:delete_object(?TABLE, T). - -%% cast/1 - -cast(Msg) -> - gen_server:cast(?SERVER, Msg). - -%% call/1 - -call(Request) -> - gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/app/diameter_sup.erl b/lib/diameter/src/app/diameter_sup.erl deleted file mode 100644 index e5afd23dcd..0000000000 --- a/lib/diameter/src/app/diameter_sup.erl +++ /dev/null @@ -1,101 +0,0 @@ -%% -%% %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% -%% - -%% -%% The top supervisor for the diameter application. -%% - --module(diameter_sup). - --behaviour(supervisor). - -%% interface --export([start_link/0, %% supervisor start - tree/0]). %% supervision tree - -%% supervisor callback --export([init/1]). - --define(CHILDREN, [diameter_misc_sup, - diameter_watchdog_sup, - diameter_peer_fsm_sup, - diameter_transport_sup, - diameter_service_sup]). - --define(TABLES, [{diameter_sequence, [set]}, - {diameter_service, [set, {keypos, 3}]}, - {diameter_request, [bag]}, - {diameter_config, [bag, {keypos, 2}]}]). - -%% start_link/0 - -start_link() -> - SupName = {local, ?MODULE}, - supervisor:start_link(SupName, ?MODULE, []). - -%% init/1 - -init([]) -> - ets_new(?TABLES), - diameter_session:init(), - Flags = {one_for_one, 1, 5}, - ChildSpecs = lists:map(fun spec/1, ?CHILDREN), - {ok, {Flags, ChildSpecs}}. - -%% spec/1 - -spec(Mod) -> - {Mod, - {Mod, start_link, []}, - permanent, - 1000, - supervisor, - [Mod]}. - -%% ets_new/1 - -ets_new(List) - when is_list(List) -> - lists:foreach(fun ets_new/1, List); - -ets_new({Table, Opts}) -> - ets:new(Table, [named_table, public | Opts]). - -%% tree/0 - -tree() -> - [{?MODULE, whereis(?MODULE), tree(?MODULE)}]. - -tree(Sup) -> - lists:map(fun t/1, supervisor:which_children(Sup)). - -t({Name, Pid, supervisor, _}) -> - t(Name, Pid, tree(Pid)); -t({Name, Pid, worker, _}) -> - t(Name, Pid). - -t(undefined, Pid, Children) -> - {Pid, Children}; -t(Name, Pid, Children) -> - {Name, Pid, Children}. - -t(undefined, Pid) -> - Pid; -t(Name, Pid) -> - {Name, Pid}. diff --git a/lib/diameter/src/app/diameter_sync.erl b/lib/diameter/src/app/diameter_sync.erl deleted file mode 100644 index ce2db4b3a2..0000000000 --- a/lib/diameter/src/app/diameter_sync.erl +++ /dev/null @@ -1,550 +0,0 @@ -%% -%% %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% -%% - -%% -%% This module implements a server that serializes requests in named -%% queues. A request is an MFA or fun and a name can be any term. A -%% request is applied in a dedicated process that terminates when -%% the request function returns. -%% - --module(diameter_sync). --behaviour(gen_server). - --export([call/4, call/5, - cast/4, cast/5, - carp/1, carp/2]). - -%% supervisor callback --export([start_link/0]). - -%% gen_server interface --export([init/1, - terminate/2, - handle_call/3, - handle_cast/2, - handle_info/2, - code_change/3]). - -%% test/debug --export([state/0, - uptime/0, - flush/1, - pending/0, - pending/1, - queues/0, - pids/1]). - --include("diameter_internal.hrl"). - -%% Locally registered server name. --define(SERVER, ?MODULE). - -%% Message to the server to queue a request ... --define(REQUEST(CallOrCast, Name, Req, Max, Timeout), - {request, CallOrCast, Name, Req, Max, Timeout}). - -%% ... and to retrieve the pid of the prevailing request process. --define(CARP(Name), - {carp, Name}). - -%% Forever ... --define(TIMEOUT, 30000). - -%% Server state. --record(state, - {time = now(), - pending = 0 :: non_neg_integer(), %% outstanding requests - monitor = new() :: ets:tid(), %% MonitorRef -> {Name, From} - queue = new() :: ets:tid()}). %% Name -> queue of {Pid, Ref} - -%% ---------------------------------------------------------- -%% # call(Node, Name, Req, Max, Timeout) -%% # call(Name, Req, Max, Timeout) -%% -%% Input: Name = term() identifying the queue in which the request is -%% to be evaluated. -%% Req = {M,F,A} -%% | {Fun, Arg} -%% | [Fun | Args] -%% | Fun -%% Max = Upper bound for the number of outstanding requests -%% in the named queue for Req to be queued. -%% If more than this number are in the queue then -%% 'rejected' is returned to the caller. Can be any -%% term but integer() | infinity is sufficient. -%% Timeout = 32 bit integer() number of milliseconds after which -%% request is cancelled (if not already started), causing -%% 'timeout' to be returned to the caller. -%% | infinity -%% -%% Output: Req() | rejected | timeout -%% -%% Description: Serialize a request in a named queue. Note that if -%% 'timeout' is returned and the request itself does not -%% return this atom then request has not been evaluated. -%% ---------------------------------------------------------- - -call(Name, Req, Max, Timeout) -> - call(node(), Name, Req, Max, Timeout). - -call(Node, Name, Req, Max, Timeout) -> - gen_call({?SERVER, Node}, ?REQUEST(call, Name, Req, Max, Timeout)). - -%%% ---------------------------------------------------------- -%%% # cast(Node, Name, Req, Max, Timeout) -%%% # cast(Name, Req, Max, Timeout) -%%% -%%% Output: ok | rejected | timeout -%%% -%%% Description: Serialize a request without returning the result to the -%%% caller. Returns after the task is queued. -%%% ---------------------------------------------------------- - -cast(Name, Req, Max, Timeout) -> - cast(node(), Name, Req, Max, Timeout). - -cast(Node, Name, Req, Max, Timeout) -> - gen_call({?SERVER, Node}, ?REQUEST(cast, Name, Req, Max, Timeout)). - -%% 'timeout' is only return if the server process that processes -%% requests isn't alive. Ditto for call/carp. - -%%% ---------------------------------------------------------- -%%% # carp(Node, Name) -%%% # carp(Name) -%%% -%%% Output: {value, Pid} | false | timeout -%%% -%%% Description: Return the pid of the process processing the task -%%% at the head of the named queue. Note that the value -%%% returned by subsequent calls changes as tasks are -%%% completed, each task executing in a dedicated -%%% process. The exit value of this process will be -%%% {value, Req()} if the task returns. -%%% ---------------------------------------------------------- - -%% The intention of this is to let a process enqueue a task that waits -%% for a message before completing, the target pid being retrieved -%% with carp/[12]. - -carp(Name) -> - carp(node(), Name). - -carp(Node, Name) -> - gen_call({?SERVER, Node}, ?CARP(Name)). - -%%% --------------------------------------------------------- -%%% EXPORTED INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -state() -> - call(state). - -uptime() -> - call(uptime). - -flush(Name) -> - call({flush, Name}). - -pending() -> - call(pending). - -pending(Name) -> - call({pending, Name}). - -queues() -> - call(queues). - -pids(Name) -> - call({pids, Name}). - -%%% ---------------------------------------------------------- -%%% # start_link() -%%% ---------------------------------------------------------- - -start_link() -> - ServerName = {local, ?SERVER}, - Module = ?MODULE, - Args = [], - Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], - gen_server:start_link(ServerName, Module, Args, Options). - -%%% ---------------------------------------------------------- -%%% # init(_) -%%% ---------------------------------------------------------- - -init(_) -> - {ok, #state{}}. - -%%% ---------------------------------------------------------- -%%% # handle_call(Request, From, State) -%%% ---------------------------------------------------------- - -%% Enqueue a new request. -handle_call(?REQUEST(Type, Name, Req, Max, Timeout), - From, - #state{queue = QD} = State) -> - T = find(Name, QD), - nq(queued(T) =< Max, T, {Type, From}, Name, Req, Timeout, State); - -handle_call(Request, From, State) -> - {reply, call(Request, From, State), State}. - -%% call/3 - -call(?CARP(Name), _, #state{queue = QD}) -> - pcar(find(Name, QD)); - -call(state, _, State) -> - State; - -call(uptime, _, #state{time = T}) -> - diameter_lib:now_diff(T); - -call({flush, Name}, _, #state{queue = QD}) -> - cancel(find(Name, QD)); - -call(pending, _, #state{pending = N}) -> - N; - -call({pending, Name}, _, #state{queue = QD}) -> - queued(find(Name, QD)); - -call(queues, _, #state{queue = QD}) -> - fetch_keys(QD); - -call({pids, Name}, _, #state{queue = QD}) -> - plist(find(Name, QD)); - -call(Req, From, _State) -> %% ignore - ?UNEXPECTED(handle_call, [Req, From]), - nok. - -%%% ---------------------------------------------------------- -%%% handle_cast(Request, State) -%%% ---------------------------------------------------------- - -handle_cast(Msg, State) -> - ?UNEXPECTED([Msg]), - {noreply, State}. - -%%% ---------------------------------------------------------- -%%% handle_info(Request, State) -%%% ---------------------------------------------------------- - -handle_info(Request, State) -> - {noreply, info(Request, State)}. - -%% info/2 - -%% A request has completed execution or timed out. -info({'DOWN', MRef, process, Pid, Info}, - #state{pending = N, - monitor = MD, - queue = QD} - = State) -> - {Name, From} = fetch(MRef, MD), - reply(From, rc(Info)), - State#state{pending = N-1, - monitor = erase(MRef, MD), - queue = dq(fetch(Name, QD), Pid, Info, Name, QD)}; - -info(Info, State) -> - ?UNEXPECTED(handle_info, [Info]), - State. - -reply({call, From}, T) -> - gen_server:reply(From, T); -reply(cast, _) -> - ok. - -rc({value, T}) -> - T; -rc(_) -> - timeout. - -%%% ---------------------------------------------------------- -%%% code_change(OldVsn, State, Extra) -%%% ---------------------------------------------------------- - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -%%% ---------------------------------------------------------- -%%% terminate(Reason, State) -%%% ---------------------------------------------------------- - -terminate(_Reason, _State)-> - ok. - -%%% --------------------------------------------------------- -%%% INTERNAL FUNCTIONS -%%% --------------------------------------------------------- - -%% queued/1 - -queued({ok, {N,_}}) -> - N; -queued(error) -> - 0. - -%% nq/7 - -%% Maximum number of pending requests exceeded ... -nq(false, _, _, _Name, _Req, _Timeout, State) -> - {reply, rejected, State}; - -%% ... or not. -nq(true, T, From, Name, Req, Timeout, #state{pending = N, - monitor = MD, - queue = QD} - = State) -> - Ref = make_ref(), - Pid = init(Ref, Req, timeout(Timeout, T)), - MRef = erlang:monitor(process, Pid), - {noreply, State#state{pending = N+1, - monitor = store(MRef, {Name, from(From)}, MD), - queue = store(Name, nq(T, {Pid, Ref}), QD)}}. - -from({call, _} = T) -> - T; -from({cast = T, From}) -> - gen_server:reply(From, ok), - T. - -%% nq/2 - -%% Other requests in the queue: append. -nq({ok, {N,Q}}, T) -> - {N+1, queue:in(T,Q)}; - -%% Queue is empty: start execution. -nq(error, T) -> - go(T), - {1, queue:from_list([T])}. - -%% Don't timeout if the request is evaluated immediately so as to -%% avoid a race between getting a 'go' and a 'timeout'. Queueing a -%% request in an empty queue always results in execution. -timeout(_, error) -> - infinity; -timeout(Timeout, _) -> - Timeout. - -%% dq/5 -%% -%% A request process has terminated. - -dq({N,Q}, Pid, _Info, Name, QD) -> - {{value, T}, TQ} = queue:out(Q), - dq(N-1, Pid, T, TQ, Name, QD). - -%% dq/6 - -%% Request was at the head of the queue: start another. -dq(N, Pid, {Pid, _}, TQ, Name, QD) -> - dq(N, TQ, Name, QD); - -%% Or not: remove the offender from the queue. -dq(N, Pid, T, TQ, Name, QD) -> - store(Name, {N, req(Pid, queue:from_list([T]), TQ)}, QD). - -%% dq/4 - -%% Queue is empty: erase. -dq(0, TQ, Name, QD) -> - true = queue:is_empty(TQ), %% assert - erase(Name, QD); - -%% Start the next request. -dq(N, TQ, Name, QD) -> - go(queue:head(TQ)), - store(Name, {N, TQ}, QD). - -%% req/3 -%% -%% Find and remove the queue element for the specified pid. - -req(Pid, HQ, Q) -> - {{value, T}, TQ} = queue:out(Q), - req(Pid, T, HQ, TQ). - -req(Pid, {Pid, _}, HQ, TQ) -> - queue:join(HQ, TQ); -req(Pid, T, HQ, TQ) -> - req(Pid, queue:in(T,HQ), TQ). - -%% go/1 - -go({Pid, Ref}) -> - Pid ! {Ref, ok}. - -%% init/4 -%% -%% Start the dedicated process for handling a request. The exit value -%% is as promised by carp/1. - -init(Ref, Req, Timeout) -> - spawn(fun() -> exit(i(Ref, Req, Timeout)) end). - -i(Ref, Req, Timeout) -> - Timer = send_timeout(Ref, Timeout), - MRef = erlang:monitor(process, ?SERVER), - receive - {Ref, ok} -> %% Do the deed. - %% Ensure we don't leave messages in the mailbox since the - %% request itself might receive. Alternatively, could have - %% done the eval in a new process but then we'd have to - %% relay messages arriving at this one. - cancel_timer(Timer), - erlang:demonitor(MRef, [flush]), - %% Ref is to ensure that we don't extract any message that - %% a client may have sent after retrieving self() with - %% carp/1, there being no guarantee that the message - %% banged by go/1 is received before the pid becomes - %% accessible. - {value, eval(Req)}; - {Ref, timeout = T} -> - T; - {'DOWN', MRef, process, _Pid, _Info} = D -> %% server death - D - end. - -send_timeout(_Ref, infinity = No) -> - No; -send_timeout(Ref, Ms) -> - Msg = {Ref, timeout}, - TRef = erlang:send_after(Ms, self(), Msg), - {TRef, Msg}. - -cancel_timer(infinity = No) -> - No; -cancel_timer({TRef, Msg}) -> - flush(Msg, erlang:cancel_timer(TRef)). - -flush(Msg, false) -> %% Message has already been sent ... - %% 'error' should never happen but crash if it does so as not to - %% hang the process. - ok = receive Msg -> ok after ?TIMEOUT -> error end; -flush(_, _) -> %% ... or not. - ok. - -eval({M,F,A}) -> - apply(M,F,A); -eval([Fun | Args]) -> - apply(Fun, Args); -eval({Fun, A}) -> - Fun(A); -eval(Fun) -> - Fun(). - -%% pcar/1 - -pcar({ok, {_,Q}}) -> - {Pid, _Ref} = queue:head(Q), - {value, Pid}; -pcar(error) -> - false. - -%% plist/1 - -plist({ok, {_,Q}}) -> - lists:map(fun({Pid, _Ref}) -> Pid end, queue:to_list(Q)); -plist(error) -> - []. - -%% cancel/1 -%% -%% Cancel all but the active request from the named queue. Return the -%% number of requests cancelled. - -%% Just send timeout messages to each request to make them die. Note -%% that these are guaranteed to arrive before a go message after the -%% current request completes since both messages are sent from the -%% server process. -cancel({ok, {N,Q}}) -> - {_,TQ} = queue:split(1,Q), - foreach(fun({Pid, Ref}) -> Pid ! {Ref, timeout} end, N-1, TQ), - N-1; -cancel(error) -> - 0. - -%% foreach/3 - -foreach(_, 0, _) -> - ok; -foreach(Fun, N, Q) -> - Fun(queue:head(Q)), - foreach(Fun, N-1, queue:tail(Q)). - -%% call/1 - -%% gen_server:call/3 will exit if the target process dies. -call(Request) -> - try - gen_server:call(?SERVER, Request, ?TIMEOUT) - catch - exit: Reason -> - {error, Reason} - end. - -%% dict-like table manipulation. - -erase(Key, Dict) -> - ets:delete(Dict, Key), - Dict. - -fetch(Key, Dict) -> - {ok, V} = find(Key, Dict), - V. - -fetch_keys(Dict) -> - ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). - -find(Key, Dict) -> - case ets:lookup(Dict, Key) of - [{Key, V}] -> - {ok, V}; - [] -> - error - end. - -new() -> - ets:new(?MODULE, [set]). - -store(Key, Value, Dict) -> - store({Key, Value}, Dict). - -store({_,_} = T, Dict) -> - ets:insert(Dict, T), - Dict. - -%% gen_call/1 - -gen_call(Server, Req) -> - gen_call(Server, Req, infinity). - -gen_call(Server, Req, Timeout) -> - try - gen_server:call(Server, Req, Timeout) - catch - exit: _ -> - timeout - end. diff --git a/lib/diameter/src/app/diameter_types.erl b/lib/diameter/src/app/diameter_types.erl deleted file mode 100644 index 6b1b1b8d39..0000000000 --- a/lib/diameter/src/app/diameter_types.erl +++ /dev/null @@ -1,537 +0,0 @@ -%% -%% %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% -%% - --module(diameter_types). - -%% -%% Encode/decode of RFC 3588 Data Formats, Basic (section 4.2) and -%% Derived (section 4.3). -%% - -%% Basic types. --export(['OctetString'/2, - 'Integer32'/2, - 'Integer64'/2, - 'Unsigned32'/2, - 'Unsigned64'/2, - 'Float32'/2, - 'Float64'/2]). - -%% Derived types. --export(['Address'/2, - 'Time'/2, - 'UTF8String'/2, - 'DiameterIdentity'/2, - 'DiameterURI'/2, - 'IPFilterRule'/2, - 'QoSFilterRule'/2]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(UINT(N,X), ((0 =< X) andalso (X < 1 bsl N))). --define(SINT(N,X), ((-1*(1 bsl (N-1)) < X) andalso (X < 1 bsl (N-1)))). - -%% The Grouped and Enumerated types are dealt with directly in -%% generated decode modules by way of diameter_gen.hrl and -%% diameter_codec.erl. Padding and the setting of Length and other -%% fields are also dealt with there. - -%% 3588: -%% -%% DIAMETER_INVALID_AVP_LENGTH 5014 -%% The request contained an AVP with an invalid length. A Diameter -%% message indicating this error MUST include the offending AVPs -%% within a Failed-AVP AVP. -%% --define(INVALID_LENGTH(Bin), erlang:error({'DIAMETER', 5014, Bin})). - -%% ------------------------------------------------------------------------- -%% 3588, 4.2. Basic AVP Data Formats -%% -%% The Data field is zero or more octets and contains information -%% specific to the Attribute. The format and length of the Data field -%% is determined by the AVP Code and AVP Length fields. The format of -%% the Data field MUST be one of the following base data types or a data -%% type derived from the base data types. In the event that a new Basic -%% AVP Data Format is needed, a new version of this RFC must be created. -%% -------------------- - -'OctetString'(decode, Bin) - when is_binary(Bin) -> - binary_to_list(Bin); - -'OctetString'(encode = M, zero) -> - 'OctetString'(M, []); - -'OctetString'(encode, Str) -> - iolist_to_binary(Str). - -%% -------------------- - -'Integer32'(decode, <>) -> - X; - -'Integer32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Integer32'(encode = M, zero) -> - 'Integer32'(M, 0); - -'Integer32'(encode, I) - when ?SINT(32,I) -> - <>. - -%% -------------------- - -'Integer64'(decode, <>) -> - X; - -'Integer64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Integer64'(encode = M, zero) -> - 'Integer64'(M, 0); - -'Integer64'(encode, I) - when ?SINT(64,I) -> - <>. - -%% -------------------- - -'Unsigned32'(decode, <>) -> - X; - -'Unsigned32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Unsigned32'(encode = M, zero) -> - 'Unsigned32'(M, 0); - -'Unsigned32'(encode, I) - when ?UINT(32,I) -> - <>. - -%% -------------------- - -'Unsigned64'(decode, <>) -> - X; - -'Unsigned64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Unsigned64'(encode = M, zero) -> - 'Unsigned64'(M, 0); - -'Unsigned64'(encode, I) - when ?UINT(64,I) -> - <>. - -%% -------------------- - -%% Decent summaries of the IEEE floating point formats can be -%% found at http://en.wikipedia.org/wiki/IEEE_754-1985 and -%% http://www.psc.edu/general/software/packages/ieee/ieee.php. -%% -%% That the bit syntax uses these formats isn't well documented but -%% this does indeed appear to be the case. However, the bit syntax -%% only encodes numeric values, not the standard's (signed) infinity -%% or NaN. It also encodes any large value as 'infinity', never 'NaN'. -%% Treat these equivalently on decode for this reason. -%% -%% An alternative would be to decode infinity/NaN to the largest -%% possible float but could likely lead to misleading results if -%% arithmetic is performed on the decoded value. Better to be explicit -%% that precision has been lost. - -'Float32'(decode, <>) -> - choose(S, infinity, '-infinity'); - -'Float32'(decode, <>) -> - X; - -'Float32'(decode, B) -> - ?INVALID_LENGTH(B); - -'Float32'(encode = M, zero) -> - 'Float32'(M, 0.0); - -'Float32'(encode, infinity) -> - <<0:1, 255:8, 0:23>>; - -'Float32'(encode, '-infinity') -> - <<1:1, 255:8, 0:23>>; - -'Float32'(encode, X) - when is_float(X) -> - <>. -%% Note that this could also encode infinity/-infinity for large -%% (signed) numeric values. Note also that precision is lost just in -%% using the floating point syntax. For example: -%% -%% 1> B = <<3.14159:32/float>>. -%% <<64,73,15,208>> -%% 2> <> = B. -%% <<64,73,15,208>> -%% 3> F. -%% 3.141590118408203 -%% -%% (The 64 bit type does better.) - -%% -------------------- - -%% The 64 bit format is entirely analogous to the 32 bit format. - -'Float64'(decode, <>) -> - choose(S, infinity, '-infinity'); - -'Float64'(decode, <>) -> - X; - -'Float64'(decode, B) -> - ?INVALID_LENGTH(B); - -'Float64'(encode, infinity) -> - <<0:1, 2047:11, 0:52>>; - -'Float64'(encode, '-infinity') -> - <<1:1, 2047:11, 0:52>>; - -'Float64'(encode = M, zero) -> - 'Float64'(M, 0.0); - -'Float64'(encode, X) - when is_float(X) -> - <>. - -%% ------------------------------------------------------------------------- -%% 3588, 4.3. Derived AVP Data Formats -%% -%% In addition to using the Basic AVP Data Formats, applications may -%% define data formats derived from the Basic AVP Data Formats. An -%% application that defines new AVP Derived Data Formats MUST include -%% them in a section entitled "AVP Derived Data Formats", using the same -%% format as the definitions below. Each new definition must be either -%% defined or listed with a reference to the RFC that defines the -%% format. -%% -------------------- - -'Address'(encode, zero) -> - <<0:48>>; - -'Address'(decode, <<1:16, B/binary>>) - when size(B) == 4 -> - list_to_tuple(binary_to_list(B)); - -'Address'(decode, <<2:16, B/binary>>) - when size(B) == 16 -> - list_to_tuple(v6dec(B, [])); - -'Address'(decode, <> = B) - when 1 == A; - 2 == A -> - ?INVALID_LENGTH(B); - -'Address'(encode, T) -> - ipenc(diameter_lib:ipaddr(T)). - -ipenc(T) - when is_tuple(T), size(T) == 4 -> - B = list_to_binary(tuple_to_list(T)), - <<1:16, B/binary>>; - -ipenc(T) - when is_tuple(T), size(T) == 8 -> - B = v6enc(lists:reverse(tuple_to_list(T)), <<>>), - <<2:16, B/binary>>. - -v6dec(<>, Acc) -> - v6dec(B, [N | Acc]); - -v6dec(<<>>, Acc) -> - lists:reverse(Acc). - -v6enc([N | Rest], B) - when ?UINT(16,N) -> - v6enc(Rest, <>); - -v6enc([], B) -> - B. - -%% -------------------- - -%% A DiameterIdentity is a FQDN as definined in RFC 1035, which is at -%% least one character. - -'DiameterIdentity'(encode = M, zero) -> - 'OctetString'(M, [0]); - -'DiameterIdentity'(encode = M, X) -> - <<_,_/binary>> = 'OctetString'(M, X); - -'DiameterIdentity'(decode = M, <<_,_/binary>> = X) -> - 'OctetString'(M, X). - -%% -------------------- - -'DiameterURI'(decode, Bin) - when is_binary(Bin) -> - scan_uri(Bin); - -%% The minimal DiameterURI is "aaa://x", 7 characters. -'DiameterURI'(encode = M, zero) -> - 'OctetString'(M, lists:duplicate(0,7)); - -'DiameterURI'(encode, #diameter_uri{type = Type, - fqdn = D, - port = P, - transport = T, - protocol = Prot} - = U) -> - S = lists:append([atom_to_list(Type), "://", D, - ":", integer_to_list(P), - ";transport=", atom_to_list(T), - ";protocol=", atom_to_list(Prot)]), - U = scan_uri(S), %% assert - list_to_binary(S); - -'DiameterURI'(encode, Str) -> - Bin = iolist_to_binary(Str), - #diameter_uri{} = scan_uri(Bin), %% type check - Bin. - -%% -------------------- - -%% This minimal rule is "deny in 0 from 0.0.0.0 to 0.0.0.0", 33 characters. -'IPFilterRule'(encode = M, zero) -> - 'OctetString'(M, lists:duplicate(0,33)); - -%% TODO: parse grammar. -'IPFilterRule'(M, X) -> - 'OctetString'(M, X). - -%% -------------------- - -%% This minimal rule is the same as for an IPFilterRule. -'QoSFilterRule'(encode = M, zero = X) -> - 'IPFilterRule'(M, X); - -%% TODO: parse grammar. -'QoSFilterRule'(M, X) -> - 'OctetString'(M, X). - -%% -------------------- - -'UTF8String'(decode, Bin) -> - udec(Bin, []); - -'UTF8String'(encode = M, zero) -> - 'UTF8String'(M, []); - -'UTF8String'(encode, S) -> - uenc(S, []). - -udec(<<>>, Acc) -> - lists:reverse(Acc); - -udec(<>, Acc) -> - udec(Rest, [C | Acc]). - -uenc(E, Acc) - when E == []; - E == <<>> -> - list_to_binary(lists:reverse(Acc)); - -uenc(<>, Acc) -> - uenc(Rest, [<> | Acc]); - -uenc([[] | Rest], Acc) -> - uenc(Rest, Acc); - -uenc([[H|T] | Rest], Acc) -> - uenc([H, T | Rest], Acc); - -uenc([C | Rest], Acc) -> - uenc(Rest, [<> | Acc]). - -%% -------------------- - -%% RFC 3588, 4.3: -%% -%% Time -%% The Time format is derived from the OctetString AVP Base Format. -%% The string MUST contain four octets, in the same format as the -%% first four bytes are in the NTP timestamp format. The NTP -%% Timestamp format is defined in chapter 3 of [SNTP]. -%% -%% This represents the number of seconds since 0h on 1 January 1900 -%% with respect to the Coordinated Universal Time (UTC). -%% -%% On 6h 28m 16s UTC, 7 February 2036 the time value will overflow. -%% SNTP [SNTP] describes a procedure to extend the time to 2104. -%% This procedure MUST be supported by all DIAMETER nodes. - -%% RFC 2030, 3: -%% -%% As the NTP timestamp format has been in use for the last 17 years, -%% it remains a possibility that it will be in use 40 years from now -%% when the seconds field overflows. As it is probably inappropriate -%% to archive NTP timestamps before bit 0 was set in 1968, a -%% convenient way to extend the useful life of NTP timestamps is the -%% following convention: If bit 0 is set, the UTC time is in the -%% range 1968-2036 and UTC time is reckoned from 0h 0m 0s UTC on 1 -%% January 1900. If bit 0 is not set, the time is in the range 2036- -%% 2104 and UTC time is reckoned from 6h 28m 16s UTC on 7 February -%% 2036. Note that when calculating the correspondence, 2000 is not a -%% leap year. Note also that leap seconds are not counted in the -%% reckoning. -%% -%% The statement regarding year 2000 is wrong: errata id 518 at -%% http://www.rfc-editor.org/errata_search.php?rfc=2030 notes this. - --define(TIME_1900, 59958230400). %% {{1900,1,1},{0,0,0}} --define(TIME_2036, 64253197696). %% {{2036,2,7},{6,28,16}} -%% TIME_2036 = TIME_1900 + (1 bsl 32) - -%% Time maps [0, 1 bsl 31) onto [TIME_1900 + 1 bsl 31, TIME_2036 + 1 bsl 31) -%% by taking integers with the high-order bit set relative to TIME_1900 -%% and those without relative to TIME_2036. This corresponds to the -%% following dates. --define(TIME_MIN, {{1968,1,20},{3,14,8}}). %% TIME_1900 + 1 bsl 31 --define(TIME_MAX, {{2104,2,26},{9,42,24}}). %% TIME_2036 + 1 bsl 31 - -'Time'(decode, <>) -> - Offset = msb(1 == Time bsr 31), - calendar:gregorian_seconds_to_datetime(Time + Offset); - -'Time'(decode, B) -> - ?INVALID_LENGTH(B); - -'Time'(encode, {{_Y,_M,_D},{_HH,_MM,_SS}} = Datetime) - when ?TIME_MIN =< Datetime, Datetime < ?TIME_MAX -> - S = calendar:datetime_to_gregorian_seconds(Datetime), - T = S - msb(S < ?TIME_2036), - 0 = T bsr 32, %% sanity check - <>; - -'Time'(encode, zero) -> - <<0:32>>. - -%% =========================================================================== -%% =========================================================================== - -choose(0, X, _) -> X; -choose(1, _, X) -> X. - -msb(true) -> ?TIME_1900; -msb(false) -> ?TIME_2036. - -%% RFC 3588, 4.3: -%% -%% The DiameterURI MUST follow the Uniform Resource Identifiers (URI) -%% syntax [URI] rules specified below: -%% -%% "aaa://" FQDN [ port ] [ transport ] [ protocol ] -%% -%% ; No transport security -%% -%% "aaas://" FQDN [ port ] [ transport ] [ protocol ] -%% -%% ; Transport security used -%% -%% FQDN = Fully Qualified Host Name -%% -%% port = ":" 1*DIGIT -%% -%% ; One of the ports used to listen for -%% ; incoming connections. -%% ; If absent, -%% ; the default Diameter port (3868) is -%% ; assumed. -%% -%% transport = ";transport=" transport-protocol -%% -%% ; One of the transports used to listen -%% ; for incoming connections. If absent, -%% ; the default SCTP [SCTP] protocol is -%% ; assumed. UDP MUST NOT be used when -%% ; the aaa-protocol field is set to -%% ; diameter. -%% -%% transport-protocol = ( "tcp" / "sctp" / "udp" ) -%% -%% protocol = ";protocol=" aaa-protocol -%% -%% ; If absent, the default AAA protocol -%% ; is diameter. -%% -%% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) - -scan_uri(Bin) - when is_binary(Bin) -> - scan_uri(binary_to_list(Bin)); -scan_uri("aaa://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaa}); -scan_uri("aaas://" ++ Rest) -> - scan_fqdn(Rest, #diameter_uri{type = aaas}). - -scan_fqdn(S, U) -> - {[_|_] = F, Rest} = lists:splitwith(fun is_fqdn/1, S), - scan_opt_port(Rest, U#diameter_uri{fqdn = F}). - -scan_opt_port(":" ++ S, U) -> - {[_|_] = P, Rest} = lists:splitwith(fun is_digit/1, S), - scan_opt_transport(Rest, U#diameter_uri{port = list_to_integer(P)}); -scan_opt_port(S, U) -> - scan_opt_transport(S, U). - -scan_opt_transport(";transport=" ++ S, U) -> - {P, Rest} = transport(S), - scan_opt_protocol(Rest, U#diameter_uri{transport = P}); -scan_opt_transport(S, U) -> - scan_opt_protocol(S, U). - -scan_opt_protocol(";protocol=" ++ S, U) -> - {P, ""} = protocol(S), - U#diameter_uri{protocol = P}; -scan_opt_protocol("", U) -> - U. - -transport("tcp" ++ S) -> - {tcp, S}; -transport("sctp" ++ S) -> - {sctp, S}; -transport("udp" ++ S) -> - {udp, S}. - -protocol("diameter" ++ S) -> - {diameter, S}; -protocol("radius" ++ S) -> - {radius, S}; -protocol("tacacs+" ++ S) -> - {'tacacs+', S}. - -is_fqdn(C) -> - is_digit(C) orelse is_alpha(C) orelse C == $. orelse C == $-. - -is_alpha(C) -> - ($a =< C andalso C =< $z) orelse ($A =< C andalso C =< $Z). - -is_digit(C) -> - $0 =< C andalso C =< $9. diff --git a/lib/diameter/src/app/diameter_types.hrl b/lib/diameter/src/app/diameter_types.hrl deleted file mode 100644 index 02bf8a74dd..0000000000 --- a/lib/diameter/src/app/diameter_types.hrl +++ /dev/null @@ -1,139 +0,0 @@ -%% -%% %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% -%% - -%% -%% Types for function specifications, primarily in diameter.erl. This -%% has nothing specifically to do with diameter_types.erl. -%% - --type evaluable() - :: {module(), atom(), list()} - | fun() - | nonempty_improper_list(evaluable(), list()). %% [evaluable() | Args] - --type app_alias() - :: any(). - --type service_name() - :: any(). - -%% Diameter basic types - --type 'OctetString'() :: iolist(). --type 'Integer32'() :: -2147483647..2147483647. --type 'Integer64'() :: -9223372036854775807..9223372036854775807. --type 'Unsigned32'() :: 0..4294967295. --type 'Unsigned64'() :: 0..18446744073709551615. --type 'Float32'() :: '-infinity' | float() | infinity. --type 'Float64'() :: '-infinity' | float() | infinity. --type 'Grouped'() :: list() | tuple(). - -%% Diameter derived types - --type 'Address'() - :: inet:ip_address() - | string(). - --type 'Time'() :: {{integer(), 1..12, 1..31}, - {0..23, 0..59, 0..59}}. --type 'UTF8String'() :: iolist(). --type 'DiameterIdentity'() :: 'OctetString'(). --type 'DiameterURI'() :: 'OctetString'(). --type 'Enumerated'() :: 'Integer32'(). --type 'IPFilterRule'() :: 'OctetString'(). --type 'QoSFilterRule'() :: 'OctetString'(). - -%% Capabilities options/avps on start_service/2 and/or add_transport/2 - --type capability() - :: {'Origin-Host', 'DiameterIdentity'()} - | {'Origin-Realm', 'DiameterIdentity'()} - | {'Host-IP-Address', ['Address'()]} - | {'Vendor-Id', 'Unsigned32'()} - | {'Product-Name', 'UTF8String'()} - | {'Supported-Vendor-Id', ['Unsigned32'()]} - | {'Auth-Application-Id', ['Unsigned32'()]} - | {'Vendor-Specific-Application-Id', ['Grouped'()]} - | {'Firmware-Revision', 'Unsigned32'()}. - -%% Filters for call/4 - --type peer_filter() - :: none - | host - | realm - | {host, any|'DiameterIdentity'()} - | {realm, any|'DiameterIdentity'()} - | {eval, evaluable()} - | {neg, peer_filter()} - | {all, [peer_filter()]} - | {any, [peer_filter()]}. - -%% Options passed to start_service/2 - --type service_opt() - :: capability() - | {application, [application_opt()]}. - --type application_opt() - :: {alias, app_alias()} - | {dictionary, module()} - | {module, app_module()} - | {state, any()} - | {call_mutates_state, boolean()} - | {answer_errors, callback|report|discard}. - --type app_module() - :: module() - | nonempty_improper_list(module(), list()). %% list with module() head - -%% Identifier returned by add_transport/2 - --type transport_ref() - :: reference(). - -%% Options passed to add_transport/2 - --type transport_opt() - :: {transport_module, atom()} - | {transport_config, any()} - | {applications, [app_alias()]} - | {capabilities, [capability()]} - | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} - | {reconnect_timer, 'Unsigned32'()} - | {private, any()}. - -%% Predicate passed to remove_transport/2 - --type transport_pred() - :: fun((reference(), connect|listen, list()) -> boolean()) - | fun((reference(), list()) -> boolean()) - | fun((list()) -> boolean()) - | reference() - | list() - | {connect|listen, transport_pred()} - | {atom(), atom(), list()}. - -%% Options passed to call/4 - --type call_opt() - :: {extra, list()} - | {filter, peer_filter()} - | {timeout, 'Unsigned32'()} - | detach. diff --git a/lib/diameter/src/app/diameter_watchdog.erl b/lib/diameter/src/app/diameter_watchdog.erl deleted file mode 100644 index b7c1491f4b..0000000000 --- a/lib/diameter/src/app/diameter_watchdog.erl +++ /dev/null @@ -1,571 +0,0 @@ -%% -%% %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% -%% - -%% -%% This module implements (as a process) the state machine documented -%% in Appendix A of RFC 3539. -%% - --module(diameter_watchdog). --behaviour(gen_server). - -%% towards diameter_service --export([start/2]). - -%% gen_server callbacks --export([init/1, - handle_call/3, - handle_cast/2, - handle_info/2, - terminate/2, - code_change/3]). - -%% diameter_watchdog_sup callback --export([start_link/1]). - --include_lib("diameter/include/diameter.hrl"). --include("diameter_internal.hrl"). - --define(DEFAULT_TW_INIT, 30000). %% RFC 3539 ch 3.4.1 - --record(watchdog, - {%% PCB - Peer Control Block; see RFC 3539, Appendix A - status = initial :: initial | okay | suspect | down | reopen, - pending = false :: boolean(), - tw :: 6000..16#FFFFFFFF | {module(), atom(), list()}, - %% {M,F,A} -> integer() >= 0 - num_dwa = 0 :: -1 | non_neg_integer(), - %% number of DWAs received during reopen - %% end PCB - parent = self() :: pid(), - transport :: pid(), - tref :: reference(), %% reference for current watchdog timer - message_data}). %% term passed into diameter_service with message - -%% start/2 - -start({_,_} = Type, T) -> - {ok, Pid} = diameter_watchdog_sup:start_child({Type, self(), T}), - Pid. - -start_link(T) -> - {ok, _} = proc_lib:start_link(?MODULE, - init, - [T], - infinity, - diameter_lib:spawn_opts(server, [])). - -%% =========================================================================== -%% =========================================================================== - -%% init/1 - -init(T) -> - proc_lib:init_ack({ok, self()}), - gen_server:enter_loop(?MODULE, [], i(T)). - -i({T, Pid, {ConnT, Opts, SvcName, #diameter_service{applications = Apps, - capabilities = Caps} - = Svc}}) -> - {M,S,U} = now(), - random:seed(M,S,U), - putr(restart, {T, Opts, Svc}), %% save seeing it in trace - putr(dwr, dwr(Caps)), %% - #watchdog{parent = monitor(Pid), - transport = monitor(diameter_peer_fsm:start(T, Opts, Svc)), - tw = proplists:get_value(watchdog_timer, - Opts, - ?DEFAULT_TW_INIT), - message_data = {ConnT, SvcName, Apps}}. - -%% handle_call/3 - -handle_call(_, _, State) -> - {reply, nok, State}. - -%% handle_cast/2 - -handle_cast(_, State) -> - {noreply, State}. - -%% handle_info/2 - -handle_info(T, State) -> - case transition(T, State) of - ok -> - {noreply, State}; - #watchdog{status = X} = S -> - ?LOGC(X =/= State#watchdog.status, transition, X), - {noreply, S}; - stop -> - ?LOG(stop, T), - {stop, {shutdown, T}, State} - end. - -%% terminate/2 - -terminate(_, _) -> - ok. - -%% code_change/3 - -code_change(_, State, _) -> - {ok, State}. - -%% =========================================================================== -%% =========================================================================== - -%% transition/2 -%% -%% The state transitions documented here are extracted from RFC 3539, -%% the commentary is ours. - -%% Service or watchdog is telling the watchdog of an accepting -%% transport to die after reconnect_timer expiry or reestablished -%% connection (in another transport process) respectively. -transition(close, #watchdog{status = down}) -> - {{accept, _}, _, _} = getr(restart), %% assert - stop; -transition(close, #watchdog{}) -> - ok; - -%% Service is asking for the peer to be taken down gracefully. -transition({shutdown, Pid}, #watchdog{parent = Pid, - transport = undefined, - status = S}) -> - down = S, %% sanity check - stop; -transition({shutdown = T, Pid}, #watchdog{parent = Pid, - transport = TPid}) -> - TPid ! {T, self()}, - ok; - -%% Parent process has died, -transition({'DOWN', _, process, Pid, _Reason}, - #watchdog{parent = Pid}) -> - stop; - -%% Transport has accepted a connection. -transition({accepted = T, TPid}, #watchdog{transport = TPid, - parent = Pid}) -> - Pid ! {T, self(), TPid}, - ok; - -%% Transport is telling us that its impending death isn't failure. -transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> - stop; - -%% STATE Event Actions New State -%% ===== ------ ------- ---------- -%% INITIAL Connection up SetWatchdog() OKAY - -%% By construction, the watchdog timer isn't set until we move into -%% state okay as the result of the Peer State Machine reaching the -%% Open state. -%% -%% If we're an acceptor then we may be resuming a connection that went -%% down in another acceptor process, in which case this is the -%% transition below, from down into reopen. That is, it's not until -%% we know the identity of the peer (ie. now) that we know that we're -%% in state down rather than initial. - -transition({open, TPid, Hosts, T} = Open, - #watchdog{transport = TPid, - status = initial, - parent = Pid} - = S) -> - case okay(getr(restart), Hosts) of - okay -> - open(Pid, {TPid, T}), - set_watchdog(S#watchdog{status = okay}); - reopen -> - transition(Open, S#watchdog{status = down}) - end; - -%% DOWN Connection up NumDWA = 0 -%% SendWatchdog() -%% SetWatchdog() -%% Pending = TRUE REOPEN - -transition({open = P, TPid, _Hosts, T}, - #watchdog{transport = TPid, - status = down} - = S) -> - %% Store the info we need to notify the parent to reopen the - %% connection after the requisite DWA's are received, at which - %% time we eraser(open). - putr(P, {TPid, T}), - set_watchdog(send_watchdog(S#watchdog{status = reopen, - num_dwa = 0})); - -%% OKAY Connection down CloseConnection() -%% Failover() -%% SetWatchdog() DOWN -%% SUSPECT Connection down CloseConnection() -%% SetWatchdog() DOWN -%% REOPEN Connection down CloseConnection() -%% SetWatchdog() DOWN - -transition({'DOWN', _, process, TPid, _}, - #watchdog{transport = TPid, - status = initial}) -> - stop; - -transition({'DOWN', _, process, Pid, _}, - #watchdog{transport = Pid} - = S) -> - failover(S), - close(S), - set_watchdog(S#watchdog{status = down, - pending = false, - transport = undefined}); -%% Any outstanding pending (or other messages from the transport) will -%% have arrived before 'DOWN' since the message comes from the same -%% process. Note that we could also get this message in the initial -%% state. - -%% Incoming message. -transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> - recv(Name, Pkt, S); - -%% Current watchdog has timed out. -transition({timeout, TRef, tw}, #watchdog{tref = TRef} = S) -> - set_watchdog(timeout(S)); - -%% Timer was canceled after message was already sent. -transition({timeout, _, tw}, #watchdog{}) -> - ok; - -%% State query. -transition({state, Pid}, #watchdog{status = S}) -> - Pid ! {self(), S}, - ok. - -%% =========================================================================== - -monitor(Pid) -> - erlang:monitor(process, Pid), - Pid. - -putr(Key, Val) -> - put({?MODULE, Key}, Val). - -getr(Key) -> - get({?MODULE, Key}). - -eraser(Key) -> - erase({?MODULE, Key}). - -%% encode/1 - -encode(Msg) -> - #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg), - Bin. - -%% okay/2 - -okay({{accept, Ref}, _, _}, Hosts) -> - T = {?MODULE, connection, Ref, Hosts}, - diameter_reg:add(T), - okay(diameter_reg:match(T)); -%% Register before matching so that at least one of two registering -%% processes will match the other. (Which can't happen as long as -%% diameter_peer_fsm guarantees at most one open connection to the same -%% peer.) - -okay({{connect, _}, _, _}, _) -> - okay. - -%% The peer hasn't been connected recently ... -okay([{_,P}]) -> - P = self(), %% assert - okay; - -%% ... or it has. -okay(C) -> - [_|_] = [P ! close || {_,P} <- C, self() /= P], - reopen. - -%% set_watchdog/1 - -set_watchdog(#watchdog{tw = TwInit, - tref = TRef} - = S) -> - cancel(TRef), - S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)}. - -cancel(undefined) -> - ok; -cancel(TRef) -> - erlang:cancel_timer(TRef). - -tw(T) - when is_integer(T), T >= 6000 -> - T - 2000 + (random:uniform(4001) - 1); %% RFC3539 jitter of +/- 2 sec. -tw({M,F,A}) -> - apply(M,F,A). - -%% open/2 - -open(Pid, {_,_} = T) -> - Pid ! {connection_up, self(), T}. - -%% failover/1 - -failover(#watchdog{status = okay, - parent = Pid}) -> - Pid ! {connection_down, self()}; - -failover(_) -> - ok. - -%% close/1 - -close(#watchdog{status = down}) -> - ok; - -close(#watchdog{parent = Pid}) -> - {{T, _}, _, _} = getr(restart), - T == accept andalso (Pid ! {close, self()}). - -%% send_watchdog/1 - -send_watchdog(#watchdog{pending = false, - transport = TPid} - = S) -> - TPid ! {send, encode(getr(dwr))}, - ?LOG(send, 'DWR'), - S#watchdog{pending = true}. - -%% recv/3 - -recv(Name, Pkt, S) -> - try rcv(Name, S) of - #watchdog{} = NS -> - rcv(Name, Pkt, S), - NS - catch - throw: {?MODULE, throwaway, #watchdog{} = NS} -> - NS - end. - -%% rcv/3 - -rcv(N, _, _) - when N == 'CER'; - N == 'CEA'; - N == 'DWR'; - N == 'DWA'; - N == 'DPR'; - N == 'DPA' -> - false; - -rcv(_, Pkt, #watchdog{transport = TPid, - message_data = T}) -> - diameter_service:receive_message(TPid, Pkt, T). - -throwaway(S) -> - throw({?MODULE, throwaway, S}). - -%% rcv/2 - -%% INITIAL Receive DWA Pending = FALSE -%% Throwaway() INITIAL -%% INITIAL Receive non-DWA Throwaway() INITIAL - -rcv('DWA', #watchdog{status = initial} = S) -> - throwaway(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = initial} = S) -> - throwaway(S); - -%% DOWN Receive DWA Pending = FALSE -%% Throwaway() DOWN -%% DOWN Receive non-DWA Throwaway() DOWN - -rcv('DWA', #watchdog{status = down} = S) -> - throwaway(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = down} = S) -> - throwaway(S); - -%% OKAY Receive DWA Pending = FALSE -%% SetWatchdog() OKAY -%% OKAY Receive non-DWA SetWatchdog() OKAY - -rcv('DWA', #watchdog{status = okay} = S) -> - set_watchdog(S#watchdog{pending = false}); - -rcv(_, #watchdog{status = okay} = S) -> - set_watchdog(S); - -%% SUSPECT Receive DWA Pending = FALSE -%% Failback() -%% SetWatchdog() OKAY -%% SUSPECT Receive non-DWA Failback() -%% SetWatchdog() OKAY - -rcv('DWA', #watchdog{status = suspect} = S) -> - failback(S), - set_watchdog(S#watchdog{status = okay, - pending = false}); - -rcv(_, #watchdog{status = suspect} = S) -> - failback(S), - set_watchdog(S#watchdog{status = okay}); - -%% REOPEN Receive DWA & Pending = FALSE -%% NumDWA == 2 NumDWA++ -%% Failback() OKAY - -rcv('DWA', #watchdog{status = reopen, - num_dwa = 2 = N, - parent = Pid} - = S) -> - open(Pid, eraser(open)), - S#watchdog{status = okay, - num_dwa = N+1, - pending = false}; - -%% REOPEN Receive DWA & Pending = FALSE -%% NumDWA < 2 NumDWA++ REOPEN - -rcv('DWA', #watchdog{status = reopen, - num_dwa = N} - = S) -> - S#watchdog{num_dwa = N+1, - pending = false}; - -%% REOPEN Receive non-DWA Throwaway() REOPEN - -rcv(_, #watchdog{status = reopen} = S) -> - throwaway(S). - -%% failback/1 - -failback(#watchdog{parent = Pid}) -> - Pid ! {connection_up, self()}. - -%% timeout/1 -%% -%% The caller sets the watchdog on the return value. - -%% OKAY Timer expires & SendWatchdog() -%% !Pending SetWatchdog() -%% Pending = TRUE OKAY -%% REOPEN Timer expires & SendWatchdog() -%% !Pending SetWatchdog() -%% Pending = TRUE REOPEN - -timeout(#watchdog{status = T, - pending = false} - = S) - when T == okay; - T == reopen -> - send_watchdog(S); - -%% OKAY Timer expires & Failover() -%% Pending SetWatchdog() SUSPECT - -timeout(#watchdog{status = okay, - pending = true} - = S) -> - failover(S), - S#watchdog{status = suspect}; - -%% SUSPECT Timer expires CloseConnection() -%% SetWatchdog() DOWN -%% REOPEN Timer expires & CloseConnection() -%% Pending & SetWatchdog() -%% NumDWA < 0 DOWN - -timeout(#watchdog{status = T, - pending = P, - num_dwa = N, - transport = TPid} - = S) - when T == suspect; - T == reopen, P, N < 0 -> - exit(TPid, shutdown), - close(S), - S#watchdog{status = down}; - -%% REOPEN Timer expires & NumDWA = -1 -%% Pending & SetWatchdog() -%% NumDWA >= 0 REOPEN - -timeout(#watchdog{status = reopen, - pending = true, - num_dwa = N} - = S) - when 0 =< N -> - S#watchdog{num_dwa = -1}; - -%% DOWN Timer expires AttemptOpen() -%% SetWatchdog() DOWN -%% INITIAL Timer expires AttemptOpen() -%% SetWatchdog() INITIAL - -%% RFC 3539, 3.4.1: -%% -%% [5] While the connection is in the closed state, the AAA client MUST -%% NOT attempt to send further watchdog messages on the connection. -%% However, after the connection is closed, the AAA client continues -%% to periodically attempt to reopen the connection. -%% -%% The AAA client SHOULD wait for the transport layer to report -%% connection failure before attempting again, but MAY choose to -%% bound this wait time by the watchdog interval, Tw. - -%% Don't bound, restarting the peer process only when the previous -%% process has died. We only need to handle state down since we start -%% the first watchdog when transitioning out of initial. - -timeout(#watchdog{status = down} = S) -> - restart(S). - -%% restart/1 - -restart(#watchdog{transport = undefined} = S) -> - restart(getr(restart), S); -restart(S) -> - S. - -%% Only restart the transport in the connecting case. For an accepting -%% transport, we've registered the peer connection when leaving state -%% initial and this is used by a new accepting process to realize that -%% it's actually in state down rather then initial when receiving -%% notification of an open connection. - -restart({{connect, _} = T, Opts, Svc}, #watchdog{parent = Pid} = S) -> - Pid ! {reconnect, self()}, - S#watchdog{transport = monitor(diameter_peer_fsm:start(T, Opts, Svc))}; -restart({{accept, _}, _, _}, S) -> - S. -%% Don't currently use Opts/Svc in the accept case but having them in -%% the process dictionary is helpful if the process dies unexpectedly. - -%% dwr/1 - -dwr(#diameter_caps{origin_host = OH, - origin_realm = OR, - origin_state_id = OSI}) -> - ['DWR', {'Origin-Host', OH}, - {'Origin-Realm', OR}, - {'Origin-State-Id', OSI}]. diff --git a/lib/diameter/src/app/diameter_watchdog_sup.erl b/lib/diameter/src/app/diameter_watchdog_sup.erl deleted file mode 100644 index fc837fe4ef..0000000000 --- a/lib/diameter/src/app/diameter_watchdog_sup.erl +++ /dev/null @@ -1,60 +0,0 @@ -%% -%% %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% -%% - -%% -%% Supervisor for all watchdog processes. -%% - --module(diameter_watchdog_sup). - --behaviour(supervisor). - -%% interface --export([start_link/0, %% supervisor start - start_child/1]). %% watchdog start - --export([init/1]). - --define(NAME, ?MODULE). %% supervisor name - -%% start_link/0 - -start_link() -> - SupName = {local, ?NAME}, - supervisor:start_link(SupName, ?MODULE, []). - -%% start_child/1 -%% -%% Start a watchdog process. - -start_child(T) -> - supervisor:start_child(?NAME, [T]). - -%% init/1 - -init([]) -> - Mod = diameter_watchdog, - Flags = {simple_one_for_one, 0, 1}, - ChildSpec = {Mod, - {Mod, start_link, []}, - temporary, - 1000, - worker, - [Mod]}, - {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/app/modules.mk b/lib/diameter/src/app/modules.mk deleted file mode 100644 index 2b602cd713..0000000000 --- a/lib/diameter/src/app/modules.mk +++ /dev/null @@ -1,69 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -DICTIONARIES = \ - base_rfc3588 \ - base_accounting \ - relay - -RUNTIME_MODULES = \ - diameter \ - diameter_app \ - diameter_capx \ - diameter_config \ - diameter_codec \ - diameter_dict \ - diameter_lib \ - diameter_misc_sup \ - diameter_peer \ - diameter_peer_fsm \ - diameter_peer_fsm_sup \ - diameter_reg \ - diameter_service \ - diameter_service_sup \ - diameter_session \ - diameter_stats \ - diameter_sup \ - diameter_sync \ - diameter_types \ - diameter_watchdog \ - diameter_watchdog_sup - -HELP_MODULES = \ - diameter_callback \ - diameter_dbg \ - diameter_info - -INTERNAL_HRL_FILES = \ - diameter_internal.hrl \ - diameter_types.hrl - -EXTERNAL_HRL_FILES = \ - ../../include/diameter.hrl \ - ../../include/diameter_gen.hrl - -EXAMPLE_FILES = \ - ../../examples/GNUmakefile \ - ../../examples/peer.erl \ - ../../examples/client.erl \ - ../../examples/client_cb.erl \ - ../../examples/server.erl \ - ../../examples/server_cb.erl \ - ../../examples/relay.erl \ - ../../examples/relay_cb.erl diff --git a/lib/diameter/src/base/diameter.app.src b/lib/diameter/src/base/diameter.app.src new file mode 100644 index 0000000000..c092fdb022 --- /dev/null +++ b/lib/diameter/src/base/diameter.app.src @@ -0,0 +1,28 @@ +%% +%% %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% +%% + +{application, diameter, + [{description, "Diameter protocol"}, + {vsn, "%VSN%"}, + {modules, [%MODULES%]}, + {registered, []}, + {applications, [stdlib, kernel]}, + {env, []}, + {mod, {diameter_app, []}} + ]}. diff --git a/lib/diameter/src/base/diameter.appup.src b/lib/diameter/src/base/diameter.appup.src new file mode 100644 index 0000000000..6d8ceadb92 --- /dev/null +++ b/lib/diameter/src/base/diameter.appup.src @@ -0,0 +1,47 @@ +%% This is an -*- erlang -*- file. +%% +%% %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% +%% + +{"%VSN%", + [ + {"0.9", + [ + {load_module, diameter, soft_purge, soft_purge, []}, + {load_module, diameter_capx, soft_purge, soft_purge, []}, + {load_module, diameter_codec, soft_purge, soft_purge, [diameter_lib]}, + {load_module, diameter_lib, soft_purge, soft_purge, []}, + {load_module, diameter_types, soft_purge, soft_purge, []}, + {load_module, diameter_gen_base_accounting, soft_purge, soft_purge, []}, + {load_module, diameter_gen_base_rfc3588, soft_purge, soft_purge, []}, + {load_module, diameter_gen_relay, soft_purge, soft_purge, []}, + {update, diameter_service, soft, soft_purge, soft_purge, [diameter_lib]}, + {update, diameter_config, soft, soft_purge, soft_purge, []}, + {update, diameter_peer, soft, soft_purge, soft_purge, []}, + {update, diameter_peer_fsm, soft, soft_purge, soft_purge, [diameter_lib]}, + {update, diameter_reg, soft, soft_purge, soft_purge, []}, + {update, diameter_sctp, soft, soft_purge, soft_purge, []}, + {update, diameter_stats, soft, soft_purge, soft_purge, []}, + {update, diameter_sync, soft, soft_purge, soft_purge, []}, + {update, diameter_watchdog, soft, soft_purge, soft_purge, [diameter_lib]} + ] + } + ], + [ + ] +}. diff --git a/lib/diameter/src/base/diameter.erl b/lib/diameter/src/base/diameter.erl new file mode 100644 index 0000000000..2f721421d8 --- /dev/null +++ b/lib/diameter/src/base/diameter.erl @@ -0,0 +1,190 @@ +%% +%% %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% +%% + +-module(diameter). + +%% Configuration. +-export([start_service/2, + stop_service/1, + add_transport/2, + remove_transport/2, + subscribe/1, + unsubscribe/1]). + +%% Traffic. +-export([session_id/1, + origin_state_id/0, + call/3, + call/4]). + +%% Information. +-export([services/0, + service_info/2]). + +%% Start/stop the application. In a "real" application this should +%% typically be a consequence of specifying diameter in a release file +%% rather than by calling start/stop explicitly. +-export([start/0, + stop/0]). + +-include("diameter_internal.hrl"). +-include("diameter_types.hrl"). + +%%% -------------------------------------------------------------------------- +%%% start/0 +%%% -------------------------------------------------------------------------- + +-spec start() + -> ok + | {error, term()}. + +start() -> + application:start(?APPLICATION). + +%%% -------------------------------------------------------------------------- +%%% stop/0 +%%% -------------------------------------------------------------------------- + +-spec stop() + -> ok + | {error, term()}. + +stop() -> + application:stop(?APPLICATION). + +%%% -------------------------------------------------------------------------- +%%% start_service/2 +%%% -------------------------------------------------------------------------- + +-spec start_service(service_name(), [service_opt()]) + -> ok + | {error, term()}. + +start_service(SvcName, Opts) + when is_list(Opts) -> + diameter_config:start_service(SvcName, Opts). + +%%% -------------------------------------------------------------------------- +%%% stop_service/1 +%%% -------------------------------------------------------------------------- + +-spec stop_service(service_name()) + -> ok + | {error, term()}. + +stop_service(SvcName) -> + diameter_config:stop_service(SvcName). + +%%% -------------------------------------------------------------------------- +%%% services/0 +%%% -------------------------------------------------------------------------- + +-spec services() + -> [service_name()]. + +services() -> + [Name || {Name, _} <- diameter_service:services()]. + +%%% -------------------------------------------------------------------------- +%%% service_info/2 +%%% -------------------------------------------------------------------------- + +-spec service_info(service_name(), atom() | [atom()]) + -> any(). + +service_info(SvcName, Option) -> + diameter_service:info(SvcName, Option). + +%%% -------------------------------------------------------------------------- +%%% add_transport/3 +%%% -------------------------------------------------------------------------- + +-spec add_transport(service_name(), {listen|connect, [transport_opt()]}) + -> {ok, transport_ref()} + | {error, term()}. + +add_transport(SvcName, {T, Opts} = Cfg) + when is_list(Opts), (T == connect orelse T == listen) -> + diameter_config:add_transport(SvcName, Cfg). + +%%% -------------------------------------------------------------------------- +%%% remove_transport/2 +%%% -------------------------------------------------------------------------- + +-spec remove_transport(service_name(), transport_pred()) + -> ok | {error, term()}. + +remove_transport(SvcName, Pred) -> + diameter_config:remove_transport(SvcName, Pred). + +%%% -------------------------------------------------------------------------- +%%% # subscribe(SvcName) +%%% +%%% Description: Subscribe to #diameter_event{} messages for the specified +%%% service. +%%% -------------------------------------------------------------------------- + +-spec subscribe(service_name()) + -> true. + +subscribe(SvcName) -> + diameter_service:subscribe(SvcName). + +%%% -------------------------------------------------------------------------- +%%% # unsubscribe(SvcName) +%%% -------------------------------------------------------------------------- + +-spec unsubscribe(service_name()) + -> true. + +unsubscribe(SvcName) -> + diameter_service:unsubscribe(SvcName). + +%%% ---------------------------------------------------------- +%%% # session_id/1 +%%% ---------------------------------------------------------- + +-spec session_id('DiameterIdentity'()) + -> 'OctetString'(). + +session_id(Ident) -> + diameter_session:session_id(Ident). + +%%% ---------------------------------------------------------- +%%% # origin_state_id/0 +%%% ---------------------------------------------------------- + +-spec origin_state_id() + -> 'Unsigned32'(). + +origin_state_id() -> + diameter_session:origin_state_id(). + +%%% -------------------------------------------------------------------------- +%%% # call/[34] +%%% -------------------------------------------------------------------------- + +-spec call(service_name(), app_alias(), any(), [call_opt()]) + -> any(). + +call(SvcName, App, Message, Options) -> + diameter_service:call(SvcName, {alias, App}, Message, Options). + +call(SvcName, App, Message) -> + call(SvcName, App, Message, []). diff --git a/lib/diameter/src/base/diameter_app.erl b/lib/diameter/src/base/diameter_app.erl new file mode 100644 index 0000000000..600f7ff04d --- /dev/null +++ b/lib/diameter/src/base/diameter_app.erl @@ -0,0 +1,36 @@ +%% +%% %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% +%% + +-module(diameter_app). + +-behaviour(application). + +%% application callbacks +-export([start/2, + stop/1]). + +%% start/2 + +start(_Type, _Args) -> + diameter_sup:start_link(). + +%% stop/1 + +stop(_) -> + ok. diff --git a/lib/diameter/src/base/diameter_callback.erl b/lib/diameter/src/base/diameter_callback.erl new file mode 100644 index 0000000000..6d5c8cdca1 --- /dev/null +++ b/lib/diameter/src/base/diameter_callback.erl @@ -0,0 +1,91 @@ +%% +%% %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% +%% + +%% +%% A minimal application callback module. +%% + +-module(diameter_callback). + +-export([peer_up/3, + peer_down/3, + pick_peer/4, + prepare_request/3, + prepare_retransmit/3, + handle_request/3, + handle_answer/4, + handle_error/4]). + +-include_lib("diameter/include/diameter.hrl"). + +%%% ---------------------------------------------------------- +%%% # peer_up/3 +%%% ---------------------------------------------------------- + +peer_up(_Svc, _Peer, State) -> + State. + +%%% ---------------------------------------------------------- +%%% # peer_down/3 +%%% ---------------------------------------------------------- + +peer_down(_SvcName, _Peer, State) -> + State. + +%%% ---------------------------------------------------------- +%%% # pick_peer/4 +%%% ---------------------------------------------------------- + +pick_peer([Peer|_], _, _SvcName, _State) -> + {ok, Peer}. + +%%% ---------------------------------------------------------- +%%% # prepare_request/3 +%%% ---------------------------------------------------------- + +prepare_request(Pkt, _SvcName, _Peer) -> + {send, Pkt}. + +%%% ---------------------------------------------------------- +%%% # prepare_retransmit/3 +%%% ---------------------------------------------------------- + +prepare_retransmit(Pkt, _SvcName, _Peer) -> + {send, Pkt}. + +%%% ---------------------------------------------------------- +%%% # handle_request/3 +%%% ---------------------------------------------------------- + +handle_request(_Pkt, _SvcName, _Peer) -> + {protocol_error, 3001}. %% DIAMETER_COMMAND_UNSUPPORTED + +%%% ---------------------------------------------------------- +%%% # handle_answer/4 +%%% ---------------------------------------------------------- + +handle_answer(#diameter_packet{msg = Ans}, _Req, _SvcName, _Peer) -> + Ans. + +%%% --------------------------------------------------------------------------- +%%% # handle_error/4 +%%% --------------------------------------------------------------------------- + +handle_error(Reason, _Req, _SvcName, _Peer) -> + {error, Reason}. diff --git a/lib/diameter/src/base/diameter_capx.erl b/lib/diameter/src/base/diameter_capx.erl new file mode 100644 index 0000000000..138e76411e --- /dev/null +++ b/lib/diameter/src/base/diameter_capx.erl @@ -0,0 +1,405 @@ +%% +%% %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% +%% + +%% +%% This module builds CER and CEA records for use during capabilities +%% exchange. All of a CER/CEA is built from AVP values configured on +%% the service in question but values for Supported-Vendor-Id, +%% Vendor-Specific-Application-Id, Auth-Application-Id and +%% Acct-Application-id are also obtained using an older method that +%% remains only for backwards compatibility. With this method, each +%% dictionary module was required to export a cer/0 that returned a +%% diameter_base_CER record (or corresponding list, although the list +%% is also a later addition). Each returned CER contributes its member +%% values for the aforementioned four AVPs to the resulting CER, with +%% remaining AVP's either unspecified or identical to those configured +%% on the service. Auth-Application-Id and Acct-Application-id were +%% originally treated a little differently, each callback being +%% required to return either no value of the same value as the other +%% callbacks, but this coupled the callback modules unnecessarily. (A +%% union is backwards compatible to boot.) +%% +%% Values obtained from the service and callbacks are all included +%% when building a CER. Older code with only callback can continue to +%% use them, newer code should probably stick to service configuration +%% (since this is more explicit) or mix at their own peril. +%% +%% The cer/0 callback is now undocumented (despite never being fully +%% documented to begin with) and should be considered deprecated even +%% by those poor souls still using it. +%% + +-module(diameter_capx). + +-export([build_CER/1, + recv_CER/2, + recv_CEA/2, + make_caps/2]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). +-include("diameter_types.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). + +-define(SUCCESS, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_SUCCESS'). +-define(NOAPP, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_APPLICATION'). +-define(NOSECURITY, ?'DIAMETER_BASE_RESULT-CODE_DIAMETER_NO_COMMON_SECURITY'). + +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + +%% =========================================================================== + +-type tried(T) :: {ok, T} | {error, {term(), list()}}. + +-spec build_CER(#diameter_caps{}) + -> tried(#diameter_base_CER{}). + +build_CER(Caps) -> + try_it([fun bCER/1, Caps]). + +-spec recv_CER(#diameter_base_CER{}, #diameter_service{}) + -> tried({['Unsigned32'()], #diameter_caps{}, #diameter_base_CEA{}}). + +recv_CER(CER, Svc) -> + try_it([fun rCER/2, CER, Svc]). + +-spec recv_CEA(#diameter_base_CEA{}, #diameter_service{}) + -> tried({['Unsigned32'()], ['Unsigned32'()], #diameter_caps{}}). + +recv_CEA(CEA, Svc) -> + try_it([fun rCEA/2, CEA, Svc]). + +make_caps(Caps, Opts) -> + try_it([fun mk_caps/2, Caps, Opts]). + +%% =========================================================================== +%% =========================================================================== + +try_it([Fun | Args]) -> + try apply(Fun, Args) of + T -> {ok, T} + catch + throw: ?FAILURE(Reason) -> {error, {Reason, Args}} + end. + +%% mk_caps/2 + +mk_caps(Caps0, Opts) -> + {Caps, _} = lists:foldl(fun set_cap/2, + {Caps0, #diameter_caps{_ = false}}, + Opts), + Caps. + +-define(SC(K,F), + set_cap({K, Val}, {Caps, #diameter_caps{F = false} = C}) -> + {Caps#diameter_caps{F = cap(K, Val)}, C#diameter_caps{F = true}}). + +?SC('Origin-Host', origin_host); +?SC('Origin-Realm', origin_realm); +?SC('Host-IP-Address', host_ip_address); +?SC('Vendor-Id', vendor_id); +?SC('Product-Name', product_name); +?SC('Origin-State-Id', origin_state_id); +?SC('Supported-Vendor-Id', supported_vendor_id); +?SC('Auth-Application-Id', auth_application_id); +?SC('Inband-Security-Id', inband_security_id); +?SC('Acct-Application-Id', acct_application_id); +?SC('Vendor-Specific-Application-Id', vendor_specific_application_id); +?SC('Firmware-Revision', firmware_revision); + +set_cap({Key, _}, _) -> + ?THROW({duplicate, Key}). + +cap(K, V) + when K == 'Origin-Host'; + K == 'Origin-Realm'; + K == 'Vendor-Id'; + K == 'Product-Name' -> + V; + +cap('Host-IP-Address', Vs) + when is_list(Vs) -> + lists:map(fun ipaddr/1, Vs); + +cap('Firmware-Revision', V) -> + [V]; + +cap(_, Vs) + when is_list(Vs) -> + Vs; + +cap(K, V) -> + ?THROW({invalid, K, V}). + +ipaddr(A) -> + try + diameter_lib:ipaddr(A) + catch + error: {invalid_address, _} = T -> + ?THROW(T) + end. + +%% bCER/1 +%% +%% Build a CER record to send to a remote peer. + +%% Use the fact that diameter_caps has the same field names as CER. +bCER(#diameter_caps{} = Rec) -> + #diameter_base_CER{} + = list_to_tuple([diameter_base_CER | tl(tuple_to_list(Rec))]). + +%% rCER/2 +%% +%% Build a CEA record to send to a remote peer in response to an +%% incoming CER. RFC 3588 gives no guidance on what should be sent +%% here: should we advertise applications that the peer hasn't sent in +%% its CER (aside from the relay application) or not? If we send +%% applications that the peer hasn't advertised then the peer may have +%% to be aware of the possibility. If we don't then we just look like +%% a server that supports a subset (possibly) of what the client +%% advertised, so this feels like the path of least incompatibility. +%% However, the current draft standard (draft-ietf-dime-rfc3588bis-26, +%% expires 24 July 2011) says this in section 5.3, Capabilities +%% Exchange: +%% +%% The receiver of the Capabilities-Exchange-Request (CER) MUST +%% determine common applications by computing the intersection of its +%% own set of supported Application Id against all of the application +%% identifier AVPs (Auth-Application-Id, Acct-Application-Id and Vendor- +%% Specific-Application-Id) present in the CER. The value of the +%% Vendor-Id AVP in the Vendor-Specific-Application-Id MUST NOT be used +%% during computation. The sender of the Capabilities-Exchange-Answer +%% (CEA) SHOULD include all of its supported applications as a hint to +%% the receiver regarding all of its application capabilities. +%% +%% Both RFC and the draft also say this: +%% +%% The receiver only issues commands to its peers that have advertised +%% support for the Diameter application that defines the command. A +%% Diameter node MUST cache the supported applications in order to +%% ensure that unrecognized commands and/or AVPs are not unnecessarily +%% sent to a peer. +%% +%% That is, each side sends all of its capabilities and is responsible for +%% not sending commands that the peer doesn't support. + +%% 6.10. Inband-Security-Id AVP +%% +%% NO_INBAND_SECURITY 0 +%% This peer does not support TLS. This is the default value, if the +%% AVP is omitted. +%% +%% TLS 1 +%% This node supports TLS security, as defined by [TLS]. + +rCER(CER, #diameter_service{capabilities = LCaps} = Svc) -> + #diameter_base_CEA{} + = CEA + = cea_from_cer(bCER(LCaps)), + + RCaps = capx_to_caps(CER), + SApps = common_applications(LCaps, RCaps, Svc), + + {SApps, + RCaps, + build_CEA(SApps, + LCaps, + RCaps, + CEA#diameter_base_CEA{'Result-Code' = ?SUCCESS})}. + +%% TODO: 5.3 of RFC 3588 says we MUST return DIAMETER_NO_COMMON_APPLICATION +%% in the CEA and SHOULD disconnect the transport. However, we have +%% no way to guarantee the send before disconnecting. + +build_CEA([], _, _, CEA) -> + CEA#diameter_base_CEA{'Result-Code' = ?NOAPP}; + +build_CEA(_, LCaps, RCaps, CEA) -> + case common_security(LCaps, RCaps) of + [] -> + CEA#diameter_base_CEA{'Result-Code' = ?NOSECURITY}; + [_] = IS -> + CEA#diameter_base_CEA{'Inband-Security-Id' = IS} + end. + +%% common_security/2 + +common_security(#diameter_caps{inband_security_id = LS}, + #diameter_caps{inband_security_id = RS}) -> + cs(LS, RS). + +%% Unspecified is equivalent to NO_INBAND_SECURITY. +cs([], RS) -> + cs([?NO_INBAND_SECURITY], RS); +cs(LS, []) -> + cs(LS, [?NO_INBAND_SECURITY]); + +%% Agree on TLS if both parties support it. When sending CEA, this is +%% to ensure the peer is clear that we will be expecting a TLS +%% handshake since there is no ssl:maybe_accept that would allow the +%% peer to choose between TLS or not upon reception of our CEA. When +%% receiving CEA it deals with a server that isn't explicit about its choice. +%% TODO: Make the choice configurable. +cs(LS, RS) -> + Is = ordsets:to_list(ordsets:intersection(ordsets:from_list(LS), + ordsets:from_list(RS))), + case lists:member(?TLS, Is) of + true -> + [?TLS]; + false when [] == Is -> + Is; + false -> + [hd(Is)] %% probably NO_INBAND_SECURITY + end. +%% The only two values defined by RFC 3588 are NO_INBAND_SECURITY and +%% TLS but don't enforce this. In theory this allows some other +%% security mechanism we don't have to know about, although in +%% practice something there may be a need for more synchronization +%% than notification by way of an event subscription offers. + +%% cea_from_cer/1 + +%% CER is a subset of CEA, the latter adding Result-Code and a few +%% more AVP's. +cea_from_cer(#diameter_base_CER{} = CER) -> + lists:foldl(fun(F,A) -> to_cea(CER, F, A) end, + #diameter_base_CEA{}, + record_info(fields, diameter_base_CER)). + +to_cea(CER, Field, CEA) -> + try ?BASE:'#get-'(Field, CER) of + V -> ?BASE:'#set-'({Field, V}, CEA) + catch + error: _ -> CEA + end. + +%% rCEA/2 + +rCEA(#diameter_base_CEA{'Result-Code' = RC} + = CEA, + #diameter_service{capabilities = LCaps} + = Svc) -> + RC == ?SUCCESS orelse ?THROW({'Result-Code', RC}), + + RCaps = capx_to_caps(CEA), + SApps = common_applications(LCaps, RCaps, Svc), + + [] == SApps andalso ?THROW(no_common_applications), + + IS = common_security(LCaps, RCaps), + + [] == IS andalso ?THROW(no_common_security), + + {SApps, IS, RCaps}; + +rCEA(CEA, _Svc) -> + ?THROW({invalid, CEA}). + +%% capx_to_caps/1 + +capx_to_caps(#diameter_base_CEA{'Origin-Host' = OH, + 'Origin-Realm' = OR, + 'Host-IP-Address' = IP, + 'Vendor-Id' = VId, + 'Product-Name' = PN, + 'Origin-State-Id' = OSI, + 'Supported-Vendor-Id' = SV, + 'Auth-Application-Id' = Auth, + 'Inband-Security-Id' = IS, + 'Acct-Application-Id' = Acct, + 'Vendor-Specific-Application-Id' = VSA, + 'Firmware-Revision' = FR, + 'AVP' = X}) -> + #diameter_caps{origin_host = OH, + origin_realm = OR, + vendor_id = VId, + product_name = PN, + origin_state_id = OSI, + host_ip_address = IP, + supported_vendor_id = SV, + auth_application_id = Auth, + inband_security_id = IS, + acct_application_id = Acct, + vendor_specific_application_id = VSA, + firmware_revision = FR, + avp = X}; + +capx_to_caps(#diameter_base_CER{} = CER) -> + capx_to_caps(cea_from_cer(CER)). + +%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- + +%% common_applications/3 +%% +%% Identify the (local) applications to be supported on the connection +%% in question. + +common_applications(LCaps, RCaps, #diameter_service{applications = Apps}) -> + LA = app_union(LCaps), + RA = app_union(RCaps), + + lists:foldl(fun(I,A) -> ca(I, Apps, RA, A) end, [], LA). + +ca(Id, Apps, RA, Acc) -> + Relay = lists:member(?APP_ID_RELAY, RA), + #diameter_app{alias = Alias} = find_app(Id, Apps), + tcons(Relay %% peer is a relay + orelse ?APP_ID_RELAY == Id %% we're a relay + orelse lists:member(Id, RA), %% app is supported by the peer + Id, + Alias, + Acc). +%% 5.3 of the RFC states that a peer advertising itself as a relay must +%% be interpreted as having common applications. + +%% Extract the list of all application identifiers from Auth-Application-Id, +%% Acct-Application-Id and Vendor-Specific-Application-Id. +app_union(#diameter_caps{auth_application_id = U, + acct_application_id = C, + vendor_specific_application_id = V}) -> + set_list(U ++ C ++ lists:flatmap(fun vsa_apps/1, V)). + +vsa_apps(#'diameter_base_Vendor-Specific-Application-Id' + {'Auth-Application-Id' = U, + 'Acct-Application-Id' = C}) -> + U ++ C; +vsa_apps(L) -> + Rec = ?BASE:'#new-'('diameter_base_Vendor-Specific-Application-Id', L), + vsa_apps(Rec). + +%% It's a configuration error for a locally advertised application not +%% to be represented in Apps. Don't just match on lists:keyfind/3 in +%% order to generate a more helpful error. +find_app(Id, Apps) -> + case lists:keyfind(Id, #diameter_app.id, Apps) of + #diameter_app{} = A -> + A; + false -> + ?THROW({app_not_configured, Id}) + end. + +set_list(L) -> + sets:to_list(sets:from_list(L)). + +tcons(true, K, V, Acc) -> + [{K,V} | Acc]; +tcons(false, _, _, Acc) -> + Acc. diff --git a/lib/diameter/src/base/diameter_codec.erl b/lib/diameter/src/base/diameter_codec.erl new file mode 100644 index 0000000000..d88f42fb7c --- /dev/null +++ b/lib/diameter/src/base/diameter_codec.erl @@ -0,0 +1,561 @@ +%% +%% %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% +%% + +-module(diameter_codec). + +-export([encode/2, + decode/2, + decode/3, + collect_avps/1, + decode_header/1, + sequence_numbers/1, + hop_by_hop_id/2, + msg_name/1, + msg_id/1]). + +%% Towards generated encoders (from diameter_gen.hrl). +-export([pack_avp/1, + pack_avp/2]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +-define(MASK(N,I), ((I) band (1 bsl (N)))). + +%% 0 1 2 3 +%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Version | Message Length | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | command flags | Command-Code | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Application-ID | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Hop-by-Hop Identifier | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | End-to-End Identifier | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | AVPs ... +%% +-+-+-+-+-+-+-+-+-+-+-+-+- + +%%% --------------------------------------------------------------------------- +%%% # encode/[2-4] +%%% --------------------------------------------------------------------------- + +encode(Mod, #diameter_packet{} = Pkt) -> + try + e(Mod, Pkt) + catch + error: Reason -> + %% Be verbose rather than letting the emulator truncate the + %% error report. + X = {Reason, ?STACK}, + diameter_lib:error_report(X, {?MODULE, encode, [Mod, Pkt]}), + exit(X) + end; + +encode(Mod, Msg) -> + Seq = diameter_session:sequence(), + Hdr = #diameter_header{version = ?DIAMETER_VERSION, + end_to_end_id = Seq, + hop_by_hop_id = Seq}, + encode(Mod, #diameter_packet{header = Hdr, + msg = Msg}). + +e(_, #diameter_packet{msg = [#diameter_header{} = Hdr | As]} = Pkt) -> + Avps = encode_avps(As), + Length = size(Avps) + 20, + + #diameter_header{version = Vsn, + cmd_code = Code, + application_id = Aid, + hop_by_hop_id = Hid, + end_to_end_id = Eid} + = Hdr, + + Flags = make_flags(0, Hdr), + + Pkt#diameter_packet{bin = <>}; + +e(Mod0, #diameter_packet{header = Hdr, msg = Msg} = Pkt) -> + #diameter_header{version = Vsn, + hop_by_hop_id = Hid, + end_to_end_id = Eid} + = Hdr, + + {Mod, MsgName} = rec2msg(Mod0, Msg), + {Code, Flags0, Aid} = msg_header(Mod, MsgName, Hdr), + Flags = make_flags(Flags0, Hdr), + + Avps = encode_avps(Mod, MsgName, values(Msg)), + Length = size(Avps) + 20, + + Pkt#diameter_packet{header = Hdr#diameter_header + {length = Length, + cmd_code = Code, + application_id = Aid, + is_request = 0 /= ?MASK(7, Flags), + is_proxiable = 0 /= ?MASK(6, Flags), + is_error = 0 /= ?MASK(5, Flags), + is_retransmitted = 0 /= ?MASK(4, Flags)}, + bin = <>}. + +%% make_flags/2 + +make_flags(Flags0, #diameter_header{is_request = R, + is_proxiable = P, + is_error = E, + is_retransmitted = T}) -> + {Flags, 3} = lists:foldl(fun(B,{F,N}) -> {mf(B,F,N), N-1} end, + {Flags0, 7}, + [R,P,E,T]), + Flags. + +mf(undefined, F, _) -> + F; +mf(B, F, N) -> %% reset the affected bit + (F bxor (F band (1 bsl N))) bor bit(B, N). + +bit(true, N) -> 1 bsl N; +bit(false, _) -> 0. + +%% values/1 + +values([H|T]) + when is_atom(H) -> + T; +values(Avps) -> + Avps. + +%% encode_avps/3 + +%% Specifying values as a #diameter_avp list bypasses arity and other +%% checks: the values are expected to be already encoded and the AVP's +%% presented are simply sent. This is needed for relay agents, since +%% these have to be able to resend whatever comes. + +%% Message as a list of #diameter_avp{} ... +encode_avps(_, _, [#diameter_avp{} | _] = Avps) -> + encode_avps(reorder(Avps, [], Avps)); + +%% ... or as a tuple list or record. +encode_avps(Mod, MsgName, Values) -> + Mod:encode_avps(MsgName, Values). + +%% reorder/1 + +reorder([#diameter_avp{index = 0} | _] = Avps, Acc, _) -> + Avps ++ Acc; + +reorder([#diameter_avp{index = N} = A | Avps], Acc, _) + when is_integer(N) -> + lists:reverse(Avps, [A | Acc]); + +reorder([H | T], Acc, Avps) -> + reorder(T, [H | Acc], Avps); + +reorder([], Acc, _) -> + Acc. + +%% encode_avps/1 + +encode_avps(Avps) -> + list_to_binary(lists:map(fun pack_avp/1, Avps)). + +%% msg_header/3 + +msg_header(Mod, MsgName, Header) -> + {Code, Flags, ApplId} = h(Mod, MsgName, Header), + {Code, p(Flags, Header), ApplId}. + +%% 6.2 of 3588 requires the same 'P' bit on an answer as on the +%% request. + +p(Flags, #diameter_header{is_request = true, + is_proxiable = P}) -> + Flags band (2#10110000 bor choose(P, 2#01000000, 0)); +p(Flags, _) -> + Flags. + +h(Mod, 'answer-message' = MsgName, Header) -> + ?BASE = Mod, + #diameter_header{cmd_code = Code} = Header, + {_, Flags, ApplId} = ?BASE:msg_header(MsgName), + {Code, Flags, ApplId}; + +h(Mod, MsgName, _) -> + Mod:msg_header(MsgName). + +%% rec2msg/2 + +rec2msg(_, ['answer-message' = M | _]) -> + {?BASE, M}; + +rec2msg(Mod, [MsgName|_]) + when is_atom(MsgName) -> + {Mod, MsgName}; + +rec2msg(Mod, Rec) -> + R = element(1, Rec), + A = 'answer-message', + case ?BASE:msg2rec(A) of + R -> + {?BASE, A}; + _ -> + {Mod, Mod:rec2msg(R)} + end. + +%%% --------------------------------------------------------------------------- +%%% # decode/2 +%%% --------------------------------------------------------------------------- + +%% Unsuccessfully decoded AVPs will be placed in #diameter_packet.errors. + +decode(Mod, Pkt) -> + decode(Mod:id(), Mod, Pkt). + +%% If we're a relay application then just extract the avp's without +%% any decoding of their data since we don't know the application in +%% question. +decode(?APP_ID_RELAY, _, #diameter_packet{} = Pkt) -> + case collect_avps(Pkt) of + {Bs, As} -> + Pkt#diameter_packet{avps = As, + errors = [Bs]}; + As -> + Pkt#diameter_packet{avps = As} + end; + +%% Otherwise decode using the dictionary. +decode(_, Mod, #diameter_packet{header = Hdr} = Pkt) + when is_atom(Mod) -> + #diameter_header{cmd_code = CmdCode, + is_request = IsRequest, + is_error = IsError} + = Hdr, + + {M, MsgName} = if IsError andalso not IsRequest -> + {?BASE, 'answer-message'}; + true -> + {Mod, Mod:msg_name(CmdCode, IsRequest)} + end, + + decode_avps(MsgName, M, Pkt, collect_avps(Pkt)); + +decode(Id, Mod, Bin) + when is_bitstring(Bin) -> + decode(Id, Mod, #diameter_packet{header = decode_header(Bin), bin = Bin}). + +decode_avps(MsgName, Mod, Pkt, {Bs, Avps}) -> %% invalid avp bits ... + ?LOG(invalid, Pkt#diameter_packet.bin), + #diameter_packet{errors = Failed} + = P + = decode_avps(MsgName, Mod, Pkt, Avps), + P#diameter_packet{errors = [Bs | Failed]}; + +decode_avps('', Mod, Pkt, Avps) -> %% unknown message ... + ?LOG(unknown, {Mod, Pkt#diameter_packet.header}), + Pkt#diameter_packet{avps = lists:reverse(Avps), + errors = [3001]}; %% DIAMETER_COMMAND_UNSUPPORTED +%% msg = undefined identifies this case. + +decode_avps(MsgName, Mod, Pkt, Avps) -> %% ... or not + {Rec, As, Failed} = Mod:decode_avps(MsgName, Avps), + ?LOGC([] /= Failed, failed, {Mod, Failed}), + Pkt#diameter_packet{msg = Rec, + errors = Failed, + avps = As}. + +%%% --------------------------------------------------------------------------- +%%% # decode_header/1 +%%% --------------------------------------------------------------------------- + +decode_header(<>) -> + <> + = CmdFlags, + %% 3588 (ch 3) says that reserved bits MUST be set to 0 and ignored + %% by the receiver. + + %% The RFC is quite unclear about the order of the bits in this + %% case. It writes + %% + %% 0 1 2 3 4 5 6 7 + %% +-+-+-+-+-+-+-+-+ + %% |R P E T r r r r| + %% +-+-+-+-+-+-+-+-+ + %% + %% in defining these but the scale refers to the (big endian) + %% transmission order, first to last, not the bit order. That is, + %% R is the high order bit. It's odd that a standard reserves + %% low-order bit rather than high-order ones. + + #diameter_header{version = Version, + length = MsgLength, + cmd_code = CmdCode, + application_id = ApplicationId, + hop_by_hop_id = HopByHopId, + end_to_end_id = EndToEndId, + is_request = 1 == R, + is_proxiable = 1 == P, + is_error = 1 == E, + is_retransmitted = 1 == T}; + +decode_header(_) -> + false. + +%%% --------------------------------------------------------------------------- +%%% # sequence_numbers/1 +%%% --------------------------------------------------------------------------- + +%% The End-To-End identifier must be unique for at least 4 minutes. We +%% maintain a 24-bit wraparound counter, and add an 8-bit persistent +%% wraparound counter. The 8-bit counter is incremented each time the +%% system is restarted. + +sequence_numbers(#diameter_packet{bin = Bin}) + when is_binary(Bin) -> + sequence_numbers(Bin); + +sequence_numbers(#diameter_packet{header = #diameter_header{} = H}) -> + sequence_numbers(H); + +sequence_numbers(#diameter_header{hop_by_hop_id = H, + end_to_end_id = E}) -> + {H,E}; + +sequence_numbers(<<_:12/binary, H:32, E:32, _/binary>>) -> + {H,E}. + +%%% --------------------------------------------------------------------------- +%%% # hop_by_hop_id/2 +%%% --------------------------------------------------------------------------- + +hop_by_hop_id(Id, <>) -> + <>. + +%%% --------------------------------------------------------------------------- +%%% # msg_name/1 +%%% --------------------------------------------------------------------------- + +msg_name(#diameter_header{application_id = ?APP_ID_COMMON, + cmd_code = C, + is_request = R}) -> + ?BASE:msg_name(C,R); + +msg_name(Hdr) -> + msg_id(Hdr). + +%% Note that messages in different applications could have the same +%% name. + +%%% --------------------------------------------------------------------------- +%%% # msg_id/1 +%%% --------------------------------------------------------------------------- + +msg_id(#diameter_packet{msg = [#diameter_header{} = Hdr | _]}) -> + msg_id(Hdr); + +msg_id(#diameter_packet{header = #diameter_header{} = Hdr}) -> + msg_id(Hdr); + +msg_id(#diameter_header{application_id = A, + cmd_code = C, + is_request = R}) -> + {A, C, if R -> 1; true -> 0 end}; + +msg_id(<<_:32, Rbit:1, _:7, CmdCode:24, ApplId:32, _/bitstring>>) -> + {ApplId, CmdCode, Rbit}. + +%%% --------------------------------------------------------------------------- +%%% # collect_avps/1 +%%% --------------------------------------------------------------------------- + +%% Note that the returned list of AVP's is reversed relative to their +%% order in the binary. Note also that grouped avp's aren't unraveled, +%% only those at the top level. + +collect_avps(#diameter_packet{bin = Bin}) -> + <<_:20/binary, Avps/bitstring>> = Bin, + collect_avps(Avps); + +collect_avps(Bin) -> + collect_avps(Bin, 0, []). + +collect_avps(<<>>, _, Acc) -> + Acc; +collect_avps(Bin, N, Acc) -> + try split_avp(Bin) of + {Rest, AVP} -> + collect_avps(Rest, N+1, [AVP#diameter_avp{index = N} | Acc]) + catch + ?FAILURE(_) -> + {Bin, Acc} + end. + +%% 0 1 2 3 +%% 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | AVP Code | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% |V M P r r r r r| AVP Length | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Vendor-ID (opt) | +%% +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ +%% | Data ... +%% +-+-+-+-+-+-+-+-+ + +%% split_avp/1 + +split_avp(Bin) -> + 8 =< size(Bin) orelse ?THROW(truncated_header), + + <> + = Bin, + + DataSize = Length - 8, % size(Code+Flags+Length) = 8 octets + PadSize = (4 - (DataSize rem 4)) rem 4, + + DataSize + PadSize =< size(Rest) + orelse ?THROW(truncated_data), + + <> + = Rest, + <> + = Flags, + + 0 == Vbit orelse 4 =< size(Data) + orelse ?THROW(truncated_vendor_id), + + {Vid, D} = vid(Vbit, Data), + {R, #diameter_avp{code = Code, + vendor_id = Vid, + is_mandatory = 1 == Mbit, + need_encryption = 1 == Pbit, + data = D}}. + +%% The RFC is a little misleading when stating that OctetString is +%% padded to a 32-bit boundary while other types align naturally. All +%% other types are already multiples of 32 bits so there's no need to +%% distinguish between types here. Any invalid lengths will result in +%% decode error in diameter_types. + +vid(1, <>) -> + {Vid, Data}; +vid(0, Data) -> + {undefined, Data}. + +%%% --------------------------------------------------------------------------- +%%% # pack_avp/1 +%%% --------------------------------------------------------------------------- + +%% The normal case here is data as an #diameter_avp{} list or an +%% iolist, which are the cases that generated codec modules use. The +%% other case is as a convenience in the relay case in which the +%% dictionary doesn't know about specific AVP's. + +%% Grouped AVP whose components need packing ... +pack_avp(#diameter_avp{data = [#diameter_avp{} | _] = Avps} = A) -> + pack_avp(A#diameter_avp{data = encode_avps(Avps)}); + +%% ... data as a type/value tuple, possibly with header data, ... +pack_avp(#diameter_avp{data = {Type, Value}} = A) + when is_atom(Type) -> + pack_avp(A#diameter_avp{data = diameter_types:Type(encode, Value)}); +pack_avp(#diameter_avp{data = {{_,_,_} = T, {Type, Value}}}) -> + pack_avp(T, iolist_to_binary(diameter_types:Type(encode, Value))); +pack_avp(#diameter_avp{data = {{_,_,_} = T, Bin}}) + when is_binary(Bin) -> + pack_avp(T, Bin); +pack_avp(#diameter_avp{data = {Dict, Name, Value}} = A) -> + {Code, _Flags, Vid} = Hdr = Dict:avp_header(Name), + {Name, Type} = Dict:avp_name(Code, Vid), + pack_avp(A#diameter_avp{data = {Hdr, {Type, Value}}}); + +%% ... or as an iolist. +pack_avp(#diameter_avp{code = Code, + vendor_id = V, + is_mandatory = M, + need_encryption = P, + data = Data}) -> + Flags = lists:foldl(fun flag_avp/2, 0, [{V /= undefined, 2#10000000}, + {M, 2#01000000}, + {P, 2#00100000}]), + pack_avp({Code, Flags, V}, iolist_to_binary(Data)). + +flag_avp({true, B}, F) -> + F bor B; +flag_avp({false, _}, F) -> + F. + +%%% --------------------------------------------------------------------------- +%%% # pack_avp/2 +%%% --------------------------------------------------------------------------- + +pack_avp({Code, Flags, VendorId}, Bin) + when is_binary(Bin) -> + Sz = size(Bin), + pack_avp(Code, Flags, VendorId, Sz, pad(Sz rem 4, Bin)). + +pad(0, Bin) -> + Bin; +pad(N, Bin) -> + P = 8*(4-N), + <>. +%% Note that padding is not included in the length field as mandated by +%% the RFC. + +%% pack_avp/5 +%% +%% Prepend the vendor id as required. + +pack_avp(Code, Flags, Vid, Sz, Bin) + when 0 == Flags band 2#10000000 -> + undefined = Vid, %% sanity check + pack_avp(Code, Flags, Sz, Bin); + +pack_avp(Code, Flags, Vid, Sz, Bin) -> + pack_avp(Code, Flags, Sz+4, <>). + +%% pack_avp/4 + +pack_avp(Code, Flags, Sz, Bin) -> + Length = Sz + 8, + <>. + +%% =========================================================================== + +choose(true, X, _) -> X; +choose(false, _, X) -> X. diff --git a/lib/diameter/src/base/diameter_config.erl b/lib/diameter/src/base/diameter_config.erl new file mode 100644 index 0000000000..a6b48fe65b --- /dev/null +++ b/lib/diameter/src/base/diameter_config.erl @@ -0,0 +1,676 @@ +%% +%% %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% +%% + +%% +%% This module writes service/transport configuration to the table +%% diameter_config, so that the config will survive service process +%% death, and then turns it into calls towards diameter_service. It +%% also restarts services upon their death. +%% +%% The table diameter_config is only written here while +%% diameter_service reads. This is all somewhat after the fact. Once +%% upon a time the config was only stored in the service process, +%% causing much grief if these processes died (which they did with +%% some regularity) and one was forced to reconfigure. This module was +%% then inserted into the service start in order to keep a more +%% permanent record of the config. That said, service processes are +%% now much more robust than they once were and crashing is a thing of +%% the past. +%% + +-module(diameter_config). +-compile({no_auto_import, [monitor/2]}). + +-behaviour(gen_server). + +-export([start_service/2, + stop_service/1, + add_transport/2, + remove_transport/2, + have_transport/2, + lookup/1]). + +%% child server start +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% diameter_sync requests. +-export([sync/1]). + +%% debug +-export([state/0, + uptime/0]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +%% Server state. +-record(state, {id = now()}). + +%% Registered name of the server. +-define(SERVER, ?MODULE). + +%% Table config is written to. +-define(TABLE, ?MODULE). + +%% Workaround for dialyzer's lack of understanding of match specs. +-type match(T) + :: T | '_' | '$1' | '$2' | '$3' | '$4'. + +%% Configuration records in ?TABLE. + +-record(service, + {name, + rec :: match(#diameter_service{}), + options :: match(list())}). + +-record(transport, + {service, %% name + ref = make_ref() :: match(reference()), + type :: match(connect | listen), + options :: match(list())}). + +%% Monitor entry in ?TABLE. +-record(monitor, {mref = make_ref() :: reference(), + service}). %% name + +%% Time to lay low before restarting a dead service. +-define(RESTART_SLEEP, 2000). + +%% A minimal diameter_caps for checking for valid capabilities values. +-define(EXAMPLE_CAPS, + #diameter_caps{origin_host = "TheHost", + origin_realm = "TheRealm", + host_ip_address = [{127,0,0,1}], + vendor_id = 42, + product_name = "TheProduct"}). + +-define(VALUES(Rec), tl(tuple_to_list(Rec))). + +%%% The return values below assume the server diameter_config is started. +%%% The functions will exit if it isn't. + +%% -------------------------------------------------------------------------- +%% # start_service(SvcName, Opts) +%% +%% Output: ok | {error, Reason} +%% -------------------------------------------------------------------------- + +start_service(SvcName, Opts) + when is_list(Opts) -> + start_rc(sync(SvcName, {start_service, SvcName, Opts})). + +start_rc({ok = T, _Pid}) -> + T; +start_rc({error, _} = No) -> + No; +start_rc(timeout) -> + {error, application_not_started}. + +%% -------------------------------------------------------------------------- +%% # stop_service(SvcName) +%% +%% Output: ok +%% -------------------------------------------------------------------------- + +stop_service(SvcName) -> + sync(SvcName, {stop_service, SvcName}). + +%% -------------------------------------------------------------------------- +%% # add_transport(SvcName, {Type, Opts}) +%% +%% Input: Type = connect | listen +%% +%% Output: {ok, Ref} | {error, Reason} +%% -------------------------------------------------------------------------- + +add_transport(SvcName, {T, Opts}) + when is_list(Opts), (T == connect orelse T == listen) -> + sync(SvcName, {add, SvcName, T, Opts}). + +%% -------------------------------------------------------------------------- +%% # remove_transport(SvcName, Pred) +%% +%% Input: Pred = arity 3 fun on transport ref, connect|listen and Opts, +%% returning true if the transport is to be removed, false if +%% not +%% | arity 2 fun on Ref and Opts only +%% | arity 1 fun on Opts only +%% | Opts matching all transports that have all of the specified +%% options +%% | Ref matching only the transport with this reference. +%% | {M,F,A} applied to Ref, connect|listen and Opts +%% | boolean() +%% +%% Output: ok | {error, Reason} +%% -------------------------------------------------------------------------- + +remove_transport(SvcName, Pred) -> + try + sync(SvcName, {remove, SvcName, pred(Pred)}) + catch + ?FAILURE(Reason) -> + {error, Reason} + end. + +pred(Pred) + when is_function(Pred, 3) -> + Pred; +pred(Pred) + when is_function(Pred, 2) -> + fun(R,_,O) -> Pred(R,O) end; +pred(Pred) + when is_function(Pred, 1) -> + fun(_,_,O) -> Pred(O) end; +pred(Opts) + when is_list(Opts) -> + fun(_,_,O) -> [] == Opts -- O end; +pred(Ref) + when is_reference(Ref) -> + fun(R,_,_) -> R == Ref end; +pred({M,F,A}) + when is_atom(M), is_atom(F), is_list(A) -> + fun(R,T,O) -> apply(M,F,[R,T,O|A]) end; +pred({Type, Pred}) -> %% backwards compatibility + P = pred(Pred), + fun(R,T,O) -> T == Type andalso P(R,T,O) end; +pred(B) + when is_boolean(B) -> + fun(_,_,_) -> B end; +pred(_) -> + ?THROW(pred). + +%% -------------------------------------------------------------------------- +%% # have_transport/2 +%% +%% Output: true | false +%% -------------------------------------------------------------------------- + +have_transport(SvcName, Ref) -> + member([{#transport{service = '$1', + ref = '$2', + _ = '_'}, + [{'andalso', {'=:=', '$1', {const, SvcName}}, + {'=:=', '$2', {const, Ref}}}], + [true]}]). + +%% -------------------------------------------------------------------------- +%% # lookup/1 +%% -------------------------------------------------------------------------- + +lookup(SvcName) -> + select([{#service{name = '$1', rec = '$2', options = '$3'}, + [{'=:=', '$1', {const, SvcName}}], + [{{'$1', '$2', '$3'}}]}, + {#transport{service = '$1', + ref = '$2', + type = '$3', + options = '$4'}, + [{'=:=', '$1', {const, SvcName}}], + [{{'$2', '$3', '$4'}}]}]). + +%% --------------------------------------------------------- +%% EXPORTED INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Module = ?MODULE, + Args = [], + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, Module, Args, Options). + +state() -> + call(state). + +uptime() -> + call(uptime). + +%%% ---------------------------------------------------------- +%%% # init/1 +%%% ---------------------------------------------------------- + +init([]) -> + {ok, #state{}}. + +%%% ---------------------------------------------------------- +%%% # handle_call/2 +%%% ---------------------------------------------------------- + +handle_call(state, _, State) -> + {reply, State, State}; + +handle_call(uptime, _, #state{id = Time} = State) -> + {reply, diameter_lib:now_diff(Time), State}; + +handle_call(Req, From, State) -> + ?UNEXPECTED([Req, From]), + Reply = {error, {bad_request, Req}}, + {reply, Reply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast/2 +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_info/2 +%%% ---------------------------------------------------------- + +%% A service process has died. This is most likely a consequence of +%% stop_service, in which case the restart will find no config for the +%% service and do nothing. The entry keyed on the monitor ref is only +%% removed as a result of the 'DOWN' notification however. +handle_info({'DOWN', MRef, process, _, Reason}, State) -> + [#monitor{service = SvcName} = T] = select([{#monitor{mref = MRef, + _ = '_'}, + [], + ['$_']}]), + queue_restart(Reason, SvcName), + delete_object(T), + {noreply, State}; + +handle_info({monitor, SvcName, Pid}, State) -> + monitor(Pid, SvcName), + {noreply, State}; + +handle_info({restart, SvcName}, State) -> + restart(SvcName), + {noreply, State}; + +handle_info(restart, State) -> + restart(), + {noreply, State}; + +handle_info(Info, State) -> + ?UNEXPECTED([Info]), + {noreply, State}. + +%%-------------------------------------------------------------------- +%% # terminate/2 +%%-------------------------------------------------------------------- + +terminate(_Reason, _State) -> + ok. + +%%% ---------------------------------------------------------- +%%% # code_change/3 +%%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% --------------------------------------------------------- +%% INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +insert(T) -> + ets:insert(?TABLE, T). + +%% ?TABLE is a bag: check only for a service entry. +have_service(SvcName) -> + member([{#service{name = '$1', _ = '_'}, + [{'=:=', '$1', {const, SvcName}}], + [true]}]). + +member(MatchSpec) -> + '$end_of_table' =/= ets:select(?TABLE, MatchSpec, 1). + +delete_object(T) -> + ets:delete_object(?TABLE, T). + +delete(Key) -> + ets:delete(?TABLE, Key). + +select(MatchSpec) -> + ets:select(?TABLE, MatchSpec). + +select_delete(MatchSpec) -> + ets:select_delete(?TABLE, MatchSpec). + +%% sync/2 +%% +%% Interface functions used to be implemented as calls to ?SERVER but +%% now serialize things per service instead since stopping a service +%% can take time if the server doesn't answer DPR. A caller who wants +%% to stop multiple services can then improve performance by spawning +%% processes to stop them concurrently. + +sync(SvcName, T) -> + diameter_sync:call({?MODULE, SvcName}, + {?MODULE, sync, [T]}, + infinity, + infinity). + +%% sync/1 + +sync({restart, SvcName}) -> + have_service(SvcName) andalso start(SvcName); + +sync({start_service, SvcName, Opts}) -> + try + start(have_service(SvcName), SvcName, Opts) + catch + ?FAILURE(Reason) -> {error, Reason} + end; + +sync({stop_service, SvcName}) -> + stop(SvcName); + +sync({add, SvcName, Type, Opts}) -> + try + add(SvcName, Type, Opts) + catch + ?FAILURE(Reason) -> {error, Reason} + end; + +sync({remove, SvcName, Pred}) -> + remove(select([{#transport{service = '$1', _ = '_'}, + [{'=:=', '$1', {const, SvcName}}], + ['$_']}]), + SvcName, + Pred). + +%% start/3 + +start(true, _, _) -> + {error, already_started}; +start(false, SvcName, Opts) -> + insert(make_config(SvcName, Opts)), + start(SvcName). + +%% start/1 + +start(SvcName) -> + RC = diameter_service:start(SvcName), + startmon(SvcName, RC), + RC. + +startmon(SvcName, {ok, Pid}) -> + ?SERVER ! {monitor, SvcName, Pid}; +startmon(_, {error, _}) -> + ok. + +monitor(Pid, SvcName) -> + MRef = erlang:monitor(process, Pid), + insert(#monitor{mref = MRef, service = SvcName}). + +%% queue_restart/2 + +%% Service has gone down on monitor death. Note that all service-related +%% config is deleted. +queue_restart({shutdown, {monitor, _}}, SvcName) -> + delete(SvcName); + +%% Application shutdown: ignore. +queue_restart(shutdown, _) -> + ok; + +%% Or not. +queue_restart(_, SvcName) -> + erlang:send_after(?RESTART_SLEEP, self(), {restart, SvcName}). + +%% restart/1 + +restart(SvcName) -> + sync(SvcName, {restart, SvcName}). + +%% restart/0 +%% +%% Start anything configured as required. Bang 'restart' to the server +%% to kick things into gear manually. (Not that it should be required +%% but it's been useful for test.) + +restart() -> + MatchSpec = [{#service{name = '$1', _ = '_'}, + [], + ['$1']}], + lists:foreach(fun restart/1, select(MatchSpec)). + +%% stop/1 + +stop(SvcName) -> + %% If the call to the service returns error for any reason other + %% than the process not being alive then deleting the config from + %% under it will surely bring it down. + diameter_service:stop(SvcName), + %% Delete only the service entry, not everything keyed on the name, + select_delete([{#service{name = '$1', _ = '_'}, + [{'=:=', '$1', {const, SvcName}}], + [true]}]), + ok. +%% Note that a transport has to be removed for its statistics to be +%% deleted. + +%% add/3 + +add(SvcName, Type, Opts) -> + %% Ensure usable capabilities. diameter_service:merge_service/2 + %% depends on this. + lists:foreach(fun(Os) -> + is_list(Os) orelse ?THROW({capabilities, Os}), + ok = encode_CER(Os) + end, + [Os || {capabilities, Os} <- Opts, is_list(Os)]), + + Ref = make_ref(), + T = {Ref, Type, Opts}, + %% The call to the service returns error if the service isn't + %% started yet, which is harmless. The transport will be started + %% when the service is in that case. + case start_transport(SvcName, T) of + ok -> + insert(#transport{service = SvcName, + ref = Ref, + type = Type, + options = Opts}), + {ok, Ref}; + {error, _} = No -> + No + end. + +start_transport(SvcName, T) -> + case diameter_service:start_transport(SvcName, T) of + {ok, _Pid} -> + ok; + {error, no_service} -> + ok; + {error, _} = No -> + No + end. + +%% remove/3 + +remove(L, SvcName, Pred) -> + rm(SvcName, lists:filter(fun(#transport{ref = R, type = T, options = O}) -> + Pred(R,T,O) + end, + L)). + +rm(_, []) -> + ok; +rm(SvcName, L) -> + Refs = lists:map(fun(#transport{ref = R}) -> R end, L), + case stop_transport(SvcName, Refs) of + ok -> + lists:foreach(fun delete_object/1, L); + {error, _} = No -> + No + end. + +stop_transport(SvcName, Refs) -> + case diameter_service:stop_transport(SvcName, Refs) of + ok -> + ok; + {error, no_service} -> + ok; + {error, _} = No -> + No + end. + +%% make_config/2 + +make_config(SvcName, Opts) -> + Apps = init_apps(Opts), + [] == Apps andalso ?THROW(no_apps), + + %% Use the fact that diameter_caps has the same field names as CER. + Fields = diameter_gen_base_rfc3588:'#info-'(diameter_base_CER) -- ['AVP'], + + COpts = [T || {K,_} = T <- Opts, lists:member(K, Fields)], + Caps = make_caps(#diameter_caps{}, COpts), + + ok = encode_CER(COpts), + + Os = split(Opts, [{[fun erlang:is_boolean/1], false, share_peers}, + {[fun erlang:is_boolean/1], false, use_shared_peers}, + {[fun erlang:is_pid/1, false], false, monitor}]), + %% share_peers and use_shared_peers are currently undocumented. + + #service{name = SvcName, + rec = #diameter_service{applications = Apps, + capabilities = Caps}, + options = Os}. + +make_caps(Caps, Opts) -> + case diameter_capx:make_caps(Caps, Opts) of + {ok, T} -> + T; + {error, {Reason, _}} -> + ?THROW(Reason) + end. + +%% Validate types by encoding a CER. +encode_CER(Opts) -> + {ok, CER} = diameter_capx:build_CER(make_caps(?EXAMPLE_CAPS, Opts)), + + Hdr = #diameter_header{version = ?DIAMETER_VERSION, + end_to_end_id = 0, + hop_by_hop_id = 0}, + + try + diameter_codec:encode(?BASE, #diameter_packet{header = Hdr, + msg = CER}), + ok + catch + exit: Reason -> + ?THROW(Reason) + end. + +init_apps(Opts) -> + lists:foldl(fun app_acc/2, [], lists:reverse(Opts)). + +app_acc({application, Opts}, Acc) -> + is_list(Opts) orelse ?THROW({application, Opts}), + + [Dict, Mod] = get_opt([dictionary, module], Opts), + Alias = get_opt(alias, Opts, Dict), + ModS = get_opt(state, Opts, Alias), + M = get_opt(call_mutates_state, Opts, false), + A = get_opt(answer_errors, Opts, report), + [#diameter_app{alias = Alias, + dictionary = Dict, + id = cb(Dict, id), + module = init_mod(Mod), + init_state = ModS, + mutable = init_mutable(M), + answer_errors = init_answers(A)} + | Acc]; +app_acc(_, Acc) -> + Acc. + +init_mod(M) + when is_atom(M) -> + [M]; +init_mod([M|_] = L) + when is_atom(M) -> + L; +init_mod(M) -> + ?THROW({module, M}). + +init_mutable(M) + when M == true; + M == false -> + M; +init_mutable(M) -> + ?THROW({call_mutates_state, M}). + +init_answers(A) + when callback == A; + report == A; + discard == A -> + A; +init_answers(A) -> + ?THROW({answer_errors, A}). + +%% Get a single value at the specified key. +get_opt(Keys, List) + when is_list(Keys) -> + [get_opt(K, List) || K <- Keys]; +get_opt(Key, List) -> + case [V || {K,V} <- List, K == Key] of + [V] -> V; + _ -> ?THROW({arity, Key}) + end. + +%% Get an optional value at the specified key. +get_opt(Key, List, Def) -> + case [V || {K,V} <- List, K == Key] of + [] -> Def; + [V] -> V; + _ -> ?THROW({arity, Key}) + end. + +split(Opts, Defs) -> + [{K, value(D, Opts)} || {_,_,K} = D <- Defs]. + +value({Preds, Def, Key}, Opts) -> + V = get_opt(Key, Opts, Def), + lists:any(fun(P) -> pred(P,V) end, Preds) + orelse ?THROW({value, Key}), + V. + +pred(F, V) + when is_function(F) -> + F(V); +pred(T, V) -> + T == V. + +cb(M,F) -> + try M:F() of + V -> V + catch + E: Reason -> + ?THROW({callback, E, Reason, ?STACK}) + end. + +%% call/1 + +call(Request) -> + gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/base/diameter_dbg.erl b/lib/diameter/src/base/diameter_dbg.erl new file mode 100644 index 0000000000..5b0ac3a3b6 --- /dev/null +++ b/lib/diameter/src/base/diameter_dbg.erl @@ -0,0 +1,516 @@ +%% +%% %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% +%% + +-module(diameter_dbg). + +-export([table/1, + tables/0, + fields/1, + help/0, + modules/0, + versions/0, + version_info/0, + compiled/0, + procs/0, + latest/0, + nl/0, + log/4]). + +-export([diameter_config/0, + diameter_peer/0, + diameter_reg/0, + diameter_request/0, + diameter_sequence/0, + diameter_service/0, + diameter_stats/0]). + +-export([pp/1, + subscriptions/0, + children/0]). + +%% Trace help. +-export([tracer/0, tracer/1, + p/0, p/1, + stop/0, + tpl/1, + tp/1]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + + +-define(INFO, diameter_info). +-define(SEP(), ?INFO:sep()). + +-define(LOCAL, [diameter_config, + diameter_peer, + diameter_reg, + diameter_request, + diameter_sequence, + diameter_service, + diameter_stats]). + +-define(VALUES(Rec), tl(tuple_to_list(Rec))). + +log(_Slogan, _Mod, _Line, _Details) -> + ok. + +%%% ---------------------------------------------------------- +%%% # help() +%%% ---------------------------------------------------------- + +help() -> + not_yet_implemented. + +%%% ---------------------------------------------------------- +%%% # table(TableName) +%%% +%%% Input: TableName = diameter table containing record entries. +%%% +%%% Output: Count | undefined +%%% ---------------------------------------------------------- + +table(T) + when (T == diameter_peer) orelse (T == diameter_reg) -> + ?INFO:format(collect(T), fields(T), fun ?INFO:split/2); + +table(Table) + when is_atom(Table) -> + case fields(Table) of + undefined = No -> + No; + Fields -> + ?INFO:format(Table, Fields, fun split/2) + end. + +split([started, name | Fs], [S, N | Vs]) -> + {name, [started | Fs], N, [S | Vs]}; +split([[F|FT]|Fs], [Rec|Vs]) -> + [_, V | VT] = tuple_to_list(Rec), + {F, FT ++ Fs, V, VT ++ Vs}; +split([F|Fs], [V|Vs]) -> + {F, Fs, V, Vs}. + +%%% ---------------------------------------------------------- +%%% # TableName() +%%% ---------------------------------------------------------- + +-define(TABLE(Name), Name() -> table(Name)). + +?TABLE(diameter_config). +?TABLE(diameter_peer). +?TABLE(diameter_reg). +?TABLE(diameter_request). +?TABLE(diameter_sequence). +?TABLE(diameter_service). +?TABLE(diameter_stats). + +%%% ---------------------------------------------------------- +%%% # tables() +%%% +%%% Output: Number of records output. +%%% +%%% Description: Pretty-print records in diameter tables from all nodes. +%%% ---------------------------------------------------------- + +tables() -> + ?INFO:format(field(?LOCAL), fun split/3, fun collect/1). + +field(Tables) -> + lists:map(fun(T) -> {T, fields(T)} end, lists:sort(Tables)). + +split(_, Fs, Vs) -> + split(Fs, Vs). + +%%% ---------------------------------------------------------- +%%% # modules() +%%% ---------------------------------------------------------- + +modules() -> + Path = filename:join([appdir(), atom_to_list(?APPLICATION) ++ ".app"]), + {ok, [{application, ?APPLICATION, Attrs}]} = file:consult(Path), + {modules, Mods} = lists:keyfind(modules, 1, Attrs), + Mods. + +appdir() -> + [_|_] = code:lib_dir(?APPLICATION, ebin). + +%%% ---------------------------------------------------------- +%%% # versions() +%%% ---------------------------------------------------------- + +versions() -> + ?INFO:versions(modules()). + +%%% ---------------------------------------------------------- +%%% # versions() +%%% ---------------------------------------------------------- + +version_info() -> + ?INFO:version_info(modules()). + +%%% ---------------------------------------------------------- +%%% # compiled() +%%% ---------------------------------------------------------- + +compiled() -> + ?INFO:compiled(modules()). + +%%% ---------------------------------------------------------- +%%% procs() +%%% ---------------------------------------------------------- + +procs() -> + ?INFO:procs(?APPLICATION). + +%%% ---------------------------------------------------------- +%%% # latest() +%%% ---------------------------------------------------------- + +latest() -> + ?INFO:latest(modules()). + +%%% ---------------------------------------------------------- +%%% # nl() +%%% ---------------------------------------------------------- + +nl() -> + lists:foreach(fun(M) -> abcast = c:nl(M) end, modules()). + +%%% ---------------------------------------------------------- +%%% # pp(Bin) +%%% +%%% Description: Pretty-print a message binary. +%%% ---------------------------------------------------------- + +%% Network byte order = big endian. + +pp(<>) -> + ?SEP(), + ppp(["Version", + "Message length", + "[Actual length]", + "R(equest)", + "P(roxiable)", + "E(rror)", + "T(Potential retrans)", + "Reserved bits", + "Command code", + "Application id", + "Hop by hop id", + "End to end id"], + [Version, MsgLength, size(AVPs) + 20, + Rbit, Pbit, Ebit, Tbit, Reserved, + CmdCode, + ApplId, + HbHid, + E2Eid]), + N = avp_loop({AVPs, MsgLength - 20}, 0), + ?SEP(), + N; + +pp(<<_Version:8, MsgLength:24, _/binary>> = Bin) -> + {bad_message_length, MsgLength, size(Bin)}; + +pp(Bin) + when is_binary(Bin) -> + {truncated_binary, size(Bin)}; + +pp(_) -> + not_binary. + +%% avp_loop/2 + +avp_loop({Bin, Size}, N) -> + avp_loop(avp(Bin, Size), N+1); +avp_loop(ok, N) -> + N; +avp_loop([_E, _Rest] = L, N) -> + io:format("! ~s: ~p~n", L), + N; +avp_loop([E, Rest, Fmt | Values], N) + when is_binary(Rest) -> + io:format("! ~s (" ++ Fmt ++ "): ~p~n", [E|Values] ++ [Rest]), + N. + +%% avp/2 + +avp(<<>>, 0) -> + ok; +avp(<>, + Size) -> + avp(Code, Flags, Length, Rest, Size); +avp(Bin, _) -> + ["truncated AVP header", Bin]. + +%% avp/5 + +avp(Code, Flags, Length, Rest, Size) -> + <> + = Flags, + b(), + ppp(["AVP Code", + "V(endor)", + "M(andatory)", + "P(Security)", + "R(eserved)", + "Length"], + [Code, V, M, P, Res, Length]), + avp(V, Rest, Length - 8, Size - 8). + +%% avp/4 + +avp(1, <>, Length, Size) -> + ppp({"Vendor-ID", V}), + data(Data, Length - 4, Size - 4); +avp(1, Bin, _, _) -> + ["truncated Vendor-ID", Bin]; +avp(0, Data, Length, Size) -> + data(Data, Length, Size). + +data(Bin, Length, Size) + when size(Bin) >= Length -> + <> = Bin, + ppp({"Data", AVP}), + unpad(Rest, Size - Length, Length rem 4); + +data(Bin, _, _) -> + ["truncated AVP data", Bin]. + +%% Remove padding bytes up to the next word boundary. +unpad(Bin, Size, 0) -> + {Bin, Size}; +unpad(Bin, Size, N) -> + un(Bin, Size, 4 - N). + +un(Bin, Size, N) + when size(Bin) >= N -> + ppp({"Padding bytes", N}), + <> = Bin, + Bits = N*8, + case Pad of + <<0:Bits>> -> + {Rest, Size - N}; + _ -> + ["non-zero padding", Bin, "~p", N] + end; + +un(Bin, _, _) -> + ["truncated padding", Bin]. + +b() -> + io:format("#~n"). + +ppp(Fields, Values) -> + lists:foreach(fun ppp/1, lists:zip(Fields, Values)). + +ppp({Field, Value}) -> + io:format(": ~-22s : ~p~n", [Field, Value]). + +%%% ---------------------------------------------------------- +%%% # subscriptions() +%%% +%%% Output: list of {SvcName, Pid} +%%% ---------------------------------------------------------- + +subscriptions() -> + diameter_service:subscriptions(). + +%%% ---------------------------------------------------------- +%%% # children() +%%% ---------------------------------------------------------- + +children() -> + diameter_sup:tree(). + +%%% ---------------------------------------------------------- + +%% tracer/[12] + +tracer(Port) + when is_integer(Port) -> + dbg:tracer(port, dbg:trace_port(ip, Port)); + +tracer(Path) + when is_list(Path) -> + dbg:tracer(port, dbg:trace_port(file, Path)). + +tracer() -> + dbg:tracer(process, {fun p/2, ok}). + +p(T,_) -> + io:format("+ ~p~n", [T]). + +%% p/[01] + +p() -> + p([c,timestamp]). + +p(T) -> + dbg:p(all,T). + +%% stop/0 + +stop() -> + dbg:ctp(), + dbg:stop_clear(). + +%% tpl/1 +%% tp/1 + +tpl(T) -> + dbg(tpl, T). + +tp(T) -> + dbg(tp, T). + +%% dbg/2 + +dbg(F, L) + when is_list(L) -> + [dbg(F, X) || X <- L]; + +dbg(F, M) + when is_atom(M) -> + apply(dbg, F, [M, x]); + +dbg(F, T) + when is_tuple(T) -> + apply(dbg, F, tuple_to_list(T)). + +%% =========================================================================== +%% =========================================================================== + +%% collect/1 + +collect(diameter_peer) -> + lists:flatmap(fun peers/1, diameter:services()); + +collect(diameter_reg) -> + diameter_reg:terms(); + +collect(Name) -> + c(ets:info(Name), Name). + +c(undefined, _) -> + []; +c(_, Name) -> + ets:tab2list(Name). + +%% peers/1 + +peers(Name) -> + peers(Name, diameter:service_info(Name, transport)). + +peers(_, undefined) -> + []; +peers(Name, Ts) -> + lists:flatmap(fun(T) -> mk_peers(Name, T) end, Ts). + +mk_peers(Name, [_, {type, connect} | _] = Ts) -> + [[Name | mk_peer(Ts)]]; +mk_peers(Name, [R, {type, listen}, O, {accept = A, As}]) -> + [[Name | mk_peer([R, {type, A}, O | Ts])] || Ts <- As]. +%% This is a bit lame: service_info works to build this list and out +%% of something like what we want here and then we take it apart. + +mk_peer(Vs) -> + [Type, Ref, State, Opts, WPid, TPid, SApps, Caps] + = get_values(Vs, [type,ref,state,options,watchdog,peer,apps,caps]), + [Ref, State, [{type, Type} | Opts], s(WPid), s(TPid), SApps, Caps]. + +get_values(Vs, Ks) -> + [proplists:get_value(K, Vs) || K <- Ks]. + +s(undefined = T) -> + T; +s({Pid, _Started, _State}) -> + state(Pid); +s({Pid, _Started}) -> + state(Pid). + +%% Collect states from watchdog/transport pids. +state(Pid) -> + MRef = erlang:monitor(process, Pid), + Pid ! {state, self()}, + receive + {'DOWN', MRef, process, _, _} -> + Pid; + {Pid, _} = T -> + erlang:demonitor(MRef, [flush]), + T + end. + +%% fields/1 + +-define(FIELDS(Table), fields(Table) -> record_info(fields, Table)). + +fields(diameter_config) -> + []; + +fields(T) + when T == diameter_request; + T == diameter_sequence -> + fun kv/1; + +fields(diameter_stats) -> + fun({Ctr, N}) when not is_pid(Ctr) -> + {[counter, value], [Ctr, N]}; + (_) -> + [] + end; + +fields(diameter_service) -> + [started, + name, + record_info(fields, diameter_service), + peerT, + connT, + share_peers, + use_shared_peers, + shared_peers, + local_peers, + monitor]; + +?FIELDS(diameter_event); +?FIELDS(diameter_uri); +?FIELDS(diameter_avp); +?FIELDS(diameter_header); +?FIELDS(diameter_packet); +?FIELDS(diameter_app); +?FIELDS(diameter_caps); + +fields(diameter_peer) -> + [service, ref, state, options, watchdog, peer, applications, capabilities]; + +fields(diameter_reg) -> + [property, pids]; + +fields(_) -> + undefined. + +kv({_,_}) -> + [key, value]; +kv(_) -> + []. diff --git a/lib/diameter/src/base/diameter_dict.erl b/lib/diameter/src/base/diameter_dict.erl new file mode 100644 index 0000000000..3b9ba00a3f --- /dev/null +++ b/lib/diameter/src/base/diameter_dict.erl @@ -0,0 +1,153 @@ +%% +%% %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% +%% + +%% +%% This module provide OTP's dict interface built on top of ets. +%% +%% Note that while the interface is the same as dict the semantics +%% aren't quite. A Dict here is just a table identifier (although +%% this fact can't be used if you want dict/ets-based implementations +%% to be interchangeable) so changes made to the Dict modify the +%% underlying table. For merge/3, the first argument table is modified. +%% +%% The underlying ets table implementing a dict is deleted when the +%% process from which new() was invoked exits and the dict is only +%% writable from this process. +%% +%% The reason for this is to be able to swap dict/ets-based +%% implementations: the former is easier to debug, the latter is +%% faster for larger tables. It's also just a nice interface even +%% when there's no need for swapability. +%% + +-module(diameter_dict). + +-export([append/3, + append_list/3, + erase/2, + fetch/2, + fetch_keys/1, + filter/2, + find/2, + fold/3, + from_list/1, + is_key/2, + map/2, + merge/3, + new/0, + store/3, + to_list/1, + update/3, + update/4, + update_counter/3]). + +%%% ---------------------------------------------------------- +%%% EXPORTED INTERNAL FUNCTIONS +%%% ---------------------------------------------------------- + +append(Key, Value, Dict) -> + append_list(Key, [Value], Dict). + +append_list(Key, ValueList, Dict) + when is_list(ValueList) -> + update(Key, fun(V) -> V ++ ValueList end, ValueList, Dict). + +erase(Key, Dict) -> + ets:delete(Dict, Key), + Dict. + +fetch(Key, Dict) -> + {ok, V} = find(Key, Dict), + V. + +fetch_keys(Dict) -> + ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). + +filter(Pred, Dict) -> + lists:foreach(fun({K,V}) -> filter(Pred(K,V), K, Dict) end, to_list(Dict)), + Dict. + +find(Key, Dict) -> + case ets:lookup(Dict, Key) of + [{Key, V}] -> + {ok, V}; + [] -> + error + end. + +fold(Fun, Acc0, Dict) -> + ets:foldl(fun({K,V}, Acc) -> Fun(K, V, Acc) end, Acc0, Dict). + +from_list(List) -> + lists:foldl(fun store/2, new(), List). + +is_key(Key, Dict) -> + ets:member(Dict, Key). + +map(Fun, Dict) -> + lists:foreach(fun({K,V}) -> store(K, Fun(K,V), Dict) end, to_list(Dict)), + Dict. + +merge(Fun, Dict1, Dict2) -> + fold(fun(K2,V2,_) -> + update(K2, fun(V1) -> Fun(K2, V1, V2) end, V2, Dict1) + end, + Dict1, + Dict2). + +new() -> + ets:new(?MODULE, [set]). + +store(Key, Value, Dict) -> + store({Key, Value}, Dict). + +to_list(Dict) -> + ets:tab2list(Dict). + +update(Key, Fun, Dict) -> + store(Key, Fun(fetch(Key, Dict)), Dict). + +update(Key, Fun, Initial, Dict) -> + store(Key, map(Key, Fun, Dict, Initial), Dict). + +update_counter(Key, Increment, Dict) + when is_integer(Increment) -> + update(Key, fun(V) -> V + Increment end, Increment, Dict). + +%%% --------------------------------------------------------- +%%% INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +store({_,_} = T, Dict) -> + ets:insert(Dict, T), + Dict. + +filter(true, _, _) -> + ok; +filter(false, K, Dict) -> + erase(K, Dict). + +map(Key, Fun, Dict, Error) -> + case find(Key, Dict) of + {ok, V} -> + Fun(V); + error -> + Error + end. + diff --git a/lib/diameter/src/base/diameter_info.erl b/lib/diameter/src/base/diameter_info.erl new file mode 100644 index 0000000000..39d32d07cd --- /dev/null +++ b/lib/diameter/src/base/diameter_info.erl @@ -0,0 +1,869 @@ +%% +%% %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% +%% + +-module(diameter_info). + +-export([usage/1, + format/1, + format/2, + format/3, + format/4, + table/2, + tables/1, + tables/2, + split/2, + split/3, + tab2list/1, + modules/1, + versions/1, + version_info/1, + attrs/2, + compiled/1, + procs/1, + latest/1, + list/1]). + +%% Support for rolling your own. +-export([sep/0, + sep/1, + widest/1, + p/1, + p/3]). + +-compile({no_auto_import,[max/2]}). + +-export([collect/2]). + +-define(LONG_TIMEOUT, 30000). +-define(VALUES(Rec), tl(tuple_to_list(Rec))). + +%%% ---------------------------------------------------------- +%%% # usage(String) +%%% ---------------------------------------------------------- + +usage(Usage) -> + sep($+), + io:format("+ ~p~n", [?MODULE]), + io:format("~n~s~n~n", [compact(Usage)]), + sep($+). + +%%% +%%% The function format/3, for pretty-printing tables, comes in +%%% several flavours. +%%% + +%%% ---------------------------------------------------------- +%%% # format(TableName, Fields, SplitFun) +%%% +%%% Input: TableName = atom() name of table. +%%% +%%% Fields = List of field names for the records maintained +%%% in the specified table. Can be empty, in which +%%% case entries are listed unadorned of field names +%%% and SplitFun is unused. +%%% | Integer, equivalent to a list with this many '' atoms. +%%% | Arity 1 fun mapping a table entry to a Fields list +%%% or a tuple {Fields, Values} of lists of the same +%%% length. +%%% +%%% If Fields is a list then its length must be the same +%%% as or one less than the size of the tuples contained +%%% in the table. (The values printed then being those +%%% in the tuple or record in question.) +%%% +%%% SplitFun = Arity 3 fun applied as +%%% +%%% SplitFun(TableName, Fields, Values) +%%% +%%% in order to obtain a tuple +%%% +%%% {Field, RestFields, Value, RestValues} +%%% +%%% for which Field/Value will be formatted on +%%% STDOUT. (This is to allow a value to be +%%% transformed before being output by returning a +%%% new value and/or replacing the remainder of +%%% the list.) The returned lists must have the +%%% same length and Field here is an atom, '' causing +%%% a value to be listed unadorned of the field name. +%%% +%%% Field can also be list of field names, in +%%% which case Value must be a record of the +%%% corresponding type. +%%% +%%% | Arity 2 fun applied as SplitFun(Fields, Values). +%%% +%%% Output: Count | undefined +%%% +%%% Count = Number of entries output. +%%% +%%% Description: Pretty-print records in a named table. +%%% ---------------------------------------------------------- + +format(Table, Fields, SFun) + when is_atom(Table), is_function(SFun, 2) -> + ft(ets:info(Table), Table, SFun, Fields); + +format(Table, Fields, SFun) + when is_atom(Table), is_function(SFun, 3) -> + format(Table, Fields, fun(Fs,Vs) -> SFun(Table, Fs, Vs) end); + +%%% ---------------------------------------------------------- +%%% # format(Recs, Fields, SplitFun) +%%% +%%% Input: Recs = list of records/tuples +%%% Fields = As for format(Table, Fields, SplitFun), a table +%%% entry there being a member of Recs. +%%% SplitFun = Arity 3 fun applied as above but with the TableName +%%% replaced by the first element of the records in +%%% question. +%%% | Arity 2 fun as for format/3. +%%% +%%% Output: length(Recs) +%%% +%%% Description: Pretty print records/tuples. +%%% ---------------------------------------------------------- + +format(Recs, Fields, SFun) + when is_list(Recs), is_function(SFun, 3) -> + lists:foldl(fun(R,A) -> f(recsplit(SFun, R), 0, Fields, R, A) end, + 0, + Recs); + +format(Recs, Fields, SFun) + when is_list(Recs), is_function(SFun, 2) -> + lists:foldl(fun(R,A) -> f(SFun, 0, Fields, R, A) end, + 0, + Recs); + +%%% ---------------------------------------------------------- +%%% # format(Tables, SplitFun, CollectFun) +%%% +%%% Input: Tables = list of {TableName, Fields}. +%%% SplitFun = As for format(Table, Fields, SplitFun). +%%% CollectFun = arity 1 fun mapping a table name to a list +%%% of elements. A non-list can be returned to indicate +%%% that the table in question doesn't exist. +%%% +%%% Output: Number of entries output. +%%% +%%% Description: Pretty-print records in a named tables as collected +%%% from known nodes. Each table listing is preceeded by +%%% a banner. +%%% ---------------------------------------------------------- + +format(Tables, SFun, CFun) + when is_list(Tables), is_function(CFun, 1) -> + format_remote(Tables, + SFun, + rpc:multicall(nodes(known), + ?MODULE, + collect, + [CFun, lists:map(fun({T,_}) -> T end, Tables)], + ?LONG_TIMEOUT)); + +%%% ---------------------------------------------------------- +%%% # format(LocalTables, RemoteTables, SplitFun, CollectFun) +%%% # format(LocalTables, RemoteTables, SplitFun) +%%% +%%% Input: LocalTables = list of {TableName, Fields}. +%%% | list of {TableName, Recs, Fields} +%%% RemoteTable = list of {TableName, Fields}. +%%% SplitFun, CollectFun = As for format(Table, CollectFun, SplitFun). +%%% +%%% Output: Number of entries output. +%%% +%%% Description: Pretty-print records in a named tables as collected +%%% from local and remote nodes. Each table listing is +%%% preceeded by a banner. +%%% ---------------------------------------------------------- + +format(Local, Remote, SFun) -> + format(Local, Remote, SFun, fun tab2list/1). + +format(Local, Remote, SFun, CFun) + when is_list(Local), is_list(Remote), is_function(CFun, 1) -> + format_local(Local, SFun) + format(Remote, SFun, CFun). + +%%% ---------------------------------------------------------- +%%% # format(Tables, SplitFun) +%%% ---------------------------------------------------------- + +format(Tables, SFun) + when is_list(Tables), (is_function(SFun, 2) or is_function(SFun, 3)) -> + format(Tables, SFun, fun tab2list/1); + +format(Tables, CFun) + when is_list(Tables), is_function(CFun, 1) -> + format(Tables, fun split/2, CFun). + +%%% ---------------------------------------------------------- +%%% # format(Table|Tables) +%%% ---------------------------------------------------------- + +format(Table) + when is_atom(Table) -> + format(Table, [], fun split/2); + +format(Tables) + when is_list(Tables) -> + format(Tables, fun split/2, fun tab2list/1). + +%%% ---------------------------------------------------------- +%%% # split(TableName, Fields, Values) +%%% +%%% Description: format/3 SplitFun that does nothing special. +%%% ---------------------------------------------------------- + +split([F|FT], [V|VT]) -> + {F, FT, V, VT}. + +split(_, Fs, Vs) -> + split(Fs, Vs). + +%%% ---------------------------------------------------------- +%%% # tab2list(TableName) +%%% +%%% Description: format/4 CollectFun that extracts records from an +%%% existing ets table. +%%% ---------------------------------------------------------- + +tab2list(Table) -> + case ets:info(Table) of + undefined = No -> + No; + _ -> + ets:tab2list(Table) + end. + +list(Table) -> + l(tab2list(Table)). + +l(undefined = No) -> + No; +l(List) + when is_list(List) -> + io:format("~p~n", [List]), + length(List). + +%%% ---------------------------------------------------------- +%%% # table(TableName, Fields) +%%% ---------------------------------------------------------- + +table(Table, Fields) -> + format(Table, Fields, fun split/2). + +%%% ---------------------------------------------------------- +%%% # tables(LocalTables, RemoteTables) +%%% ---------------------------------------------------------- + +tables(Local, Remote) -> + format(Local, Remote, fun split/2). + +%%% ---------------------------------------------------------- +%%% # tables(Tables) +%%% ---------------------------------------------------------- + +tables(Tables) -> + format(Tables, fun split/2). + +%%% ---------------------------------------------------------- +%%% # modules(Prefix|Prefixes) +%%% +%%% Input: Prefix = atom() +%%% +%%% Description: Return the list of all loaded modules with the +%%% specified prefix. +%%% ---------------------------------------------------------- + +modules(Prefix) + when is_atom(Prefix) -> + lists:sort(mods(Prefix)); + +modules(Prefixes) + when is_list(Prefixes) -> + lists:sort(lists:flatmap(fun modules/1, Prefixes)). + +mods(Prefix) -> + P = atom_to_list(Prefix), + lists:filter(fun(M) -> + lists:prefix(P, atom_to_list(M)) + end, + erlang:loaded()). + +%%% ---------------------------------------------------------- +%%% # versions(Modules|Prefix) +%%% +%%% Output: Number of modules listed. +%%% +%%% Description: List the versions of the specified modules. +%%% ---------------------------------------------------------- + +versions(Modules) -> + {SysInfo, OsInfo, ModInfo} = version_info(Modules), + sep(), + print_sys_info(SysInfo), + sep(), + print_os_info(OsInfo), + sep(), + print_mod_info(ModInfo), + sep(). + +%%% ---------------------------------------------------------- +%%% # attrs(Modules|Prefix, Attr|FormatFun) +%%% +%%% Output: Number of modules listed. +%%% +%%% Description: List an attribute from module_info. +%%% ---------------------------------------------------------- + +attrs(Modules, Attr) + when is_atom(Attr) -> + attrs(Modules, fun(W,M) -> attr(W, M, Attr, fun attr/1) end); + +attrs(Modules, Fun) + when is_list(Modules) -> + sep(), + W = 2 + widest(Modules), + N = lists:foldl(fun(M,A) -> Fun(W,M), A+1 end, 0, Modules), + sep(), + N; + +attrs(Prefix, Fun) -> + attrs(modules(Prefix), Fun). + +%% attr/1 + +attr(T) when is_atom(T) -> + atom_to_list(T); +attr(N) when is_integer(N) -> + integer_to_list(N); +attr(V) -> + case is_list(V) andalso lists:all(fun is_char/1, V) of + true -> %% string + V; + false -> + io_lib:format("~p", [V]) + end. + +is_char(C) -> + 0 =< C andalso C < 256. + +%% attr/4 + +attr(Width, Mod, Attr, VFun) -> + io:format(": ~*s~s~n", [-Width, Mod, attr(Mod, Attr, VFun)]). + +attr(Mod, Attr, VFun) -> + Key = key(Attr), + try + VFun(val(Attr, keyfetch(Attr, Mod:module_info(Key)))) + catch + _:_ -> + "-" + end. + +attr(Mod, Attr) -> + attr(Mod, Attr, fun attr/1). + +key(time) -> compile; +key(_) -> attributes. + +val(time, {_,_,_,_,_,_} = T) -> + lists:flatten(io_lib:format("~p-~2..0B-~2..0B ~2..0B:~2..0B:~2..0B", + tuple_to_list(T))); +val(_, [V]) -> + V. + +%%% ---------------------------------------------------------- +%%% # compiled(Modules|Prefix) +%%% +%%% Output: Number of modules listed. +%%% +%%% Description: List the compile times of the specified modules. +%%% ---------------------------------------------------------- + +compiled(Modules) + when is_list(Modules) -> + attrs(Modules, fun compiled/2); + +compiled(Prefix) -> + compiled(modules(Prefix)). + +compiled(Width, Mod) -> + io:format(": ~*s~19s ~s~n", [-Width, + Mod, + attr(Mod, time), + opt(attr(Mod, date))]). + +opt("-") -> + ""; +opt(D) -> + "(" ++ D ++ ")". + +%%% ---------------------------------------------------------- +%%% # procs(Pred|Prefix|Prefixes|Pid|Pids) +%%% +%%% Input: Pred = arity 2 fun returning true|false when applied to a +%%% pid and its process info. +%%% +%%% Output: Number of processes listed. +%%% +%%% Description: List process info for all local processes that test +%%% true with the specified predicate. With the prefix +%%% form, those processes that are either currently +%%% executing in, started executing in, or have a +%%% registered name with a specified prefix are listed. +%%% With the pid forms, only those process that are local +%%% are listed and those that are dead list only the pid +%%% itself. +%%% ---------------------------------------------------------- + +procs(Pred) + when is_function(Pred, 2) -> + procs(Pred, erlang:processes()); + +procs([]) -> + 0; + +procs(Prefix) + when is_atom(Prefix) -> + procs(fun(_,I) -> info(fun pre1/2, I, atom_to_list(Prefix)) end); + +procs(Prefixes) + when is_atom(hd(Prefixes)) -> + procs(fun(_,I) -> info(fun pre/2, I, Prefixes) end); + +procs(Pid) + when is_pid(Pid) -> + procs(fun true2/2, [Pid]); + +procs(Pids) + when is_list(Pids) -> + procs(fun true2/2, Pids). + +true2(_,_) -> + true. + +%% procs/2 + +procs(Pred, Pids) -> + Procs = lists:foldl(fun(P,A) -> + procs_acc(Pred, P, catch process_info(P), A) + end, + [], + Pids), + sep(0 < length(Procs)), + lists:foldl(fun(T,N) -> p(T), sep(), N+1 end, 0, Procs). + +procs_acc(_, Pid, undefined, Acc) -> %% dead + [[{pid, Pid}] | Acc]; +procs_acc(Pred, Pid, Info, Acc) + when is_list(Info) -> + p_acc(Pred(Pid, Info), Pid, Info, Acc); +procs_acc(_, _, _, Acc) -> + Acc. + +p_acc(true, Pid, Info, Acc) -> + [[{pid, Pid} | Info] | Acc]; +p_acc(false, _, _, Acc) -> + Acc. + +%% info/3 + +info(Pred, Info, T) -> + lists:any(fun(I) -> i(Pred, I, T) end, Info). + +i(Pred, {K, {M,_,_}}, T) + when K == current_function; + K == initial_call -> + Pred(M,T); +i(Pred, {registered_name, N}, T) -> + Pred(N,T); +i(_,_,_) -> + false. + +pre1(A, Pre) -> + lists:prefix(Pre, atom_to_list(A)). + +pre(A, Prefixes) -> + lists:any(fun(P) -> pre1(A, atom_to_list(P)) end, Prefixes). + +%%% ---------------------------------------------------------- +%%% # latest(Modules|Prefix) +%%% +%%% Output: {Mod, {Y,M,D,HH,MM,SS}, Version} +%%% +%%% Description: Return the compile time of the most recently compiled +%%% module from the specified non-empty list. The modules +%%% are assumed to exist. +%%% ---------------------------------------------------------- + +latest(Prefix) + when is_atom(Prefix) -> + latest(modules(Prefix)); + +latest([_|_] = Modules) -> + {Mod, T} + = hd(lists:sort(fun latest/2, lists:map(fun compile_time/1, Modules))), + {Mod, T, app_vsn(Mod)}. + +app_vsn(Mod) -> + keyfetch(app_vsn, Mod:module_info(attributes)). + +compile_time(Mod) -> + T = keyfetch(time, Mod:module_info(compile)), + {Mod, T}. + +latest({_,T1},{_,T2}) -> + T1 > T2. + +%%% ---------------------------------------------------------- +%%% version_info(Modules|Prefix) +%%% +%%% Output: {SysInfo, OSInfo, [ModInfo]} +%%% +%%% SysInfo = {Arch, Vers} +%%% OSInfo = {Vers, {Fam, Name}} +%%% ModInfo = {Vsn, AppVsn, Time, CompilerVsn} +%%% ---------------------------------------------------------- + +version_info(Prefix) + when is_atom(Prefix) -> + version_info(modules(Prefix)); + +version_info(Mods) + when is_list(Mods) -> + {sys_info(), os_info(), [{M, mod_version_info(M)} || M <- Mods]}. + +mod_version_info(Mod) -> + try + Info = Mod:module_info(), + [[Vsn], AppVsn] = get_values(attributes, [vsn, app_vsn], Info), + [Ver, Time] = get_values(compile, [version, time], Info), + [Vsn, AppVsn, Ver, Time] + catch + _:_ -> + [] + end. + +get_values(Attr, Keys, Info) -> + As = proplists:get_value(Attr, Info), + [proplists:get_value(K, As, "?") || K <- Keys]. + +sys_info() -> + [A,V] = [chomp(erlang:system_info(K)) || K <- [system_architecture, + system_version]], + {A,V}. + +os_info() -> + {os:version(), case os:type() of + {_Fam, _Name} = T -> + T; + Fam -> + {Fam, ""} + end}. + +chomp(S) -> + string:strip(S, right, $\n). + +print_sys_info({Arch, Ver}) -> + io:format("System info:~n" + " architecture : ~s~n" + " version : ~s~n", + [Arch, Ver]). + +print_os_info({Vsn, {Fam, Name}}) -> + io:format("OS info:~n" + " family : ~s ~s~n" + " version : ~s~n", + [str(Fam), bkt(str(Name)), vsn(Vsn)]). + +print_mod_info(Mods) -> + io:format("Module info:~n", []), + lists:foreach(fun print_mod/1, Mods). + +print_mod({Mod, []}) -> + io:format(" ~w:~n", [Mod]); +print_mod({Mod, [Vsn, AppVsn, Ver, {Year, Month, Day, Hour, Min, Sec}]}) -> + Time = io_lib:format("~w-~2..0w-~2..0w ~2..0w:~2..0w:~2..0w", + [Year, Month, Day, Hour, Min, Sec]), + io:format(" ~w:~n" + " vsn : ~s~n" + " app_vsn : ~s~n" + " compiled : ~s~n" + " compiler : ~s~n", + [Mod, str(Vsn), str(AppVsn), Time, Ver]). + +str(A) + when is_atom(A) -> + atom_to_list(A); +str(S) + when is_list(S) -> + S; +str(T) -> + io_lib:format("~p", [T]). + +bkt("" = S) -> + S; +bkt(S) -> + [$[, S, $]]. + +vsn(T) when is_tuple(T) -> + case [[$., integer_to_list(N)] || N <- tuple_to_list(T)] of + [[$.,S] | Rest] -> + [S | Rest]; + [] = S -> + S + end; +vsn(T) -> + str(T). + +%%% ---------------------------------------------------------- +%%% ---------------------------------------------------------- + +%% p/1 + +p(Info) -> + W = 2 + widest([K || {K,_} <- Info]), + lists:foreach(fun({K,V}) -> p(W,K,V) end, Info). + +p(Width, Key, Value) -> + io:format(": ~*s: ~p~n", [-Width, Key, Value]). + +%% sep/[01] + +sep() -> + sep($#). + +sep(true) -> + sep(); +sep(false) -> + ok; + +sep(Ch) -> + io:format("~c~65c~n", [Ch, $-]). + +%% widest/1 + +widest(List) -> + lists:foldl(fun widest/2, 0, List). + +widest(T, Max) + when is_atom(T) -> + widest(atom_to_list(T), Max); + +widest(T, Max) + when is_integer(T) -> + widest(integer_to_list(T), Max); + +widest(T, Max) + when is_list(T) -> %% string + max(length(T), Max). + +pt(T) -> + io:format(": ~p~n", [T]). + +recsplit(SFun, Rec) -> + fun(Fs,Vs) -> SFun(element(1, Rec), Fs, Vs) end. + +max(A, B) -> + if A > B -> A; true -> B end. + +keyfetch(Key, List) -> + {Key,V} = lists:keyfind(Key, 1, List), + V. + +%% ft/4 + +ft(undefined = No, _, _, _) -> + No; + +ft(_, Table, SFun, Fields) -> + ets:foldl(fun(R,A) -> + f(SFun, 0, Fields, R, A) + end, + 0, + Table). + +%% f/5 + +f(SFun, Width, Fields, Rec, Count) -> + ff(SFun, Width, fields(Fields, Rec), Rec, Count). + +ff(SFun, Width, Fields, Rec, Count) -> + sep(0 == Count), + f(SFun, Width, Fields, Rec), + sep(), + Count+1. + +fields(N, _) + when is_integer(N), N >= 0 -> + lists:duplicate(N, ''); %% list values unadorned +fields(Fields, R) + when is_function(Fields, 1) -> + fields(Fields(R), R); +fields({Fields, Values} = T, _) + when length(Fields) == length(Values) -> + T; +fields(Fields, _) + when is_list(Fields) -> + Fields. %% list field/value pairs, or tuples if [] + +%% f/4 + +%% Empty fields list: just print the entry. +f(_, _, [], Rec) + when is_tuple(Rec) -> + pt(Rec); + +%% Otherwise list field names/values. +f(SFun, Width, {Fields, Values}, _) -> + f(SFun, Width, Fields, Values); + +f(SFun, Width, Fields, Rec) + when is_tuple(Rec) -> + f(SFun, Width, Fields, values(Fields, Rec)); + +f(_, _, [], []) -> + ok; + +f(SFun, Width, [HF | _] = Fields, Values) -> + {F, FT, V, VT} = SFun(Fields, Values), + if is_list(F) -> %% V is a record + break($>, HF), + f(SFun, Width, F, values(F,V)), + break($<, HF), + f(SFun, Width, FT, VT); + F == '' -> %% no field name: just list value + pt(V), + f(SFun, Width, FT, VT); + true -> %% list field/value. + W = max(Width, 1 + widest(Fields)), + p(W, F, V), + f(SFun, W, FT, VT) + end. + +values(Fields, Rec) + when length(Fields) == size(Rec) - 1 -> + ?VALUES(Rec); +values(Fields, T) + when length(Fields) == size(T) -> + tuple_to_list(T). + +%% format_local/2 + +format_local(Tables, SFun) -> + lists:foldl(fun(T,A) -> fl(SFun, T, A) end, 0, Tables). + +fl(SFun, {Table, Recs, Fields}, Count) -> + sep(), + io:format("# ~p~n", [Table]), + N = fmt(Recs, Fields, SFun), + sep(0 == N), + Count + N; + +fl(SFun, {Table, Fields}, Count) -> + fl(SFun, {Table, Table, Fields}, Count). + +%% fmt/3 + +fmt(T, Fields, SFun) -> + case format(T, Fields, SFun) of + undefined -> + 0; + N -> + N + end. + +%% break/2 + +break(C, T) -> + io:format("~c ~p~n", [C, T]). + +%% collect/2 +%% +%% Output: {[{TableName, Recs}, ...], node()} + +collect(CFun, TableNames) -> + {lists:foldl(fun(N,A) -> c(CFun, N, A) end, [], TableNames), node()}. + +c(CFun, TableName, Acc) -> + case CFun(TableName) of + Recs when is_list(Recs) -> + [{TableName, Recs} | Acc]; + _ -> + Acc + end. + +%% format_remote/3 + +format_remote(Tables, SFun, {Replies, BadNodes}) -> + N = lists:foldl(fun(T,A) -> fr(Tables, SFun, T, A) end, + 0, + Replies), + sep(0 == N andalso [] /= BadNodes), + lists:foreach(fun(Node) -> io:format("# no reply from ~p~n", [Node]) end, + BadNodes), + sep([] /= BadNodes), + N. + +fr(Tables, SFun, {List, Node}, Count) + when is_list(List) -> %% guard against {badrpc, Reason} + lists:foldl(fun({T,Recs}, C) -> fr(Tables, SFun, Node, T, Recs,C) end, + Count, + List); +fr(_, _, _, Count) -> + Count. + +fr(Tables, SFun, Node, Table, Recs, Count) -> + Fields = keyfetch(Table, Tables), + sep(), + io:format("# ~p@~p~n", [Table, Node]), + N = format(Recs, Fields, tblsplit(SFun, Table)), + sep(0 == N), + Count + N. + +tblsplit(SFun, Table) + when is_function(SFun, 3) -> + fun(Fs,Vs) -> SFun(Table, Fs, Vs) end; +tblsplit(SFun, _) + when is_function(SFun, 2) -> + SFun. + +%% compact/1 +%% +%% Strip whitespace from both ends of a string. + +compact(Str) -> + compact(Str, true). + +compact([Ch|Rest], B) + when Ch == $\n; + Ch == $ ; + Ch == $\t; + Ch == $\v; + Ch == $\r -> + compact(Rest, B); + +compact(Str, false) -> + Str; + +compact(Str, true) -> + lists:reverse(compact(lists:reverse(Str), false)). diff --git a/lib/diameter/src/base/diameter_internal.hrl b/lib/diameter/src/base/diameter_internal.hrl new file mode 100644 index 0000000000..63b35550a8 --- /dev/null +++ b/lib/diameter/src/base/diameter_internal.hrl @@ -0,0 +1,80 @@ +%% +%% %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% +%% + +%% Our Erlang application. +-define(APPLICATION, diameter). + +%% The one and only. +-define(DIAMETER_VERSION, 1). + +%% Exception for use within a module with decent protection against +%% catching something we haven't thrown. Not foolproof but close +%% enough. ?MODULE is rudmentary protection against catching across +%% module boundaries, a root of much evil: always catch ?FAILURE(X), +%% never X. +-define(FAILURE(Reason), {{?MODULE}, {Reason}}). +-define(THROW(Reason), throw(?FAILURE(Reason))). + +%% A corresponding error when failure is the best option. +-define(ERROR(T), erlang:error({T, ?MODULE, ?LINE})). + +%% Failure reports always get a stack trace. +-define(STACK, erlang:get_stacktrace()). + +%% Warning report for unexpected messages in various processes. +-define(UNEXPECTED(F,A), + diameter_lib:warning_report(unexpected, {?MODULE, F, A})). +-define(UNEXPECTED(A), ?UNEXPECTED(?FUNC, A)). + +%% Something to trace on. +-define(LOG(Slogan, Details), + diameter_lib:log(Slogan, ?MODULE, ?LINE, Details)). +-define(LOGC(Bool, Slogan, Details), ((Bool) andalso ?LOG(Slogan, Details))). + +%% Compensate for no builtin ?FUNC for use in log reports. +-define(FUNC, element(2, element(2, process_info(self(), current_function)))). + +%% Disjunctive match spec condition. 'false' is to ensure that there's at +%% least one condition. +-define(ORCOND(List), list_to_tuple(['orelse', false | List])). + +%% 3588, 2.4: +-define(APP_ID_COMMON, 0). +-define(APP_ID_RELAY, 16#FFFFFFFF). + +-define(BASE, diameter_gen_base_rfc3588). + +%%% --------------------------------------------------------- + +%%% RFC 3588, ch 2.6 Peer table +-record(diameter_peer, + {host_id, + statusT, + is_dynamic, + expiration, + tls_enabled}). + +%%% RFC 3588, ch 2.7 Realm-based routing table +-record(diameter_realm, + {name, + app_id, + local_action, % LOCAL | RELAY | PROXY | REDIRECT + server_id, + is_dynamic, + expiration}). diff --git a/lib/diameter/src/base/diameter_lib.erl b/lib/diameter/src/base/diameter_lib.erl new file mode 100644 index 0000000000..362d593b24 --- /dev/null +++ b/lib/diameter/src/base/diameter_lib.erl @@ -0,0 +1,272 @@ +%% +%% %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% +%% + +-module(diameter_lib). + +-export([report/2, info_report/2, + error_report/2, + warning_report/2, + now_diff/1, + time/1, + eval/1, + ip4address/1, + ip6address/1, + ipaddr/1, + spawn_opts/2, + wait/1, + fold_tuple/3, + log/4]). + +-include("diameter_internal.hrl"). + +%% --------------------------------------------------------------------------- +%% # info_report(Reason, MFA) +%% +%% Input: Reason = Arbitrary term indicating the reason for the report. +%% MFA = {Module, Function, Args} to report. +%% +%% Output: true +%% --------------------------------------------------------------------------- + +report(Reason, MFA) -> + info_report(Reason, MFA). + +info_report(Reason, MFA) -> + report(fun error_logger:info_report/1, Reason, MFA), + true. + +%%% --------------------------------------------------------------------------- +%%% # error_report(Reason, MFA) +%%% # warning_report(Reason, MFA) +%%% +%%% Output: false +%%% --------------------------------------------------------------------------- + +error_report(Reason, MFA) -> + report(fun error_logger:error_report/1, Reason, MFA). + +warning_report(Reason, MFA) -> + report(fun error_logger:warning_report/1, Reason, MFA). + +report(Fun, Reason, MFA) -> + Fun([{why, Reason}, {who, self()}, {what, MFA}]), + false. + +%%% --------------------------------------------------------------------------- +%%% # now_diff(Time) +%%% +%%% Description: Return timer:now_diff(now(), Time) as an {H, M, S, MicroS} +%%% tuple instead of as integer microseconds. +%%% --------------------------------------------------------------------------- + +now_diff({_,_,_} = Time) -> + time(timer:now_diff(erlang:now(), Time)). + +%%% --------------------------------------------------------------------------- +%%% # time(Time) +%%% +%%% Input: Time = {MegaSec, Sec, MicroSec} +%%% | MicroSec +%%% +%%% Output: {H, M, S, MicroS} +%%% --------------------------------------------------------------------------- + +time({_,_,_} = Time) -> %% time of day + %% 24 hours = 24*60*60*1000000 = 86400000000 microsec + time(timer:now_diff(Time, {0,0,0}) rem 86400000000); + +time(Micro) -> %% elapsed time + Seconds = Micro div 1000000, + H = Seconds div 3600, + M = (Seconds rem 3600) div 60, + S = Seconds rem 60, + {H, M, S, Micro rem 1000000}. + +%%% --------------------------------------------------------------------------- +%%% # eval(Func) +%%% --------------------------------------------------------------------------- + +eval({M,F,A}) -> + apply(M,F,A); + +eval([{M,F,A} | X]) -> + apply(M, F, X ++ A); + +eval([[F|A] | X]) -> + eval([F | X ++ A]); + +eval([F|A]) -> + apply(F,A); + +eval({F}) -> + eval(F); + +eval(F) -> + F(). + +%%% --------------------------------------------------------------------------- +%%% # ip4address(Addr) +%%% +%%% Input: string() (eg. "10.0.0.1") +%%% | list of integer() +%%% | tuple of integer() +%%% +%%% Output: {_,_,_,_} of integer +%%% +%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} +%%% --------------------------------------------------------------------------- + +ip4address([_,_,_,_] = Addr) -> %% Length 4 string can't be an address. + ipaddr(list_to_tuple(Addr)); + +%% Be brutal. +ip4address(Addr) -> + try + {_,_,_,_} = ipaddr(Addr) + catch + error: _ -> + erlang:error({invalid_address, Addr, ?STACK}) + end. + +%%% --------------------------------------------------------------------------- +%%% # ip6address(Addr) +%%% +%%% Input: string() (eg. "1080::8:800:200C:417A") +%%% | list of integer() +%%% | tuple of integer() +%%% +%%% Output: {_,_,_,_,_,_,_,_} of integer +%%% +%%% Exceptions: error: {invalid_address, Addr, erlang:get_stacktrace()} +%%% --------------------------------------------------------------------------- + +ip6address([_,_,_,_,_,_,_,_] = Addr) -> %% Length 8 string can't be an address. + ipaddr(list_to_tuple(Addr)); + +%% Be brutal. +ip6address(Addr) -> + try + {_,_,_,_,_,_,_,_} = ipaddr(Addr) + catch + error: _ -> + erlang:error({invalid_address, Addr, ?STACK}) + end. + +%%% --------------------------------------------------------------------------- +%%% # ipaddr(Addr) +%%% +%%% Input: string() | tuple of integer() +%%% +%%% Output: {_,_,_,_} | {_,_,_,_,_,_,_,_} +%%% +%%% Exceptions: error: {invalid_address, erlang:get_stacktrace()} +%%% --------------------------------------------------------------------------- + +-spec ipaddr(string() | tuple()) + -> inet:ip_address(). + +%% Don't convert lists of integers since a length 8 list like +%% [$1,$0,$.,$0,$.,$0,$.,$1] is ambiguous: is it "10.0.0.1" or +%% "49:48:46:48:46:48:46:49"? +%% +%% RFC 2373 defines the format parsed for v6 addresses. + +%% Be brutal. +ipaddr(Addr) -> + try + ip(Addr) + catch + error: _ -> + erlang:error({invalid_address, ?STACK}) + end. + +%% Already a tuple: ensure non-negative integers of the right size. +ip(T) + when size(T) == 4; + size(T) == 8 -> + Bs = 2*size(T), + [] = lists:filter(fun(N) when 0 =< N -> 0 < N bsr Bs end, + tuple_to_list(T)), + T; + +%% Or not: convert from '.'/':'-separated decimal/hex. +ip(Addr) -> + {ok, A} = inet_parse:address(Addr), %% documented in inet(3) + A. + +%%% --------------------------------------------------------------------------- +%%% # spawn_opts(Type, Opts) +%%% --------------------------------------------------------------------------- + +%% TODO: config variables. + +spawn_opts(server, Opts) -> + opts(75000, Opts); +spawn_opts(worker, Opts) -> + opts(5000, Opts). + +opts(HeapSize, Opts) -> + [{min_heap_size, HeapSize} | lists:keydelete(min_heap_size, 1, Opts)]. + +%%% --------------------------------------------------------------------------- +%%% # wait(MRefs) +%%% --------------------------------------------------------------------------- + +wait(L) -> + w([erlang:monitor(process, P) || P <- L]). + +w([]) -> + ok; +w(L) -> + receive + {'DOWN', MRef, process, _, _} -> + w(lists:delete(MRef, L)) + end. + +%%% --------------------------------------------------------------------------- +%%% # fold_tuple(N, T0, T) +%%% --------------------------------------------------------------------------- + +%% Replace fields in T0 by those of T starting at index N, unless the +%% new value is 'undefined'. +%% +%% eg. fold_tuple(2, Hdr, #diameter_header{end_to_end_id = 42}) + +fold_tuple(_, T, undefined) -> + T; + +fold_tuple(N, T0, T1) -> + {_, T} = lists:foldl(fun(V, {I,_} = IT) -> {I+1, ft(V, IT)} end, + {N, T0}, + lists:nthtail(N-1, tuple_to_list(T1))), + T. + +ft(undefined, {_, T}) -> + T; +ft(Value, {Idx, T}) -> + setelement(Idx, T, Value). + +%%% ---------------------------------------------------------- +%%% # log(Slogan, Mod, Line, Details) +%%% +%%% Called to have something to trace on for happenings of interest. +%%% ---------------------------------------------------------- + +log(_, _, _, _) -> + ok. diff --git a/lib/diameter/src/base/diameter_misc_sup.erl b/lib/diameter/src/base/diameter_misc_sup.erl new file mode 100644 index 0000000000..4e40476f14 --- /dev/null +++ b/lib/diameter/src/base/diameter_misc_sup.erl @@ -0,0 +1,58 @@ +%% +%% %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% +%% + +%% +%% The supervisor of the static server processes. +%% + +-module(diameter_misc_sup). + +-behaviour(supervisor). + +-export([start_link/0]). %% supervisor start + +%% supervisor callback +-export([init/1]). + +-define(CHILDREN, [diameter_sync, %% serialization + diameter_stats, %% statistics counter management + diameter_reg, %% service/property publishing + diameter_peer, %% remote peer manager + diameter_config]). %% configuration/restart + +%% start_link/0 + +start_link() -> + SupName = {local, ?MODULE}, + supervisor:start_link(SupName, ?MODULE, []). + +%% init/1 + +init([]) -> + Flags = {one_for_one, 1, 5}, + Workers = lists:map(fun spec/1, ?CHILDREN), + {ok, {Flags, Workers}}. + +spec(Mod) -> + {Mod, + {Mod, start_link, []}, + permanent, + 1000, + worker, + [Mod]}. diff --git a/lib/diameter/src/base/diameter_peer.erl b/lib/diameter/src/base/diameter_peer.erl new file mode 100644 index 0000000000..3e78c4caef --- /dev/null +++ b/lib/diameter/src/base/diameter_peer.erl @@ -0,0 +1,225 @@ +%% +%% %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% +%% + +-module(diameter_peer). + +-behaviour(gen_server). + +%% Interface towards transport modules ... +-export([recv/2, + up/1, + up/2]). + +%% ... and the stack. +-export([start/3, + send/2, + close/1, + abort/1, + notify/2]). + +%% Server start. +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% debug +-export([state/0, + uptime/0]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +%% Registered name of the server. +-define(SERVER, ?MODULE). + +%% Server state. +-record(state, {id = now()}). + +%%% --------------------------------------------------------------------------- +%%% # notify/2 +%%% --------------------------------------------------------------------------- + +notify(SvcName, T) -> + rpc:abcast(nodes(), ?SERVER, {notify, SvcName, T}). + +%%% --------------------------------------------------------------------------- +%%% # start/3 +%%% --------------------------------------------------------------------------- + +start(T, Opts, #diameter_service{} = Svc) -> + {Mod, Cfg} = split_transport(Opts), + apply(Mod, start, [T, Svc, Cfg]). + +%%% --------------------------------------------------------------------------- +%%% # up/[12] +%%% --------------------------------------------------------------------------- + +up(Pid) -> %% accepting transport + ifc_send(Pid, {self(), connected}). + +up(Pid, Remote) -> %% connecting transport + ifc_send(Pid, {self(), connected, Remote}). + +%%% --------------------------------------------------------------------------- +%%% # recv/2 +%%% --------------------------------------------------------------------------- + +recv(Pid, Pkt) -> + ifc_send(Pid, {recv, Pkt}). + +%%% --------------------------------------------------------------------------- +%%% # send/2 +%%% --------------------------------------------------------------------------- + +send(Pid, #diameter_packet{transport_data = undefined, + bin = Bin}) -> + send(Pid, Bin); + +send(Pid, Pkt) -> + ifc_send(Pid, {send, Pkt}). + +%%% --------------------------------------------------------------------------- +%%% # close/1 +%%% --------------------------------------------------------------------------- + +close(Pid) -> + ifc_send(Pid, {close, self()}). + +%%% --------------------------------------------------------------------------- +%%% # abort/1 +%%% --------------------------------------------------------------------------- + +abort(Pid) -> + exit(Pid, shutdown). + +%% --------------------------------------------------------------------------- +%% --------------------------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Module = ?MODULE, + Args = [], + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, Module, Args, Options). + +state() -> + call(state). + +uptime() -> + call(uptime). + +%%% ---------------------------------------------------------- +%%% # init(Role) +%%% ---------------------------------------------------------- + +init([]) -> + {ok, #state{}}. + +%%% ---------------------------------------------------------- +%%% # handle_call(Request, From, State) +%%% ---------------------------------------------------------- + +handle_call(state, _, State) -> + {reply, State, State}; + +handle_call(uptime, _, #state{id = Time} = State) -> + {reply, diameter_lib:now_diff(Time), State}; + +handle_call(Req, From, State) -> + ?UNEXPECTED([Req, From]), + {reply, nok, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_info(Request, State) +%%% ---------------------------------------------------------- + +%% Remote service is distributing a message. +handle_info({notify, SvcName, T}, S) -> + bang(diameter_service:whois(SvcName), T), + {noreply, S}; + +handle_info(Info, State) -> + ?UNEXPECTED([Info]), + {noreply, State}. + +%% ---------------------------------------------------------- +%% terminate(Reason, State) +%% ---------------------------------------------------------- + +terminate(_Reason, _State) -> + ok. + +%% ---------------------------------------------------------- +%% code_change(OldVsn, State, Extra) +%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% --------------------------------------------------------- +%% INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +%% ifc_send/2 +%% +%% Send something over the transport interface. + +ifc_send(Pid, T) -> + Pid ! {diameter, T}. + +%% bang/2 + +bang(undefined = No, _) -> + No; +bang(Pid, T) -> + Pid ! T. + +%% split_transport/1 +%% +%% Split options into transport module, transport config and +%% remaining options. + +split_transport(Opts) -> + {[M,C], _} = proplists:split(Opts, [transport_module, + transport_config]), + {value(M, diameter_tcp), value(C, [])}. + +value([{_,V}], _) -> + V; +value([], V) -> + V. + +%% call/1 + +call(Request) -> + gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/base/diameter_peer_fsm.erl b/lib/diameter/src/base/diameter_peer_fsm.erl new file mode 100644 index 0000000000..282fa2742f --- /dev/null +++ b/lib/diameter/src/base/diameter_peer_fsm.erl @@ -0,0 +1,777 @@ +%% +%% %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% +%% + +%% +%% This module implements (as a process) the RFC 3588 Peer State +%% Machine modulo the necessity of adapting the peer election to the +%% fact that we don't know the identity of a peer until we've +%% received a CER/CEA from it. +%% + +-module(diameter_peer_fsm). +-behaviour(gen_server). + +%% Interface towards diameter_watchdog. +-export([start/3]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +%% diameter_peer_fsm_sup callback +-export([start_link/1]). + +%% internal callbacks +-export([match/1]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). +-include("diameter_types.hrl"). +-include("diameter_gen_base_rfc3588.hrl"). + +-define(GOAWAY, ?'DIAMETER_BASE_DISCONNECT-CAUSE_DO_NOT_WANT_TO_TALK_TO_YOU'). +-define(REBOOT, ?'DIAMETER_BASE_DISCONNECT-CAUSE_REBOOTING'). + +-define(NO_INBAND_SECURITY, 0). +-define(TLS, 1). + +-define(LOOP_TIMEOUT, 2000). + +%% RFC 3588: +%% +%% Timeout An application-defined timer has expired while waiting +%% for some event. +%% +-define(EVENT_TIMEOUT, 10000). + +%% How long to wait for a DPA in response to DPR before simply +%% aborting. Used to distinguish between shutdown and not but there's +%% not really any need. Stopping a service will require a timeout if +%% the peer doesn't answer DPR so the value should be short-ish. +-define(DPA_TIMEOUT, 1000). + +-record(state, + {state = 'Wait-Conn-Ack' %% state of RFC 3588 Peer State Machine + :: 'Wait-Conn-Ack' | recv_CER | 'Wait-CEA' | 'Open', + mode :: accept | connect | {connect, reference()}, + parent :: pid(), + transport :: pid(), + service :: #diameter_service{}, + dpr = false :: false | {'Unsigned32'(), 'Unsigned32'()}}). + %% | hop by hop and end to end identifiers + +%% There are non-3588 states possible as a consequence of 5.6.1 of the +%% standard and the corresponding problem for incoming CEA's: we don't +%% know who we're talking to until either a CER or CEA has been +%% received. The CEA problem in particular makes it impossible to +%% follow the state machine exactly as documented in 3588: there can +%% be no election until the CEA arrives and we have an Origin-Host to +%% elect. + +%% +%% Once upon a time start/2 started a process akin to that started by +%% start/3 below, which in turn started a watchdog/transport process +%% with the result that the watchdog could send DWR/DWA regardless of +%% whether or not the corresponding Peer State Machine was in its open +%% state; that is, before capabilities exchange had taken place. This +%% is not what RFC's 3588 and 3539 say (albeit not very clearly). +%% Watchdog messages are only exchanged on *open* connections, so the +%% 3539 state machine is more naturally placed on top of the 3588 Peer +%% State Machine rather than closer to the transport. This is what we +%% now do below: connect/accept call diameter_watchdog and return the +%% pid of the watchdog process, and the watchdog in turn calls start/3 +%% below to start the process implementing the Peer State Machine. The +%% former is a "peer" in diameter_service while the latter is a +%% "conn". In a sense, diameter_service sees the watchdog as +%% implementing the Peer State Machine and the process implemented +%% here as being the transport, not being aware of the watchdog at +%% all. +%% + +%%% --------------------------------------------------------------------------- +%%% # start({connect|accept, Ref}, Opts, Service) +%%% +%%% Output: Pid +%%% --------------------------------------------------------------------------- + +%% diameter_config requires a non-empty list of applications on the +%% service but diameter_service then constrains the list to any +%% specified on the transport in question. Check here that the list is +%% still non-empty. + +start({_, Ref} = Type, Opts, #diameter_service{applications = Apps} = Svc) -> + [] /= Apps orelse ?ERROR({no_apps, Type, Opts}), + T = {self(), Type, Opts, Svc}, + {ok, Pid} = diameter_peer_fsm_sup:start_child(T), + diameter_stats:reg(Pid, Ref), + Pid. + +start_link(T) -> + {ok, _} = proc_lib:start_link(?MODULE, + init, + [T], + infinity, + diameter_lib:spawn_opts(server, [])). + +%%% --------------------------------------------------------------------------- +%%% --------------------------------------------------------------------------- + +%% init/1 + +init(T) -> + proc_lib:init_ack({ok, self()}), + gen_server:enter_loop(?MODULE, [], i(T)). + +i({WPid, {M, _} = T, Opts, #diameter_service{capabilities = Caps} = Svc0}) -> + putr(dwa, dwa(Caps)), + {ok, TPid, Svc} = start_transport(T, Opts, Svc0), + erlang:monitor(process, TPid), + erlang:monitor(process, WPid), + #state{parent = WPid, + transport = TPid, + mode = M, + service = Svc}. +%% The transport returns its local ip addresses so that different +%% transports on the same service can use different local addresses. +%% The local addresses are put into Host-IP-Address avps here when +%% sending capabilities exchange messages. +%% +%% Invalid transport config may cause us to crash but note that the +%% watchdog start (start/2) succeeds regardless so as not to crash the +%% service. + +start_transport(T, Opts, Svc) -> + case diameter_peer:start(T, Opts, Svc) of + {ok, TPid} -> + {ok, TPid, Svc}; + {ok, TPid, [_|_] = Addrs} -> + #diameter_service{capabilities = Caps0} = Svc, + Caps = Caps0#diameter_caps{host_ip_address = Addrs}, + {ok, TPid, Svc#diameter_service{capabilities = Caps}}; + No -> + exit({shutdown, No}) + end. + +%% handle_call/3 + +handle_call(_, _, State) -> + {reply, nok, State}. + +%% handle_cast/2 + +handle_cast(_, State) -> + {noreply, State}. + +%% handle_info/1 + +handle_info(T, #state{} = State) -> + try transition(T, State) of + ok -> + {noreply, State}; + #state{state = X} = S -> + ?LOGC(X =/= State#state.state, transition, X), + {noreply, S}; + {stop, Reason} -> + ?LOG(stop, Reason), + x(Reason, State); + stop -> + ?LOG(stop, T), + x(T, State) + catch + throw: {?MODULE, Tag, Reason} -> + ?LOG(Tag, {Reason, T}), + {stop, {shutdown, Reason}, State} + end. + +x(Reason, #state{} = S) -> + close_wd(Reason, S), + {stop, {shutdown, Reason}, S}. + +%% terminate/2 + +terminate(_, _) -> + ok. + +%% code_change/3 + +code_change(_, State, _) -> + {ok, State}. + +%%% --------------------------------------------------------------------------- +%%% --------------------------------------------------------------------------- + +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + +%% transition/2 + +%% Connection to peer. +transition({diameter, {TPid, connected, Remote}}, + #state{state = PS, + mode = M} + = S) -> + 'Wait-Conn-Ack' = PS, %% assert + connect = M, %% + send_CER(S#state{mode = {M, Remote}, + transport = TPid}); + +%% Connection from peer. +transition({diameter, {TPid, connected}}, + #state{state = PS, + mode = M, + parent = Pid} + = S) -> + 'Wait-Conn-Ack' = PS, %% assert + accept = M, %% + Pid ! {accepted, self()}, + start_timer(S#state{state = recv_CER, + transport = TPid}); + +%% Incoming message from the transport. +transition({diameter, {recv, Pkt}}, S) -> + recv(Pkt, S); + +%% Timeout when still in the same state ... +transition({timeout, PS}, #state{state = PS}) -> + stop; + +%% ... or not. +transition({timeout, _}, _) -> + ok; + +%% Outgoing message. +transition({send, Msg}, #state{transport = TPid}) -> + send(TPid, Msg), + ok; + +%% Request for graceful shutdown. +transition({shutdown, Pid}, #state{parent = Pid, dpr = false} = S) -> + dpr(?GOAWAY, S); +transition({shutdown, Pid}, #state{parent = Pid}) -> + ok; + +%% Application shutdown. +transition(shutdown, #state{dpr = false} = S) -> + dpr(?REBOOT, S); +transition(shutdown, _) -> %% DPR already send: ensure expected timeout + dpa_timer(), + ok; + +%% Request to close the transport connection. +transition({close = T, Pid}, #state{parent = Pid, + transport = TPid}) -> + diameter_peer:close(TPid), + {stop, T}; + +%% DPA reception has timed out. +transition(dpa_timeout, _) -> + stop; + +%% Someone wants to know a resolved port: forward to the transport process. +transition({resolve_port, _Pid} = T, #state{transport = TPid}) -> + TPid ! T, + ok; + +%% Parent or transport has died. +transition({'DOWN', _, process, P, _}, + #state{parent = Pid, + transport = TPid}) + when P == Pid; + P == TPid -> + stop; + +%% State query. +transition({state, Pid}, #state{state = S, transport = TPid}) -> + Pid ! {self(), [S, TPid]}, + ok. + +%% Crash on anything unexpected. + +%% send_CER/1 + +send_CER(#state{mode = {connect, Remote}, + service = #diameter_service{capabilities = Caps}, + transport = TPid} + = S) -> + req_send_CER(Caps#diameter_caps.origin_host, Remote) + orelse + close(connected, S), + CER = build_CER(S), + ?LOG(send, 'CER'), + send(TPid, encode(CER)), + start_timer(S#state{state = 'Wait-CEA'}). + +%% Register ourselves as connecting to the remote endpoint in +%% question. This isn't strictly necessary since a peer implementing +%% the 3588 Peer State Machine should reject duplicate connection's +%% from the same peer but there's little point in us setting up a +%% duplicate connection in the first place. This could also include +%% the transport protocol being used but since we're blind to +%% transport just avoid duplicate connections to the same host/port. +req_send_CER(OriginHost, Remote) -> + register_everywhere({?MODULE, connection, OriginHost, {remote, Remote}}). + +%% start_timer/1 + +start_timer(#state{state = PS} = S) -> + erlang:send_after(?EVENT_TIMEOUT, self(), {timeout, PS}), + S. + +%% build_CER/1 + +build_CER(#state{service = #diameter_service{capabilities = Caps}}) -> + {ok, CER} = diameter_capx:build_CER(Caps), + CER. + +%% encode/1 + +encode(Rec) -> + #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Rec), + Bin. + +%% recv/2 + +%% RFC 3588 has result code 5015 for an invalid length but if a +%% transport is detecting message boundaries using the length header +%% then a length error will likely lead to further errors. + +recv(#diameter_packet{header = #diameter_header{length = Len} + = Hdr, + bin = Bin}, + S) + when Len < 20; + (0 /= Len rem 4 orelse bit_size(Bin) /= 8*Len) -> + discard(invalid_message_length, recv, [size(Bin), + bit_size(Bin) rem 8, + Hdr, + S]); + +recv(#diameter_packet{header = #diameter_header{} = Hdr} + = Pkt, + #state{parent = Pid} + = S) -> + Name = diameter_codec:msg_name(Hdr), + Pid ! {recv, self(), Name, Pkt}, + diameter_stats:incr({msg_id(Name, Hdr), recv}), %% count received + rcv(Name, Pkt, S); + +recv(#diameter_packet{header = undefined, + bin = Bin} + = Pkt, + S) -> + recv(Pkt#diameter_packet{header = diameter_codec:decode_header(Bin)}, S); + +recv(Bin, S) + when is_binary(Bin) -> + recv(#diameter_packet{bin = Bin}, S); + +recv(#diameter_packet{header = false} = Pkt, S) -> + discard(truncated_header, recv, [Pkt, S]). + +msg_id({_,_,_} = T, _) -> + T; +msg_id(_, Hdr) -> + diameter_codec:msg_id(Hdr). + +%% Treat invalid length as a transport error and die. Especially in +%% the TCP case, in which there's no telling where the next message +%% begins in the incoming byte stream, keeping a crippled connection +%% alive may just make things worse. + +discard(Reason, F, A) -> + diameter_stats:incr(Reason), + diameter_lib:warning_report(Reason, {?MODULE, F, A}), + throw({?MODULE, abort, Reason}). + +%% rcv/3 + +%% Incoming CEA. +rcv('CEA', Pkt, #state{state = 'Wait-CEA'} = S) -> + handle_CEA(Pkt, S); + +%% Incoming CER +rcv('CER' = N, Pkt, #state{state = recv_CER} = S) -> + handle_request(N, Pkt, S); + +%% Anything but CER/CEA in a non-Open state is an error, as is +%% CER/CEA in anything but recv_CER/Wait-CEA. +rcv(Name, _, #state{state = PS}) + when PS /= 'Open'; + Name == 'CER'; + Name == 'CEA' -> + {stop, {Name, PS}}; + +rcv(N, Pkt, S) + when N == 'DWR'; + N == 'DPR' -> + handle_request(N, Pkt, S); + +%% DPA even though we haven't sent DPR: ignore. +rcv('DPA', _Pkt, #state{dpr = false}) -> + ok; + +%% DPA in response to DPR. We could check the sequence numbers but +%% don't bother, just close. +rcv('DPA' = N, _Pkt, #state{transport = TPid}) -> + diameter_peer:close(TPid), + {stop, N}; + +rcv(_, _, _) -> + ok. + +%% send/2 + +%% Msg here could be a #diameter_packet or a binary depending on who's +%% sending. In particular, the watchdog will send DWR as a binary +%% while messages coming from clients will be in a #diameter_packet. +send(Pid, Msg) -> + diameter_stats:incr({diameter_codec:msg_id(Msg), send}), + diameter_peer:send(Pid, Msg). + +%% handle_request/3 + +handle_request(Type, #diameter_packet{} = Pkt, S) -> + ?LOG(recv, Type), + send_answer(Type, diameter_codec:decode(?BASE, Pkt), S). + +%% send_answer/3 + +send_answer(Type, ReqPkt, #state{transport = TPid} = S) -> + #diameter_packet{header = #diameter_header{version = V, + end_to_end_id = Eid, + hop_by_hop_id = Hid, + is_proxiable = P}, + transport_data = TD} + = ReqPkt, + + {Answer, PostF} = build_answer(Type, V, ReqPkt, S), + + Pkt = #diameter_packet{header = #diameter_header{version = V, + end_to_end_id = Eid, + hop_by_hop_id = Hid, + is_proxiable = P}, + msg = Answer, + transport_data = TD}, + + send(TPid, diameter_codec:encode(?BASE, Pkt)), + eval(PostF, S). + +eval([F|A], S) -> + apply(F, A ++ [S]); +eval(ok, S) -> + S. + +%% build_answer/4 + +build_answer('CER', + ?DIAMETER_VERSION, + #diameter_packet{msg = CER, + header = #diameter_header{is_error = false}, + errors = []} + = Pkt, + #state{service = Svc} + = S) -> + #diameter_service{capabilities = #diameter_caps{origin_host = OH}} + = Svc, + + {SupportedApps, + #diameter_caps{origin_host = DH} = RCaps, + #diameter_base_CEA{'Result-Code' = RC} + = CEA} + = recv_CER(CER, S), + + try + 2001 == RC %% DIAMETER_SUCCESS + orelse ?THROW({sent_CEA, RC}), + register_everywhere({?MODULE, connection, OH, DH}) + orelse ?THROW({election_lost, 4003}), + #diameter_base_CEA{'Inband-Security-Id' = [IS]} + = CEA, + {CEA, [fun open/5, Pkt, SupportedApps, RCaps, {accept, IS}]} + catch + ?FAILURE({Reason, RC}) -> + {answer('CER', S) ++ [{'Result-Code', RC}], + [fun close/2, {'CER', Reason, DH}]} + end; + +%% The error checks below are similar to those in diameter_service for +%% other messages. Should factor out the commonality. + +build_answer(Type, V, #diameter_packet{header = H, errors = Es} = Pkt, S) -> + FailedAvp = failed_avp([A || {_,A} <- Es]), + Ans = answer(answer(Type, S), V, H, Es), + {set(Ans, FailedAvp), if 'CER' == Type -> + [fun close/2, {Type, V, Pkt}]; + true -> + ok + end}. + +failed_avp([] = No) -> + No; +failed_avp(Avps) -> + [{'Failed-AVP', [[{'AVP', Avps}]]}]. + +set(Ans, []) -> + Ans; +set(['answer-message' | _] = Ans, FailedAvp) -> + Ans ++ [{'AVP', [FailedAvp]}]; +set([_|_] = Ans, FailedAvp) -> + Ans ++ FailedAvp. + +answer([_, OH, OR | _], _, #diameter_header{is_error = true}, _) -> + ['answer-message', OH, OR, {'Result-Code', 3008}]; + +answer([_, OH, OR | _], _, _, [Bs|_]) + when is_bitstring(Bs) -> + ['answer-message', OH, OR, {'Result-Code', 3009}]; + +answer(Ans, ?DIAMETER_VERSION, _, Es) -> + Ans ++ [{'Result-Code', rc(Es)}]; + +answer(Ans, _, _, _) -> + Ans ++ [{'Result-Code', 5011}]. %% DIAMETER_UNSUPPORTED_VERSION + +rc([]) -> + 2001; %% DIAMETER_SUCCESS +rc([{RC,_}|_]) -> + RC; +rc([RC|_]) -> + RC. + +%% DIAMETER_INVALID_HDR_BITS 3008 +%% A request was received whose bits in the Diameter header were +%% either set to an invalid combination, or to a value that is +%% inconsistent with the command code's definition. + +%% DIAMETER_INVALID_AVP_BITS 3009 +%% A request was received that included an AVP whose flag bits are +%% set to an unrecognized value, or that is inconsistent with the +%% AVP's definition. + +%% ELECTION_LOST 4003 +%% The peer has determined that it has lost the election process and +%% has therefore disconnected the transport connection. + +%% DIAMETER_NO_COMMON_APPLICATION 5010 +%% This error is returned when a CER message is received, and there +%% are no common applications supported between the peers. + +%% DIAMETER_UNSUPPORTED_VERSION 5011 +%% This error is returned when a request was received, whose version +%% number is unsupported. + +%% answer/2 + +answer('DWR', _) -> + getr(dwa); + +answer(Name, #state{service = #diameter_service{capabilities = Caps}}) -> + a(Name, Caps). + +a('CER', #diameter_caps{vendor_id = Vid, + origin_host = Host, + origin_realm = Realm, + host_ip_address = Addrs, + product_name = Name}) -> + ['CEA', {'Origin-Host', Host}, + {'Origin-Realm', Realm}, + {'Host-IP-Address', Addrs}, + {'Vendor-Id', Vid}, + {'Product-Name', Name}]; + +a('DPR', #diameter_caps{origin_host = Host, + origin_realm = Realm}) -> + ['DPA', {'Origin-Host', Host}, + {'Origin-Realm', Realm}]. + +%% recv_CER/2 + +recv_CER(CER, #state{service = Svc}) -> + {ok, T} = diameter_capx:recv_CER(CER, Svc), + T. + +%% handle_CEA/1 + +handle_CEA(#diameter_packet{header = #diameter_header{version = V}, + bin = Bin} + = Pkt, + #state{service = #diameter_service{capabilities = LCaps}} + = S) + when is_binary(Bin) -> + ?LOG(recv, 'CEA'), + + ?DIAMETER_VERSION == V orelse close({version, V}, S), + + #diameter_packet{msg = CEA, errors = Errors} + = DPkt + = diameter_codec:decode(?BASE, Pkt), + + [] == Errors orelse close({errors, Errors}, S), + + {SApps, [IS], #diameter_caps{origin_host = DH} = RCaps} + = recv_CEA(CEA, S), + + #diameter_caps{origin_host = OH} + = LCaps, + + %% Ensure that we don't already have a connection to the peer in + %% question. This isn't the peer election of 3588 except in the + %% sense that, since we don't know who we're talking to until we + %% receive a CER/CEA, the first that arrives wins the right to a + %% connection with the peer. + + register_everywhere({?MODULE, connection, OH, DH}) + orelse close({'CEA', DH}, S), + + open(DPkt, SApps, RCaps, {connect, IS}, S). + +%% recv_CEA/2 + +recv_CEA(CEA, #state{service = Svc} = S) -> + case diameter_capx:recv_CEA(CEA, Svc) of + {ok, {_,_}} -> %% return from old code + close({'CEA', update}, S); + {ok, {[], _, _}} -> + close({'CEA', no_common_application}, S); + {ok, {_, [], _}} -> + close({'CEA', no_common_security}, S); + {ok, {_,_,_} = T} -> + T; + {error, Reason} -> + close({'CEA', Reason}, S) + end. + +%% open/5 + +open(Pkt, SupportedApps, RCaps, {Type, IS}, #state{parent = Pid, + service = Svc} + = S) -> + #diameter_service{capabilities = #diameter_caps{origin_host = OH, + inband_security_id = LS} + = LCaps} + = Svc, + #diameter_caps{origin_host = DH} + = RCaps, + + tls_ack(lists:member(?TLS, LS), Type, IS, S), + Pid ! {open, self(), {OH,DH}, {capz(LCaps, RCaps), SupportedApps, Pkt}}, + + S#state{state = 'Open'}. + +%% We've advertised TLS support: tell the transport the result +%% and expect a reply when the handshake is complete. +tls_ack(true, Type, IS, #state{transport = TPid} = S) -> + Ref = make_ref(), + MRef = erlang:monitor(process, TPid), + TPid ! {diameter, {tls, Ref, Type, IS == ?TLS}}, + receive + {diameter, {tls, Ref}} -> + erlang:demonitor(MRef, [flush]); + {'DOWN', MRef, process, _, _} = T -> + close({tls_ack, T}, S) + end; + +%% Or not. Don't send anything to the transport so that transports +%% not supporting TLS work as before without modification. +tls_ack(false, _, _, _) -> + ok. + +capz(#diameter_caps{} = L, #diameter_caps{} = R) -> + #diameter_caps{} + = list_to_tuple([diameter_caps | lists:zip(tl(tuple_to_list(L)), + tl(tuple_to_list(R)))]). + +%% close/2 + +%% Tell the watchdog that our death isn't due to transport failure. +close(Reason, #state{parent = Pid}) -> + close_wd(Reason, Pid), + throw({?MODULE, close, Reason}). + +%% close_wd/2 + +%% Ensure the watchdog dies if DPR has been sent ... +close_wd(_, #state{dpr = false}) -> + ok; +close_wd(Reason, #state{parent = Pid}) -> + close_wd(Reason, Pid); + +%% ... or otherwise +close_wd(Reason, Pid) -> + Pid ! {close, self(), Reason}. + +%% dwa/1 + +dwa(#diameter_caps{origin_host = OH, + origin_realm = OR, + origin_state_id = OSI}) -> + ['DWA', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Origin-State-Id', OSI}]. + +%% dpr/2 + +dpr(Cause, #state{transport = TPid, + service = #diameter_service{capabilities = Caps}} + = S) -> + #diameter_caps{origin_host = OH, + origin_realm = OR} + = Caps, + + Bin = encode(['DPR', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Disconnect-Cause', Cause}]), + send(TPid, Bin), + dpa_timer(), + ?LOG(send, 'DPR'), + S#state{dpr = diameter_codec:sequence_numbers(Bin)}. + +dpa_timer() -> + erlang:send_after(?DPA_TIMEOUT, self(), dpa_timeout). + +%% register_everywhere/1 +%% +%% Register a term and ensure it's not registered elsewhere. Note that +%% two process that simultaneously register the same term may well +%% both fail to do so this isn't foolproof. + +register_everywhere(T) -> + diameter_reg:add_new(T) + andalso unregistered(T). + +unregistered(T) -> + {ResL, _} = rpc:multicall(?MODULE, match, [{node(), T}]), + lists:all(fun(L) -> [] == L end, ResL). + +match({Node, _}) + when Node == node() -> + []; +match({_, T}) -> + try + diameter_reg:match(T) + catch + _:_ -> [] + end. diff --git a/lib/diameter/src/base/diameter_peer_fsm_sup.erl b/lib/diameter/src/base/diameter_peer_fsm_sup.erl new file mode 100644 index 0000000000..995eaf74d0 --- /dev/null +++ b/lib/diameter/src/base/diameter_peer_fsm_sup.erl @@ -0,0 +1,63 @@ +%% +%% %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% +%% + +%% +%% The supervisor of peer_fsm processes. +%% + +-module(diameter_peer_fsm_sup). + +-behaviour(supervisor). + +-define(NAME, ?MODULE). %% supervisor name + +%%----------------------------------------------------------------- +%% External exports +%%----------------------------------------------------------------- + +-export([start_link/0, %% supervisor start + start_child/1]). %% peer fsm start + +-export([init/1]). + +%% start_link/0 + +start_link() -> + SupName = {local, ?NAME}, + supervisor:start_link(SupName, ?MODULE, []). + +%% start_child/1 +%% +%% Start a peer_fsm process. + +start_child(T) -> + supervisor:start_child(?NAME, [T]). + +%% init/1 + +init([]) -> + Mod = diameter_peer_fsm, + Flags = {simple_one_for_one, 0, 1}, + ChildSpec = {Mod, + {Mod, start_link, []}, + temporary, + 1000, + worker, + [Mod]}, + {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl new file mode 100644 index 0000000000..882b9da238 --- /dev/null +++ b/lib/diameter/src/base/diameter_reg.erl @@ -0,0 +1,327 @@ +%% +%% %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% +%% + +%% +%% The module implements a simple term -> pid registry. +%% + +-module(diameter_reg). +-compile({no_auto_import, [monitor/2]}). + +-behaviour(gen_server). + +-export([add/1, + add_new/1, + del/1, + repl/2, + match/1]). + +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% test +-export([pids/0, + terms/0]). + +%% debug +-export([state/0, + uptime/0]). + +-include("diameter_internal.hrl"). + +-define(SERVER, ?MODULE). +-define(TABLE, ?MODULE). + +%% Table entry used to keep from starting more than one monitor on the +%% same process. This isn't a problem but there's no point in starting +%% multiple monitors if we can avoid it. Note that we can't have a 2-tuple +%% keyed on Pid since a registered term can be anything. Want the entry +%% keyed on Pid so that lookup is fast. +-define(MONITOR(Pid, MRef), {Pid, monitor, MRef}). + +%% Table entry containing the Term -> Pid mapping. +-define(MAPPING(Term, Pid), {Term, Pid}). + +-record(state, {id = now()}). + +%%% ---------------------------------------------------------- +%%% # add(T) +%%% +%%% Input: Term = term() +%%% +%%% Output: true +%%% +%%% Description: Associate the specified term with self(). The list of pids +%%% having this or other assocations can be retrieved using +%%% match/1. +%%% +%%% An association is removed when the calling process dies +%%% or as a result of calling del/1. Adding the same term +%%% more than once is equivalent to adding it exactly once. +%%% +%%% Note that since match/1 takes a pattern as argument, +%%% specifying a term that contains match variables is +%%% probably not a good idea +%%% ---------------------------------------------------------- + +-spec add(any()) + -> true. + +add(T) -> + call({add, fun ets:insert/2, T, self()}). + +%%% ---------------------------------------------------------- +%%% # add_new(T) +%%% +%%% Input: T = term() +%%% +%%% Output: true | false +%%% +%%% Description: Like add/1 but only one process is allowed to have the +%%% the association, false being returned if an association +%%% already exists. +%%% ---------------------------------------------------------- + +-spec add_new(any()) + -> boolean(). + +add_new(T) -> + call({add, fun insert_new/2, T, self()}). + +%%% ---------------------------------------------------------- +%%% # repl(T, NewT) +%%% +%%% Input: T, NewT = term() +%%% +%%% Output: true | false +%%% +%%% Description: Like add/1 but only replace an existing association on T, +%%% false being returned if it doesn't exist. +%%% ---------------------------------------------------------- + +-spec repl(any(), any()) + -> boolean(). + +repl(T, U) -> + call({repl, T, U, self()}). + +%%% ---------------------------------------------------------- +%%% # del(Term) +%%% +%%% Input: Term = term() +%%% +%%% Output: true +%%% +%%% Description: Remove any existing association of Term with self(). +%%% ---------------------------------------------------------- + +-spec del(any()) + -> true. + +del(T) -> + call({del, T, self()}). + +%%% ---------------------------------------------------------- +%%% # match(Pat) +%%% +%%% Input: Pat = pattern in the sense of ets:match_object/2. +%%% +%%% Output: list of {Term, Pid} +%%% +%%% Description: Return the list of associations whose Term, as specified +%%% to add/1 or add_new/1, matches the specified pattern. +%%% +%%% Note that there's no guarantee that the returned processes +%%% are still alive. (Although one that isn't will soon have +%%% its associations removed.) +%%% ---------------------------------------------------------- + +-spec match(tuple()) + -> [{term(), pid()}]. + +match(Pat) -> + ets:match_object(?TABLE, ?MAPPING(Pat, '_')). + +%% --------------------------------------------------------- +%% EXPORTED INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, ?MODULE, [], Options). + +state() -> + call(state). + +uptime() -> + call(uptime). + +%% pids/0 +%% +%% Output: list of {Pid, [Term, ...]} + +pids() -> + to_list(fun swap/1). + +to_list(Fun) -> + ets:foldl(fun(T,A) -> acc(Fun, T, A) end, orddict:new(), ?TABLE). + +acc(Fun, ?MAPPING(Term, Pid), Dict) -> + append(Fun({Term, Pid}), Dict); +acc(_, _, Dict) -> + Dict. + +append({K,V}, Dict) -> + orddict:append(K, V, Dict). + +id(T) -> T. + +%% terms/0 +%% +%% Output: list of {Term, [Pid, ...]} + +terms() -> + to_list(fun id/1). + +swap({X,Y}) -> {Y,X}. + +%%% ---------------------------------------------------------- +%%% # init(Role) +%%% +%%% Output: {ok, State} +%%% ---------------------------------------------------------- + +init(_) -> + ets:new(?TABLE, [bag, named_table]), + {ok, #state{}}. + +%%% ---------------------------------------------------------- +%%% # handle_call(Request, From, State) +%%% ---------------------------------------------------------- + +handle_call({add, Fun, Key, Pid}, _, State) -> + B = Fun(?TABLE, {Key, Pid}), + monitor(B andalso no_monitor(Pid), Pid), + {reply, B, State}; + +handle_call({del, Key, Pid}, _, State) -> + {reply, ets:delete_object(?TABLE, ?MAPPING(Key, Pid)), State}; + +handle_call({repl, T, U, Pid}, _, State) -> + MatchSpec = [{?MAPPING('$1', Pid), + [{'=:=', '$1', {const, T}}], + ['$_']}], + {reply, repl(ets:select(?TABLE, MatchSpec), U, Pid), State}; + +handle_call(state, _, State) -> + {reply, State, State}; + +handle_call(uptime, _, #state{id = Time} = State) -> + {reply, diameter_lib:now_diff(Time), State}; + +handle_call(Req, From, State) -> + ?UNEXPECTED([Req, From]), + {reply, nok, State}. + +%%% ---------------------------------------------------------- +%%% # handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State)-> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% # handle_info(Request, State) +%%% ---------------------------------------------------------- + +handle_info({'DOWN', MRef, process, Pid, _}, State) -> + ets:delete_object(?TABLE, ?MONITOR(Pid, MRef)), + ets:match_delete(?TABLE, ?MAPPING('_', Pid)), + {noreply, State}; + +handle_info(Info, State) -> + ?UNEXPECTED([Info]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% # terminate(Reason, State) +%%% ---------------------------------------------------------- + +terminate(_Reason, _State)-> + ok. + +%%% ---------------------------------------------------------- +%%% # code_change(OldVsn, State, Extra) +%%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% --------------------------------------------------------- +%% INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +monitor(true, Pid) -> + ets:insert(?TABLE, ?MONITOR(Pid, erlang:monitor(process, Pid))); +monitor(false, _) -> + ok. + +%% Do we need a monitor for the specified Pid? +no_monitor(Pid) -> + [] == ets:match_object(?TABLE, ?MONITOR(Pid, '_')). + +%% insert_new/2 + +insert_new(?TABLE, {Key, _} = T) -> + flush(ets:lookup(?TABLE, Key)), + ets:insert_new(?TABLE, T). + +%% Remove any processes that are dead but for which we may not have +%% received 'DOWN' yet. This is to ensure that add_new can be used +%% to register a unique name each time a process restarts. +flush(List) -> + lists:foreach(fun({_,P} = T) -> + del(erlang:is_process_alive(P), T) + end, + List). + +del(Alive, T) -> + Alive orelse ets:delete_object(?TABLE, T). + +%% repl/3 + +repl([?MAPPING(_, Pid) = M], Key, Pid) -> + ets:delete_object(?TABLE, M), + true = ets:insert(?TABLE, ?MAPPING(Key, Pid)); +repl([], _, _) -> + false. + +%% call/1 + +call(Request) -> + gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl new file mode 100644 index 0000000000..421e36ccf5 --- /dev/null +++ b/lib/diameter/src/base/diameter_service.erl @@ -0,0 +1,2903 @@ +%% +%% %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% +%% + +%% +%% Implements the process that represents a service. +%% + +-module(diameter_service). +-behaviour(gen_server). + +-export([start/1, + stop/1, + start_transport/2, + stop_transport/2, + info/2, + call/4]). + +%% towards diameter_watchdog +-export([receive_message/3]). + +%% service supervisor +-export([start_link/1]). + +-export([subscribe/1, + unsubscribe/1, + subscriptions/1, + subscriptions/0, + services/0, + services/1, + whois/1, + flush_stats/1]). + +%% test/debug +-export([call_module/3, + state/1, + uptime/1]). + +%%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +%% Other callbacks. +-export([send/1]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). +-include("diameter_types.hrl"). + +-define(STATE_UP, up). +-define(STATE_DOWN, down). + +-define(DEFAULT_TC, 30000). %% RFC 3588 ch 2.1 +-define(DEFAULT_TIMEOUT, 5000). %% for outgoing requests +-define(RESTART_TC, 1000). %% if restart was this recent + +%% Used to be able to swap this with anything else dict-like but now +%% rely on the fact that a service's #state{} record does not change +%% in storing in it ?STATE table and not always going through the +%% service process. In particular, rely on the fact that operations on +%% a ?Dict don't change the handle to it. +-define(Dict, diameter_dict). + +%% Table containing outgoing requests for which a reply has yet to be +%% received. +-define(REQUEST_TABLE, diameter_request). + +%% Maintains state in a table. In contrast to previously, a service's +%% stat is not constant and is accessed outside of the service +%% process. +-define(STATE_TABLE, ?MODULE). + +%% Workaround for dialyzer's lack of understanding of match specs. +-type match(T) + :: T | '_' | '$1' | '$2' | '$3' | '$4'. + +%% State of service gen_server. +-record(state, + {id = now(), + service_name, %% as passed to start_service/2, key in ?STATE_TABLE + service :: #diameter_service{}, + peerT = ets_new(peers) :: ets:tid(), %% #peer{} at start_fsm + connT = ets_new(conns) :: ets:tid(), %% #conn{} at connection_up + share_peers = false :: boolean(), %% broadcast peers to remote nodes? + use_shared_peers = false :: boolean(), %% use broadcasted peers? + shared_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] + local_peers = ?Dict:new(), %% Alias -> [{TPid, Caps}, ...] + monitor = false :: false | pid()}). %% process to die with +%% shared_peers reflects the peers broadcast from remote nodes. Note +%% that the state term itself doesn't change, which is relevant for +%% the stateless application callbacks since the state is retrieved +%% from ?STATE_TABLE from outside the service process. The pid in the +%% service record is used to determine whether or not we need to call +%% the process for a pick_peer callback. + +%% Record representing a watchdog process. +-record(peer, + {pid :: match(pid()), + type :: match(connect | accept), + ref :: match(reference()), %% key into diameter_config + options :: match([transport_opt()]), %% as passed to start_transport + op_state = ?STATE_DOWN :: match(?STATE_DOWN | ?STATE_UP), + started = now(), %% at process start + conn = false :: match(boolean() | pid())}). + %% true at accept, pid() at connection_up (connT key) + +%% Record representing a peer_fsm process. +-record(conn, + {pid :: pid(), + apps :: [{0..16#FFFFFFFF, app_alias()}], %% {Id, Alias} + caps :: #diameter_caps{}, + started = now(), %% at process start + peer :: pid()}). %% key into peerT + +%% Record stored in diameter_request for each outgoing request. +-record(request, + {from, %% arg 2 of handle_call/3 + handler :: match(pid()), %% request process + transport :: match(pid()), %% peer process + caps :: match(#diameter_caps{}), + app :: match(app_alias()), %% #diameter_app.alias + dictionary :: match(module()), %% #diameter_app.dictionary + module :: match(nonempty_improper_list(module(), list())), + %% #diameter_app.module + filter :: match(peer_filter()), + packet :: match(#diameter_packet{})}). + +%% Record call/4 options are parsed into. +-record(options, + {filter = none :: peer_filter(), + extra = [] :: list(), + timeout = ?DEFAULT_TIMEOUT :: 0..16#FFFFFFFF, + detach = false :: boolean()}). + +%% Since RFC 3588 requires that a Diameter agent not modify End-to-End +%% Identifiers, the possibility of explicitly setting an End-to-End +%% Identifier would be needed to be able to implement an agent in +%% which one side of the communication is not implemented on top of +%% diameter. For example, Diameter being sent or received encapsulated +%% in some other protocol, or even another Diameter stack in a +%% non-Erlang environment. (Not that this is likely to be a normal +%% case.) +%% +%% The implemented solution is not an option but to respect any header +%% values set in a diameter_header record returned from a +%% prepare_request callback. A call to diameter:call/4 can communicate +%% values to the callback using the 'extra' option if so desired. + +%%% --------------------------------------------------------------------------- +%%% # start(SvcName) +%%% --------------------------------------------------------------------------- + +start(SvcName) -> + diameter_service_sup:start_child(SvcName). + +start_link(SvcName) -> + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(?MODULE, [SvcName], Options). +%% Put the arbitrary term SvcName in a list in case we ever want to +%% send more than this and need to distinguish old from new. + +%%% --------------------------------------------------------------------------- +%%% # stop(SvcName) +%%% --------------------------------------------------------------------------- + +stop(SvcName) -> + case whois(SvcName) of + undefined -> + {error, not_started}; + Pid -> + stop(call_service(Pid, stop), Pid) + end. + +stop(ok, Pid) -> + MRef = erlang:monitor(process, Pid), + receive {'DOWN', MRef, process, _, _} -> ok end; +stop(No, _) -> + No. + +%%% --------------------------------------------------------------------------- +%%% # start_transport(SvcName, {Ref, Type, Opts}) +%%% --------------------------------------------------------------------------- + +start_transport(SvcName, {_,_,_} = T) -> + call_service_by_name(SvcName, {start, T}). + +%%% --------------------------------------------------------------------------- +%%% # stop_transport(SvcName, Refs) +%%% --------------------------------------------------------------------------- + +stop_transport(_, []) -> + ok; +stop_transport(SvcName, [_|_] = Refs) -> + call_service_by_name(SvcName, {stop, Refs}). + +%%% --------------------------------------------------------------------------- +%%% # info(SvcName, Item) +%%% --------------------------------------------------------------------------- + +info(SvcName, Item) -> + info_rc(call_service_by_name(SvcName, {info, Item})). + +info_rc({error, _}) -> + undefined; +info_rc(Info) -> + Info. + +%%% --------------------------------------------------------------------------- +%%% # receive_message(TPid, Pkt, MessageData) +%%% --------------------------------------------------------------------------- + +%% Handle an incoming message in the watchdog process. This used to +%% come through the service process but this avoids that becoming a +%% bottleneck. + +receive_message(TPid, Pkt, T) + when is_pid(TPid) -> + #diameter_packet{header = #diameter_header{is_request = R}} = Pkt, + recv(R, (not R) andalso lookup_request(Pkt, TPid), TPid, Pkt, T). + +%% Incoming request ... +recv(true, false, TPid, Pkt, T) -> + try + spawn(fun() -> recv_request(TPid, Pkt, T) end) + catch + error: system_limit = E -> %% discard + ?LOG({error, E}, now()) + end; + +%% ... answer to known request ... +recv(false, #request{from = {_, Ref}, handler = Pid} = Req, _, Pkt, _) -> + Pid ! {answer, Ref, Req, Pkt}; +%% Note that failover could have happened prior to this message being +%% received and triggering failback. That is, both a failover message +%% and answer may be on their way to the handler process. In the worst +%% case the request process gets notification of the failover and +%% sends to the alternate peer before an answer arrives, so it's +%% always the case that we can receive more than one answer after +%% failover. The first answer received by the request process wins, +%% any others are discarded. + +%% ... or not. +recv(false, false, _, _, _) -> + ok. + +%%% --------------------------------------------------------------------------- +%%% # call(SvcName, App, Msg, Options) +%%% --------------------------------------------------------------------------- + +call(SvcName, App, Msg, Options) + when is_list(Options) -> + Rec = make_options(Options), + Ref = make_ref(), + Caller = {self(), Ref}, + Fun = fun() -> exit({Ref, call(SvcName, App, Msg, Rec, Caller)}) end, + try spawn_monitor(Fun) of + {_, MRef} -> + recv(MRef, Ref, Rec#options.detach, false) + catch + error: system_limit = E -> + {error, E} + end. + +%% Don't rely on gen_server:call/3 for the timeout handling since it +%% makes no guarantees about not leaving a reply message in the +%% mailbox if we catch its exit at timeout. It currently *can* do so, +%% which is also undocumented. + +recv(MRef, _, true, true) -> + erlang:demonitor(MRef, [flush]), + ok; + +recv(MRef, Ref, Detach, Sent) -> + receive + Ref -> %% send has been attempted + recv(MRef, Ref, Detach, true); + {'DOWN', MRef, process, _, Reason} -> + call_rc(Reason, Ref, Sent) + end. + +%% call/5 has returned ... +call_rc({Ref, Ans}, Ref, _) -> + Ans; + +%% ... or not. In this case failure/encode are documented. +call_rc(_, _, Sent) -> + {error, choose(Sent, failure, encode)}. + +%% call/5 +%% +%% In the process spawned for the outgoing request. + +call(SvcName, App, Msg, Opts, Caller) -> + c(ets:lookup(?STATE_TABLE, SvcName), App, Msg, Opts, Caller). + +c([#state{service_name = SvcName} = S], App, Msg, Opts, Caller) -> + case find_transport(App, Msg, Opts, S) of + {_,_,_} = T -> + send_request(T, Msg, Opts, Caller, SvcName); + false -> + {error, no_connection}; + {error, _} = No -> + No + end; + +c([], _, _, _, _) -> + {error, no_service}. + +%% make_options/1 + +make_options(Options) -> + lists:foldl(fun mo/2, #options{}, Options). + +mo({timeout, T}, Rec) + when is_integer(T), 0 =< T -> + Rec#options{timeout = T}; + +mo({filter, F}, #options{filter = none} = Rec) -> + Rec#options{filter = F}; +mo({filter, F}, #options{filter = {all, Fs}} = Rec) -> + Rec#options{filter = {all, [F | Fs]}}; +mo({filter, F}, #options{filter = F0} = Rec) -> + Rec#options{filter = {all, [F0, F]}}; + +mo({extra, L}, #options{extra = X} = Rec) + when is_list(L) -> + Rec#options{extra = X ++ L}; + +mo(detach, Rec) -> + Rec#options{detach = true}; + +mo(T, _) -> + ?ERROR({invalid_option, T}). + +%%% --------------------------------------------------------------------------- +%%% # subscribe(SvcName) +%%% # unsubscribe(SvcName) +%%% --------------------------------------------------------------------------- + +subscribe(SvcName) -> + diameter_reg:add({?MODULE, subscriber, SvcName}). + +unsubscribe(SvcName) -> + diameter_reg:del({?MODULE, subscriber, SvcName}). + +subscriptions(Pat) -> + pmap(diameter_reg:match({?MODULE, subscriber, Pat})). + +subscriptions() -> + subscriptions('_'). + +pmap(Props) -> + lists:map(fun({{?MODULE, _, Name}, Pid}) -> {Name, Pid} end, Props). + +%%% --------------------------------------------------------------------------- +%%% # services(Pattern) +%%% --------------------------------------------------------------------------- + +services(Pat) -> + pmap(diameter_reg:match({?MODULE, service, Pat})). + +services() -> + services('_'). + +whois(SvcName) -> + case diameter_reg:match({?MODULE, service, SvcName}) of + [{_, Pid}] -> + Pid; + [] -> + undefined + end. + +%%% --------------------------------------------------------------------------- +%%% # flush_stats/1 +%%% +%%% Output: list of {{SvcName, Alias, Counter}, Value} +%%% --------------------------------------------------------------------------- + +flush_stats(TPid) -> + diameter_stats:flush(TPid). + +%% =========================================================================== +%% =========================================================================== + +state(Svc) -> + call_service(Svc, state). + +uptime(Svc) -> + call_service(Svc, uptime). + +%% call_module/3 + +call_module(Service, AppMod, Request) -> + call_service(Service, {call_module, AppMod, Request}). + +%%% --------------------------------------------------------------------------- +%%% # init([SvcName]) +%%% --------------------------------------------------------------------------- + +init([SvcName]) -> + process_flag(trap_exit, true), %% ensure terminate(shutdown, _) + i(SvcName, diameter_reg:add_new({?MODULE, service, SvcName})). + +i(SvcName, true) -> + {ok, i(SvcName)}; +i(_, false) -> + {stop, {shutdown, already_started}}. + +%%% --------------------------------------------------------------------------- +%%% # handle_call(Req, From, State) +%%% --------------------------------------------------------------------------- + +handle_call(state, _, S) -> + {reply, S, S}; + +handle_call(uptime, _, #state{id = T} = S) -> + {reply, diameter_lib:now_diff(T), S}; + +%% Start a transport. +handle_call({start, {Ref, Type, Opts}}, _From, S) -> + {reply, start(Ref, {Type, Opts}, S), S}; + +%% Stop transports. +handle_call({stop, Refs}, _From, S) -> + shutdown(Refs, S), + {reply, ok, S}; + +%% pick_peer with mutable state +handle_call({pick_peer, Local, Remote, App}, _From, S) -> + #diameter_app{mutable = true} = App, %% assert + {reply, pick_peer(Local, Remote, self(), S#state.service_name, App), S}; + +handle_call({call_module, AppMod, Req}, From, S) -> + call_module(AppMod, Req, From, S); + +handle_call({info, Item}, _From, S) -> + {reply, service_info(Item, S), S}; + +handle_call(stop, _From, S) -> + shutdown(S), + {stop, normal, ok, S}; +%% The server currently isn't guaranteed to be dead when the caller +%% gets the reply. We deal with this in the call to the server, +%% stating a monitor that waits for DOWN before returning. + +handle_call(Req, From, S) -> + unexpected(handle_call, [Req, From], S), + {reply, nok, S}. + +%%% --------------------------------------------------------------------------- +%%% # handle_cast(Req, State) +%%% --------------------------------------------------------------------------- + +handle_cast(Req, S) -> + unexpected(handle_cast, [Req], S), + {noreply, S}. + +%%% --------------------------------------------------------------------------- +%%% # handle_info(Req, State) +%%% --------------------------------------------------------------------------- + +handle_info(T,S) -> + case transition(T,S) of + ok -> + {noreply, S}; + #state{} = NS -> + {noreply, NS}; + {stop, Reason} -> + {stop, {shutdown, Reason}, S} + end. + +%% transition/2 + +%% Peer process is telling us to start a new accept process. +transition({accepted, Pid, TPid}, S) -> + accepted(Pid, TPid, S), + ok; + +%% Peer process has a new open connection. +transition({connection_up, Pid, T}, S) -> + connection_up(Pid, T, S); + +%% Peer process has left state open. +transition({connection_down, Pid}, S) -> + connection_down(Pid, S); + +%% Peer process has returned to state open. +transition({connection_up, Pid}, S) -> + connection_up(Pid, S); + +%% Accepting transport has lost connectivity. +transition({close, Pid}, S) -> + close(Pid, S), + ok; + +%% Connecting transport is being restarted by watchdog. +transition({reconnect, Pid}, S) -> + reconnect(Pid, S), + ok; + +%% Monitor process has died. Just die with a reason that tells +%% diameter_config about the happening. If a cleaner shutdown is +%% required then someone should stop us. +transition({'DOWN', MRef, process, _, Reason}, #state{monitor = MRef}) -> + {stop, {monitor, Reason}}; + +%% Local peer process has died. +transition({'DOWN', _, process, Pid, Reason}, S) + when node(Pid) == node() -> + peer_down(Pid, Reason, S); + +%% Remote service wants to know about shared transports. +transition({service, Pid}, S) -> + share_peers(Pid, S), + ok; + +%% Remote service is communicating a shared peer. +transition({peer, TPid, Aliases, Caps}, S) -> + remote_peer_up(TPid, Aliases, Caps, S); + +%% Remote peer process has died. +transition({'DOWN', _, process, TPid, _}, S) -> + remote_peer_down(TPid, S); + +%% Restart after tc expiry. +transition({tc_timeout, T}, S) -> + tc_timeout(T, S), + ok; + +%% Request process is telling us it may have missed a failover message +%% after a transport went down and the service process looked up +%% outstanding requests. +transition({failover, TRef, Seqs}, S) -> + failover(TRef, Seqs, S), + ok; + +transition(Req, S) -> + unexpected(handle_info, [Req], S), + ok. + +%%% --------------------------------------------------------------------------- +%%% # terminate(Reason, State) +%%% --------------------------------------------------------------------------- + +terminate(Reason, #state{service_name = Name} = S) -> + ets:delete(?STATE_TABLE, Name), + shutdown == Reason %% application shutdown + andalso shutdown(S). + +%%% --------------------------------------------------------------------------- +%%% # code_change(FromVsn, State, Extra) +%%% --------------------------------------------------------------------------- + +code_change(FromVsn, + #state{service_name = SvcName, + service = #diameter_service{applications = Apps}} + = S, + Extra) -> + lists:foreach(fun(A) -> + code_change(FromVsn, SvcName, Extra, A) + end, + Apps), + {ok, S}. + +code_change(FromVsn, SvcName, Extra, #diameter_app{alias = Alias} = A) -> + {ok, S} = cb(A, code_change, [FromVsn, + mod_state(Alias), + Extra, + SvcName]), + mod_state(Alias, S). + +%% =========================================================================== +%% =========================================================================== + +unexpected(F, A, #state{service_name = Name}) -> + ?UNEXPECTED(F, A ++ [Name]). + +cb([_|_] = M, F, A) -> + eval(M, F, A); +cb(Rec, F, A) -> + {_, M} = app(Rec), + eval(M, F, A). + +app(#request{app = A, module = M}) -> + {A,M}; +app(#diameter_app{alias = A, module = M}) -> + {A,M}. + +eval([M|X], F, A) -> + apply(M, F, A ++ X). + +%% Callback with state. + +state_cb(#diameter_app{mutable = false, init_state = S}, {ModX, F, A}) -> + eval(ModX, F, A ++ [S]); + +state_cb(#diameter_app{mutable = true, alias = Alias}, {_,_,_} = MFA) -> + state_cb(MFA, Alias); + +state_cb({ModX,F,A}, Alias) + when is_list(ModX) -> + eval(ModX, F, A ++ [mod_state(Alias)]). + +choose(true, X, _) -> X; +choose(false, _, X) -> X. + +ets_new(Tbl) -> + ets:new(Tbl, [{keypos, 2}]). + +insert(Tbl, Rec) -> + ets:insert(Tbl, Rec), + Rec. + +monitor(Pid) -> + erlang:monitor(process, Pid), + Pid. + +%% Using the process dictionary for the callback state was initially +%% just a way to make what was horrendous trace (big state record and +%% much else everywhere) somewhat more readable. There's not as much +%% need for it now but it's no worse (except possibly that we don't +%% see the table identifier being passed around) than an ets table so +%% keep it. + +mod_state(Alias) -> + get({?MODULE, mod_state, Alias}). + +mod_state(Alias, ModS) -> + put({?MODULE, mod_state, Alias}, ModS). + +%% have_transport/2 + +have_transport(SvcName, Ref) -> + [] /= diameter_config:have_transport(SvcName, Ref). + +%%% --------------------------------------------------------------------------- +%%% # shutdown/2 +%%% --------------------------------------------------------------------------- + +shutdown(Refs, #state{peerT = PeerT}) -> + ets:foldl(fun(P,ok) -> s(P, Refs), ok end, ok, PeerT). + +s(#peer{ref = Ref, pid = Pid}, Refs) -> + s(lists:member(Ref, Refs), Pid); + +s(true, Pid) -> + Pid ! {shutdown, self()}; %% 'DOWN' will cleanup as usual +s(false, _) -> + ok. + +%%% --------------------------------------------------------------------------- +%%% # shutdown/1 +%%% --------------------------------------------------------------------------- + +shutdown(#state{peerT = PeerT}) -> + %% A transport might not be alive to receive the shutdown request + %% but give those that are a chance to shutdown gracefully. + wait(fun st/2, PeerT), + %% Kill the watchdogs explicitly in case there was no transport. + wait(fun sw/2, PeerT). + +wait(Fun, T) -> + diameter_lib:wait(ets:foldl(Fun, [], T)). + +st(#peer{conn = B}, Acc) + when is_boolean(B) -> + Acc; +st(#peer{conn = Pid}, Acc) -> + Pid ! shutdown, + [Pid | Acc]. + +sw(#peer{pid = Pid}, Acc) -> + exit(Pid, shutdown), + [Pid | Acc]. + +%%% --------------------------------------------------------------------------- +%%% # call_service/2 +%%% --------------------------------------------------------------------------- + +call_service(Pid, Req) + when is_pid(Pid) -> + cs(Pid, Req); +call_service(SvcName, Req) -> + call_service_by_name(SvcName, Req). + +call_service_by_name(SvcName, Req) -> + cs(whois(SvcName), Req). + +cs(Pid, Req) + when is_pid(Pid) -> + try + gen_server:call(Pid, Req, infinity) + catch + E: Reason when E == exit -> + {error, {E, Reason}} + end; + +cs(undefined, _) -> + {error, no_service}. + +%%% --------------------------------------------------------------------------- +%%% # i/1 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Intialize the state of a service gen_server. + +i(SvcName) -> + %% Split the config into a server state and a list of transports. + {#state{} = S, CL} = lists:foldl(fun cfg_acc/2, + {false, []}, + diameter_config:lookup(SvcName)), + + %% Publish the state in order to be able to access it outside of + %% the service process. Originally table identifiers were only + %% known to the service process but we now want to provide the + %% option of application callbacks being 'stateless' in order to + %% avoid having to go through a common process. (Eg. An agent that + %% sends a request for every incoming request.) + true = ets:insert_new(?STATE_TABLE, S), + + %% Start fsms for each transport. + lists:foreach(fun(T) -> start_fsm(T,S) end, CL), + + init_shared(S), + S. + +cfg_acc({SvcName, #diameter_service{applications = Apps} = Rec, Opts}, + {false, Acc}) -> + lists:foreach(fun init_mod/1, Apps), + S = #state{service_name = SvcName, + service = Rec#diameter_service{pid = self()}, + share_peers = get_value(share_peers, Opts), + use_shared_peers = get_value(use_shared_peers, Opts), + monitor = mref(get_value(monitor, Opts))}, + {S, Acc}; + +cfg_acc({_Ref, Type, _Opts} = T, {S, Acc}) + when Type == connect; + Type == listen -> + {S, [T | Acc]}. + +mref(false = No) -> + No; +mref(P) -> + erlang:monitor(process, P). + +init_shared(#state{use_shared_peers = true, + service_name = Svc}) -> + diameter_peer:notify(Svc, {service, self()}); +init_shared(#state{use_shared_peers = false}) -> + ok. + +init_mod(#diameter_app{alias = Alias, + init_state = S}) -> + mod_state(Alias, S). + +start_fsm({Ref, Type, Opts}, S) -> + start(Ref, {Type, Opts}, S). + +get_value(Key, Vs) -> + {_, V} = lists:keyfind(Key, 1, Vs), + V. + +%%% --------------------------------------------------------------------------- +%%% # start/3 +%%% --------------------------------------------------------------------------- + +%% If the initial start/3 at service/transport start succeeds then +%% subsequent calls to start/4 on the same service will also succeed +%% since they involve the same call to merge_service/2. We merge here +%% rather than earlier since the service may not yet be configured +%% when the transport is configured. + +start(Ref, {T, Opts}, S) + when T == connect; + T == listen -> + try + {ok, start(Ref, type(T), Opts, S)} + catch + ?FAILURE(Reason) -> + {error, Reason} + end. +%% TODO: don't actually raise any errors yet + +%% There used to be a difference here between the handling of +%% configured listening and connecting transports but now we simply +%% tell the transport_module to start an accepting or connecting +%% process respectively, the transport implementation initiating +%% listening on a port as required. +type(listen) -> accept; +type(accept) -> listen; +type(connect = T) -> T. + +%% start/4 + +start(Ref, Type, Opts, #state{peerT = PeerT, + connT = ConnT, + service_name = SvcName, + service = Svc}) + when Type == connect; + Type == accept -> + Pid = monitor(s(Type, Ref, {ConnT, + Opts, + SvcName, + merge_service(Opts, Svc)})), + insert(PeerT, #peer{pid = Pid, + type = Type, + ref = Ref, + options = Opts}), + Pid. + +%% Note that the service record passed into the watchdog is the merged +%% record so that each watchdog (and peer_fsm) may get a different +%% record. This record is what is passed back into application +%% callbacks. + +s(Type, Ref, T) -> + diameter_watchdog:start({Type, Ref}, T). + +%% merge_service/2 + +merge_service(Opts, Svc) -> + lists:foldl(fun ms/2, Svc, Opts). + +%% Limit the applications known to the fsm to those in the 'apps' +%% option. That this might be empty is checked by the fsm. It's not +%% checked at config-time since there's no requirement that the +%% service be configured first. (Which could be considered a bit odd.) +ms({applications, As}, #diameter_service{applications = Apps} = S) + when is_list(As) -> + S#diameter_service{applications + = [A || A <- Apps, + lists:member(A#diameter_app.alias, As)]}; + +%% The fact that all capabilities can be configured on the transports +%% means that the service doesn't necessarily represent a single +%% locally implemented Diameter peer as identified by Origin-Host: a +%% transport can configure its own Origin-Host. This means that the +%% service little more than a placeholder for default capabilities +%% plus a list of applications that individual transports can choose +%% to support (or not). +ms({capabilities, Opts}, #diameter_service{capabilities = Caps0} = Svc) + when is_list(Opts) -> + %% make_caps has already succeeded in diameter_config so it will succeed + %% again here. + {ok, Caps} = diameter_capx:make_caps(Caps0, Opts), + Svc#diameter_service{capabilities = Caps}; + +ms(_, Svc) -> + Svc. + +%%% --------------------------------------------------------------------------- +%%% # accepted/3 +%%% --------------------------------------------------------------------------- + +accepted(Pid, _TPid, #state{peerT = PeerT} = S) -> + #peer{ref = Ref, type = accept = T, conn = false, options = Opts} + = P + = fetch(PeerT, Pid), + insert(PeerT, P#peer{conn = true}), %% mark replacement transport started + start(Ref, T, Opts, S). %% start new peer + +fetch(Tid, Key) -> + [T] = ets:lookup(Tid, Key), + T. + +%%% --------------------------------------------------------------------------- +%%% # connection_up/3 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Peer process has reached the open state. + +connection_up(Pid, {TPid, {Caps, SApps, Pkt}}, #state{peerT = PeerT, + connT = ConnT} + = S) -> + P = fetch(PeerT, Pid), + C = #conn{pid = TPid, + apps = SApps, + caps = Caps, + peer = Pid}, + + insert(ConnT, C), + connection_up([Pkt], P#peer{conn = TPid}, C, S). + +%%% --------------------------------------------------------------------------- +%%% # connection_up/2 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Peer process has transitioned back into the open state. Note that there +%% has been no new capabilties exchange in this case. + +connection_up(Pid, #state{peerT = PeerT, + connT = ConnT} + = S) -> + #peer{conn = TPid} = P = fetch(PeerT, Pid), + C = fetch(ConnT, TPid), + connection_up([], P, C, S). + +%% connection_up/4 + +connection_up(T, P, C, #state{peerT = PeerT, + local_peers = LDict, + service_name = SvcName, + service + = #diameter_service{applications = Apps}} + = S) -> + #peer{conn = TPid, op_state = ?STATE_DOWN} + = P, + #conn{apps = SApps, caps = Caps} + = C, + + insert(PeerT, P#peer{op_state = ?STATE_UP}), + + request_peer_up(TPid), + report_status(up, P, C, S, T), + S#state{local_peers = insert_local_peer(SApps, + {{TPid, Caps}, {SvcName, Apps}}, + LDict)}. + +insert_local_peer(SApps, T, LDict) -> + lists:foldl(fun(A,D) -> ilp(A, T, D) end, LDict, SApps). + +ilp({Id, Alias}, {TC, SA}, LDict) -> + init_conn(Id, Alias, TC, SA), + ?Dict:append(Alias, TC, LDict). + +init_conn(Id, Alias, TC, {SvcName, Apps}) -> + #diameter_app{module = ModX, + id = Id} %% assert + = find_app(Alias, Apps), + + peer_cb({ModX, peer_up, [SvcName, TC]}, Alias). + +find_app(Alias, Apps) -> + lists:keyfind(Alias, #diameter_app.alias, Apps). + +%% A failing peer callback brings down the service. In the case of +%% peer_up we could just kill the transport and emit an error but for +%% peer_down we have no way to cleanup any state change that peer_up +%% may have introduced. +peer_cb(MFA, Alias) -> + try state_cb(MFA, Alias) of + ModS -> + mod_state(Alias, ModS) + catch + E: Reason -> + ?ERROR({E, Reason, MFA, ?STACK}) + end. + +%%% --------------------------------------------------------------------------- +%%% # connection_down/2 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Peer process has transitioned out of the open state. + +connection_down(Pid, #state{peerT = PeerT, + connT = ConnT} + = S) -> + #peer{conn = TPid} + = P + = fetch(PeerT, Pid), + + C = fetch(ConnT, TPid), + insert(PeerT, P#peer{op_state = ?STATE_DOWN}), + connection_down(P,C,S). + +%% connection_down/3 + +connection_down(#peer{conn = TPid, + op_state = ?STATE_UP} + = P, + #conn{caps = Caps, + apps = SApps} + = C, + #state{service_name = SvcName, + service = #diameter_service{applications = Apps}, + local_peers = LDict} + = S) -> + report_status(down, P, C, S, []), + NewS = S#state{local_peers + = remove_local_peer(SApps, + {{TPid, Caps}, {SvcName, Apps}}, + LDict)}, + request_peer_down(TPid, NewS), + NewS. + +remove_local_peer(SApps, T, LDict) -> + lists:foldl(fun(A,D) -> rlp(A, T, D) end, LDict, SApps). + +rlp({Id, Alias}, {TC, SA}, LDict) -> + L = ?Dict:fetch(Alias, LDict), + down_conn(Id, Alias, TC, SA), + ?Dict:store(Alias, lists:delete(TC, L), LDict). + +down_conn(Id, Alias, TC, {SvcName, Apps}) -> + #diameter_app{module = ModX, + id = Id} %% assert + = find_app(Alias, Apps), + + peer_cb({ModX, peer_down, [SvcName, TC]}, Alias). + +%%% --------------------------------------------------------------------------- +%%% # peer_down/3 +%%% +%%% Output: #state{} +%%% --------------------------------------------------------------------------- + +%% Peer process has died. + +peer_down(Pid, _Reason, #state{peerT = PeerT} = S) -> + P = fetch(PeerT, Pid), + ets:delete_object(PeerT, P), + restart(P,S), + peer_down(P,S). + +%% peer_down/2 + +%% The peer has never come up ... +peer_down(#peer{conn = B}, S) + when is_boolean(B) -> + S; + +%% ... or it has. +peer_down(#peer{ref = Ref, + conn = TPid, + type = Type, + options = Opts} + = P, + #state{service_name = SvcName, + connT = ConnT} + = S) -> + #conn{caps = Caps} + = C + = fetch(ConnT, TPid), + ets:delete_object(ConnT, C), + try + pd(P,C,S) + after + send_event(SvcName, {closed, Ref, {TPid, Caps}, {type(Type), Opts}}) + end. + +pd(#peer{op_state = ?STATE_DOWN}, _, S) -> + S; +pd(#peer{op_state = ?STATE_UP} = P, C, S) -> + connection_down(P,C,S). + +%% restart/2 + +restart(P,S) -> + q_restart(restart(P), S). + +%% restart/1 + +%% Always try to reconnect. +restart(#peer{ref = Ref, + type = connect = T, + options = Opts, + started = Time}) -> + {Time, {Ref, T, Opts}}; + +%% Transport connection hasn't yet been accepted ... +restart(#peer{ref = Ref, + type = accept = T, + options = Opts, + conn = false, + started = Time}) -> + {Time, {Ref, T, Opts}}; + +%% ... or it has: a replacement transport has already been spawned. +restart(#peer{type = accept}) -> + false. + +%% q_restart/2 + +%% Start the reconnect timer. +q_restart({Time, {_Ref, Type, Opts} = T}, S) -> + start_tc(tc(Time, default_tc(Type, Opts)), T, S); +q_restart(false, _) -> + ok. + +%% RFC 3588, 2.1: +%% +%% When no transport connection exists with a peer, an attempt to +%% connect SHOULD be periodically made. This behavior is handled via +%% the Tc timer, whose recommended value is 30 seconds. There are +%% certain exceptions to this rule, such as when a peer has terminated +%% the transport connection stating that it does not wish to +%% communicate. + +default_tc(connect, Opts) -> + proplists:get_value(reconnect_timer, Opts, ?DEFAULT_TC); +default_tc(accept, _) -> + 0. + +%% Bound tc below if the peer was restarted recently to avoid +%% continuous in case of faulty config or other problems. +tc(Time, Tc) -> + choose(Tc > ?RESTART_TC + orelse timer:now_diff(now(), Time) > 1000*?RESTART_TC, + Tc, + ?RESTART_TC). + +start_tc(0, T, S) -> + tc_timeout(T, S); +start_tc(Tc, T, _) -> + erlang:send_after(Tc, self(), {tc_timeout, T}). + +%% tc_timeout/2 + +tc_timeout({Ref, _Type, _Opts} = T, #state{service_name = SvcName} = S) -> + tc(have_transport(SvcName, Ref), T, S). + +tc(true, {Ref, Type, Opts}, #state{service_name = SvcName} + = S) -> + send_event(SvcName, {reconnect, Ref, Opts}), + start(Ref, Type, Opts, S); +tc(false = No, _, _) -> %% removed + No. + +%%% --------------------------------------------------------------------------- +%%% # close/2 +%%% --------------------------------------------------------------------------- + +%% The watchdog doesn't start a new fsm in the accept case, it +%% simply stays alive until someone tells it to die in order for +%% another watchdog to be able to detect that it should transition +%% from initial into reopen rather than okay. That someone is either +%% the accepting watchdog upon reception of a CER from the previously +%% connected peer, or us after reconnect_timer timeout. + +close(Pid, #state{service_name = SvcName, + peerT = PeerT}) -> + #peer{pid = Pid, + type = accept, + ref = Ref, + options = Opts} + = fetch(PeerT, Pid), + + c(Pid, have_transport(SvcName, Ref), Opts). + +%% Tell watchdog to (maybe) die later ... +c(Pid, true, Opts) -> + Tc = proplists:get_value(reconnect_timer, Opts, 2*?DEFAULT_TC), + erlang:send_after(Tc, Pid, close); + +%% ... or now. +c(Pid, false, _Opts) -> + Pid ! close. + +%% The RFC's only document the behaviour of Tc, our reconnect_timer, +%% for the establishment of connections but we also give +%% reconnect_timer semantics for a listener, being the time within +%% which a new connection attempt is expected of a connecting peer. +%% The value should be greater than the peer's Tc + jitter. + +%%% --------------------------------------------------------------------------- +%%% # reconnect/2 +%%% --------------------------------------------------------------------------- + +reconnect(Pid, #state{service_name = SvcName, + peerT = PeerT}) -> + #peer{ref = Ref, + type = connect, + options = Opts} + = fetch(PeerT, Pid), + send_event(SvcName, {reconnect, Ref, Opts}). + +%%% --------------------------------------------------------------------------- +%%% # call_module/4 +%%% --------------------------------------------------------------------------- + +%% Backwards compatibility and never documented/advertised. May be +%% removed. + +call_module(Mod, Req, From, #state{service + = #diameter_service{applications = Apps}, + service_name = Svc} + = S) -> + case cm([A || A <- Apps, Mod == hd(A#diameter_app.module)], + Req, + From, + Svc) + of + {reply = T, RC} -> + {T, RC, S}; + noreply = T -> + {T, S}; + Reason -> + {reply, {error, Reason}, S} + end. + +cm([#diameter_app{module = ModX, alias = Alias}], Req, From, Svc) -> + MFA = {ModX, handle_call, [Req, From, Svc]}, + + try state_cb(MFA, Alias) of + {noreply = T, ModS} -> + mod_state(Alias, ModS), + T; + {reply = T, RC, ModS} -> + mod_state(Alias, ModS), + {T, RC}; + T -> + diameter_lib:error_report({invalid, T}, MFA), + invalid + catch + E: Reason -> + diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA), + failure + end; + +cm([], _, _, _) -> + unknown; + +cm([_,_|_], _, _, _) -> + multiple. + +%%% --------------------------------------------------------------------------- +%%% # send_request/5 +%%% --------------------------------------------------------------------------- + +%% Send an outgoing request in its dedicated process. +%% +%% Note that both encode of the outgoing request and of the received +%% answer happens in this process. It's also this process that replies +%% to the caller. The service process only handles the state-retaining +%% callbacks. +%% +%% The mod field of the #diameter_app{} here includes any extra +%% arguments passed to diameter:call/2. + +send_request({TPid, Caps, App}, Msg, Opts, Caller, SvcName) -> + #diameter_app{module = ModX} + = App, + + Pkt = make_packet(Msg), + + case cb(ModX, prepare_request, [Pkt, SvcName, {TPid, Caps}]) of + {send, P} -> + send_request(make_packet(P, Pkt), + TPid, + Caps, + App, + Opts, + Caller, + SvcName); + {discard, Reason} -> + {error, Reason}; + discard -> + {error, discarded}; + T -> + ?ERROR({invalid_return, prepare_request, App, T}) + end. + +%% make_packet/1 +%% +%% Turn an outgoing request as passed to call/4 into a diameter_packet +%% record in preparation for a prepare_request callback. + +make_packet(Bin) + when is_binary(Bin) -> + #diameter_packet{header = diameter_codec:decode_header(Bin), + bin = Bin}; + +make_packet(#diameter_packet{msg = [#diameter_header{} = Hdr | Avps]} = Pkt) -> + Pkt#diameter_packet{msg = [make_header(Hdr) | Avps]}; + +make_packet(#diameter_packet{header = Hdr} = Pkt) -> + Pkt#diameter_packet{header = make_header(Hdr)}; + +make_packet(Msg) -> + make_packet(#diameter_packet{msg = Msg}). + +%% make_header/1 + +make_header(undefined) -> + Seq = diameter_session:sequence(), + make_header(#diameter_header{end_to_end_id = Seq, + hop_by_hop_id = Seq}); + +make_header(#diameter_header{version = undefined} = Hdr) -> + make_header(Hdr#diameter_header{version = ?DIAMETER_VERSION}); + +make_header(#diameter_header{end_to_end_id = undefined} = H) -> + Seq = diameter_session:sequence(), + make_header(H#diameter_header{end_to_end_id = Seq}); + +make_header(#diameter_header{hop_by_hop_id = undefined} = H) -> + Seq = diameter_session:sequence(), + make_header(H#diameter_header{hop_by_hop_id = Seq}); + +make_header(#diameter_header{} = Hdr) -> + Hdr; + +make_header(T) -> + ?ERROR({invalid_header, T}). + +%% make_packet/2 +%% +%% Reconstruct a diameter_packet from the return value of +%% prepare_request or prepare_retransmit callback. + +make_packet(Bin, _) + when is_binary(Bin) -> + make_packet(Bin); + +make_packet(#diameter_packet{msg = [#diameter_header{} | _]} = Pkt, _) -> + Pkt; + +%% Returning a diameter_packet with no header from a prepare_request +%% or prepare_retransmit callback retains the header passed into it. +%% This is primarily so that the end to end and hop by hop identifiers +%% are retained. +make_packet(#diameter_packet{header = Hdr} = Pkt, + #diameter_packet{header = Hdr0}) -> + Pkt#diameter_packet{header = fold_record(Hdr0, Hdr)}; + +make_packet(Msg, Pkt) -> + Pkt#diameter_packet{msg = Msg}. + +%% fold_record/2 + +fold_record(undefined, R) -> + R; +fold_record(Rec, R) -> + diameter_lib:fold_tuple(2, Rec, R). + +%% send_request/7 + +send_request(Pkt, TPid, Caps, App, Opts, Caller, SvcName) -> + #diameter_app{alias = Alias, + dictionary = Dict, + module = ModX, + answer_errors = AE} + = App, + + EPkt = encode(Dict, Pkt), + + #options{filter = Filter, + timeout = Timeout} + = Opts, + + Req = #request{packet = Pkt, + from = Caller, + handler = self(), + transport = TPid, + caps = Caps, + app = Alias, + filter = Filter, + dictionary = Dict, + module = ModX}, + + try + TRef = send_request(TPid, EPkt, Req, Timeout), + ack(Caller), + handle_answer(SvcName, AE, recv_answer(Timeout, SvcName, {TRef, Req})) + after + erase_request(EPkt) + end. + +%% Tell caller a send has been attempted. +ack({Pid, Ref}) -> + Pid ! Ref. + +%% recv_answer/3 + +recv_answer(Timeout, + SvcName, + {TRef, #request{from = {_, Ref}, packet = RPkt} = Req} + = T) -> + + %% Matching on TRef below ensures we ignore messages that pertain + %% to a previous transport prior to failover. The answer message + %% includes the #request{} since it's not necessarily Req; that + %% is, from the last peer to which we've transmitted. + + receive + {answer = A, Ref, Rq, Pkt} -> %% Answer from peer + {A, Rq, Pkt}; + {timeout = Reason, TRef, _} -> %% No timely reply + {error, Req, Reason}; + {failover = Reason, TRef, false} -> %% No alternate peer + {error, Req, Reason}; + {failover, TRef, Transport} -> %% Resend to alternate peer + try_retransmit(Timeout, SvcName, Req, Transport); + {failover, TRef} -> %% May have missed failover notification + Seqs = diameter_codec:sequence_numbers(RPkt), + Pid = whois(SvcName), + is_pid(Pid) andalso (Pid ! {failover, TRef, Seqs}), + recv_answer(Timeout, SvcName, T) + end. +%% Note that failover starts a new timer and that expiry of an old +%% timer value is ignored. This means that an answer could be accepted +%% from a peer after timeout in the case of failover. + +try_retransmit(Timeout, SvcName, Req, Transport) -> + try retransmit(Transport, Req, SvcName, Timeout) of + T -> recv_answer(Timeout, SvcName, T) + catch + ?FAILURE(Reason) -> {error, Req, Reason} + end. + +%% handle_error/3 + +handle_error(Req, Reason, SvcName) -> + #request{module = ModX, + packet = Pkt, + transport = TPid, + caps = Caps} + = Req, + cb(ModX, handle_error, [Reason, msg(Pkt), SvcName, {TPid, Caps}]). + +msg(#diameter_packet{msg = undefined, bin = Bin}) -> + Bin; +msg(#diameter_packet{msg = Msg}) -> + Msg. + +%% encode/2 + +%% Note that prepare_request can return a diameter_packet containing +%% header or transport_data. Even allow the returned record to contain +%% an encoded binary. This isn't the usual case but could some in +%% handy, for test at least. (For example, to send garbage.) + +%% The normal case: encode the returned message. +encode(Dict, #diameter_packet{msg = Msg, bin = undefined} = Pkt) -> + D = pick_dictionary([Dict, ?BASE], Msg), + diameter_codec:encode(D, Pkt); + +%% Callback has returned an encoded binary: just send. +encode(_, #diameter_packet{} = Pkt) -> + Pkt. + +%% pick_dictionary/2 + +%% Pick the first dictionary that declares the application id in the +%% specified header. +pick_dictionary(Ds, [#diameter_header{application_id = Id} | _]) -> + pd(Ds, fun(D) -> Id = D:id() end); + +%% Pick the first dictionary that knows the specified message name. +pick_dictionary(Ds, [MsgName|_]) -> + pd(Ds, fun(D) -> D:msg2rec(MsgName) end); + +%% Pick the first dictionary that knows the name of the specified +%% message record. +pick_dictionary(Ds, Rec) -> + Name = element(1, Rec), + pd(Ds, fun(D) -> D:rec2msg(Name) end). + +pd([D|Ds], F) -> + try + F(D), + D + catch + error:_ -> + pd(Ds, F) + end; + +pd([], _) -> + ?ERROR(no_dictionary). + +%% send_request/4 + +send_request(TPid, #diameter_packet{bin = Bin} = Pkt, Req, Timeout) + when node() == node(TPid) -> + %% Store the outgoing request before sending to avoid a race with + %% reply reception. + TRef = store_request(TPid, Bin, Req, Timeout), + send(TPid, Pkt), + TRef; + +%% Send using a remote transport: spawn a process on the remote node +%% to relay the answer. +send_request(TPid, #diameter_packet{} = Pkt, Req, Timeout) -> + TRef = erlang:start_timer(Timeout, self(), timeout), + T = {TPid, Pkt, Req, Timeout, TRef}, + spawn(node(TPid), ?MODULE, send, [T]), + TRef. + +%% send/1 + +send({TPid, Pkt, #request{handler = Pid} = Req, Timeout, TRef}) -> + Ref = send_request(TPid, Pkt, Req#request{handler = self()}, Timeout), + Pid ! reref(receive T -> T end, Ref, TRef). + +reref({T, Ref, R}, Ref, TRef) -> + {T, TRef, R}; +reref(T, _, _) -> + T. + +%% send/2 + +send(Pid, Pkt) -> + Pid ! {send, Pkt}. + +%% retransmit/4 + +retransmit({TPid, Caps, #diameter_app{alias = Alias} = App}, + #request{app = Alias, + packet = Pkt} + = Req, + SvcName, + Timeout) -> + have_request(Pkt, TPid) %% Don't failover to a peer we've + andalso ?THROW(timeout), %% already sent to. + + case cb(App, prepare_retransmit, [Pkt, SvcName, {TPid, Caps}]) of + {send, P} -> + retransmit(make_packet(P, Pkt), TPid, Caps, Req, Timeout); + {discard, Reason} -> + ?THROW(Reason); + discard -> + ?THROW(discarded); + T -> + ?ERROR({invalid_return, prepare_retransmit, App, T}) + end. + +%% retransmit/5 + +retransmit(Pkt, TPid, Caps, #request{dictionary = Dict} = Req, Timeout) -> + EPkt = encode(Dict, Pkt), + + NewReq = Req#request{transport = TPid, + packet = Pkt, + caps = Caps}, + + ?LOG(retransmission, NewReq), + TRef = send_request(TPid, EPkt, NewReq, Timeout), + {TRef, NewReq}. + +%% store_request/4 + +store_request(TPid, Bin, Req, Timeout) -> + Seqs = diameter_codec:sequence_numbers(Bin), + TRef = erlang:start_timer(Timeout, self(), timeout), + ets:insert(?REQUEST_TABLE, {Seqs, Req, TRef}), + ets:member(?REQUEST_TABLE, TPid) + orelse (self() ! {failover, TRef}), %% possibly missed failover + TRef. + +%% lookup_request/2 + +lookup_request(Msg, TPid) + when is_pid(TPid) -> + lookup(Msg, TPid, '_'); + +lookup_request(Msg, TRef) + when is_reference(TRef) -> + lookup(Msg, '_', TRef). + +lookup(Msg, TPid, TRef) -> + Seqs = diameter_codec:sequence_numbers(Msg), + Spec = [{{Seqs, #request{transport = TPid, _ = '_'}, TRef}, + [], + ['$_']}], + case ets:select(?REQUEST_TABLE, Spec) of + [{_, Req, _}] -> + Req; + [] -> + false + end. + +%% erase_request/1 + +erase_request(Pkt) -> + ets:delete(?REQUEST_TABLE, diameter_codec:sequence_numbers(Pkt)). + +%% match_requests/1 + +match_requests(TPid) -> + Pat = {'_', #request{transport = TPid, _ = '_'}, '_'}, + ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}]). + +%% have_request/2 + +have_request(Pkt, TPid) -> + Seqs = diameter_codec:sequence_numbers(Pkt), + Pat = {Seqs, #request{transport = TPid, _ = '_'}, '_'}, + '$end_of_table' /= ets:select(?REQUEST_TABLE, [{Pat, [], ['$_']}], 1). + +%% request_peer_up/1 + +request_peer_up(TPid) -> + ets:insert(?REQUEST_TABLE, {TPid}). + +%% request_peer_down/2 + +request_peer_down(TPid, S) -> + ets:delete(?REQUEST_TABLE, TPid), + lists:foreach(fun(T) -> failover(T,S) end, match_requests(TPid)). +%% Note that a request process can store its request after failover +%% notifications are sent here: store_request/4 sends the notification +%% in that case. Note also that we'll send as many notifications to a +%% given handler as there are peers its sent to. All but one of these +%% will be ignored. + +%%% --------------------------------------------------------------------------- +%%% recv_request/3 +%%% --------------------------------------------------------------------------- + +recv_request(TPid, Pkt, {ConnT, SvcName, Apps}) -> + try ets:lookup(ConnT, TPid) of + [C] -> + recv_request(C, TPid, Pkt, SvcName, Apps); + [] -> %% transport has gone down + ok + catch + error: badarg -> %% service has gone down (and taken table with it) + ok + end. + +%% recv_request/5 + +recv_request(#conn{apps = SApps, caps = Caps}, TPid, Pkt, SvcName, Apps) -> + #diameter_caps{origin_host = {OH,_}, + origin_realm = {OR,_}} + = Caps, + + #diameter_packet{header = #diameter_header{application_id = Id}} + = Pkt, + + recv_request(find_recv_app(Id, SApps), + {SvcName, OH, OR}, + TPid, + Apps, + Caps, + Pkt). + +%% find_recv_app/2 + +%% No one should be sending the relay identifier. +find_recv_app(?APP_ID_RELAY, _) -> + false; + +%% With any other id we either support it locally or as a relay. +find_recv_app(Id, SApps) -> + keyfind([Id, ?APP_ID_RELAY], 1, SApps). + +%% keyfind/3 + +keyfind([], _, _) -> + false; +keyfind([Key | Rest], Pos, L) -> + case lists:keyfind(Key, Pos, L) of + false -> + keyfind(Rest, Pos, L); + T -> + T + end. + +%% recv_request/6 + +recv_request({Id, Alias}, T, TPid, Apps, Caps, Pkt) -> + #diameter_app{dictionary = Dict} + = A + = find_app(Alias, Apps), + recv_request(T, {TPid, Caps}, A, diameter_codec:decode(Id, Dict, Pkt)); +%% Note that the decode is different depending on whether or not Id is +%% ?APP_ID_RELAY. + +%% DIAMETER_APPLICATION_UNSUPPORTED 3007 +%% A request was sent for an application that is not supported. + +recv_request(false, T, TPid, _, _, Pkt) -> + As = collect_avps(Pkt), + protocol_error(3007, T, TPid, Pkt#diameter_packet{avps = As}). + +collect_avps(Pkt) -> + case diameter_codec:collect_avps(Pkt) of + {_Bs, As} -> + As; + As -> + As + end. + +%% recv_request/4 + +%% Wrong number of bits somewhere in the message: reply. +%% +%% DIAMETER_INVALID_AVP_BITS 3009 +%% A request was received that included an AVP whose flag bits are +%% set to an unrecognized value, or that is inconsistent with the +%% AVP's definition. +%% +recv_request(T, {TPid, _}, _, #diameter_packet{errors = [Bs | _]} = Pkt) + when is_bitstring(Bs) -> + protocol_error(3009, T, TPid, Pkt); + +%% Either we support this application but don't recognize the command +%% or we're a relay and the command isn't proxiable. +%% +%% DIAMETER_COMMAND_UNSUPPORTED 3001 +%% The Request contained a Command-Code that the receiver did not +%% recognize or support. This MUST be used when a Diameter node +%% receives an experimental command that it does not understand. +%% +recv_request(T, + {TPid, _}, + #diameter_app{id = Id}, + #diameter_packet{header = #diameter_header{is_proxiable = P}, + msg = M} + = Pkt) + when ?APP_ID_RELAY /= Id, undefined == M; + ?APP_ID_RELAY == Id, not P -> + protocol_error(3001, T, TPid, Pkt); + +%% Error bit was set on a request. +%% +%% DIAMETER_INVALID_HDR_BITS 3008 +%% A request was received whose bits in the Diameter header were +%% either set to an invalid combination, or to a value that is +%% inconsistent with the command code's definition. +%% +recv_request(T, + {TPid, _}, + _, + #diameter_packet{header = #diameter_header{is_error = true}} + = Pkt) -> + protocol_error(3008, T, TPid, Pkt); + +%% A message in a locally supported application or a proxiable message +%% in the relay application. Don't distinguish between the two since +%% each application has its own callback config. That is, the user can +%% easily distinguish between the two cases. +recv_request(T, TC, App, Pkt) -> + request_cb(T, TC, App, examine(Pkt)). + +%% Note that there may still be errors but these aren't protocol +%% (3xxx) errors that lead to an answer-message. + +request_cb({SvcName, _OH, _OR} = T, TC, App, Pkt) -> + request_cb(cb(App, handle_request, [Pkt, SvcName, TC]), App, T, TC, Pkt). + +%% examine/1 +%% +%% Look for errors in a decoded message. Length errors result in +%% decode failure in diameter_codec. + +examine(#diameter_packet{header = #diameter_header{version + = ?DIAMETER_VERSION}} + = Pkt) -> + Pkt; + +%% DIAMETER_UNSUPPORTED_VERSION 5011 +%% This error is returned when a request was received, whose version +%% number is unsupported. + +examine(#diameter_packet{errors = Es} = Pkt) -> + Pkt#diameter_packet{errors = [5011 | Es]}. +%% It's odd/unfortunate that this isn't a protocol error. + +%% request_cb/5 + +%% A reply may be an answer-message, constructed either here or by +%% the handle_request callback. The header from the incoming request +%% is passed into the encode so that it can retrieve the relevant +%% command code in this case. It will also then ignore Dict and use +%% the base encoder. +request_cb({reply, Ans}, + #diameter_app{dictionary = Dict}, + _, + {TPid, _}, + Pkt) -> + reply(Ans, Dict, TPid, Pkt); + +%% An 3xxx result code, for which the E-bit is set in the header. +request_cb({protocol_error, RC}, _, T, {TPid, _}, Pkt) + when 3000 =< RC, RC < 4000 -> + protocol_error(RC, T, TPid, Pkt); + +%% RFC 3588 says we must reply 3001 to anything unrecognized or +%% unsupported. 'noreply' is undocumented (and inappropriately named) +%% backwards compatibility for this, protocol_error the documented +%% alternative. +request_cb(noreply, _, T, {TPid, _}, Pkt) -> + protocol_error(3001, T, TPid, Pkt); + +%% Relay a request to another peer. This is equivalent to doing an +%% explicit call/4 with the message in question except that (1) a loop +%% will be detected by examining Route-Record AVP's, (3) a +%% Route-Record AVP will be added to the outgoing request and (3) the +%% End-to-End Identifier will default to that in the +%% #diameter_header{} without the need for an end_to_end_identifier +%% option. +%% +%% relay and proxy are similar in that they require the same handling +%% with respect to Route-Record and End-to-End identifier. The +%% difference is that a proxy advertises specific applications, while +%% a relay advertises the relay application. If a callback doesn't +%% want to distinguish between the cases in the callback return value +%% then 'resend' is a neutral alternative. +%% +request_cb({A, Opts}, + #diameter_app{id = Id} + = App, + T, + TC, + Pkt) + when A == relay, Id == ?APP_ID_RELAY; + A == proxy, Id /= ?APP_ID_RELAY; + A == resend -> + resend(Opts, App, T, TC, Pkt); + +request_cb(discard, _, _, _, _) -> + ok; + +request_cb({eval, RC, F}, App, T, TC, Pkt) -> + request_cb(RC, App, T, TC, Pkt), + diameter_lib:eval(F). + +%% protocol_error/4 + +protocol_error(RC, {_, OH, OR}, TPid, #diameter_packet{avps = Avps} = Pkt) -> + ?LOG({error, RC}, Pkt), + reply(answer_message({OH, OR, RC}, Avps), ?BASE, TPid, Pkt). + +%% resend/5 +%% +%% Resend a message as a relay or proxy agent. + +resend(Opts, + #diameter_app{} = App, + {_SvcName, OH, _OR} = T, + {_TPid, _Caps} = TC, + #diameter_packet{avps = Avps} = Pkt) -> + {Code, _Flags, Vid} = ?BASE:avp_header('Route-Record'), + resend(is_loop(Code, Vid, OH, Avps), Opts, App, T, TC, Pkt). + +%% DIAMETER_LOOP_DETECTED 3005 +%% An agent detected a loop while trying to get the message to the +%% intended recipient. The message MAY be sent to an alternate peer, +%% if one is available, but the peer reporting the error has +%% identified a configuration problem. + +resend(true, _, _, T, {TPid, _}, Pkt) -> %% Route-Record loop + protocol_error(3005, T, TPid, Pkt); + +%% 6.1.8. Relaying and Proxying Requests +%% +%% A relay or proxy agent MUST append a Route-Record AVP to all requests +%% forwarded. The AVP contains the identity of the peer the request was +%% received from. + +resend(false, + Opts, + App, + {SvcName, _, _} = T, + {TPid, #diameter_caps{origin_host = {_, OH}}}, + #diameter_packet{header = Hdr0, + avps = Avps} + = Pkt) -> + Route = #diameter_avp{data = {?BASE, 'Route-Record', OH}}, + Seq = diameter_session:sequence(), + Hdr = Hdr0#diameter_header{hop_by_hop_id = Seq}, + Msg = [Hdr, Route | Avps], + resend(call(SvcName, App, Msg, Opts), T, TPid, Pkt). +%% The incoming request is relayed with the addition of a +%% Route-Record. Note the requirement on the return from call/4 below, +%% which places a requirement on the value returned by the +%% handle_answer callback of the application module in question. +%% +%% Note that there's nothing stopping the request from being relayed +%% back to the sender. A pick_peer callback may want to avoid this but +%% a smart peer might recognize the potential loop and choose another +%% route. A less smart one will probably just relay the request back +%% again and force us to detect the loop. A pick_peer that wants to +%% avoid this can specify filter to avoid the possibility. +%% Eg. {neg, {host, OH} where #diameter_caps{origin_host = {OH, _}}. +%% +%% RFC 6.3 says that a relay agent does not modify Origin-Host but +%% says nothing about a proxy. Assume it should behave the same way. + +%% resend/4 +%% +%% Relay a reply to a relayed request. + +%% Answer from the peer: reset the hop by hop identifier and send. +resend(#diameter_packet{bin = B} + = Pkt, + _, + TPid, + #diameter_packet{header = #diameter_header{hop_by_hop_id = Id}, + transport_data = TD}) -> + send(TPid, Pkt#diameter_packet{bin = diameter_codec:hop_by_hop_id(Id, B), + transport_data = TD}); +%% TODO: counters + +%% Or not: DIAMETER_UNABLE_TO_DELIVER. +resend(_, T, TPid, Pkt) -> + protocol_error(3002, T, TPid, Pkt). + +%% is_loop/4 +%% +%% Is there a Route-Record AVP with our Origin-Host? + +is_loop(Code, + Vid, + Bin, + [#diameter_avp{code = Code, vendor_id = Vid, data = Bin} | _]) -> + true; + +is_loop(_, _, _, []) -> + false; + +is_loop(Code, Vid, OH, [_ | Avps]) + when is_binary(OH) -> + is_loop(Code, Vid, OH, Avps); + +is_loop(Code, Vid, OH, Avps) -> + is_loop(Code, Vid, ?BASE:avp(encode, OH, 'Route-Record'), Avps). + +%% reply/4 +%% +%% Send a locally originating reply. + +%% No errors or a diameter_header/avp list. +reply(Msg, Dict, TPid, #diameter_packet{errors = Es, + transport_data = TD} + = ReqPkt) + when [] == Es; + is_record(hd(Msg), diameter_header) -> + Pkt = diameter_codec:encode(Dict, make_reply_packet(Msg, ReqPkt)), + incr(send, Pkt, Dict, TPid), %% count result codes in sent answers + send(TPid, Pkt#diameter_packet{transport_data = TD}); + +%% Or not: set Result-Code and Failed-AVP AVP's. +reply(Msg, Dict, TPid, #diameter_packet{errors = [H|_] = Es} = Pkt) -> + reply(rc(Msg, rc(H), [A || {_,A} <- Es], Dict), + Dict, + TPid, + Pkt#diameter_packet{errors = []}). + +%% make_reply_packet/2 + +%% Binaries and header/avp lists are sent as-is. +make_reply_packet(Bin, _) + when is_binary(Bin) -> + #diameter_packet{bin = Bin}; +make_reply_packet([#diameter_header{} | _] = Msg, _) -> + #diameter_packet{msg = Msg}; + +%% Otherwise a reply message clears the R and T flags and retains the +%% P flag. The E flag will be set at encode. +make_reply_packet(Msg, #diameter_packet{header = ReqHdr}) -> + Hdr = ReqHdr#diameter_header{version = ?DIAMETER_VERSION, + is_request = false, + is_error = undefined, + is_retransmitted = false}, + #diameter_packet{header = Hdr, + msg = Msg}. + +%% rc/1 + +rc({RC, _}) -> + RC; +rc(RC) -> + RC. + +%% rc/4 + +rc(Rec, RC, Failed, Dict) + when is_integer(RC) -> + set(Rec, [{'Result-Code', RC} | failed_avp(Rec, Failed, Dict)], Dict). + +%% Reply as name and tuple list ... +set([_|_] = Ans, Avps, _) -> + Ans ++ Avps; %% Values nearer tail take precedence. + +%% ... or record. +set(Rec, Avps, Dict) -> + Dict:'#set-'(Avps, Rec). + +%% failed_avp/3 + +failed_avp(_, [] = No, _) -> + No; + +failed_avp(Rec, Failed, Dict) -> + [fa(Rec, [{'AVP', Failed}], Dict)]. + +%% Reply as name and tuple list ... +fa([MsgName | Values], FailedAvp, Dict) -> + R = Dict:msg2rec(MsgName), + try + Dict:'#info-'(R, {index, 'Failed-AVP'}), + {'Failed-AVP', [FailedAvp]} + catch + error: _ -> + Avps = proplists:get_value('AVP', Values, []), + A = #diameter_avp{name = 'Failed-AVP', + value = FailedAvp}, + {'AVP', [A|Avps]} + end; + +%% ... or record. +fa(Rec, FailedAvp, Dict) -> + try + {'Failed-AVP', [FailedAvp]} + catch + error: _ -> + Avps = Dict:'get-'('AVP', Rec), + A = #diameter_avp{name = 'Failed-AVP', + value = FailedAvp}, + {'AVP', [A|Avps]} + end. + +%% 3. Diameter Header +%% +%% E(rror) - If set, the message contains a protocol error, +%% and the message will not conform to the ABNF +%% described for this command. Messages with the 'E' +%% bit set are commonly referred to as error +%% messages. This bit MUST NOT be set in request +%% messages. See Section 7.2. + +%% 3.2. Command Code ABNF specification +%% +%% e-bit = ", ERR" +%% ; If present, the 'E' bit in the Command +%% ; Flags is set, indicating that the answer +%% ; message contains a Result-Code AVP in +%% ; the "protocol error" class. + +%% 7.1.3. Protocol Errors +%% +%% Errors that fall within the Protocol Error category SHOULD be treated +%% on a per-hop basis, and Diameter proxies MAY attempt to correct the +%% error, if it is possible. Note that these and only these errors MUST +%% only be used in answer messages whose 'E' bit is set. + +%% Thus, only construct answers to protocol errors. Other errors +%% require an message-specific answer and must be handled by the +%% application. + +%% 6.2. Diameter Answer Processing +%% +%% When a request is locally processed, the following procedures MUST be +%% applied to create the associated answer, in addition to any +%% additional procedures that MAY be discussed in the Diameter +%% application defining the command: +%% +%% - The same Hop-by-Hop identifier in the request is used in the +%% answer. +%% +%% - The local host's identity is encoded in the Origin-Host AVP. +%% +%% - The Destination-Host and Destination-Realm AVPs MUST NOT be +%% present in the answer message. +%% +%% - The Result-Code AVP is added with its value indicating success or +%% failure. +%% +%% - If the Session-Id is present in the request, it MUST be included +%% in the answer. +%% +%% - Any Proxy-Info AVPs in the request MUST be added to the answer +%% message, in the same order they were present in the request. +%% +%% - The 'P' bit is set to the same value as the one in the request. +%% +%% - The same End-to-End identifier in the request is used in the +%% answer. +%% +%% Note that the error messages (see Section 7.3) are also subjected to +%% the above processing rules. + +%% 7.3. Error-Message AVP +%% +%% The Error-Message AVP (AVP Code 281) is of type UTF8String. It MAY +%% accompany a Result-Code AVP as a human readable error message. The +%% Error-Message AVP is not intended to be useful in real-time, and +%% SHOULD NOT be expected to be parsed by network entities. + +%% answer_message/2 + +answer_message({OH, OR, RC}, Avps) -> + {Code, _, Vid} = ?BASE:avp_header('Session-Id'), + ['answer-message', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Result-Code', RC} + | session_id(Code, Vid, Avps)]. + +session_id(Code, Vid, Avps) + when is_list(Avps) -> + try + {value, #diameter_avp{data = D}} = find_avp(Code, Vid, Avps), + [{'Session-Id', [?BASE:avp(decode, D, 'Session-Id')]}] + catch + error: _ -> + [] + end. + +%% find_avp/3 + +find_avp(Code, Vid, Avps) + when is_integer(Code), (undefined == Vid orelse is_integer(Vid)) -> + find(fun(A) -> is_avp(Code, Vid, A) end, Avps). + +%% The final argument here could be a list of AVP's, depending on the case, +%% but we're only searching at the top level. +is_avp(Code, Vid, #diameter_avp{code = Code, vendor_id = Vid}) -> + true; +is_avp(_, _, _) -> + false. + +find(_, []) -> + false; +find(Pred, [H|T]) -> + case Pred(H) of + true -> + {value, H}; + false -> + find(Pred, T) + end. + +%% 7. Error Handling +%% +%% There are certain Result-Code AVP application errors that require +%% additional AVPs to be present in the answer. In these cases, the +%% Diameter node that sets the Result-Code AVP to indicate the error +%% MUST add the AVPs. Examples are: +%% +%% - An unrecognized AVP is received with the 'M' bit (Mandatory bit) +%% set, causes an answer to be sent with the Result-Code AVP set to +%% DIAMETER_AVP_UNSUPPORTED, and the Failed-AVP AVP containing the +%% offending AVP. +%% +%% - An AVP that is received with an unrecognized value causes an +%% answer to be returned with the Result-Code AVP set to +%% DIAMETER_INVALID_AVP_VALUE, with the Failed-AVP AVP containing the +%% AVP causing the error. +%% +%% - A command is received with an AVP that is omitted, yet is +%% mandatory according to the command's ABNF. The receiver issues an +%% answer with the Result-Code set to DIAMETER_MISSING_AVP, and +%% creates an AVP with the AVP Code and other fields set as expected +%% in the missing AVP. The created AVP is then added to the Failed- +%% AVP AVP. +%% +%% The Result-Code AVP describes the error that the Diameter node +%% encountered in its processing. In case there are multiple errors, +%% the Diameter node MUST report only the first error it encountered +%% (detected possibly in some implementation dependent order). The +%% specific errors that can be described by this AVP are described in +%% the following section. + +%% 7.5. Failed-AVP AVP +%% +%% The Failed-AVP AVP (AVP Code 279) is of type Grouped and provides +%% debugging information in cases where a request is rejected or not +%% fully processed due to erroneous information in a specific AVP. The +%% value of the Result-Code AVP will provide information on the reason +%% for the Failed-AVP AVP. +%% +%% The possible reasons for this AVP are the presence of an improperly +%% constructed AVP, an unsupported or unrecognized AVP, an invalid AVP +%% value, the omission of a required AVP, the presence of an explicitly +%% excluded AVP (see tables in Section 10), or the presence of two or +%% more occurrences of an AVP which is restricted to 0, 1, or 0-1 +%% occurrences. +%% +%% A Diameter message MAY contain one Failed-AVP AVP, containing the +%% entire AVP that could not be processed successfully. If the failure +%% reason is omission of a required AVP, an AVP with the missing AVP +%% code, the missing vendor id, and a zero filled payload of the minimum +%% required length for the omitted AVP will be added. + +%%% --------------------------------------------------------------------------- +%%% # handle_answer/3 +%%% --------------------------------------------------------------------------- + +%% Process an answer message in call-specific process. + +handle_answer(SvcName, _, {error, Req, Reason}) -> + handle_error(Req, Reason, SvcName); + +handle_answer(SvcName, + AnswerErrors, + {answer, #request{dictionary = Dict} = Req, Pkt}) -> + a(examine(diameter_codec:decode(Dict, Pkt)), + SvcName, + AnswerErrors, + Req). + +%% We don't really need to do a full decode if we're a relay and will +%% just resend with a new hop by hop identifier, but might a proxy +%% want to examine the answer? + +a(#diameter_packet{errors = []} + = Pkt, + SvcName, + AE, + #request{transport = TPid, + dictionary = Dict, + caps = Caps, + packet = P} + = Req) -> + try + incr(in, Pkt, Dict, TPid) + of + _ -> + cb(Req, handle_answer, [Pkt, msg(P), SvcName, {TPid, Caps}]) + catch + exit: {invalid_error_bit, _} = E -> + e(Pkt#diameter_packet{errors = [E]}, SvcName, AE, Req) + end; + +a(#diameter_packet{} = Pkt, SvcName, AE, Req) -> + e(Pkt, SvcName, AE, Req). + +e(Pkt, SvcName, callback, #request{transport = TPid, + caps = Caps, + packet = Pkt} + = Req) -> + cb(Req, handle_answer, [Pkt, msg(Pkt), SvcName, {TPid, Caps}]); +e(Pkt, SvcName, report, Req) -> + x(errors, handle_answer, [SvcName, Req, Pkt]); +e(Pkt, SvcName, discard, Req) -> + x({errors, handle_answer, [SvcName, Req, Pkt]}). + +%% Note that we don't check that the application id in the answer's +%% header is what we expect. (TODO: Does the rfc says anything about +%% this?) + +%% incr/4 +%% +%% Increment a stats counter for an incoming or outgoing message. + +%% TODO: fix +incr(_, #diameter_packet{msg = undefined}, _, _) -> + ok; + +incr(Dir, Pkt, Dict, TPid) + when is_pid(TPid) -> + #diameter_packet{header = #diameter_header{is_error = E} + = Hdr, + msg = Rec} + = Pkt, + + D = choose(E, ?BASE, Dict), + RC = int(get_avp_value(D, 'Result-Code', Rec)), + PE = is_protocol_error(RC), + + %% Check that the E bit is set only for 3xxx result codes. + (not (E orelse PE)) + orelse (E andalso PE) + orelse x({invalid_error_bit, RC}, answer, [Dir, Pkt]), + + Ctr = rc_counter(D, Rec, RC), + is_tuple(Ctr) + andalso incr(TPid, {diameter_codec:msg_id(Hdr), Dir, Ctr}). + +%% incr/2 + +incr(TPid, Counter) -> + diameter_stats:incr(Counter, TPid, 1). + +%% RFC 3588, 7.6: +%% +%% All Diameter answer messages defined in vendor-specific +%% applications MUST include either one Result-Code AVP or one +%% Experimental-Result AVP. +%% +%% Maintain statistics assuming one or the other, not both, which is +%% surely the intent of the RFC. + +rc_counter(_, _, RC) + when is_integer(RC) -> + {'Result-Code', RC}; +rc_counter(D, Rec, _) -> + rcc(get_avp_value(D, 'Experimental-Result', Rec)). + +%% Outgoing answers may be in any of the forms messages can be sent +%% in. Incoming messages will be records. We're assuming here that the +%% arity of the result code AVP's is 0 or 1. + +rcc([{_,_,RC} = T]) + when is_integer(RC) -> + T; +rcc({_,_,RC} = T) + when is_integer(RC) -> + T; +rcc(_) -> + undefined. + +int([N]) + when is_integer(N) -> + N; +int(N) + when is_integer(N) -> + N; +int(_) -> + undefined. + +is_protocol_error(RC) -> + 3000 =< RC andalso RC < 4000. + +-spec x(any(), atom(), list()) -> no_return(). + +%% Warn and exit request process on errors in an incoming answer. +x(Reason, F, A) -> + diameter_lib:warning_report(Reason, {?MODULE, F, A}), + x(Reason). + +x(T) -> + exit(T). + +%%% --------------------------------------------------------------------------- +%%% # failover/[23] +%%% --------------------------------------------------------------------------- + +%% Failover as a consequence of request_peer_down/2. +failover({_, #request{handler = Pid} = Req, TRef}, S) -> + Pid ! {failover, TRef, rt(Req, S)}. + +%% Failover as a consequence of store_request/4. +failover(TRef, Seqs, S) + when is_reference(TRef) -> + case lookup_request(Seqs, TRef) of + #request{} = Req -> + failover({Seqs, Req, TRef}, S); + false -> + ok + end. + +%% prepare_request returned a binary ... +rt(#request{packet = #diameter_packet{msg = undefined}}, _) -> + false; %% TODO: Not what we should do. + +%% ... or not. +rt(#request{packet = #diameter_packet{msg = Msg}, dictionary = D} = Req, S) -> + find_transport(get_destination(Msg, D), Req, S). + +%%% --------------------------------------------------------------------------- +%%% # report_status/5 +%%% --------------------------------------------------------------------------- + +report_status(Status, + #peer{ref = Ref, + conn = TPid, + type = Type, + options = Opts}, + #conn{apps = [_|_] = As, + caps = Caps}, + #state{service_name = SvcName} + = S, + Extra) -> + share_peer(Status, Caps, As, TPid, S), + Info = [Status, Ref, {TPid, Caps}, {type(Type), Opts} | Extra], + send_event(SvcName, list_to_tuple(Info)). + +%% send_event/2 + +send_event(SvcName, Info) -> + send_event(#diameter_event{service = SvcName, + info = Info}). + +send_event(#diameter_event{service = SvcName} = E) -> + lists:foreach(fun({_, Pid}) -> Pid ! E end, subscriptions(SvcName)). + +%%% --------------------------------------------------------------------------- +%%% # share_peer/5 +%%% --------------------------------------------------------------------------- + +share_peer(up, Caps, Aliases, TPid, #state{share_peers = true, + service_name = Svc}) -> + diameter_peer:notify(Svc, {peer, TPid, Aliases, Caps}); + +share_peer(_, _, _, _, _) -> + ok. + +%%% --------------------------------------------------------------------------- +%%% # share_peers/2 +%%% --------------------------------------------------------------------------- + +share_peers(Pid, #state{share_peers = true, + local_peers = PDict}) -> + ?Dict:fold(fun(A,Ps,ok) -> sp(Pid, A, Ps), ok end, ok, PDict); + +share_peers(_, #state{share_peers = false}) -> + ok. + +sp(Pid, Alias, Peers) -> + lists:foreach(fun({P,C}) -> Pid ! {peer, P, [Alias], C} end, Peers). + +%%% --------------------------------------------------------------------------- +%%% # remote_peer_up/4 +%%% --------------------------------------------------------------------------- + +remote_peer_up(Pid, Aliases, Caps, #state{use_shared_peers = true, + service = Svc, + shared_peers = PDict} + = S) -> + #diameter_service{applications = Apps} = Svc, + Update = lists:filter(fun(A) -> + lists:keymember(A, #diameter_app.alias, Apps) + end, + Aliases), + S#state{shared_peers = rpu(Pid, Caps, PDict, Update)}; + +remote_peer_up(_, _, _, #state{use_shared_peers = false} = S) -> + S. + +rpu(_, _, PDict, []) -> + PDict; +rpu(Pid, Caps, PDict, Aliases) -> + erlang:monitor(process, Pid), + T = {Pid, Caps}, + lists:foldl(fun(A,D) -> ?Dict:append(A, T, D) end, + PDict, + Aliases). + +%%% --------------------------------------------------------------------------- +%%% # remote_peer_down/2 +%%% --------------------------------------------------------------------------- + +remote_peer_down(Pid, #state{use_shared_peers = true, + shared_peers = PDict} + = S) -> + S#state{shared_peers = lists:foldl(fun(A,D) -> rpd(Pid, A, D) end, + PDict, + ?Dict:fetch_keys(PDict))}. + +rpd(Pid, Alias, PDict) -> + ?Dict:update(Alias, fun(Ps) -> lists:keydelete(Pid, 1, Ps) end, PDict). + +%%% --------------------------------------------------------------------------- +%%% find_transport/[34] +%%% +%%% Output: {TransportPid, #diameter_caps{}, #diameter_app{}} +%%% | false +%%% | {error, Reason} +%%% --------------------------------------------------------------------------- + +%% Initial call, from an arbitrary process. +find_transport({alias, Alias}, Msg, Opts, #state{service = Svc} = S) -> + #diameter_service{applications = Apps} = Svc, + ft(find_send_app(Alias, Apps), Msg, Opts, S); + +%% Relay or proxy send. +find_transport(#diameter_app{} = App, Msg, Opts, S) -> + ft(App, Msg, Opts, S). + +ft(#diameter_app{module = Mod, dictionary = D} = App, Msg, Opts, S) -> + #options{filter = Filter, + extra = Xtra} + = Opts, + pick_peer(App#diameter_app{module = Mod ++ Xtra}, + get_destination(Msg, D), + Filter, + S); +ft(false = No, _, _, _) -> + No. + +%% This can't be used if we're a relay and sending a message +%% in an application not known locally. (TODO) +find_send_app(Alias, Apps) -> + case lists:keyfind(Alias, #diameter_app.alias, Apps) of + #diameter_app{id = ?APP_ID_RELAY} -> + false; + T -> + T + end. + +%% Retransmission, in the service process. +find_transport([_,_] = RH, + Req, + #state{service = #diameter_service{pid = Pid, + applications = Apps}} + = S) + when self() == Pid -> + #request{app = Alias, + filter = Filter, + module = ModX} + = Req, + #diameter_app{} + = App + = lists:keyfind(Alias, #diameter_app.alias, Apps), + + pick_peer(App#diameter_app{module = ModX}, + RH, + Filter, + S). + +%% get_destination/2 + +get_destination(Msg, Dict) -> + [str(get_avp_value(Dict, 'Destination-Realm', Msg)), + str(get_avp_value(Dict, 'Destination-Host', Msg))]. + +%% This is not entirely correct. The avp could have an arity 1, in +%% which case an empty list is a DiameterIdentity of length 0 rather +%% than the list of no values we treat it as by mapping to undefined. +%% This behaviour is documented. +str([]) -> + undefined; +str(T) -> + T. + +%% get_avp_value/3 +%% +%% Find an AVP in a message of one of three forms: +%% +%% - a message record (as generated from a .dia spec) or +%% - a list of an atom message name followed by 2-tuple, avp name/value pairs. +%% - a list of a #diameter_header{} followed by #diameter_avp{} records, +%% +%% In the first two forms a dictionary module is used at encode to +%% identify the type of the AVP and its arity in the message in +%% question. The third form allows messages to be sent as is, without +%% a dictionary, which is needed in the case of relay agents, for one. + +get_avp_value(Dict, Name, [#diameter_header{} | Avps]) -> + try + {Code, _, VId} = Dict:avp_header(Name), + [A|_] = lists:dropwhile(fun(#diameter_avp{code = C, vendor_id = V}) -> + C /= Code orelse V /= VId + end, + Avps), + avp_decode(Dict, Name, A) + catch + error: _ -> + undefined + end; + +get_avp_value(_, Name, [_MsgName | Avps]) -> + case lists:keyfind(Name, 1, Avps) of + {_, V} -> + V; + _ -> + undefined + end; + +%% Message is typically a record but not necessarily: diameter:call/4 +%% can be passed an arbitrary term. +get_avp_value(Dict, Name, Rec) -> + try + Dict:'#get-'(Name, Rec) + catch + error:_ -> + undefined + end. + +avp_decode(Dict, Name, #diameter_avp{value = undefined, + data = Bin}) -> + Dict:avp(decode, Bin, Name); +avp_decode(_, _, #diameter_avp{value = V}) -> + V. + +%%% --------------------------------------------------------------------------- +%%% # pick_peer(App, [DestRealm, DestHost], Filter, #state{}) +%%% +%%% Output: {TransportPid, #diameter_caps{}, App} +%%% | false +%%% | {error, Reason} +%%% --------------------------------------------------------------------------- + +%% Find transports to a given realm/host. + +pick_peer(#diameter_app{alias = Alias} + = App, + [_,_] = RH, + Filter, + #state{local_peers = L, + shared_peers = S, + service_name = SvcName, + service = #diameter_service{pid = Pid}}) -> + pick_peer(peers(Alias, RH, Filter, L), + peers(Alias, RH, Filter, S), + Pid, + SvcName, + App). + +%% pick_peer/5 + +pick_peer([], [], _, _, _) -> + false; + +%% App state is mutable but we're not in the service process: go there. +pick_peer(Local, Remote, Pid, _SvcName, #diameter_app{mutable = true} = App) + when self() /= Pid -> + call_service(Pid, {pick_peer, Local, Remote, App}); + +%% App state isn't mutable or it is and we're in the service process: +%% do the deed. +pick_peer(Local, + Remote, + _Pid, + SvcName, + #diameter_app{module = ModX, + alias = Alias, + init_state = S, + mutable = M} + = App) -> + MFA = {ModX, pick_peer, [Local, Remote, SvcName]}, + + try state_cb(App, MFA) of + {ok, {TPid, #diameter_caps{} = Caps}} when is_pid(TPid) -> + {TPid, Caps, App}; + {{TPid, #diameter_caps{} = Caps}, ModS} when is_pid(TPid), M -> + mod_state(Alias, ModS), + {TPid, Caps, App}; + {false = No, ModS} when M -> + mod_state(Alias, ModS), + No; + {ok, false = No} -> + No; + false = No -> + No; + {{TPid, #diameter_caps{} = Caps}, S} when is_pid(TPid) -> + {TPid, Caps, App}; %% Accept returned state in the immutable + {false = No, S} -> %% case as long it isn't changed. + No; + T -> + diameter_lib:error_report({invalid, T, App}, MFA) + catch + E: Reason -> + diameter_lib:error_report({failure, {E, Reason, ?STACK}}, MFA) + end. + +%% peers/4 + +peers(Alias, RH, Filter, Peers) -> + case ?Dict:find(Alias, Peers) of + {ok, L} -> + ps(L, RH, Filter, {[],[]}); + error -> + [] + end. + +%% Place a peer whose Destination-Host/Realm matches those of the +%% request at the front of the result list. Could add some sort of +%% 'sort' option to allow more control. + +ps([], _, _, {Ys, Ns}) -> + lists:reverse(Ys, Ns); +ps([{_TPid, #diameter_caps{} = Caps} = TC | Rest], RH, Filter, Acc) -> + ps(Rest, RH, Filter, pacc(caps_filter(Caps, RH, Filter), + caps_filter(Caps, RH, {all, [host, realm]}), + TC, + Acc)). + +pacc(true, true, Peer, {Ts, Fs}) -> + {[Peer|Ts], Fs}; +pacc(true, false, Peer, {Ts, Fs}) -> + {Ts, [Peer|Fs]}; +pacc(_, _, _, Acc) -> + Acc. + +%% caps_filter/3 + +caps_filter(C, RH, {neg, F}) -> + not caps_filter(C, RH, F); + +caps_filter(C, RH, {all, L}) + when is_list(L) -> + lists:all(fun(F) -> caps_filter(C, RH, F) end, L); + +caps_filter(C, RH, {any, L}) + when is_list(L) -> + lists:any(fun(F) -> caps_filter(C, RH, F) end, L); + +caps_filter(#diameter_caps{origin_host = {_,OH}}, [_,DH], host) -> + eq(undefined, DH, OH); + +caps_filter(#diameter_caps{origin_realm = {_,OR}}, [DR,_], realm) -> + eq(undefined, DR, OR); + +caps_filter(C, _, Filter) -> + caps_filter(C, Filter). + +%% caps_filter/2 + +caps_filter(_, none) -> + true; + +caps_filter(#diameter_caps{origin_host = {_,OH}}, {host, H}) -> + eq(any, H, OH); + +caps_filter(#diameter_caps{origin_realm = {_,OR}}, {realm, R}) -> + eq(any, R, OR); + +%% Anything else is expected to be an eval filter. Filter failure is +%% documented as being equivalent to a non-matching filter. + +caps_filter(C, T) -> + try + {eval, F} = T, + diameter_lib:eval([F,C]) + catch + _:_ -> false + end. + +eq(Any, Id, PeerId) -> + Any == Id orelse try + iolist_to_binary(Id) == iolist_to_binary(PeerId) + catch + _:_ -> false + end. +%% OctetString() can be specified as an iolist() so test for string +%% rather then term equality. + +%% transports/1 + +transports(#state{peerT = PeerT}) -> + ets:select(PeerT, [{#peer{conn = '$1', _ = '_'}, + [{'is_pid', '$1'}], + ['$1']}]). + +%%% --------------------------------------------------------------------------- +%%% # service_info/2 +%%% --------------------------------------------------------------------------- + +%% The config passed to diameter:start_service/2. +-define(CAP_INFO, ['Origin-Host', + 'Origin-Realm', + 'Vendor-Id', + 'Product-Name', + 'Origin-State-Id', + 'Host-IP-Address', + 'Supported-Vendor-Id', + 'Auth-Application-Id', + 'Inband-Security-Id', + 'Acct-Application-Id', + 'Vendor-Specific-Application-Id', + 'Firmware-Revision']). + +-define(ALL_INFO, [capabilities, + applications, + transport, + pending, + statistics]). + +service_info(Items, S) + when is_list(Items) -> + [{complete(I), service_info(I,S)} || I <- Items]; +service_info(Item, S) + when is_atom(Item) -> + service_info(Item, S, true). + +service_info(Item, #state{service = Svc} = S, Complete) -> + case Item of + name -> + S#state.service_name; + 'Origin-Host' -> + (Svc#diameter_service.capabilities) + #diameter_caps.origin_host; + 'Origin-Realm' -> + (Svc#diameter_service.capabilities) + #diameter_caps.origin_realm; + 'Vendor-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.vendor_id; + 'Product-Name' -> + (Svc#diameter_service.capabilities) + #diameter_caps.product_name; + 'Origin-State-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.origin_state_id; + 'Host-IP-Address' -> + (Svc#diameter_service.capabilities) + #diameter_caps.host_ip_address; + 'Supported-Vendor-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.supported_vendor_id; + 'Auth-Application-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.auth_application_id; + 'Inband-Security-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.inband_security_id; + 'Acct-Application-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.acct_application_id; + 'Vendor-Specific-Application-Id' -> + (Svc#diameter_service.capabilities) + #diameter_caps.vendor_specific_application_id; + 'Firmware-Revision' -> + (Svc#diameter_service.capabilities) + #diameter_caps.firmware_revision; + capabilities -> service_info(?CAP_INFO, S); + applications -> info_apps(S); + transport -> info_transport(S); + pending -> info_pending(S); + statistics -> info_stats(S); + keys -> ?ALL_INFO ++ ?CAP_INFO; %% mostly for test + all -> service_info(?ALL_INFO, S); + _ when Complete -> service_info(complete(Item), S, false); + _ -> undefined + end. + +complete(Pre) -> + P = atom_to_list(Pre), + case [I || I <- [name | ?ALL_INFO] ++ ?CAP_INFO, + lists:prefix(P, atom_to_list(I))] + of + [I] -> I; + _ -> Pre + end. + +info_stats(#state{peerT = PeerT}) -> + Peers = ets:select(PeerT, [{#peer{ref = '$1', conn = '$2', _ = '_'}, + [{'is_pid', '$2'}], + [['$1', '$2']]}]), + diameter_stats:read(lists:append(Peers)). +%% TODO: include peer identities in return value + +info_transport(#state{peerT = PeerT, connT = ConnT}) -> + dict:fold(fun it/3, + [], + ets:foldl(fun(T,A) -> it_acc(ConnT, A, T) end, + dict:new(), + PeerT)). + +it(Ref, [[{type, connect} | _] = L], Acc) -> + [[{ref, Ref} | L] | Acc]; +it(Ref, [[{type, accept}, {options, Opts} | _] | _] = L, Acc) -> + [[{ref, Ref}, + {type, listen}, + {options, Opts}, + {accept, [lists:nthtail(2,A) || A <- L]}] + | Acc]. +%% Each entry has the same Opts. (TODO) + +it_acc(ConnT, Acc, #peer{pid = Pid, + type = Type, + ref = Ref, + options = Opts, + op_state = OS, + started = T, + conn = TPid}) -> + dict:append(Ref, + [{type, Type}, + {options, Opts}, + {watchdog, {Pid, T, OS}} + | info_conn(ConnT, TPid)], + Acc). + +info_conn(ConnT, TPid) -> + info_conn(ets:lookup(ConnT, TPid)). + +info_conn([#conn{pid = Pid, apps = SApps, caps = Caps, started = T}]) -> + [{peer, {Pid, T}}, + {apps, SApps}, + {caps, info_caps(Caps)}]; +info_conn([] = No) -> + No. + +info_caps(#diameter_caps{} = C) -> + lists:zip(record_info(fields, diameter_caps), tl(tuple_to_list(C))). + +info_apps(#state{service = #diameter_service{applications = Apps}}) -> + lists:map(fun mk_app/1, Apps). + +mk_app(#diameter_app{alias = Alias, + dictionary = Dict, + module = ModX, + id = Id}) -> + [{alias, Alias}, + {dictionary, Dict}, + {module, ModX}, + {id, Id}]. + +info_pending(#state{} = S) -> + MatchSpec = [{{'$1', + #request{transport = '$2', + from = '$3', + app = '$4', + _ = '_'}, + '_'}, + [?ORCOND([{'==', T, '$2'} || T <- transports(S)])], + [{{'$1', [{{app, '$4'}}, + {{transport, '$2'}}, + {{from, '$3'}}]}}]}], + + ets:select(?REQUEST_TABLE, MatchSpec). diff --git a/lib/diameter/src/base/diameter_service_sup.erl b/lib/diameter/src/base/diameter_service_sup.erl new file mode 100644 index 0000000000..153fff902f --- /dev/null +++ b/lib/diameter/src/base/diameter_service_sup.erl @@ -0,0 +1,64 @@ +%% +%% %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% +%% + +%% +%% The supervisor of service processes. +%% + +-module(diameter_service_sup). + +-behaviour(supervisor). + +-export([start_link/0, %% supervisor start + start_child/1]). %% service start + +%% supervisor callback +-export([init/1]). + +-define(NAME, ?MODULE). %% supervisor name + +%% start_link/0 + +start_link() -> + SupName = {local, ?NAME}, + supervisor:start_link(SupName, ?MODULE, []). + +%% start_child/1 +%% +%% A service and its related processes (transport, peer_fwm and +%% watchdog) are all temporary since they're all restarted in +%% application code. A Transport and peer_fsm is restarted by a +%% watchdog as required by the RFC 3539 state machine, a watchdog is +%% restarted by service, and services are restarted by diameter_config. + +start_child(ServiceName) -> + supervisor:start_child(?NAME, [ServiceName]). + +%% init/1 + +init([]) -> + Mod = diameter_service, + Flags = {simple_one_for_one, 0, 1}, + ChildSpec = {Mod, + {Mod, start_link, []}, + temporary, + 1000, + worker, + [Mod]}, + {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/base/diameter_session.erl b/lib/diameter/src/base/diameter_session.erl new file mode 100644 index 0000000000..bb91e97f39 --- /dev/null +++ b/lib/diameter/src/base/diameter_session.erl @@ -0,0 +1,172 @@ +%% +%% %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% +%% + +-module(diameter_session). + +-export([sequence/0, + session_id/1, + origin_state_id/0]). + +%% towards diameter_sup +-export([init/0]). + +-include("diameter_types.hrl"). + +-define(INT64, 16#FFFFFFFFFFFFFFFF). +-define(INT32, 16#FFFFFFFF). + +%% --------------------------------------------------------------------------- +%% # sequence/0 +%% +%% Output: 32-bit +%% --------------------------------------------------------------------------- + +%% 3588, 3: +%% +%% Hop-by-Hop Identifier +%% The Hop-by-Hop Identifier is an unsigned 32-bit integer field (in +%% network byte order) and aids in matching requests and replies. +%% The sender MUST ensure that the Hop-by-Hop identifier in a request +%% is unique on a given connection at any given time, and MAY attempt +%% to ensure that the number is unique across reboots. The sender of +%% an Answer message MUST ensure that the Hop-by-Hop Identifier field +%% contains the same value that was found in the corresponding +%% request. The Hop-by-Hop identifier is normally a monotonically +%% increasing number, whose start value was randomly generated. An +%% answer message that is received with an unknown Hop-by-Hop +%% Identifier MUST be discarded. +%% +%% End-to-End Identifier +%% The End-to-End Identifier is an unsigned 32-bit integer field (in +%% network byte order) and is used to detect duplicate messages. +%% Upon reboot implementations MAY set the high order 12 bits to +%% contain the low order 12 bits of current time, and the low order +%% 20 bits to a random value. Senders of request messages MUST +%% insert a unique identifier on each message. The identifier MUST +%% remain locally unique for a period of at least 4 minutes, even +%% across reboots. The originator of an Answer message MUST ensure +%% that the End-to-End Identifier field contains the same value that +%% was found in the corresponding request. The End-to-End Identifier +%% MUST NOT be modified by Diameter agents of any kind. The +%% combination of the Origin-Host (see Section 6.3) and this field is +%% used to detect duplicates. Duplicate requests SHOULD cause the +%% same answer to be transmitted (modulo the hop-by-hop Identifier +%% field and any routing AVPs that may be present), and MUST NOT +%% affect any state that was set when the original request was +%% processed. Duplicate answer messages that are to be locally +%% consumed (see Section 6.2) SHOULD be silently discarded. + +-spec sequence() + -> 'Unsigned32'(). + +sequence() -> + Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT32, _SetVal = 0}, + ets:update_counter(diameter_sequence, sequence, Instr). + +%% --------------------------------------------------------------------------- +%% # origin_state_id/0 +%% --------------------------------------------------------------------------- + +%% 3588, 8.16: +%% +%% The Origin-State-Id AVP (AVP Code 278), of type Unsigned32, is a +%% monotonically increasing value that is advanced whenever a Diameter +%% entity restarts with loss of previous state, for example upon reboot. +%% Origin-State-Id MAY be included in any Diameter message, including +%% CER. +%% +%% A Diameter entity issuing this AVP MUST create a higher value for +%% this AVP each time its state is reset. A Diameter entity MAY set +%% Origin-State-Id to the time of startup, or it MAY use an incrementing +%% counter retained in non-volatile memory across restarts. + +-spec origin_state_id() + -> 'Unsigned32'(). + +origin_state_id() -> + ets:lookup_element(diameter_sequence, origin_state_id, 2). + +%% --------------------------------------------------------------------------- +%% # session_id/1 +%% --------------------------------------------------------------------------- + +%% 3588, 8.8: +%% +%% The Session-Id MUST begin with the sender's identity encoded in the +%% DiameterIdentity type (see Section 4.4). The remainder of the +%% Session-Id is delimited by a ";" character, and MAY be any sequence +%% that the client can guarantee to be eternally unique; however, the +%% following format is recommended, (square brackets [] indicate an +%% optional element): +%% +%% ;;[;] +%% +%% and are decimal representations of the +%% high and low 32 bits of a monotonically increasing 64-bit value. The +%% 64-bit value is rendered in two part to simplify formatting by 32-bit +%% processors. At startup, the high 32 bits of the 64-bit value MAY be +%% initialized to the time, and the low 32 bits MAY be initialized to +%% zero. This will for practical purposes eliminate the possibility of +%% overlapping Session-Ids after a reboot, assuming the reboot process +%% takes longer than a second. Alternatively, an implementation MAY +%% keep track of the increasing value in non-volatile memory. +%% +%% is implementation specific but may include a modem's +%% device Id, a layer 2 address, timestamp, etc. + +-spec session_id('DiameterIdentity'()) + -> 'OctetString'(). +%% Note that Session-Id has type UTF8String and that any OctetString +%% is a UTF8String. + +session_id(Host) -> + Instr = {_Pos = 2, _Incr = 1, _Threshold = ?INT64, _Set = 0}, + N = ets:update_counter(diameter_sequence, session_base, Instr), + Hi = N bsr 32, + Lo = N band ?INT32, + [Host, ";", integer_to_list(Hi), + ";", integer_to_list(Lo), + ";", atom_to_list(node())]. + +%% --------------------------------------------------------------------------- +%% # init/0 +%% --------------------------------------------------------------------------- + +init() -> + Now = now(), + random:seed(Now), + Time = time32(Now), + Seq = (?INT32 band (Time bsl 20)) bor (random:uniform(1 bsl 20) - 1), + ets:insert(diameter_sequence, [{origin_state_id, Time}, + {session_base, Time bsl 32}, + {sequence, Seq}]), + Time. + +%% --------------------------------------------------------- +%% INTERNAL FUNCTIONS +%% --------------------------------------------------------- + +%% The minimum value represented by a Time value. (See diameter_types.) +%% 32 bits extends to 2104. +-define(TIME0, 62105714048). %% {{1968,1,20},{3,14,8}} + +time32(Now) -> + Time = calendar:now_to_universal_time(Now), + Diff = calendar:datetime_to_gregorian_seconds(Time) - ?TIME0, + Diff band ?INT32. diff --git a/lib/diameter/src/base/diameter_stats.erl b/lib/diameter/src/base/diameter_stats.erl new file mode 100644 index 0000000000..71479afa95 --- /dev/null +++ b/lib/diameter/src/base/diameter_stats.erl @@ -0,0 +1,342 @@ +%% +%% %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% +%% + +%% +%% Statistics collector. +%% + +-module(diameter_stats). +-compile({no_auto_import, [monitor/2]}). + +-behaviour(gen_server). + +-export([reg/1, reg/2, + incr/1, incr/2, incr/3, + read/1, + flush/0, flush/1]). + +%% supervisor callback +-export([start_link/0]). + +%% gen_server callbacks +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% debug +-export([state/0, + uptime/0]). + +-include("diameter_internal.hrl"). + +%% ets table containing stats. reg(Pid, Ref) inserts a {Pid, Ref}, +%% incr(Counter, X, N) updates the counter keyed at {Counter, X}, and +%% Pid death causes counters keyed on {Counter, Pid} to be deleted and +%% added to those keyed on {Counter, Ref}. +-define(TABLE, ?MODULE). + +%% Name of registered server. +-define(SERVER, ?MODULE). + +%% Entries in the table. +-define(REC(Key, Value), {Key, Value}). + +%% Server state. +-record(state, {id = now()}). + +-type counter() :: any(). +-type contrib() :: any(). + +%%% --------------------------------------------------------------------------- +%%% # reg(Pid, Contrib) +%%% +%%% Description: Register a process as a contributor of statistics +%%% associated with a specified term. Statistics can be +%%% contributed by specifying either Pid or Contrib as +%%% the second argument to incr/3. Statistics contributed +%%% by Pid are folded into the corresponding entry for +%%% Contrib when the process dies. +%%% +%%% Contrib can be any term but should not be a pid +%%% passed as the first argument to reg/2. Subsequent +%%% registrations for the same Pid overwrite the association +%%% --------------------------------------------------------------------------- + +-spec reg(pid(), contrib()) + -> true. + +reg(Pid, Contrib) + when is_pid(Pid) -> + call({reg, Pid, Contrib}). + +-spec reg(contrib()) + -> true. + +reg(Ref) -> + reg(self(), Ref). + +%%% --------------------------------------------------------------------------- +%%% # incr(Counter, Contrib, N) +%%% +%%% Description: Increment a counter for the specified contributor. +%%% +%%% Contrib will typically be an argument passed to reg/2 +%%% but there's nothing that requires this. In particular, +%%% if Contrib is a pid that hasn't been registered then +%%% counters are unaffected by the death of the process. +%%% --------------------------------------------------------------------------- + +-spec incr(counter(), contrib(), integer()) + -> integer(). + +incr(Ctr, Contrib, N) -> + update_counter({Ctr, Contrib}, N). + +incr(Ctr, N) + when is_integer(N) -> + incr(Ctr, self(), N); + +incr(Ctr, Contrib) -> + incr(Ctr, Contrib, 1). + +incr(Ctr) -> + incr(Ctr, self(), 1). + +%%% --------------------------------------------------------------------------- +%%% # read(Contribs) +%%% +%%% Description: Retrieve counters for the specified contributors. +%%% --------------------------------------------------------------------------- + +-spec read([contrib()]) + -> [{contrib(), [{counter(), integer()}]}]. + +read(Contribs) -> + lists:foldl(fun(?REC({T,C}, N), D) -> orddict:append(C, {T,N}, D) end, + orddict:new(), + ets:select(?TABLE, [{?REC({'_', '$1'}, '_'), + [?ORCOND([{'=:=', '$1', {const, C}} + || C <- Contribs])], + ['$_']}])). + +%%% --------------------------------------------------------------------------- +%%% # flush(Contrib) +%%% +%%% Description: Retrieve and delete statistics for the specified +%%% contributor. +%%% +%%% If Contrib is a pid registered with reg/2 then statistics +%%% for both and its associated contributor are retrieved. +%%% --------------------------------------------------------------------------- + +-spec flush(contrib()) + -> [{counter(), integer()}]. + +flush(Contrib) -> + try + call({flush, Contrib}) + catch + exit: _ -> + [] + end. + +flush() -> + flush(self()). + +%%% --------------------------------------------------------- +%%% EXPORTED INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Module = ?MODULE, + Args = [], + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, Module, Args, Options). + +state() -> + call(state). + +uptime() -> + call(uptime). + +%%% ---------------------------------------------------------- +%%% # init(_) +%%% +%%% Output: {ok, State} +%%% ---------------------------------------------------------- + +init([]) -> + ets:new(?TABLE, [named_table, ordered_set, public]), + {ok, #state{}}. + +%% ---------------------------------------------------------- +%% handle_call(Request, From, State) +%% ---------------------------------------------------------- + +handle_call(state, _, State) -> + {reply, State, State}; + +handle_call(uptime, _, #state{id = Time} = State) -> + {reply, diameter_lib:now_diff(Time), State}; + +handle_call({reg, Pid, Contrib}, _From, State) -> + monitor(not ets:member(?TABLE, Pid), Pid), + {reply, insert(?REC(Pid, Contrib)), State}; + +handle_call({flush, Contrib}, _From, State) -> + {reply, fetch(Contrib), State}; + +handle_call(Req, From, State) -> + ?UNEXPECTED([Req, From]), + {reply, nok, State}. + +%% ---------------------------------------------------------- +%% handle_cast(Request, State) +%% ---------------------------------------------------------- + +handle_cast({incr, Rec}, State) -> + update_counter(Rec), + {noreply, State}; + +handle_cast(Msg, State) -> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%% ---------------------------------------------------------- +%% handle_info(Request, State) +%% ---------------------------------------------------------- + +handle_info({'DOWN', _MRef, process, Pid, _}, State) -> + down(Pid), + {noreply, State}; + +handle_info(Info, State) -> + ?UNEXPECTED([Info]), + {noreply, State}. + +%% ---------------------------------------------------------- +%% terminate(Reason, State) +%% ---------------------------------------------------------- + +terminate(_Reason, _State) -> + ok. + +%% ---------------------------------------------------------- +%% code_change(OldVsn, State, Extra) +%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%% --------------------------------------------------------- +%%% INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +%% monitor/2 + +monitor(true, Pid) -> + erlang:monitor(process, Pid); +monitor(false = No, _) -> + No. + +%% down/1 + +down(Pid) -> + L = ets:match_object(?TABLE, ?REC({'_', Pid}, '_')), + [?REC(_, Ref) = T] = lookup(Pid), + fold(Ref, L), + delete_object(T), + delete(L). + +%% Fold Pid-based entries into Ref-based ones. +fold(Ref, L) -> + lists:foreach(fun(?REC({K, _}, V)) -> update_counter({{K, Ref}, V}) end, + L). + +delete(Objs) -> + lists:foreach(fun delete_object/1, Objs). + +%% fetch/1 + +fetch(X) -> + MatchSpec = [{?REC({'_', '$1'}, '_'), + [?ORCOND([{'==', '$1', {const, T}} || T <- [X | ref(X)]])], + ['$_']}], + L = ets:select(?TABLE, MatchSpec), + delete(L), + D = lists:foldl(fun sum/2, dict:new(), L), + dict:to_list(D). + +sum({{Ctr, _}, N}, Dict) -> + dict:update(Ctr, fun(V) -> V+N end, N, Dict). + +ref(Pid) + when is_pid(Pid) -> + ets:select(?TABLE, [{?REC(Pid, '$1'), [], ['$1']}]); +ref(_) -> + []. + +%% update_counter/2 +%% +%% From an arbitrary request process. Cast to the server process to +%% insert a new element if the counter doesn't exists so that two +%% processes don't do so simultaneously. + +update_counter(Key, N) -> + try + ets:update_counter(?TABLE, Key, N) + catch + error: badarg -> + cast({incr, ?REC(Key, N)}) + end. + +%% update_counter/1 +%% +%% From the server process. + +update_counter(?REC(Key, N) = T) -> + try + ets:update_counter(?TABLE, Key, N) + catch + error: badarg -> + insert(T) + end. + +insert(T) -> + ets:insert(?TABLE, T). + +lookup(Key) -> + ets:lookup(?TABLE, Key). + +delete_object(T) -> + ets:delete_object(?TABLE, T). + +%% cast/1 + +cast(Msg) -> + gen_server:cast(?SERVER, Msg). + +%% call/1 + +call(Request) -> + gen_server:call(?SERVER, Request, infinity). diff --git a/lib/diameter/src/base/diameter_sup.erl b/lib/diameter/src/base/diameter_sup.erl new file mode 100644 index 0000000000..e5afd23dcd --- /dev/null +++ b/lib/diameter/src/base/diameter_sup.erl @@ -0,0 +1,101 @@ +%% +%% %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% +%% + +%% +%% The top supervisor for the diameter application. +%% + +-module(diameter_sup). + +-behaviour(supervisor). + +%% interface +-export([start_link/0, %% supervisor start + tree/0]). %% supervision tree + +%% supervisor callback +-export([init/1]). + +-define(CHILDREN, [diameter_misc_sup, + diameter_watchdog_sup, + diameter_peer_fsm_sup, + diameter_transport_sup, + diameter_service_sup]). + +-define(TABLES, [{diameter_sequence, [set]}, + {diameter_service, [set, {keypos, 3}]}, + {diameter_request, [bag]}, + {diameter_config, [bag, {keypos, 2}]}]). + +%% start_link/0 + +start_link() -> + SupName = {local, ?MODULE}, + supervisor:start_link(SupName, ?MODULE, []). + +%% init/1 + +init([]) -> + ets_new(?TABLES), + diameter_session:init(), + Flags = {one_for_one, 1, 5}, + ChildSpecs = lists:map(fun spec/1, ?CHILDREN), + {ok, {Flags, ChildSpecs}}. + +%% spec/1 + +spec(Mod) -> + {Mod, + {Mod, start_link, []}, + permanent, + 1000, + supervisor, + [Mod]}. + +%% ets_new/1 + +ets_new(List) + when is_list(List) -> + lists:foreach(fun ets_new/1, List); + +ets_new({Table, Opts}) -> + ets:new(Table, [named_table, public | Opts]). + +%% tree/0 + +tree() -> + [{?MODULE, whereis(?MODULE), tree(?MODULE)}]. + +tree(Sup) -> + lists:map(fun t/1, supervisor:which_children(Sup)). + +t({Name, Pid, supervisor, _}) -> + t(Name, Pid, tree(Pid)); +t({Name, Pid, worker, _}) -> + t(Name, Pid). + +t(undefined, Pid, Children) -> + {Pid, Children}; +t(Name, Pid, Children) -> + {Name, Pid, Children}. + +t(undefined, Pid) -> + Pid; +t(Name, Pid) -> + {Name, Pid}. diff --git a/lib/diameter/src/base/diameter_sync.erl b/lib/diameter/src/base/diameter_sync.erl new file mode 100644 index 0000000000..ce2db4b3a2 --- /dev/null +++ b/lib/diameter/src/base/diameter_sync.erl @@ -0,0 +1,550 @@ +%% +%% %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% +%% + +%% +%% This module implements a server that serializes requests in named +%% queues. A request is an MFA or fun and a name can be any term. A +%% request is applied in a dedicated process that terminates when +%% the request function returns. +%% + +-module(diameter_sync). +-behaviour(gen_server). + +-export([call/4, call/5, + cast/4, cast/5, + carp/1, carp/2]). + +%% supervisor callback +-export([start_link/0]). + +%% gen_server interface +-export([init/1, + terminate/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3]). + +%% test/debug +-export([state/0, + uptime/0, + flush/1, + pending/0, + pending/1, + queues/0, + pids/1]). + +-include("diameter_internal.hrl"). + +%% Locally registered server name. +-define(SERVER, ?MODULE). + +%% Message to the server to queue a request ... +-define(REQUEST(CallOrCast, Name, Req, Max, Timeout), + {request, CallOrCast, Name, Req, Max, Timeout}). + +%% ... and to retrieve the pid of the prevailing request process. +-define(CARP(Name), + {carp, Name}). + +%% Forever ... +-define(TIMEOUT, 30000). + +%% Server state. +-record(state, + {time = now(), + pending = 0 :: non_neg_integer(), %% outstanding requests + monitor = new() :: ets:tid(), %% MonitorRef -> {Name, From} + queue = new() :: ets:tid()}). %% Name -> queue of {Pid, Ref} + +%% ---------------------------------------------------------- +%% # call(Node, Name, Req, Max, Timeout) +%% # call(Name, Req, Max, Timeout) +%% +%% Input: Name = term() identifying the queue in which the request is +%% to be evaluated. +%% Req = {M,F,A} +%% | {Fun, Arg} +%% | [Fun | Args] +%% | Fun +%% Max = Upper bound for the number of outstanding requests +%% in the named queue for Req to be queued. +%% If more than this number are in the queue then +%% 'rejected' is returned to the caller. Can be any +%% term but integer() | infinity is sufficient. +%% Timeout = 32 bit integer() number of milliseconds after which +%% request is cancelled (if not already started), causing +%% 'timeout' to be returned to the caller. +%% | infinity +%% +%% Output: Req() | rejected | timeout +%% +%% Description: Serialize a request in a named queue. Note that if +%% 'timeout' is returned and the request itself does not +%% return this atom then request has not been evaluated. +%% ---------------------------------------------------------- + +call(Name, Req, Max, Timeout) -> + call(node(), Name, Req, Max, Timeout). + +call(Node, Name, Req, Max, Timeout) -> + gen_call({?SERVER, Node}, ?REQUEST(call, Name, Req, Max, Timeout)). + +%%% ---------------------------------------------------------- +%%% # cast(Node, Name, Req, Max, Timeout) +%%% # cast(Name, Req, Max, Timeout) +%%% +%%% Output: ok | rejected | timeout +%%% +%%% Description: Serialize a request without returning the result to the +%%% caller. Returns after the task is queued. +%%% ---------------------------------------------------------- + +cast(Name, Req, Max, Timeout) -> + cast(node(), Name, Req, Max, Timeout). + +cast(Node, Name, Req, Max, Timeout) -> + gen_call({?SERVER, Node}, ?REQUEST(cast, Name, Req, Max, Timeout)). + +%% 'timeout' is only return if the server process that processes +%% requests isn't alive. Ditto for call/carp. + +%%% ---------------------------------------------------------- +%%% # carp(Node, Name) +%%% # carp(Name) +%%% +%%% Output: {value, Pid} | false | timeout +%%% +%%% Description: Return the pid of the process processing the task +%%% at the head of the named queue. Note that the value +%%% returned by subsequent calls changes as tasks are +%%% completed, each task executing in a dedicated +%%% process. The exit value of this process will be +%%% {value, Req()} if the task returns. +%%% ---------------------------------------------------------- + +%% The intention of this is to let a process enqueue a task that waits +%% for a message before completing, the target pid being retrieved +%% with carp/[12]. + +carp(Name) -> + carp(node(), Name). + +carp(Node, Name) -> + gen_call({?SERVER, Node}, ?CARP(Name)). + +%%% --------------------------------------------------------- +%%% EXPORTED INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +state() -> + call(state). + +uptime() -> + call(uptime). + +flush(Name) -> + call({flush, Name}). + +pending() -> + call(pending). + +pending(Name) -> + call({pending, Name}). + +queues() -> + call(queues). + +pids(Name) -> + call({pids, Name}). + +%%% ---------------------------------------------------------- +%%% # start_link() +%%% ---------------------------------------------------------- + +start_link() -> + ServerName = {local, ?SERVER}, + Module = ?MODULE, + Args = [], + Options = [{spawn_opt, diameter_lib:spawn_opts(server, [])}], + gen_server:start_link(ServerName, Module, Args, Options). + +%%% ---------------------------------------------------------- +%%% # init(_) +%%% ---------------------------------------------------------- + +init(_) -> + {ok, #state{}}. + +%%% ---------------------------------------------------------- +%%% # handle_call(Request, From, State) +%%% ---------------------------------------------------------- + +%% Enqueue a new request. +handle_call(?REQUEST(Type, Name, Req, Max, Timeout), + From, + #state{queue = QD} = State) -> + T = find(Name, QD), + nq(queued(T) =< Max, T, {Type, From}, Name, Req, Timeout, State); + +handle_call(Request, From, State) -> + {reply, call(Request, From, State), State}. + +%% call/3 + +call(?CARP(Name), _, #state{queue = QD}) -> + pcar(find(Name, QD)); + +call(state, _, State) -> + State; + +call(uptime, _, #state{time = T}) -> + diameter_lib:now_diff(T); + +call({flush, Name}, _, #state{queue = QD}) -> + cancel(find(Name, QD)); + +call(pending, _, #state{pending = N}) -> + N; + +call({pending, Name}, _, #state{queue = QD}) -> + queued(find(Name, QD)); + +call(queues, _, #state{queue = QD}) -> + fetch_keys(QD); + +call({pids, Name}, _, #state{queue = QD}) -> + plist(find(Name, QD)); + +call(Req, From, _State) -> %% ignore + ?UNEXPECTED(handle_call, [Req, From]), + nok. + +%%% ---------------------------------------------------------- +%%% handle_cast(Request, State) +%%% ---------------------------------------------------------- + +handle_cast(Msg, State) -> + ?UNEXPECTED([Msg]), + {noreply, State}. + +%%% ---------------------------------------------------------- +%%% handle_info(Request, State) +%%% ---------------------------------------------------------- + +handle_info(Request, State) -> + {noreply, info(Request, State)}. + +%% info/2 + +%% A request has completed execution or timed out. +info({'DOWN', MRef, process, Pid, Info}, + #state{pending = N, + monitor = MD, + queue = QD} + = State) -> + {Name, From} = fetch(MRef, MD), + reply(From, rc(Info)), + State#state{pending = N-1, + monitor = erase(MRef, MD), + queue = dq(fetch(Name, QD), Pid, Info, Name, QD)}; + +info(Info, State) -> + ?UNEXPECTED(handle_info, [Info]), + State. + +reply({call, From}, T) -> + gen_server:reply(From, T); +reply(cast, _) -> + ok. + +rc({value, T}) -> + T; +rc(_) -> + timeout. + +%%% ---------------------------------------------------------- +%%% code_change(OldVsn, State, Extra) +%%% ---------------------------------------------------------- + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%% ---------------------------------------------------------- +%%% terminate(Reason, State) +%%% ---------------------------------------------------------- + +terminate(_Reason, _State)-> + ok. + +%%% --------------------------------------------------------- +%%% INTERNAL FUNCTIONS +%%% --------------------------------------------------------- + +%% queued/1 + +queued({ok, {N,_}}) -> + N; +queued(error) -> + 0. + +%% nq/7 + +%% Maximum number of pending requests exceeded ... +nq(false, _, _, _Name, _Req, _Timeout, State) -> + {reply, rejected, State}; + +%% ... or not. +nq(true, T, From, Name, Req, Timeout, #state{pending = N, + monitor = MD, + queue = QD} + = State) -> + Ref = make_ref(), + Pid = init(Ref, Req, timeout(Timeout, T)), + MRef = erlang:monitor(process, Pid), + {noreply, State#state{pending = N+1, + monitor = store(MRef, {Name, from(From)}, MD), + queue = store(Name, nq(T, {Pid, Ref}), QD)}}. + +from({call, _} = T) -> + T; +from({cast = T, From}) -> + gen_server:reply(From, ok), + T. + +%% nq/2 + +%% Other requests in the queue: append. +nq({ok, {N,Q}}, T) -> + {N+1, queue:in(T,Q)}; + +%% Queue is empty: start execution. +nq(error, T) -> + go(T), + {1, queue:from_list([T])}. + +%% Don't timeout if the request is evaluated immediately so as to +%% avoid a race between getting a 'go' and a 'timeout'. Queueing a +%% request in an empty queue always results in execution. +timeout(_, error) -> + infinity; +timeout(Timeout, _) -> + Timeout. + +%% dq/5 +%% +%% A request process has terminated. + +dq({N,Q}, Pid, _Info, Name, QD) -> + {{value, T}, TQ} = queue:out(Q), + dq(N-1, Pid, T, TQ, Name, QD). + +%% dq/6 + +%% Request was at the head of the queue: start another. +dq(N, Pid, {Pid, _}, TQ, Name, QD) -> + dq(N, TQ, Name, QD); + +%% Or not: remove the offender from the queue. +dq(N, Pid, T, TQ, Name, QD) -> + store(Name, {N, req(Pid, queue:from_list([T]), TQ)}, QD). + +%% dq/4 + +%% Queue is empty: erase. +dq(0, TQ, Name, QD) -> + true = queue:is_empty(TQ), %% assert + erase(Name, QD); + +%% Start the next request. +dq(N, TQ, Name, QD) -> + go(queue:head(TQ)), + store(Name, {N, TQ}, QD). + +%% req/3 +%% +%% Find and remove the queue element for the specified pid. + +req(Pid, HQ, Q) -> + {{value, T}, TQ} = queue:out(Q), + req(Pid, T, HQ, TQ). + +req(Pid, {Pid, _}, HQ, TQ) -> + queue:join(HQ, TQ); +req(Pid, T, HQ, TQ) -> + req(Pid, queue:in(T,HQ), TQ). + +%% go/1 + +go({Pid, Ref}) -> + Pid ! {Ref, ok}. + +%% init/4 +%% +%% Start the dedicated process for handling a request. The exit value +%% is as promised by carp/1. + +init(Ref, Req, Timeout) -> + spawn(fun() -> exit(i(Ref, Req, Timeout)) end). + +i(Ref, Req, Timeout) -> + Timer = send_timeout(Ref, Timeout), + MRef = erlang:monitor(process, ?SERVER), + receive + {Ref, ok} -> %% Do the deed. + %% Ensure we don't leave messages in the mailbox since the + %% request itself might receive. Alternatively, could have + %% done the eval in a new process but then we'd have to + %% relay messages arriving at this one. + cancel_timer(Timer), + erlang:demonitor(MRef, [flush]), + %% Ref is to ensure that we don't extract any message that + %% a client may have sent after retrieving self() with + %% carp/1, there being no guarantee that the message + %% banged by go/1 is received before the pid becomes + %% accessible. + {value, eval(Req)}; + {Ref, timeout = T} -> + T; + {'DOWN', MRef, process, _Pid, _Info} = D -> %% server death + D + end. + +send_timeout(_Ref, infinity = No) -> + No; +send_timeout(Ref, Ms) -> + Msg = {Ref, timeout}, + TRef = erlang:send_after(Ms, self(), Msg), + {TRef, Msg}. + +cancel_timer(infinity = No) -> + No; +cancel_timer({TRef, Msg}) -> + flush(Msg, erlang:cancel_timer(TRef)). + +flush(Msg, false) -> %% Message has already been sent ... + %% 'error' should never happen but crash if it does so as not to + %% hang the process. + ok = receive Msg -> ok after ?TIMEOUT -> error end; +flush(_, _) -> %% ... or not. + ok. + +eval({M,F,A}) -> + apply(M,F,A); +eval([Fun | Args]) -> + apply(Fun, Args); +eval({Fun, A}) -> + Fun(A); +eval(Fun) -> + Fun(). + +%% pcar/1 + +pcar({ok, {_,Q}}) -> + {Pid, _Ref} = queue:head(Q), + {value, Pid}; +pcar(error) -> + false. + +%% plist/1 + +plist({ok, {_,Q}}) -> + lists:map(fun({Pid, _Ref}) -> Pid end, queue:to_list(Q)); +plist(error) -> + []. + +%% cancel/1 +%% +%% Cancel all but the active request from the named queue. Return the +%% number of requests cancelled. + +%% Just send timeout messages to each request to make them die. Note +%% that these are guaranteed to arrive before a go message after the +%% current request completes since both messages are sent from the +%% server process. +cancel({ok, {N,Q}}) -> + {_,TQ} = queue:split(1,Q), + foreach(fun({Pid, Ref}) -> Pid ! {Ref, timeout} end, N-1, TQ), + N-1; +cancel(error) -> + 0. + +%% foreach/3 + +foreach(_, 0, _) -> + ok; +foreach(Fun, N, Q) -> + Fun(queue:head(Q)), + foreach(Fun, N-1, queue:tail(Q)). + +%% call/1 + +%% gen_server:call/3 will exit if the target process dies. +call(Request) -> + try + gen_server:call(?SERVER, Request, ?TIMEOUT) + catch + exit: Reason -> + {error, Reason} + end. + +%% dict-like table manipulation. + +erase(Key, Dict) -> + ets:delete(Dict, Key), + Dict. + +fetch(Key, Dict) -> + {ok, V} = find(Key, Dict), + V. + +fetch_keys(Dict) -> + ets:foldl(fun({K,_}, Acc) -> [K | Acc] end, [], Dict). + +find(Key, Dict) -> + case ets:lookup(Dict, Key) of + [{Key, V}] -> + {ok, V}; + [] -> + error + end. + +new() -> + ets:new(?MODULE, [set]). + +store(Key, Value, Dict) -> + store({Key, Value}, Dict). + +store({_,_} = T, Dict) -> + ets:insert(Dict, T), + Dict. + +%% gen_call/1 + +gen_call(Server, Req) -> + gen_call(Server, Req, infinity). + +gen_call(Server, Req, Timeout) -> + try + gen_server:call(Server, Req, Timeout) + catch + exit: _ -> + timeout + end. diff --git a/lib/diameter/src/base/diameter_types.erl b/lib/diameter/src/base/diameter_types.erl new file mode 100644 index 0000000000..6b1b1b8d39 --- /dev/null +++ b/lib/diameter/src/base/diameter_types.erl @@ -0,0 +1,537 @@ +%% +%% %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% +%% + +-module(diameter_types). + +%% +%% Encode/decode of RFC 3588 Data Formats, Basic (section 4.2) and +%% Derived (section 4.3). +%% + +%% Basic types. +-export(['OctetString'/2, + 'Integer32'/2, + 'Integer64'/2, + 'Unsigned32'/2, + 'Unsigned64'/2, + 'Float32'/2, + 'Float64'/2]). + +%% Derived types. +-export(['Address'/2, + 'Time'/2, + 'UTF8String'/2, + 'DiameterIdentity'/2, + 'DiameterURI'/2, + 'IPFilterRule'/2, + 'QoSFilterRule'/2]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +-define(UINT(N,X), ((0 =< X) andalso (X < 1 bsl N))). +-define(SINT(N,X), ((-1*(1 bsl (N-1)) < X) andalso (X < 1 bsl (N-1)))). + +%% The Grouped and Enumerated types are dealt with directly in +%% generated decode modules by way of diameter_gen.hrl and +%% diameter_codec.erl. Padding and the setting of Length and other +%% fields are also dealt with there. + +%% 3588: +%% +%% DIAMETER_INVALID_AVP_LENGTH 5014 +%% The request contained an AVP with an invalid length. A Diameter +%% message indicating this error MUST include the offending AVPs +%% within a Failed-AVP AVP. +%% +-define(INVALID_LENGTH(Bin), erlang:error({'DIAMETER', 5014, Bin})). + +%% ------------------------------------------------------------------------- +%% 3588, 4.2. Basic AVP Data Formats +%% +%% The Data field is zero or more octets and contains information +%% specific to the Attribute. The format and length of the Data field +%% is determined by the AVP Code and AVP Length fields. The format of +%% the Data field MUST be one of the following base data types or a data +%% type derived from the base data types. In the event that a new Basic +%% AVP Data Format is needed, a new version of this RFC must be created. +%% -------------------- + +'OctetString'(decode, Bin) + when is_binary(Bin) -> + binary_to_list(Bin); + +'OctetString'(encode = M, zero) -> + 'OctetString'(M, []); + +'OctetString'(encode, Str) -> + iolist_to_binary(Str). + +%% -------------------- + +'Integer32'(decode, <>) -> + X; + +'Integer32'(decode, B) -> + ?INVALID_LENGTH(B); + +'Integer32'(encode = M, zero) -> + 'Integer32'(M, 0); + +'Integer32'(encode, I) + when ?SINT(32,I) -> + <>. + +%% -------------------- + +'Integer64'(decode, <>) -> + X; + +'Integer64'(decode, B) -> + ?INVALID_LENGTH(B); + +'Integer64'(encode = M, zero) -> + 'Integer64'(M, 0); + +'Integer64'(encode, I) + when ?SINT(64,I) -> + <>. + +%% -------------------- + +'Unsigned32'(decode, <>) -> + X; + +'Unsigned32'(decode, B) -> + ?INVALID_LENGTH(B); + +'Unsigned32'(encode = M, zero) -> + 'Unsigned32'(M, 0); + +'Unsigned32'(encode, I) + when ?UINT(32,I) -> + <>. + +%% -------------------- + +'Unsigned64'(decode, <>) -> + X; + +'Unsigned64'(decode, B) -> + ?INVALID_LENGTH(B); + +'Unsigned64'(encode = M, zero) -> + 'Unsigned64'(M, 0); + +'Unsigned64'(encode, I) + when ?UINT(64,I) -> + <>. + +%% -------------------- + +%% Decent summaries of the IEEE floating point formats can be +%% found at http://en.wikipedia.org/wiki/IEEE_754-1985 and +%% http://www.psc.edu/general/software/packages/ieee/ieee.php. +%% +%% That the bit syntax uses these formats isn't well documented but +%% this does indeed appear to be the case. However, the bit syntax +%% only encodes numeric values, not the standard's (signed) infinity +%% or NaN. It also encodes any large value as 'infinity', never 'NaN'. +%% Treat these equivalently on decode for this reason. +%% +%% An alternative would be to decode infinity/NaN to the largest +%% possible float but could likely lead to misleading results if +%% arithmetic is performed on the decoded value. Better to be explicit +%% that precision has been lost. + +'Float32'(decode, <>) -> + choose(S, infinity, '-infinity'); + +'Float32'(decode, <>) -> + X; + +'Float32'(decode, B) -> + ?INVALID_LENGTH(B); + +'Float32'(encode = M, zero) -> + 'Float32'(M, 0.0); + +'Float32'(encode, infinity) -> + <<0:1, 255:8, 0:23>>; + +'Float32'(encode, '-infinity') -> + <<1:1, 255:8, 0:23>>; + +'Float32'(encode, X) + when is_float(X) -> + <>. +%% Note that this could also encode infinity/-infinity for large +%% (signed) numeric values. Note also that precision is lost just in +%% using the floating point syntax. For example: +%% +%% 1> B = <<3.14159:32/float>>. +%% <<64,73,15,208>> +%% 2> <> = B. +%% <<64,73,15,208>> +%% 3> F. +%% 3.141590118408203 +%% +%% (The 64 bit type does better.) + +%% -------------------- + +%% The 64 bit format is entirely analogous to the 32 bit format. + +'Float64'(decode, <>) -> + choose(S, infinity, '-infinity'); + +'Float64'(decode, <>) -> + X; + +'Float64'(decode, B) -> + ?INVALID_LENGTH(B); + +'Float64'(encode, infinity) -> + <<0:1, 2047:11, 0:52>>; + +'Float64'(encode, '-infinity') -> + <<1:1, 2047:11, 0:52>>; + +'Float64'(encode = M, zero) -> + 'Float64'(M, 0.0); + +'Float64'(encode, X) + when is_float(X) -> + <>. + +%% ------------------------------------------------------------------------- +%% 3588, 4.3. Derived AVP Data Formats +%% +%% In addition to using the Basic AVP Data Formats, applications may +%% define data formats derived from the Basic AVP Data Formats. An +%% application that defines new AVP Derived Data Formats MUST include +%% them in a section entitled "AVP Derived Data Formats", using the same +%% format as the definitions below. Each new definition must be either +%% defined or listed with a reference to the RFC that defines the +%% format. +%% -------------------- + +'Address'(encode, zero) -> + <<0:48>>; + +'Address'(decode, <<1:16, B/binary>>) + when size(B) == 4 -> + list_to_tuple(binary_to_list(B)); + +'Address'(decode, <<2:16, B/binary>>) + when size(B) == 16 -> + list_to_tuple(v6dec(B, [])); + +'Address'(decode, <> = B) + when 1 == A; + 2 == A -> + ?INVALID_LENGTH(B); + +'Address'(encode, T) -> + ipenc(diameter_lib:ipaddr(T)). + +ipenc(T) + when is_tuple(T), size(T) == 4 -> + B = list_to_binary(tuple_to_list(T)), + <<1:16, B/binary>>; + +ipenc(T) + when is_tuple(T), size(T) == 8 -> + B = v6enc(lists:reverse(tuple_to_list(T)), <<>>), + <<2:16, B/binary>>. + +v6dec(<>, Acc) -> + v6dec(B, [N | Acc]); + +v6dec(<<>>, Acc) -> + lists:reverse(Acc). + +v6enc([N | Rest], B) + when ?UINT(16,N) -> + v6enc(Rest, <>); + +v6enc([], B) -> + B. + +%% -------------------- + +%% A DiameterIdentity is a FQDN as definined in RFC 1035, which is at +%% least one character. + +'DiameterIdentity'(encode = M, zero) -> + 'OctetString'(M, [0]); + +'DiameterIdentity'(encode = M, X) -> + <<_,_/binary>> = 'OctetString'(M, X); + +'DiameterIdentity'(decode = M, <<_,_/binary>> = X) -> + 'OctetString'(M, X). + +%% -------------------- + +'DiameterURI'(decode, Bin) + when is_binary(Bin) -> + scan_uri(Bin); + +%% The minimal DiameterURI is "aaa://x", 7 characters. +'DiameterURI'(encode = M, zero) -> + 'OctetString'(M, lists:duplicate(0,7)); + +'DiameterURI'(encode, #diameter_uri{type = Type, + fqdn = D, + port = P, + transport = T, + protocol = Prot} + = U) -> + S = lists:append([atom_to_list(Type), "://", D, + ":", integer_to_list(P), + ";transport=", atom_to_list(T), + ";protocol=", atom_to_list(Prot)]), + U = scan_uri(S), %% assert + list_to_binary(S); + +'DiameterURI'(encode, Str) -> + Bin = iolist_to_binary(Str), + #diameter_uri{} = scan_uri(Bin), %% type check + Bin. + +%% -------------------- + +%% This minimal rule is "deny in 0 from 0.0.0.0 to 0.0.0.0", 33 characters. +'IPFilterRule'(encode = M, zero) -> + 'OctetString'(M, lists:duplicate(0,33)); + +%% TODO: parse grammar. +'IPFilterRule'(M, X) -> + 'OctetString'(M, X). + +%% -------------------- + +%% This minimal rule is the same as for an IPFilterRule. +'QoSFilterRule'(encode = M, zero = X) -> + 'IPFilterRule'(M, X); + +%% TODO: parse grammar. +'QoSFilterRule'(M, X) -> + 'OctetString'(M, X). + +%% -------------------- + +'UTF8String'(decode, Bin) -> + udec(Bin, []); + +'UTF8String'(encode = M, zero) -> + 'UTF8String'(M, []); + +'UTF8String'(encode, S) -> + uenc(S, []). + +udec(<<>>, Acc) -> + lists:reverse(Acc); + +udec(<>, Acc) -> + udec(Rest, [C | Acc]). + +uenc(E, Acc) + when E == []; + E == <<>> -> + list_to_binary(lists:reverse(Acc)); + +uenc(<>, Acc) -> + uenc(Rest, [<> | Acc]); + +uenc([[] | Rest], Acc) -> + uenc(Rest, Acc); + +uenc([[H|T] | Rest], Acc) -> + uenc([H, T | Rest], Acc); + +uenc([C | Rest], Acc) -> + uenc(Rest, [<> | Acc]). + +%% -------------------- + +%% RFC 3588, 4.3: +%% +%% Time +%% The Time format is derived from the OctetString AVP Base Format. +%% The string MUST contain four octets, in the same format as the +%% first four bytes are in the NTP timestamp format. The NTP +%% Timestamp format is defined in chapter 3 of [SNTP]. +%% +%% This represents the number of seconds since 0h on 1 January 1900 +%% with respect to the Coordinated Universal Time (UTC). +%% +%% On 6h 28m 16s UTC, 7 February 2036 the time value will overflow. +%% SNTP [SNTP] describes a procedure to extend the time to 2104. +%% This procedure MUST be supported by all DIAMETER nodes. + +%% RFC 2030, 3: +%% +%% As the NTP timestamp format has been in use for the last 17 years, +%% it remains a possibility that it will be in use 40 years from now +%% when the seconds field overflows. As it is probably inappropriate +%% to archive NTP timestamps before bit 0 was set in 1968, a +%% convenient way to extend the useful life of NTP timestamps is the +%% following convention: If bit 0 is set, the UTC time is in the +%% range 1968-2036 and UTC time is reckoned from 0h 0m 0s UTC on 1 +%% January 1900. If bit 0 is not set, the time is in the range 2036- +%% 2104 and UTC time is reckoned from 6h 28m 16s UTC on 7 February +%% 2036. Note that when calculating the correspondence, 2000 is not a +%% leap year. Note also that leap seconds are not counted in the +%% reckoning. +%% +%% The statement regarding year 2000 is wrong: errata id 518 at +%% http://www.rfc-editor.org/errata_search.php?rfc=2030 notes this. + +-define(TIME_1900, 59958230400). %% {{1900,1,1},{0,0,0}} +-define(TIME_2036, 64253197696). %% {{2036,2,7},{6,28,16}} +%% TIME_2036 = TIME_1900 + (1 bsl 32) + +%% Time maps [0, 1 bsl 31) onto [TIME_1900 + 1 bsl 31, TIME_2036 + 1 bsl 31) +%% by taking integers with the high-order bit set relative to TIME_1900 +%% and those without relative to TIME_2036. This corresponds to the +%% following dates. +-define(TIME_MIN, {{1968,1,20},{3,14,8}}). %% TIME_1900 + 1 bsl 31 +-define(TIME_MAX, {{2104,2,26},{9,42,24}}). %% TIME_2036 + 1 bsl 31 + +'Time'(decode, <>) -> + Offset = msb(1 == Time bsr 31), + calendar:gregorian_seconds_to_datetime(Time + Offset); + +'Time'(decode, B) -> + ?INVALID_LENGTH(B); + +'Time'(encode, {{_Y,_M,_D},{_HH,_MM,_SS}} = Datetime) + when ?TIME_MIN =< Datetime, Datetime < ?TIME_MAX -> + S = calendar:datetime_to_gregorian_seconds(Datetime), + T = S - msb(S < ?TIME_2036), + 0 = T bsr 32, %% sanity check + <>; + +'Time'(encode, zero) -> + <<0:32>>. + +%% =========================================================================== +%% =========================================================================== + +choose(0, X, _) -> X; +choose(1, _, X) -> X. + +msb(true) -> ?TIME_1900; +msb(false) -> ?TIME_2036. + +%% RFC 3588, 4.3: +%% +%% The DiameterURI MUST follow the Uniform Resource Identifiers (URI) +%% syntax [URI] rules specified below: +%% +%% "aaa://" FQDN [ port ] [ transport ] [ protocol ] +%% +%% ; No transport security +%% +%% "aaas://" FQDN [ port ] [ transport ] [ protocol ] +%% +%% ; Transport security used +%% +%% FQDN = Fully Qualified Host Name +%% +%% port = ":" 1*DIGIT +%% +%% ; One of the ports used to listen for +%% ; incoming connections. +%% ; If absent, +%% ; the default Diameter port (3868) is +%% ; assumed. +%% +%% transport = ";transport=" transport-protocol +%% +%% ; One of the transports used to listen +%% ; for incoming connections. If absent, +%% ; the default SCTP [SCTP] protocol is +%% ; assumed. UDP MUST NOT be used when +%% ; the aaa-protocol field is set to +%% ; diameter. +%% +%% transport-protocol = ( "tcp" / "sctp" / "udp" ) +%% +%% protocol = ";protocol=" aaa-protocol +%% +%% ; If absent, the default AAA protocol +%% ; is diameter. +%% +%% aaa-protocol = ( "diameter" / "radius" / "tacacs+" ) + +scan_uri(Bin) + when is_binary(Bin) -> + scan_uri(binary_to_list(Bin)); +scan_uri("aaa://" ++ Rest) -> + scan_fqdn(Rest, #diameter_uri{type = aaa}); +scan_uri("aaas://" ++ Rest) -> + scan_fqdn(Rest, #diameter_uri{type = aaas}). + +scan_fqdn(S, U) -> + {[_|_] = F, Rest} = lists:splitwith(fun is_fqdn/1, S), + scan_opt_port(Rest, U#diameter_uri{fqdn = F}). + +scan_opt_port(":" ++ S, U) -> + {[_|_] = P, Rest} = lists:splitwith(fun is_digit/1, S), + scan_opt_transport(Rest, U#diameter_uri{port = list_to_integer(P)}); +scan_opt_port(S, U) -> + scan_opt_transport(S, U). + +scan_opt_transport(";transport=" ++ S, U) -> + {P, Rest} = transport(S), + scan_opt_protocol(Rest, U#diameter_uri{transport = P}); +scan_opt_transport(S, U) -> + scan_opt_protocol(S, U). + +scan_opt_protocol(";protocol=" ++ S, U) -> + {P, ""} = protocol(S), + U#diameter_uri{protocol = P}; +scan_opt_protocol("", U) -> + U. + +transport("tcp" ++ S) -> + {tcp, S}; +transport("sctp" ++ S) -> + {sctp, S}; +transport("udp" ++ S) -> + {udp, S}. + +protocol("diameter" ++ S) -> + {diameter, S}; +protocol("radius" ++ S) -> + {radius, S}; +protocol("tacacs+" ++ S) -> + {'tacacs+', S}. + +is_fqdn(C) -> + is_digit(C) orelse is_alpha(C) orelse C == $. orelse C == $-. + +is_alpha(C) -> + ($a =< C andalso C =< $z) orelse ($A =< C andalso C =< $Z). + +is_digit(C) -> + $0 =< C andalso C =< $9. diff --git a/lib/diameter/src/base/diameter_types.hrl b/lib/diameter/src/base/diameter_types.hrl new file mode 100644 index 0000000000..02bf8a74dd --- /dev/null +++ b/lib/diameter/src/base/diameter_types.hrl @@ -0,0 +1,139 @@ +%% +%% %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% +%% + +%% +%% Types for function specifications, primarily in diameter.erl. This +%% has nothing specifically to do with diameter_types.erl. +%% + +-type evaluable() + :: {module(), atom(), list()} + | fun() + | nonempty_improper_list(evaluable(), list()). %% [evaluable() | Args] + +-type app_alias() + :: any(). + +-type service_name() + :: any(). + +%% Diameter basic types + +-type 'OctetString'() :: iolist(). +-type 'Integer32'() :: -2147483647..2147483647. +-type 'Integer64'() :: -9223372036854775807..9223372036854775807. +-type 'Unsigned32'() :: 0..4294967295. +-type 'Unsigned64'() :: 0..18446744073709551615. +-type 'Float32'() :: '-infinity' | float() | infinity. +-type 'Float64'() :: '-infinity' | float() | infinity. +-type 'Grouped'() :: list() | tuple(). + +%% Diameter derived types + +-type 'Address'() + :: inet:ip_address() + | string(). + +-type 'Time'() :: {{integer(), 1..12, 1..31}, + {0..23, 0..59, 0..59}}. +-type 'UTF8String'() :: iolist(). +-type 'DiameterIdentity'() :: 'OctetString'(). +-type 'DiameterURI'() :: 'OctetString'(). +-type 'Enumerated'() :: 'Integer32'(). +-type 'IPFilterRule'() :: 'OctetString'(). +-type 'QoSFilterRule'() :: 'OctetString'(). + +%% Capabilities options/avps on start_service/2 and/or add_transport/2 + +-type capability() + :: {'Origin-Host', 'DiameterIdentity'()} + | {'Origin-Realm', 'DiameterIdentity'()} + | {'Host-IP-Address', ['Address'()]} + | {'Vendor-Id', 'Unsigned32'()} + | {'Product-Name', 'UTF8String'()} + | {'Supported-Vendor-Id', ['Unsigned32'()]} + | {'Auth-Application-Id', ['Unsigned32'()]} + | {'Vendor-Specific-Application-Id', ['Grouped'()]} + | {'Firmware-Revision', 'Unsigned32'()}. + +%% Filters for call/4 + +-type peer_filter() + :: none + | host + | realm + | {host, any|'DiameterIdentity'()} + | {realm, any|'DiameterIdentity'()} + | {eval, evaluable()} + | {neg, peer_filter()} + | {all, [peer_filter()]} + | {any, [peer_filter()]}. + +%% Options passed to start_service/2 + +-type service_opt() + :: capability() + | {application, [application_opt()]}. + +-type application_opt() + :: {alias, app_alias()} + | {dictionary, module()} + | {module, app_module()} + | {state, any()} + | {call_mutates_state, boolean()} + | {answer_errors, callback|report|discard}. + +-type app_module() + :: module() + | nonempty_improper_list(module(), list()). %% list with module() head + +%% Identifier returned by add_transport/2 + +-type transport_ref() + :: reference(). + +%% Options passed to add_transport/2 + +-type transport_opt() + :: {transport_module, atom()} + | {transport_config, any()} + | {applications, [app_alias()]} + | {capabilities, [capability()]} + | {watchdog_timer, 'Unsigned32'() | {module(), atom(), list()}} + | {reconnect_timer, 'Unsigned32'()} + | {private, any()}. + +%% Predicate passed to remove_transport/2 + +-type transport_pred() + :: fun((reference(), connect|listen, list()) -> boolean()) + | fun((reference(), list()) -> boolean()) + | fun((list()) -> boolean()) + | reference() + | list() + | {connect|listen, transport_pred()} + | {atom(), atom(), list()}. + +%% Options passed to call/4 + +-type call_opt() + :: {extra, list()} + | {filter, peer_filter()} + | {timeout, 'Unsigned32'()} + | detach. diff --git a/lib/diameter/src/base/diameter_watchdog.erl b/lib/diameter/src/base/diameter_watchdog.erl new file mode 100644 index 0000000000..b7c1491f4b --- /dev/null +++ b/lib/diameter/src/base/diameter_watchdog.erl @@ -0,0 +1,571 @@ +%% +%% %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% +%% + +%% +%% This module implements (as a process) the state machine documented +%% in Appendix A of RFC 3539. +%% + +-module(diameter_watchdog). +-behaviour(gen_server). + +%% towards diameter_service +-export([start/2]). + +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +%% diameter_watchdog_sup callback +-export([start_link/1]). + +-include_lib("diameter/include/diameter.hrl"). +-include("diameter_internal.hrl"). + +-define(DEFAULT_TW_INIT, 30000). %% RFC 3539 ch 3.4.1 + +-record(watchdog, + {%% PCB - Peer Control Block; see RFC 3539, Appendix A + status = initial :: initial | okay | suspect | down | reopen, + pending = false :: boolean(), + tw :: 6000..16#FFFFFFFF | {module(), atom(), list()}, + %% {M,F,A} -> integer() >= 0 + num_dwa = 0 :: -1 | non_neg_integer(), + %% number of DWAs received during reopen + %% end PCB + parent = self() :: pid(), + transport :: pid(), + tref :: reference(), %% reference for current watchdog timer + message_data}). %% term passed into diameter_service with message + +%% start/2 + +start({_,_} = Type, T) -> + {ok, Pid} = diameter_watchdog_sup:start_child({Type, self(), T}), + Pid. + +start_link(T) -> + {ok, _} = proc_lib:start_link(?MODULE, + init, + [T], + infinity, + diameter_lib:spawn_opts(server, [])). + +%% =========================================================================== +%% =========================================================================== + +%% init/1 + +init(T) -> + proc_lib:init_ack({ok, self()}), + gen_server:enter_loop(?MODULE, [], i(T)). + +i({T, Pid, {ConnT, Opts, SvcName, #diameter_service{applications = Apps, + capabilities = Caps} + = Svc}}) -> + {M,S,U} = now(), + random:seed(M,S,U), + putr(restart, {T, Opts, Svc}), %% save seeing it in trace + putr(dwr, dwr(Caps)), %% + #watchdog{parent = monitor(Pid), + transport = monitor(diameter_peer_fsm:start(T, Opts, Svc)), + tw = proplists:get_value(watchdog_timer, + Opts, + ?DEFAULT_TW_INIT), + message_data = {ConnT, SvcName, Apps}}. + +%% handle_call/3 + +handle_call(_, _, State) -> + {reply, nok, State}. + +%% handle_cast/2 + +handle_cast(_, State) -> + {noreply, State}. + +%% handle_info/2 + +handle_info(T, State) -> + case transition(T, State) of + ok -> + {noreply, State}; + #watchdog{status = X} = S -> + ?LOGC(X =/= State#watchdog.status, transition, X), + {noreply, S}; + stop -> + ?LOG(stop, T), + {stop, {shutdown, T}, State} + end. + +%% terminate/2 + +terminate(_, _) -> + ok. + +%% code_change/3 + +code_change(_, State, _) -> + {ok, State}. + +%% =========================================================================== +%% =========================================================================== + +%% transition/2 +%% +%% The state transitions documented here are extracted from RFC 3539, +%% the commentary is ours. + +%% Service or watchdog is telling the watchdog of an accepting +%% transport to die after reconnect_timer expiry or reestablished +%% connection (in another transport process) respectively. +transition(close, #watchdog{status = down}) -> + {{accept, _}, _, _} = getr(restart), %% assert + stop; +transition(close, #watchdog{}) -> + ok; + +%% Service is asking for the peer to be taken down gracefully. +transition({shutdown, Pid}, #watchdog{parent = Pid, + transport = undefined, + status = S}) -> + down = S, %% sanity check + stop; +transition({shutdown = T, Pid}, #watchdog{parent = Pid, + transport = TPid}) -> + TPid ! {T, self()}, + ok; + +%% Parent process has died, +transition({'DOWN', _, process, Pid, _Reason}, + #watchdog{parent = Pid}) -> + stop; + +%% Transport has accepted a connection. +transition({accepted = T, TPid}, #watchdog{transport = TPid, + parent = Pid}) -> + Pid ! {T, self(), TPid}, + ok; + +%% Transport is telling us that its impending death isn't failure. +transition({close, TPid, _Reason}, #watchdog{transport = TPid}) -> + stop; + +%% STATE Event Actions New State +%% ===== ------ ------- ---------- +%% INITIAL Connection up SetWatchdog() OKAY + +%% By construction, the watchdog timer isn't set until we move into +%% state okay as the result of the Peer State Machine reaching the +%% Open state. +%% +%% If we're an acceptor then we may be resuming a connection that went +%% down in another acceptor process, in which case this is the +%% transition below, from down into reopen. That is, it's not until +%% we know the identity of the peer (ie. now) that we know that we're +%% in state down rather than initial. + +transition({open, TPid, Hosts, T} = Open, + #watchdog{transport = TPid, + status = initial, + parent = Pid} + = S) -> + case okay(getr(restart), Hosts) of + okay -> + open(Pid, {TPid, T}), + set_watchdog(S#watchdog{status = okay}); + reopen -> + transition(Open, S#watchdog{status = down}) + end; + +%% DOWN Connection up NumDWA = 0 +%% SendWatchdog() +%% SetWatchdog() +%% Pending = TRUE REOPEN + +transition({open = P, TPid, _Hosts, T}, + #watchdog{transport = TPid, + status = down} + = S) -> + %% Store the info we need to notify the parent to reopen the + %% connection after the requisite DWA's are received, at which + %% time we eraser(open). + putr(P, {TPid, T}), + set_watchdog(send_watchdog(S#watchdog{status = reopen, + num_dwa = 0})); + +%% OKAY Connection down CloseConnection() +%% Failover() +%% SetWatchdog() DOWN +%% SUSPECT Connection down CloseConnection() +%% SetWatchdog() DOWN +%% REOPEN Connection down CloseConnection() +%% SetWatchdog() DOWN + +transition({'DOWN', _, process, TPid, _}, + #watchdog{transport = TPid, + status = initial}) -> + stop; + +transition({'DOWN', _, process, Pid, _}, + #watchdog{transport = Pid} + = S) -> + failover(S), + close(S), + set_watchdog(S#watchdog{status = down, + pending = false, + transport = undefined}); +%% Any outstanding pending (or other messages from the transport) will +%% have arrived before 'DOWN' since the message comes from the same +%% process. Note that we could also get this message in the initial +%% state. + +%% Incoming message. +transition({recv, TPid, Name, Pkt}, #watchdog{transport = TPid} = S) -> + recv(Name, Pkt, S); + +%% Current watchdog has timed out. +transition({timeout, TRef, tw}, #watchdog{tref = TRef} = S) -> + set_watchdog(timeout(S)); + +%% Timer was canceled after message was already sent. +transition({timeout, _, tw}, #watchdog{}) -> + ok; + +%% State query. +transition({state, Pid}, #watchdog{status = S}) -> + Pid ! {self(), S}, + ok. + +%% =========================================================================== + +monitor(Pid) -> + erlang:monitor(process, Pid), + Pid. + +putr(Key, Val) -> + put({?MODULE, Key}, Val). + +getr(Key) -> + get({?MODULE, Key}). + +eraser(Key) -> + erase({?MODULE, Key}). + +%% encode/1 + +encode(Msg) -> + #diameter_packet{bin = Bin} = diameter_codec:encode(?BASE, Msg), + Bin. + +%% okay/2 + +okay({{accept, Ref}, _, _}, Hosts) -> + T = {?MODULE, connection, Ref, Hosts}, + diameter_reg:add(T), + okay(diameter_reg:match(T)); +%% Register before matching so that at least one of two registering +%% processes will match the other. (Which can't happen as long as +%% diameter_peer_fsm guarantees at most one open connection to the same +%% peer.) + +okay({{connect, _}, _, _}, _) -> + okay. + +%% The peer hasn't been connected recently ... +okay([{_,P}]) -> + P = self(), %% assert + okay; + +%% ... or it has. +okay(C) -> + [_|_] = [P ! close || {_,P} <- C, self() /= P], + reopen. + +%% set_watchdog/1 + +set_watchdog(#watchdog{tw = TwInit, + tref = TRef} + = S) -> + cancel(TRef), + S#watchdog{tref = erlang:start_timer(tw(TwInit), self(), tw)}. + +cancel(undefined) -> + ok; +cancel(TRef) -> + erlang:cancel_timer(TRef). + +tw(T) + when is_integer(T), T >= 6000 -> + T - 2000 + (random:uniform(4001) - 1); %% RFC3539 jitter of +/- 2 sec. +tw({M,F,A}) -> + apply(M,F,A). + +%% open/2 + +open(Pid, {_,_} = T) -> + Pid ! {connection_up, self(), T}. + +%% failover/1 + +failover(#watchdog{status = okay, + parent = Pid}) -> + Pid ! {connection_down, self()}; + +failover(_) -> + ok. + +%% close/1 + +close(#watchdog{status = down}) -> + ok; + +close(#watchdog{parent = Pid}) -> + {{T, _}, _, _} = getr(restart), + T == accept andalso (Pid ! {close, self()}). + +%% send_watchdog/1 + +send_watchdog(#watchdog{pending = false, + transport = TPid} + = S) -> + TPid ! {send, encode(getr(dwr))}, + ?LOG(send, 'DWR'), + S#watchdog{pending = true}. + +%% recv/3 + +recv(Name, Pkt, S) -> + try rcv(Name, S) of + #watchdog{} = NS -> + rcv(Name, Pkt, S), + NS + catch + throw: {?MODULE, throwaway, #watchdog{} = NS} -> + NS + end. + +%% rcv/3 + +rcv(N, _, _) + when N == 'CER'; + N == 'CEA'; + N == 'DWR'; + N == 'DWA'; + N == 'DPR'; + N == 'DPA' -> + false; + +rcv(_, Pkt, #watchdog{transport = TPid, + message_data = T}) -> + diameter_service:receive_message(TPid, Pkt, T). + +throwaway(S) -> + throw({?MODULE, throwaway, S}). + +%% rcv/2 + +%% INITIAL Receive DWA Pending = FALSE +%% Throwaway() INITIAL +%% INITIAL Receive non-DWA Throwaway() INITIAL + +rcv('DWA', #watchdog{status = initial} = S) -> + throwaway(S#watchdog{pending = false}); + +rcv(_, #watchdog{status = initial} = S) -> + throwaway(S); + +%% DOWN Receive DWA Pending = FALSE +%% Throwaway() DOWN +%% DOWN Receive non-DWA Throwaway() DOWN + +rcv('DWA', #watchdog{status = down} = S) -> + throwaway(S#watchdog{pending = false}); + +rcv(_, #watchdog{status = down} = S) -> + throwaway(S); + +%% OKAY Receive DWA Pending = FALSE +%% SetWatchdog() OKAY +%% OKAY Receive non-DWA SetWatchdog() OKAY + +rcv('DWA', #watchdog{status = okay} = S) -> + set_watchdog(S#watchdog{pending = false}); + +rcv(_, #watchdog{status = okay} = S) -> + set_watchdog(S); + +%% SUSPECT Receive DWA Pending = FALSE +%% Failback() +%% SetWatchdog() OKAY +%% SUSPECT Receive non-DWA Failback() +%% SetWatchdog() OKAY + +rcv('DWA', #watchdog{status = suspect} = S) -> + failback(S), + set_watchdog(S#watchdog{status = okay, + pending = false}); + +rcv(_, #watchdog{status = suspect} = S) -> + failback(S), + set_watchdog(S#watchdog{status = okay}); + +%% REOPEN Receive DWA & Pending = FALSE +%% NumDWA == 2 NumDWA++ +%% Failback() OKAY + +rcv('DWA', #watchdog{status = reopen, + num_dwa = 2 = N, + parent = Pid} + = S) -> + open(Pid, eraser(open)), + S#watchdog{status = okay, + num_dwa = N+1, + pending = false}; + +%% REOPEN Receive DWA & Pending = FALSE +%% NumDWA < 2 NumDWA++ REOPEN + +rcv('DWA', #watchdog{status = reopen, + num_dwa = N} + = S) -> + S#watchdog{num_dwa = N+1, + pending = false}; + +%% REOPEN Receive non-DWA Throwaway() REOPEN + +rcv(_, #watchdog{status = reopen} = S) -> + throwaway(S). + +%% failback/1 + +failback(#watchdog{parent = Pid}) -> + Pid ! {connection_up, self()}. + +%% timeout/1 +%% +%% The caller sets the watchdog on the return value. + +%% OKAY Timer expires & SendWatchdog() +%% !Pending SetWatchdog() +%% Pending = TRUE OKAY +%% REOPEN Timer expires & SendWatchdog() +%% !Pending SetWatchdog() +%% Pending = TRUE REOPEN + +timeout(#watchdog{status = T, + pending = false} + = S) + when T == okay; + T == reopen -> + send_watchdog(S); + +%% OKAY Timer expires & Failover() +%% Pending SetWatchdog() SUSPECT + +timeout(#watchdog{status = okay, + pending = true} + = S) -> + failover(S), + S#watchdog{status = suspect}; + +%% SUSPECT Timer expires CloseConnection() +%% SetWatchdog() DOWN +%% REOPEN Timer expires & CloseConnection() +%% Pending & SetWatchdog() +%% NumDWA < 0 DOWN + +timeout(#watchdog{status = T, + pending = P, + num_dwa = N, + transport = TPid} + = S) + when T == suspect; + T == reopen, P, N < 0 -> + exit(TPid, shutdown), + close(S), + S#watchdog{status = down}; + +%% REOPEN Timer expires & NumDWA = -1 +%% Pending & SetWatchdog() +%% NumDWA >= 0 REOPEN + +timeout(#watchdog{status = reopen, + pending = true, + num_dwa = N} + = S) + when 0 =< N -> + S#watchdog{num_dwa = -1}; + +%% DOWN Timer expires AttemptOpen() +%% SetWatchdog() DOWN +%% INITIAL Timer expires AttemptOpen() +%% SetWatchdog() INITIAL + +%% RFC 3539, 3.4.1: +%% +%% [5] While the connection is in the closed state, the AAA client MUST +%% NOT attempt to send further watchdog messages on the connection. +%% However, after the connection is closed, the AAA client continues +%% to periodically attempt to reopen the connection. +%% +%% The AAA client SHOULD wait for the transport layer to report +%% connection failure before attempting again, but MAY choose to +%% bound this wait time by the watchdog interval, Tw. + +%% Don't bound, restarting the peer process only when the previous +%% process has died. We only need to handle state down since we start +%% the first watchdog when transitioning out of initial. + +timeout(#watchdog{status = down} = S) -> + restart(S). + +%% restart/1 + +restart(#watchdog{transport = undefined} = S) -> + restart(getr(restart), S); +restart(S) -> + S. + +%% Only restart the transport in the connecting case. For an accepting +%% transport, we've registered the peer connection when leaving state +%% initial and this is used by a new accepting process to realize that +%% it's actually in state down rather then initial when receiving +%% notification of an open connection. + +restart({{connect, _} = T, Opts, Svc}, #watchdog{parent = Pid} = S) -> + Pid ! {reconnect, self()}, + S#watchdog{transport = monitor(diameter_peer_fsm:start(T, Opts, Svc))}; +restart({{accept, _}, _, _}, S) -> + S. +%% Don't currently use Opts/Svc in the accept case but having them in +%% the process dictionary is helpful if the process dies unexpectedly. + +%% dwr/1 + +dwr(#diameter_caps{origin_host = OH, + origin_realm = OR, + origin_state_id = OSI}) -> + ['DWR', {'Origin-Host', OH}, + {'Origin-Realm', OR}, + {'Origin-State-Id', OSI}]. diff --git a/lib/diameter/src/base/diameter_watchdog_sup.erl b/lib/diameter/src/base/diameter_watchdog_sup.erl new file mode 100644 index 0000000000..fc837fe4ef --- /dev/null +++ b/lib/diameter/src/base/diameter_watchdog_sup.erl @@ -0,0 +1,60 @@ +%% +%% %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% +%% + +%% +%% Supervisor for all watchdog processes. +%% + +-module(diameter_watchdog_sup). + +-behaviour(supervisor). + +%% interface +-export([start_link/0, %% supervisor start + start_child/1]). %% watchdog start + +-export([init/1]). + +-define(NAME, ?MODULE). %% supervisor name + +%% start_link/0 + +start_link() -> + SupName = {local, ?NAME}, + supervisor:start_link(SupName, ?MODULE, []). + +%% start_child/1 +%% +%% Start a watchdog process. + +start_child(T) -> + supervisor:start_child(?NAME, [T]). + +%% init/1 + +init([]) -> + Mod = diameter_watchdog, + Flags = {simple_one_for_one, 0, 1}, + ChildSpec = {Mod, + {Mod, start_link, []}, + temporary, + 1000, + worker, + [Mod]}, + {ok, {Flags, [ChildSpec]}}. diff --git a/lib/diameter/src/compiler/.gitignore b/lib/diameter/src/compiler/.gitignore deleted file mode 100644 index d9f072e262..0000000000 --- a/lib/diameter/src/compiler/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ - -/depend.mk - diff --git a/lib/diameter/src/compiler/Makefile b/lib/diameter/src/compiler/Makefile deleted file mode 100644 index 779013bfbc..0000000000 --- a/lib/diameter/src/compiler/Makefile +++ /dev/null @@ -1,131 +0,0 @@ -# -# %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% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -ERL_FILES = \ - $(MODULES:%=%.erl) - -TARGET_FILES = \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include ../app/diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "HRL_FILES = $(HRL_FILES)" - @echo "" - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo "" - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/src/compiler - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src/compiler - -release_docs_spec: - -force: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -depend: depend.mk - -# Generate dependencies makefile. -depend.mk: ../app/depend.sed $(ERL_FILES) Makefile - for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done \ - > $@ - --include depend.mk - -.PHONY: clean debug depend docs force info opt release_docs_spec release_spec diff --git a/lib/diameter/src/compiler/modules.mk b/lib/diameter/src/compiler/modules.mk deleted file mode 100644 index 6fbc8fa8d4..0000000000 --- a/lib/diameter/src/compiler/modules.mk +++ /dev/null @@ -1,29 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -MODULES = \ - diameter_codegen \ - diameter_exprecs \ - diameter_spec_scan \ - diameter_spec_util \ - diameter_make - -HRL_FILES = \ - diameter_forms.hrl - diff --git a/lib/diameter/src/depend.sed b/lib/diameter/src/depend.sed new file mode 100644 index 0000000000..8f999f646f --- /dev/null +++ b/lib/diameter/src/depend.sed @@ -0,0 +1,51 @@ +# +# %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% +# + +# +# Extract include dependencies from .erl files. First line of input +# is the path to the module in question (minus the .erl extension), +# the rest is the contents of the module. +# + +1{ + s@^[^/]*/@@ + h + d +} + +# Only interested in includes of diameter hrls. +/^-include/!d +/"diameter/!d + +# Extract the name of the included files in one of two forms: +# +# $(INCDIR)/diameter.hrl +# diameter_internal.hrl + +s@^-include_lib(".*/@$(INCDIR)/@ +s@^-include("@@ +s@".*@@ + +# Retrieve the path to our module from the hold space, morph it +# into a beam path and turn it into a dependency like this: +# +# $(EBIN)/diameter_service.$(EMULATOR): $(INCDIR)/diameter.hrl + +G +s@^\(.*\)\n\(.*\)@$(EBIN)/\2.$(EMULATOR): \1@ diff --git a/lib/diameter/src/gen/.gitignore b/lib/diameter/src/gen/.gitignore new file mode 100644 index 0000000000..d490642eb7 --- /dev/null +++ b/lib/diameter/src/gen/.gitignore @@ -0,0 +1,2 @@ + +/diameter_gen*rl diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk new file mode 100644 index 0000000000..ef72bab17b --- /dev/null +++ b/lib/diameter/src/modules.mk @@ -0,0 +1,93 @@ +#-*-makefile-*- ; force emacs to enter makefile-mode + +# %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% + +# Runtime dictionary files in ./dict. Modules will be generated from +# these are included in the app file. +RT_DICTS = \ + base_rfc3588 \ + base_accounting \ + relay + +# Handwritten (runtime) modules included in the app file. +RT_MODULES = \ + base/diameter \ + base/diameter_app \ + base/diameter_capx \ + base/diameter_config \ + base/diameter_codec \ + base/diameter_dict \ + base/diameter_lib \ + base/diameter_misc_sup \ + base/diameter_peer \ + base/diameter_peer_fsm \ + base/diameter_peer_fsm_sup \ + base/diameter_reg \ + base/diameter_service \ + base/diameter_service_sup \ + base/diameter_session \ + base/diameter_stats \ + base/diameter_sup \ + base/diameter_sync \ + base/diameter_types \ + base/diameter_watchdog \ + base/diameter_watchdog_sup \ + transport/diameter_etcp \ + transport/diameter_etcp_sup \ + transport/diameter_tcp \ + transport/diameter_tcp_sup \ + transport/diameter_sctp \ + transport/diameter_sctp_sup \ + transport/diameter_transport_sup + +# Handwritten (compile time) modules not included in the app file. +CT_MODULES = \ + base/diameter_callback \ + base/diameter_dbg \ + base/diameter_info \ + compiler/diameter_codegen \ + compiler/diameter_exprecs \ + compiler/diameter_spec_scan \ + compiler/diameter_spec_util \ + compiler/diameter_make + +# Released hrl files intended for public consumption. +EXTERNAL_HRL_FILES = \ + ../include/diameter.hrl \ + ../include/diameter_gen.hrl + +# Release hrl files intended for private use. +INTERNAL_HRL_FILES = \ + base/diameter_internal.hrl \ + base/diameter_types.hrl \ + compiler/diameter_forms.hrl + +# Released files relative to ../bin. +BINS = \ + diameterc + +# Released files relative to ../examples. +EXAMPLES = \ + GNUmakefile \ + peer.erl \ + client.erl \ + client_cb.erl \ + server.erl \ + server_cb.erl \ + relay.erl \ + relay_cb.erl diff --git a/lib/diameter/src/subdirs.mk b/lib/diameter/src/subdirs.mk deleted file mode 100644 index 3e12d935bc..0000000000 --- a/lib/diameter/src/subdirs.mk +++ /dev/null @@ -1,21 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -SUB_DIRS = compiler app transport -SUB_DIRECTORIES = $(SUB_DIRS) \ No newline at end of file diff --git a/lib/diameter/src/transport/.gitignore b/lib/diameter/src/transport/.gitignore deleted file mode 100644 index d9f072e262..0000000000 --- a/lib/diameter/src/transport/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ - -/depend.mk - diff --git a/lib/diameter/src/transport/Makefile b/lib/diameter/src/transport/Makefile deleted file mode 100644 index 4b53100fd2..0000000000 --- a/lib/diameter/src/transport/Makefile +++ /dev/null @@ -1,141 +0,0 @@ -# -# %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% -# -# - -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/target.mk -EBIN = ../../ebin -include $(ERL_TOP)/make/$(TARGET)/otp.mk -else -include $(DIAMETER_TOP)/make/target.mk -EBIN = ../../ebin -include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk -endif - - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- - -include ../../vsn.mk -VSN=$(DIAMETER_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- - -RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) - -INCDIR = ../../include - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -include modules.mk - -ERL_FILES = \ - $(MODULES:%=%.erl) - -TARGET_FILES = \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -endif - -include ../app/diameter.mk - -ERL_COMPILE_FLAGS += \ - $(DIAMETER_ERL_COMPILE_FLAGS) \ - -I$(INCDIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug: - @${MAKE} TYPE=debug opt - -opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f errs core *~ - rm -f depend.mk - -docs: - -info: - @echo "" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "HRL_FILES = $(HRL_FILES)" - @echo "" - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo "" - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# Invoked from ../app to add modules to the app file. -$(APP_TARGET): force - M=`echo $(MODULES) | sed -e 's/^ *//' -e 's/ *$$//' -e 'y/ /,/'`; \ - echo "/%TRANSPORT_MODULES%/s//$$M/;w;q" | tr ';' '\n' \ - | ed -s $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -ifneq ($(ERL_TOP),) -include $(ERL_TOP)/make/otp_release_targets.mk -else -include $(DIAMETER_TOP)/make/release_targets.mk -endif - -release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DIR) $(RELSYSDIR)/src/transport - $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/src/transport - -release_docs_spec: - -force: - -# ---------------------------------------------------- -# Dependencies -# ---------------------------------------------------- - -depend: depend.mk - -# Generate dependencies makefile. -depend.mk: ../app/depend.sed $(ERL_FILES) Makefile - for f in $(MODULES); do \ - sed -f $< $$f.erl | sed "s@/@/$$f@"; \ - done \ - > $@ - --include depend.mk - -.PHONY: clean debug depend docs force info opt release_docs_spec release_spec diff --git a/lib/diameter/src/transport/modules.mk b/lib/diameter/src/transport/modules.mk deleted file mode 100644 index a0dc3cf2c0..0000000000 --- a/lib/diameter/src/transport/modules.mk +++ /dev/null @@ -1,29 +0,0 @@ -#-*-makefile-*- ; force emacs to enter makefile-mode - -# %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% - -MODULES = \ - diameter_etcp \ - diameter_etcp_sup \ - diameter_tcp \ - diameter_tcp_sup \ - diameter_sctp \ - diameter_sctp_sup \ - diameter_transport_sup - -HRL_FILES = diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index 04e686c969..8df7cc85fe 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -17,15 +17,14 @@ # %CopyrightEnd% ifeq ($(ERL_TOP),) -TOP = $(DIAMETER_TOP) +include $(DIAMETER_TOP)/make/target.mk +include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk else -TOP = $(ERL_TOP) -DIAMETER_TOP = $(TOP)/lib/diameter +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk +DIAMETER_TOP = $(ERL_TOP)/lib/diameter endif -include $(TOP)/make/target.mk -include $(TOP)/make/$(TARGET)/otp.mk - # ---------------------------------------------------- # Application version # ---------------------------------------------------- @@ -63,13 +62,11 @@ RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) # FLAGS # ---------------------------------------------------- -include ../src/app/diameter.mk - # This is only used to compile suite locally when running with a # target like 'all' below. Target release_tests only installs source. -ERL_COMPILE_FLAGS += $(DIAMETER_ERL_COMPILE_FLAGS) \ +ERL_COMPILE_FLAGS += +warn_unused_vars \ -DDIAMETER_CT=true \ - -I $(DIAMETER_TOP)/src/app + -I $(DIAMETER_TOP)/src/gen # ---------------------------------------------------- # Targets @@ -156,7 +153,11 @@ log: # Release Targets # ---------------------------------------------------- -include $(TOP)/make/otp_release_targets.mk +ifeq ($(ERL_TOP),) +include $(DIAMETER_TOP)/make/release_targets.mk +else +include $(ERL_TOP)/make/otp_release_targets.mk +endif release_spec: -- cgit v1.2.3 From 28580ff54b09710358ad366975289ef9a86bb867 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 16 Oct 2011 12:10:08 +0200 Subject: Use secondary expansion for src subdirectory rules Makes for a quieter rule with no recursion. --- lib/diameter/src/Makefile | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'lib/diameter') diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index a72bf4420b..861fc0c435 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -171,11 +171,6 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk app: $(APP_TARGET) $(APPUP_TARGET) dict: $(DICT_ERL_FILES) -# Make the modules from a subdirectory. -$(TARGET_DIRS:%/=%): - $(MAKE) \ - $(patsubst $@/%,$(EBIN)/%.$(EMULATOR),$(filter $@/%,$(TARGET_MODULES))) - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -241,3 +236,9 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PHONY: app clean depend dict info release_subdir .PHONY: debug opt release_docs_spec release_spec .PHONY: $(TARGET_DIRS:%/=%) + +.SECONDEXPANSION: + +# Make the modules from a subdirectory. +$(TARGET_DIRS:%/=%): \ + $$(patsubst $$@/%,$(EBIN)/%.$(EMULATOR),$$(filter $$@/%,$(TARGET_MODULES))) -- cgit v1.2.3 From 0f5d56109d7b51298a2c90dae1b11ba5819471b2 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 16 Oct 2011 12:27:23 +0200 Subject: Simpler release targets for src subdirectories --- lib/diameter/src/Makefile | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) (limited to 'lib/diameter') diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 861fc0c435..f6ceb7217f 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -194,15 +194,12 @@ release_spec: opt $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) \ $(RELSYSDIR)/include $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples - for dir in $(TARGET_DIRS); do \ - $(MAKE) release_subdir SRCDIR=$$dir; \ - done + $(MAKE) $(TARGET_DIRS:%/=release_src_%) -release_subdir: - [ -d "$(SRCDIR)" ] - $(INSTALL_DATA) $(filter $(SRCDIR)%,$(TARGET_MODULES:%=%.erl) \ - $(INTERNAL_HRL_FILES)) \ - $(RELSYSDIR)/src/$(SRCDIR) +$(TARGET_DIRS:%/=release_src_%): release_src_%: + $(INSTALL_DATA) $(filter $*/%,$(TARGET_MODULES:%=%.erl) \ + $(INTERNAL_HRL_FILES)) \ + $(RELSYSDIR)/src/$* release_docs_spec: @@ -235,7 +232,7 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) .PHONY: app clean depend dict info release_subdir .PHONY: debug opt release_docs_spec release_spec -.PHONY: $(TARGET_DIRS:%/=%) +.PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) .SECONDEXPANSION: -- cgit v1.2.3 From af9759875f237353339fad921ad82a712f889dcc Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Mon, 17 Oct 2011 18:36:51 +0200 Subject: Need absolute -pa for bootstrap build Otherwise include_lib will fail. --- lib/diameter/src/Makefile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'lib/diameter') diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index f6ceb7217f..6b3a5e340e 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -106,9 +106,11 @@ ERL_COMPILE_FLAGS += \ +'{parse_transform,sys_pre_attributes}' \ +'{attribute,insert,app_vsn,$(APP_VSN)}' \ +warn_unused_vars \ - -pa $(EBIN) \ + -pa $(realpath $(EBIN)) \ -I $(INCDIR) \ -I gen +# -pa is so that we can include_lib from our include directory. The +# path has to be absolute to contain the application name. # ---------------------------------------------------- # Targets -- cgit v1.2.3 From 955bbc378a146611929551cdabcfe63264a570ac Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Sun, 16 Oct 2011 15:09:35 +0200 Subject: Minor tweaks and cleanup Tweak some comments and variable names, move things around a bit (default src target is now opt, not debug), only clean what's built, use +warn_export_vars. --- lib/diameter/src/Makefile | 101 ++++++++++++++++++++----------------------- lib/diameter/src/modules.mk | 14 +++--- lib/diameter/test/Makefile | 77 ++++++++++++++------------------- lib/diameter/test/modules.mk | 2 +- 4 files changed, 88 insertions(+), 106 deletions(-) (limited to 'lib/diameter') diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 6b3a5e340e..ea1e43875e 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -46,15 +46,14 @@ INCDIR = ../include VPATH = .:base:compiler:transport:gen # ---------------------------------------------------- -# Target Specs +# Target specs # ---------------------------------------------------- include modules.mk -DICT_FILES = $(RT_DICTS:%=dict/%.dia) -DICT_MODULES = $(RT_DICTS:%=gen/diameter_gen_%) -DICT_ERL_FILES = $(DICT_MODULES:%=%.erl) -DICT_HRL_FILES = $(DICT_MODULES:%=%.hrl) +DICT_MODULES = $(DICTS:%=gen/diameter_gen_%) +DICT_ERLS = $(DICT_MODULES:%=%.erl) +DICT_HRLS = $(DICT_MODULES:%=%.hrl) # Modules to build before compiling dictionaries. COMPILER_MODULES = $(filter compiler/%, $(CT_MODULES)) @@ -91,11 +90,8 @@ APPUP_FILE = diameter.appup APPUP_SRC = $(APPUP_FILE).src APPUP_TARGET = $(EBIN)/$(APPUP_FILE) -EXAMPLE_FILES = $(EXAMPLES:%=../examples/%) -BIN_FILES = $(BINS:%=../bin/%) - # ---------------------------------------------------- -# FLAGS +# Flags # ---------------------------------------------------- ifeq ($(TYPE),debug) @@ -105,27 +101,39 @@ endif ERL_COMPILE_FLAGS += \ +'{parse_transform,sys_pre_attributes}' \ +'{attribute,insert,app_vsn,$(APP_VSN)}' \ + +warn_export_vars \ +warn_unused_vars \ -pa $(realpath $(EBIN)) \ -I $(INCDIR) \ -I gen -# -pa is so that we can include_lib from our include directory. The -# path has to be absolute to contain the application name. +# -pa is to be able to include_lib from the include directory: the +# path must contain the application name. # ---------------------------------------------------- # Targets # ---------------------------------------------------- +# erl/hrl from dictionary file. +gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia + ../bin/diameterc -o gen -i $(EBIN) $< + +opt: $(TARGET_FILES) + debug: @$(MAKE) TYPE=debug opt -opt: $(TARGET_FILES) +# Generate the app file. +$(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk + M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ + sed -e 's;%VSN%;$(VSN);' \ + -e "s;%MODULES%;$$M;" \ + $< > $@ -clean: - rm -f $(TARGET_FILES) $(DICT_ERL_FILES) $(DICT_HRL_FILES) - rm -f $(APP_TARGET) $(APPUP_TARGET) - rm -f errs core *~ gen/diameter_gen_*.forms gen/diameter_gen_*.spec - rm -f depend.mk +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +app: $(APP_TARGET) $(APPUP_TARGET) +dict: $(DICT_ERLS) docs: @@ -133,7 +141,7 @@ list = echo $(1):; echo $($(1)) | tr ' ' '\n' | sort | sed 's@^@ @' info: @echo ======================================== - @$(call list,RT_DICTS) + @$(call list,DICTS) @echo @$(call list,RT_MODULES) @echo @@ -143,38 +151,21 @@ info: @echo @$(call list,TARGET_DIRS) @echo - @$(call list,EXTERNAL_HRL_FILES) + @$(call list,EXTERNAL_HRLS) @echo - @$(call list,INTERNAL_HRL_FILES) + @$(call list,INTERNAL_HRLS) @echo - @$(call list,EXAMPLE_FILES) + @$(call list,EXAMPLES) @echo - @$(call list,BIN_FILES) + @$(call list,BINS) @echo ======================================== -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -# erl/hrl from dictionary file. -gen/diameter_gen_%.erl gen/diameter_gen_%.hrl: dict/%.dia - ../bin/diameterc -o gen -i $(EBIN) $< - -# Generate the app file. -$(APP_TARGET): $(APP_SRC) ../vsn.mk modules.mk - M=`echo $(notdir $(APP_MODULES)) | tr ' ' ,`; \ - sed -e 's;%VSN%;$(VSN);' \ - -e "s;%MODULES%;$$M;" \ - $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(VSN);' $< > $@ - -app: $(APP_TARGET) $(APPUP_TARGET) -dict: $(DICT_ERL_FILES) +clean: + rm -f $(TARGET_FILES) $(DICT_ERLS) $(DICT_HRLS) + rm -f depend.mk # ---------------------------------------------------- -# Release Target +# Release targets # ---------------------------------------------------- ifeq ($(ERL_TOP),) @@ -186,21 +177,21 @@ endif release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/bin \ $(RELSYSDIR)/ebin \ - $(RELSYSDIR)/src/dict \ - $(TARGET_DIRS:%=$(RELSYSDIR)/src/%) \ + $(RELSYSDIR)/examples \ $(RELSYSDIR)/include \ - $(RELSYSDIR)/examples - $(INSTALL_SCRIPT) $(BIN_FILES) $(RELSYSDIR)/bin + $(RELSYSDIR)/src/dict \ + $(TARGET_DIRS:%/=$(RELSYSDIR)/src/%) + $(INSTALL_SCRIPT) $(BINS:%=../bin/%) $(RELSYSDIR)/bin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(DICT_FILES) $(RELSYSDIR)/src/dict - $(INSTALL_DATA) $(EXTERNAL_HRL_FILES) $(DICT_HRL_FILES) \ + $(INSTALL_DATA) $(EXAMPLES:%=../examples/%) $(RELSYSDIR)/examples + $(INSTALL_DATA) $(EXTERNAL_HRLS:%=../include/%) $(DICT_HRLS) \ $(RELSYSDIR)/include - $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples + $(INSTALL_DATA) $(DICTS:%=dict/%.dia) $(RELSYSDIR)/src/dict $(MAKE) $(TARGET_DIRS:%/=release_src_%) $(TARGET_DIRS:%/=release_src_%): release_src_%: $(INSTALL_DATA) $(filter $*/%,$(TARGET_MODULES:%=%.erl) \ - $(INTERNAL_HRL_FILES)) \ + $(INTERNAL_HRLS)) \ $(RELSYSDIR)/src/$* release_docs_spec: @@ -231,13 +222,17 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile -include depend.mk -.PRECIOUS: $(DICT_ERL_FILES) $(DICT_HRL_FILES) +.PRECIOUS: $(DICT_ERLS) $(DICT_HRLS) .PHONY: app clean depend dict info release_subdir .PHONY: debug opt release_docs_spec release_spec .PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) +# ---------------------------------------------------- +# Targets using secondary expansion +# ---------------------------------------------------- + .SECONDEXPANSION: -# Make the modules from a subdirectory. +# Make beams from a subdirectory. $(TARGET_DIRS:%/=%): \ $$(patsubst $$@/%,$(EBIN)/%.$(EMULATOR),$$(filter $$@/%,$(TARGET_MODULES))) diff --git a/lib/diameter/src/modules.mk b/lib/diameter/src/modules.mk index ef72bab17b..c7cbe598af 100644 --- a/lib/diameter/src/modules.mk +++ b/lib/diameter/src/modules.mk @@ -19,7 +19,7 @@ # Runtime dictionary files in ./dict. Modules will be generated from # these are included in the app file. -RT_DICTS = \ +DICTS = \ base_rfc3588 \ base_accounting \ relay @@ -66,13 +66,13 @@ CT_MODULES = \ compiler/diameter_spec_util \ compiler/diameter_make -# Released hrl files intended for public consumption. -EXTERNAL_HRL_FILES = \ - ../include/diameter.hrl \ - ../include/diameter_gen.hrl +# Released hrl files in ../include intended for public consumption. +EXTERNAL_HRLS = \ + diameter.hrl \ + diameter_gen.hrl -# Release hrl files intended for private use. -INTERNAL_HRL_FILES = \ +# Released hrl files intended for private use. +INTERNAL_HRLS = \ base/diameter_internal.hrl \ base/diameter_types.hrl \ compiler/diameter_forms.hrl diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index 8df7cc85fe..69bcabbfbb 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -22,7 +22,6 @@ include $(DIAMETER_TOP)/make/$(TARGET)/rules.mk else include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk -DIAMETER_TOP = $(ERL_TOP)/lib/diameter endif # ---------------------------------------------------- @@ -45,18 +44,11 @@ RELSYSDIR = $(RELEASE_PATH)/diameter_test include modules.mk -EBIN = . - -HRL_FILES = $(INTERNAL_HRL_FILES) -ERL_FILES = $(MODULES:%=%.erl) - -SOURCE = $(HRL_FILES) $(ERL_FILES) +ERL_FILES = $(MODULES:%=%.erl) TARGET_FILES = $(MODULES:%=%.$(EMULATOR)) SUITE_MODULES = $(filter diameter_%_SUITE, $(MODULES)) -SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) - -RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) +SUITES = $(SUITE_MODULES:diameter_%_SUITE=%) # ---------------------------------------------------- # FLAGS @@ -64,9 +56,10 @@ RELTEST_FILES = $(TEST_SPEC_FILE) $(COVER_SPEC_FILE) $(SOURCE) # This is only used to compile suite locally when running with a # target like 'all' below. Target release_tests only installs source. -ERL_COMPILE_FLAGS += +warn_unused_vars \ +ERL_COMPILE_FLAGS += +warn_export_vars \ + +warn_unused_vars \ -DDIAMETER_CT=true \ - -I $(DIAMETER_TOP)/src/gen + -I ../src/gen # ---------------------------------------------------- # Targets @@ -82,62 +75,52 @@ clean: realclean: clean rm -rf log - rm -f errs core *~ - -.PHONY: all tests debug opt clean realclean docs: +list = echo $(1):; echo $($(1)) | tr ' ' '\n' | sort | sed 's@^@ @' + info: - @echo "TARGET_FILES = $(TARGET_FILES)" + @echo ======================================== + @$(call list,MODULES) @echo - @echo "ERL_COMPILE_FLAGS = $(ERL_COMPILE_FLAGS)" - @echo "ERL = $(ERL)" - @echo "ERLC = $(ERLC)" - @echo - @echo "HRL_FILES = $(HRL_FILES)" - @echo "ERL_FILES = $(ERL_FILES)" - @echo "TARGET_FILES = $(TARGET_FILES)" - @echo - @echo "SUITE_MODULES = $(SUITE_MODULES)" - @echo "SUITES = $(SUITES)" + @$(call list,HRL_FILES) @echo + @$(call list,SUITES) + @echo ======================================== help: + @echo ======================================== + @echo "Useful targets:" @echo - @echo "Targets:" - @echo - @echo " all" - @echo " Run all test suites." + @echo " all:" + @echo " Compile and run all test suites." @echo - @echo " $(SUITES)" - @echo " Run a specific test suite." + @echo " $(SUITES):" + @echo " Compile and run a specific test suite." @echo - @echo " tests" + @echo " beam:" @echo " Compile all test-code." @echo - @echo " clean | realclean" + @echo " clean | realclean:" @echo " Remove generated files." @echo - @echo " info" - @echo " Prints various environment variables." - @echo " May be useful when debugging this Makefile." - @echo - @echo " help" - @echo " Print this info." - @echo + @echo " info:" + @echo " Echo some interesting variables." + @echo ======================================== -.PHONY: docs info help +.PHONY: all beam clean debug docs help info opt realclean tests # ---------------------------------------------------- # Special Targets # ---------------------------------------------------- # Exit with a non-zero status if the output looks to indicate failure. -# diameter_ct:run/1 itself can't tell (it seems). +# diameter_ct:run/1 itself can't tell (it seems). The absolute -pa is +# because ct will change directories. $(SUITES): log tests $(ERL) -noshell \ - -pa $(DIAMETER_TOP)/ebin \ + -pa $(realpath ../ebin) \ -sname diameter_test_$@ \ -s diameter_ct run diameter_$@_SUITE \ -s init stop \ @@ -165,7 +148,11 @@ release_docs_spec: release_tests_spec: $(INSTALL_DIR) $(RELSYSDIR) - $(INSTALL_DATA) $(RELTEST_FILES) $(RELSYSDIR) + $(INSTALL_DATA) $(TEST_SPEC_FILE) \ + $(COVER_SPEC_FILE) \ + $(HRL_FILES) \ + $(ERL_FILES) \ + $(RELSYSDIR) .PHONY: release_spec release_docs_spec release_test_specs diff --git a/lib/diameter/test/modules.mk b/lib/diameter/test/modules.mk index 531aca2799..75fdd0bd1d 100644 --- a/lib/diameter/test/modules.mk +++ b/lib/diameter/test/modules.mk @@ -38,5 +38,5 @@ MODULES = \ diameter_tls_SUITE \ diameter_failover_SUITE -INTERNAL_HRL_FILES = \ +HRL_FILES = \ diameter_ct.hrl -- cgit v1.2.3 From e89a59263762c1b625b1b054784b73112fb440a3 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Tue, 18 Oct 2011 14:10:53 +0200 Subject: Dumb down opt/release targets to make 3.80 --- lib/diameter/src/Makefile | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'lib/diameter') diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index ea1e43875e..15196bc002 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -42,6 +42,9 @@ RELSYSDIR = $(RELEASE_PATH)/lib/diameter-$(VSN) EBIN = ../ebin INCDIR = ../include +# Dumbed down to make 3.80. In 3.81 and later it's just $(realpath $(EBIN)). +ABS_EBIN := $(shell cd $(EBIN) && pwd) + # Where make should look for dependencies. VPATH = .:base:compiler:transport:gen @@ -103,7 +106,7 @@ ERL_COMPILE_FLAGS += \ +'{attribute,insert,app_vsn,$(APP_VSN)}' \ +warn_export_vars \ +warn_unused_vars \ - -pa $(realpath $(EBIN)) \ + -pa $(ABS_EBIN) \ -I $(INCDIR) \ -I gen # -pa is to be able to include_lib from the include directory: the @@ -228,7 +231,7 @@ depend.mk: depend.sed $(MODULES:%=%.erl) Makefile .PHONY: $(TARGET_DIRS:%/=%) $(TARGET_DIRS:%/=release_src_%) # ---------------------------------------------------- -# Targets using secondary expansion +# Targets using secondary expansion (make >= 3.81) # ---------------------------------------------------- .SECONDEXPANSION: -- cgit v1.2.3 From 6c048c57a4714e033f484ff79425ce847e9a43e9 Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Wed, 19 Oct 2011 11:55:46 +0200 Subject: Dumb down release target to Solaris /usr/ucb/install --- lib/diameter/src/Makefile | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'lib/diameter') diff --git a/lib/diameter/src/Makefile b/lib/diameter/src/Makefile index 15196bc002..a057632d15 100644 --- a/lib/diameter/src/Makefile +++ b/lib/diameter/src/Makefile @@ -177,13 +177,12 @@ else include $(ERL_TOP)/make/otp_release_targets.mk endif +# Can't $(INSTALL_DIR) more than on directory at a time on Solaris. + release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/bin \ - $(RELSYSDIR)/ebin \ - $(RELSYSDIR)/examples \ - $(RELSYSDIR)/include \ - $(RELSYSDIR)/src/dict \ - $(TARGET_DIRS:%/=$(RELSYSDIR)/src/%) + for d in bin ebin examples include src/dict $(TARGET_DIRS:%/=src/%); do \ + $(INSTALL_DIR) $(RELSYSDIR)/$$d; \ + done $(INSTALL_SCRIPT) $(BINS:%=../bin/%) $(RELSYSDIR)/bin $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin $(INSTALL_DATA) $(EXAMPLES:%=../examples/%) $(RELSYSDIR)/examples -- cgit v1.2.3