From 09145645eb87e2d83766c38e5d3f134c3c6721e3 Mon Sep 17 00:00:00 2001 From: Harald Welte Date: Mon, 10 Oct 2011 20:44:10 +0200 Subject: [PATCH] move ss7_link into libosm-ss7 --- ebin/osmo_sccp.app | 5 +- src/osmo_sccp_sup.erl | 25 +-- src/sccp_routing.erl | 21 +-- src/sccp_scrc.erl | 29 ++-- src/ss7_link_ipa_client.erl | 109 ------------- src/ss7_link_m3ua.erl | 115 -------------- src/ss7_links.erl | 306 ------------------------------------ 7 files changed, 32 insertions(+), 578 deletions(-) delete mode 100644 src/ss7_link_ipa_client.erl delete mode 100644 src/ss7_link_m3ua.erl delete mode 100644 src/ss7_links.erl diff --git a/ebin/osmo_sccp.app b/ebin/osmo_sccp.app index d8fe44e..2a663db 100644 --- a/ebin/osmo_sccp.app +++ b/ebin/osmo_sccp.app @@ -4,9 +4,6 @@ {modules, [ osmo_sccp, osmo_sccp_app, osmo_sccp_sup, - ss7_links, - ss7_link_ipa_client, - ss7_link_m3ua, sccp_routing, sccp_scrc, sccp_scoc, @@ -14,7 +11,7 @@ ]}, {registered, [osmo_sccp_app]}, {mod, {osmo_sccp_app, []}}, - {applications, []}, + {applications, [osmo_ss7]}, {env, [ ]} ]}. diff --git a/src/osmo_sccp_sup.erl b/src/osmo_sccp_sup.erl index 3258670..9b42370 100644 --- a/src/osmo_sccp_sup.erl +++ b/src/osmo_sccp_sup.erl @@ -20,36 +20,17 @@ -module(osmo_sccp_sup). -behavior(supervisor). --export([start_link/0, add_mtp_link/1]). +-export([start_link/0]). -export([init/1]). -include("osmo_sccp.hrl"). start_link() -> - supervisor:start_link({local, ?MODULE}, ?MODULE, [{debug, [trace]}]). + supervisor:start_link({local, ?MODULE}, ?MODULE, []). init(Args) -> ScrcChild = {sccp_scrc, {sccp_scrc, start_link, [Args]}, permanent, 2000, worker, [sccp_scrc, sccp_codec, sccp_routing]}, UserChild = {sccp_user, {sccp_user, start_link, []}, permanent, 2000, worker, [sccp_user]}, - LinksChild = {ss7_links, {ss7_links, start_link, []}, - permanent, 2000, worker, [ss7_links]}, - %ScrcChild = {sccp_sclc, {sccp_sclc, start_link, [Args]}, - % permanent, 2000, worker, [sccp_sclc, sccp_codec]}, - {ok,{{one_for_one,60,600}, [ScrcChild, UserChild, LinksChild]}}. - -% Add a m3ua link to this supervisor -add_mtp_link(L=#sigtran_link{type = m3ua, name = Name, - local = Local, remote = Remote}) -> - ChildName = list_to_atom("ss7_link_m3ua_" ++ Name), - ChildSpec = {ChildName, {ss7_link_m3ua, start_link, [L]}, - permanent, infinity, worker, [ss7_link_m3ua]}, - supervisor:start_child(?MODULE, ChildSpec); -add_mtp_link([]) -> - ok; -add_mtp_link([Head|Tail]) -> - add_mtp_link(Head, Tail). -add_mtp_link(Head, Tail) -> - {ok, _Child} = add_mtp_link(Head), - add_mtp_link(Tail). + {ok,{{one_for_one,60,600}, [ScrcChild, UserChild]}}. diff --git a/src/sccp_routing.erl b/src/sccp_routing.erl index d171993..bf5ae21 100644 --- a/src/sccp_routing.erl +++ b/src/sccp_routing.erl @@ -100,11 +100,11 @@ route_local_out_action(1, SccpMsg, CalledParty) -> case pointcode_is_local(Pc) of true -> % c) procedures 2.3.1, item 2) are folloed - case sccp_user:local_ssn_avail(Ssn, Pc) of - true -> + case sccp_user:pid_for_ssn(Ssn, Pc) of + {ok, UserPid} -> % pass to either SCOC or SCLC - {local, SccpMsg}; - false -> + {local, SccpMsg, UserPid}; + {error, _Error} -> % message return / connection refusal msg_return_or_cr_refusal(SccpMsg, ?SCCP_CAUSE_RET_UNEQUIP_USER, @@ -134,7 +134,7 @@ route_local_out_action(2, SccpMsg, CalledParty) -> true -> % message is passed, based on the message type, to % either SCOC or SCLC; - {local, SccpMsg}; + {local, SccpMsg, undefined}; false -> % MTP-TRANSFER request primitive is invoked unless the % compatibility test returns the message to SCLC or @@ -151,7 +151,8 @@ route_local_out_action(3, SccpMsg, CalledParty) -> case pointcode_is_local(Pc) of true -> % pass to either SCOC or SCLC - {local, SccpMsg}; + % theoretic case, as we only enter Action(3) for remote DPC + {local, SccpMsg, undefined}; false -> % If the DPC is not the node itself and the remote DPC, SCCP % and SSN are available, then the MTP-TRANSFER request @@ -178,7 +179,7 @@ route_cr_connless(Mtp3Msg, SccpMsg) when is_record(SccpMsg, sccp_msg) -> case sccp_user:pid_for_ssn(Ssn, Pc) of {ok, UserPid} -> % forward to SCOC/SCLC - {local, SccpMsg, Mtp3Msg}; + {local, SccpMsg, UserPid}; {error, Error} -> % invoke connection refusal (if CR) or message return msg_return_or_cr_refusal(SccpMsg, @@ -207,12 +208,12 @@ route_cr_connless(Mtp3Msg, SccpMsg) when is_record(SccpMsg, sccp_msg) -> % FIXME: handle UDTS/XUDTS/LUDTS messages (RI=0 check) of C.1/Q.714 (1/12) % FIXME: handle translation already performed == yes) case of C.1/Q.714 (1/12) route_main(SccpMsg), - {remote}. + {remote, SccpMsg}. % CR or connectionless message, coming in from MTP % return values -% {local, SccpMsg, Mtp3Msg} +% {local, SccpMsg, UserPid} % {remote} route_mtp3_sccp_in(Mtp3Msg) when is_record(Mtp3Msg, mtp3_msg) -> {ok, Msg} = sccp_codec:parse_sccp_msg(Mtp3Msg#mtp3_msg.payload), @@ -225,7 +226,7 @@ route_mtp3_sccp_in(Mtp3Msg) when is_record(Mtp3Msg, mtp3_msg) -> true -> route_cr_connless(Mtp3Msg, Msg); false -> - {local, Msg, Mtp3Msg} + {local, Msg, undefined} end end. diff --git a/src/sccp_scrc.erl b/src/sccp_scrc.erl index bc9e150..7377d81 100644 --- a/src/sccp_scrc.erl +++ b/src/sccp_scrc.erl @@ -58,6 +58,7 @@ init(InitPropList) -> LoopData = #scrc_state{user_pid = UserPid, next_local_ref = 0}, TableRef = ets:new(scoc_by_ref, [set]), put(scoc_by_ref, TableRef), + ok = ss7_links:bind_service(?MTP3_SERV_SCCP, "osmo_sccp"), {ok, idle, LoopData}. @@ -91,7 +92,7 @@ is_cr_or_connless(SccpMsg) when is_record(SccpMsg, sccp_msg) -> end. % deliver message to local SCOC or SCLC -deliver_to_scoc_sclc(LoopDat, Msg) when is_record(Msg, sccp_msg) -> +deliver_to_scoc_sclc(LoopDat, Msg, UserPid) when is_record(Msg, sccp_msg) -> case Msg of % special handling for CR message here in SCRC #sccp_msg{msg_type = ?SCCP_MSGT_CR} -> @@ -108,12 +109,16 @@ deliver_to_scoc_sclc(LoopDat, Msg) when is_record(Msg, sccp_msg) -> IsConnLess = sccp_codec:is_connectionless(Msg), case IsConnLess of true -> - % it would be more proper to send them via SCLC ?? - %gen_fsm:send(sccp_sclc, ?? - UserPid = LoopDat#scrc_state.user_pid, - % FIXME: N-NOTICE.ind for NOTICE - UserPrim = osmo_util:make_prim('N','UNITDATA', indication, Msg), - UserPid ! {sccp, UserPrim}; + case UserPid of + undefined -> + io:format("CL message to unequipped SSN~n"); + _ -> + % it would be more proper to send them via SCLC ?? + %gen_fsm:send(sccp_sclc, ?? + % FIXME: N-NOTICE.ind for NOTICE + UserPrim = osmo_util:make_prim('N','UNITDATA', indication, Msg), + UserPid ! {sccp, UserPrim} + end; false -> % connection oriented messages need to go via SCOC instance #sccp_msg{parameters = Opts} = Msg, @@ -154,11 +159,11 @@ idle(P= #primitive{subsystem = 'N', gen_name = 'UNITDATA', idle(#primitive{subsystem = 'MTP', gen_name = 'TRANSFER', spec_name = indication, parameters = Params}, LoopDat) -> case sccp_routing:route_mtp3_sccp_in(Params) of - {remote} -> + {remote, SccpMsg} -> % routing has taken care of it LoopDat1 = LoopDat; - {local, SccpMsg, _} -> - LoopDat1 = deliver_to_scoc_sclc(LoopDat, SccpMsg) + {local, SccpMsg, UserPid} -> + LoopDat1 = deliver_to_scoc_sclc(LoopDat, SccpMsg, UserPid) end, {next_state, idle, LoopDat1}; idle({sclc_scrc_connless_msg, SccpMsg}, LoopDat) -> @@ -168,8 +173,8 @@ idle({sclc_scrc_connless_msg, SccpMsg}, LoopDat) -> LoopDat1 = LoopDat; {error, _} -> LoopDat1 = LoopDat; - {local, SccpMsg2} -> - LoopDat1 = deliver_to_scoc_sclc(LoopDat, SccpMsg2) + {local, SccpMsg2, UserPid} -> + LoopDat1 = deliver_to_scoc_sclc(LoopDat, SccpMsg2, UserPid) end, {next_state, idle, LoopDat}; % connection oriented messages like N-DATA.req from user diff --git a/src/ss7_link_ipa_client.erl b/src/ss7_link_ipa_client.erl deleted file mode 100644 index da9e611..0000000 --- a/src/ss7_link_ipa_client.erl +++ /dev/null @@ -1,109 +0,0 @@ -% Osmocom adaptor to interface the IPA core with osmo_sccp - -% (C) 2011 by Harald Welte -% -% All Rights Reserved -% -% This program is free software; you can redistribute it and/or modify -% it under the terms of the GNU Affero General Public License as -% published by the Free Software Foundation; either version 3 of the -% License, or (at your option) any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU Affero General Public License -% along with this program. If not, see . - --module(ss7_link_ipa_client). --author('Harald Welte '). --behavior(gen_server). - --include_lib("osmo_ss7/include/osmo_util.hrl"). -%-include_lib("osmo_ss7/include/ipa.hrl"). --include_lib("osmo_ss7/include/sccp.hrl"). - --include("osmo_sccp.hrl"). - --export([start_link/1, init/1]). - --export([handle_cast/2]). - --record(loop_dat, { - ipa_pid, - link - }). - -start_link(Args) -> - gen_server:start_link(?MODULE, Args, []). - -init(L = #sigtran_link{type = ipa_client, name = Name, linkset_name = LinksetName, - sls = Sls, local = Local, remote = Remote}) -> - #sigtran_peer{ip = LocalIp, port = LocalPort} = Local, - #sigtran_peer{ip = RemoteIp, port = RemotePort} = Remote, - % start the IPA link to the SG - Opts = [{user_pid, self()}, {sctp_remote_ip, RemoteIp}, - {sctp_remote_port, RemotePort}, {sctp_local_port, LocalPort}, - {user_fun, fun ipa_tx_to_user/2}, {user_args, self()}], - {ok, IpaPid} = ipa_core:start_link(Opts), - % FIXME: register this link with SCCP_SCRC - ok = ss7_link:register_link(LinksetName, Sls, Name), - {ok, #loop_dat{ipa_pid = IpaPid, link = L}}. - -% % instantiate SCCP routing instance -% {ok, ScrcPid} = sccp_scrc:start_link([{mtp_tx_action, {callback_fn, fun scrc_tx_to_mtp/2, M3uaPid}}]), -% loop(#loop_dat{ipa_pid = M3uaPid, scrc_pid = ScrcPid}). - - -set_link_state(#sigtran_link{linkset_name = LinksetName, sls = Sls}, State) -> - ok = ss7_links:set_link_state(LinksetName, Sls, State). - -scrc_tx_to_mtp(Prim, Args) -> - M3uaPid = Args, - gen_fsm:send_event(M3uaPid, Prim). - -% Callback that we pass to the ipa_core, which it will call when it wants to -% send a primitive up the stack to SCCP -ipa_tx_to_user(Prim, Args) -> - UserPid = Args, - gen_server:cast(UserPid, Prim). - -% This is what we receive from ipa_tx_to_user/2 -handle_cast(#primitive{subsystem = 'M', gen_name = 'SCTP_ESTABLISH', spec_name = confirm}, L) -> - io:format("~p: SCTP_ESTABLISH.ind -> ASP_UP.req~n", [?MODULE]), - gen_fsm:send_event(L#loop_dat.ipa_pid, osmo_util:make_prim('M','ASP_UP',request)), - {noreply, L}; -handle_cast(#primitive{subsystem = 'M', gen_name = 'ASP_UP', spec_name = confirm}, L) -> - io:format("~p: ASP_UP.ind -> ASP_ACTIVE.req~n", [?MODULE]), - set_link_state(L, up), - gen_fsm:send_event(L#loop_dat.ipa_pid, osmo_util:make_prim('M','ASP_ACTIVE',request)), - {noreply, L}; -handle_cast(#primitive{subsystem = 'M', gen_name = 'ASP_ACTIVE', spec_name = confirm}, L) -> - io:format("~p: ASP_ACTIVE.ind - M3UA now active and ready~n", [?MODULE]), - set_link_state(L, active), - %tx_sccp_udt(L#loop_dat.scrc_pid), - {noreply, L}; -handle_cast(#primitive{subsystem = 'M', gen_name = 'ASP_DOWN'}, L) -> - io:format("~p: ASP_DOWN.ind~n", [?MODULE]), - set_link_state(L, down), - {noreply, L}; -handle_cast(#primitive{subsystem = 'M', gen_name = 'ASP_INACTIVE'}, L) -> - io:format("~p: ASP_DOWN.ind~n", [?MODULE]), - set_link_state(L, inactive), - {noreply, L}; -handle_cast(P, L) -> - io:format("~p: Ignoring M3UA prim ~p~n", [?MODULE, P]), - {noreply, L}. - - -tx_sccp_udt(ScrcPid) -> - CallingP = #sccp_addr{ssn = ?SCCP_SSN_MSC, point_code = osmo_util:pointcode2int(itu, {1,2,2})}, - CalledP = #sccp_addr{ssn = ?SCCP_SSN_HLR, point_code = osmo_util:pointcode2int(itu, {1,1,1})}, - Data = <<1,2,3,4>>, - Opts = [{protocol_class, 0}, {called_party_addr, CalledP}, - {calling_party_addr, CallingP}, {user_data, Data}], - io:format("~p: Sending N-UNITDATA.req to SCRC~n", [?MODULE]), - gen_fsm:send_event(ScrcPid, osmo_util:make_prim('N','UNITDATA',request,Opts)). - diff --git a/src/ss7_link_m3ua.erl b/src/ss7_link_m3ua.erl deleted file mode 100644 index 5a8450f..0000000 --- a/src/ss7_link_m3ua.erl +++ /dev/null @@ -1,115 +0,0 @@ -% Osmocom adaptor to interface the M3UA core with osmo_sccp - -% (C) 2011 by Harald Welte -% -% All Rights Reserved -% -% This program is free software; you can redistribute it and/or modify -% it under the terms of the GNU Affero General Public License as -% published by the Free Software Foundation; either version 3 of the -% License, or (at your option) any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU Affero General Public License -% along with this program. If not, see . - --module(ss7_link_m3ua). --author('Harald Welte '). --behavior(gen_server). - --include_lib("osmo_ss7/include/osmo_util.hrl"). --include_lib("osmo_ss7/include/m3ua.hrl"). --include_lib("osmo_ss7/include/sccp.hrl"). - --include("osmo_sccp.hrl"). - --export([start_link/1, init/1]). - --export([handle_cast/2]). - --record(loop_dat, { - m3ua_pid, - link - }). - -start_link(Args) -> - gen_server:start_link(?MODULE, Args, [{debug, [trace]}]). - -init(L = #sigtran_link{type = m3ua, name = Name, linkset_name = LinksetName, - sls = Sls, local = Local, remote = Remote}) -> - #sigtran_peer{ip = LocalIp, port = LocalPort} = Local, - #sigtran_peer{ip = RemoteIp, port = RemotePort} = Remote, - % start the M3UA link to the SG - Opts = [{user_pid, self()}, {sctp_remote_ip, RemoteIp}, - {sctp_remote_port, RemotePort}, {sctp_local_port, LocalPort}, - {user_fun, fun m3ua_tx_to_user/2}, {user_args, self()}], - {ok, M3uaPid} = m3ua_core:start_link(Opts), - % FIXME: register this link with SCCP_SCRC - ok = ss7_links:register_link(LinksetName, Sls, Name), - {ok, #loop_dat{m3ua_pid = M3uaPid, link = L}}. - -% % instantiate SCCP routing instance -% {ok, ScrcPid} = sccp_scrc:start_link([{mtp_tx_action, {callback_fn, fun scrc_tx_to_mtp/2, M3uaPid}}]), -% loop(#loop_dat{m3ua_pid = M3uaPid, scrc_pid = ScrcPid}). - - -set_link_state(#sigtran_link{linkset_name = LinksetName, sls = Sls}, State) -> - ok = ss7_links:set_link_state(LinksetName, Sls, State). - -scrc_tx_to_mtp(Prim, Args) -> - M3uaPid = Args, - gen_fsm:send_event(M3uaPid, Prim). - -% Callback that we pass to the m3ua_core, which it will call when it wants to -% send a primitive up the stack to SCCP -m3ua_tx_to_user(Prim, Args) -> - UserPid = Args, - gen_server:cast(UserPid, Prim). - -handle_cast(P = #primitive{subsystem = 'MTP', gen_name = 'TRANSFER', spec_name = request}, L) -> - scrc_tx_to_mtp(P, L#loop_dat.m3ua_pid), - {noreply, L}; -% This is what we receive from m3ua_tx_to_user/2 -handle_cast(#primitive{subsystem = 'M', gen_name = 'SCTP_ESTABLISH', spec_name = confirm}, L) -> - io:format("~p: SCTP_ESTABLISH.ind -> ASP_UP.req~n", [?MODULE]), - gen_fsm:send_event(L#loop_dat.m3ua_pid, osmo_util:make_prim('M','ASP_UP',request)), - {noreply, L}; -handle_cast(#primitive{subsystem = 'M', gen_name = 'ASP_UP', spec_name = confirm}, L) -> - io:format("~p: ASP_UP.ind -> ASP_ACTIVE.req~n", [?MODULE]), - set_link_state(L#loop_dat.link, up), - gen_fsm:send_event(L#loop_dat.m3ua_pid, osmo_util:make_prim('M','ASP_ACTIVE',request)), - {noreply, L}; -handle_cast(#primitive{subsystem = 'M', gen_name = 'ASP_ACTIVE', spec_name = confirm}, L) -> - io:format("~p: ASP_ACTIVE.ind - M3UA now active and ready~n", [?MODULE]), - set_link_state(L#loop_dat.link, active), - %tx_sccp_udt(L#loop_dat.scrc_pid), - {noreply, L}; -handle_cast(#primitive{subsystem = 'M', gen_name = 'ASP_DOWN'}, L) -> - io:format("~p: ASP_DOWN.ind~n", [?MODULE]), - set_link_state(L#loop_dat.link, down), - {noreply, L}; -handle_cast(#primitive{subsystem = 'M', gen_name = 'ASP_INACTIVE'}, L) -> - io:format("~p: ASP_DOWN.ind~n", [?MODULE]), - set_link_state(L#loop_dat.link, inactive), - {noreply, L}; -handle_cast(P, L) -> - io:format("~p: Ignoring M3UA prim ~p~n", [?MODULE, P]), - {noreply, L}. - -terminate(Reason, _S) -> - io:format("terminating ~p with reason ~p", [?MODULE, Reason]), - ok. - -tx_sccp_udt(ScrcPid) -> - CallingP = #sccp_addr{ssn = ?SCCP_SSN_MSC, point_code = osmo_util:pointcode2int(itu, {1,2,2})}, - CalledP = #sccp_addr{ssn = ?SCCP_SSN_HLR, point_code = osmo_util:pointcode2int(itu, {1,1,1})}, - Data = <<1,2,3,4>>, - Opts = [{protocol_class, 0}, {called_party_addr, CalledP}, - {calling_party_addr, CallingP}, {user_data, Data}], - io:format("~p: Sending N-UNITDATA.req to SCRC~n", [?MODULE]), - gen_fsm:send_event(ScrcPid, osmo_util:make_prim('N','UNITDATA',request,Opts)). - diff --git a/src/ss7_links.erl b/src/ss7_links.erl deleted file mode 100644 index 8f6cd53..0000000 --- a/src/ss7_links.erl +++ /dev/null @@ -1,306 +0,0 @@ -% Internal SCCP link database keeping - -% (C) 2011 by Harald Welte -% -% All Rights Reserved -% -% This program is free software; you can redistribute it and/or modify -% it under the terms of the GNU Affero General Public License as -% published by the Free Software Foundation; either version 3 of the -% License, or (at your option) any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU Affero General Public License -% along with this program. If not, see . - --module(ss7_links). --behaviour(gen_server). - --include_lib("osmo_ss7/include/mtp3.hrl"). - -% gen_fsm callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). - -% our published API --export([start_link/0]). - -% client functions, may internally talk to our sccp_user server --export([register_linkset/3, unregister_linkset/1]). --export([register_link/3, unregister_link/2, set_link_state/3]). --export([bind_service/2, unbind_service/1]). - --export([get_pid_for_link/2, get_pid_for_dpc_sls/2, mtp3_tx/1, - get_linkset_for_dpc/1, dump_all_links/0]). - --record(slink, { - key, % {linkset_name, sls} - name, - linkset_name, - sls, - user_pid, - state -}). - --record(slinkset, { - name, - local_pc, - remote_pc, - user_pid, - state, - links -}). - --record(service, { - name, - service_nr, - user_pid -}). - --record(su_state, { - linkset_tbl, - link_tbl, - service_tbl -}). - - -% initialization code - -start_link() -> - gen_server:start_link({local, ?MODULE}, ?MODULE, [], [{debug, [trace]}]). - -init(_Arg) -> - LinksetTbl = ets:new(ss7_linksets, [ordered_set, named_table, - {keypos, #slinkset.name}]), - ServiceTbl = ets:new(mtp3_services, [ordered_set, named_table, - {keypos, #service.service_nr}]), - - % create a named table so we can query without reference directly - % within client/caller process - LinkTbl = ets:new(ss7_link_table, [ordered_set, named_table, - {keypos, #slink.key}]), - {ok, #su_state{linkset_tbl = LinksetTbl, link_tbl = LinkTbl, - service_tbl = ServiceTbl}}. - -% client side API - -% all write operations go through gen_server:call(), as only the ?MODULE -% process has permission to modify the table content - -register_linkset(LocalPc, RemotePc, Name) -> - gen_server:call(?MODULE, {register_linkset, {LocalPc, RemotePc, Name}}). - -unregister_linkset(Name) -> - gen_server:call(?MODULE, {unregister_linkset, {Name}}). - -register_link(LinksetName, Sls, Name) -> - gen_server:call(?MODULE, {register_link, {LinksetName, Sls, Name}}). - -unregister_link(LinksetName, Sls) -> - gen_server:call(?MODULE, {unregister_link, {LinksetName, Sls}}). - -set_link_state(LinksetName, Sls, State) -> - gen_server:call(?MODULE, {set_link_state, {LinksetName, Sls, State}}). - -% bind a service (such as ISUP, SCCP) to the MTP3 link manager -bind_service(ServiceNum, ServiceName) -> - gen_server:call(?MODULE, {bind_service, {ServiceNum, ServiceName}}). - -% unbind a service (such as ISUP, SCCP) from the MTP3 link manager -unbind_service(ServiceNum) -> - gen_server:call(?MODULE, {unbind_service, {ServiceNum}}). - -% the lookup functions can directly use the ets named_table from within -% the client process, no need to go through a synchronous IPC - -get_pid_for_link(LinksetName, Sls) -> - case ets:lookup(ss7_link_table, {LinksetName, Sls}) of - [#slink{user_pid = Pid}] -> - % FIXME: check the link state - {ok, Pid}; - _ -> - {error, no_such_link} - end. - -% Resolve linkset name directly connected to given point code -get_linkset_for_dpc(Dpc) -> - Ret = ets:match_object(ss7_linksets, - #slinkset{remote_pc = Dpc, _ = '_'}), - case Ret of - [] -> - {error, undefined}; - [#slinkset{name=Name}|_Tail] -> - {ok, Name} - end. - -% resolve link-handler Pid for given (directly connected) point code/sls -get_pid_for_dpc_sls(Dpc, Sls) -> - case get_linkset_for_dpc(Dpc) of - {error, Err} -> - {error, Err}; - {ok, LinksetName} -> - get_pid_for_link(LinksetName, Sls) - end. - -% process a received message on an underlying link -mtp3_rx(Mtp3 = #mtp3_msg{service_ind = Serv}) -> - case ets:lookup(mtp3_services, Serv) of - [#service{user_pid = Pid}] -> - gen_server:cast(Pid, - osmo_util:make_prim('MTP', 'TRANSFER', - indication, Mtp3)); - _ -> - % FIXME: send back some error message on MTP level - ok - end. - - -% transmit a MTP3 message via any of the avaliable links for the DPC -mtp3_tx(Mtp3 = #mtp3_msg{routing_label = RoutLbl}) -> - #mtp3_routing_label{dest_pc = Dpc, sig_link_sel = Sls} = RoutLbl, - % discover the link through which we shall send - case get_pid_for_dpc_sls(Dpc, Sls) of - {error, Error} -> - {error, Error}; - {ok, Pid} -> - gen_server:cast(Pid, - osmo_util:make_prim('MTP', 'TRANSFER', - request, Mtp3)) - end. - -dump_all_links() -> - List = ets:tab2list(ss7_linksets), - dump_linksets(List). - -dump_linksets([]) -> - ok; -dump_linksets([Head|Tail]) when is_record(Head, slinkset) -> - dump_single_linkset(Head), - dump_linksets(Tail). - -dump_single_linkset(Sls) when is_record(Sls, slinkset) -> - #slinkset{name = Name, local_pc = Lpc, remote_pc = Rpc, - state = State} = Sls, - io:format("Linkset ~p, Local PC: ~p, Remote PC: ~p, State: ~p~n", - [Name, Lpc, Rpc, State]), - dump_linkset_links(Name). - -dump_linkset_links(Name) -> - List = ets:match_object(ss7_link_table, - #slink{key={Name,'_'}, _='_'}), - dump_links(List). - -dump_links([]) -> - ok; -dump_links([Head|Tail]) when is_record(Head, slink) -> - #slink{name = Name, sls = Sls, state = State} = Head, - io:format(" Link ~p, SLS: ~p, State: ~p~n", - [Name, Sls, State]), - dump_links(Tail). - - -% server side code - -handle_call({register_linkset, {LocalPc, RemotePc, Name}}, - {FromPid, _FromRef}, S) -> - #su_state{linkset_tbl = Tbl} = S, - Ls = #slinkset{local_pc = LocalPc, remote_pc = RemotePc, - name = Name, user_pid = FromPid}, - case ets:insert_new(Tbl, Ls) of - false -> - {reply, {error, ets_insert}, S}; - _ -> - % We need to trap the user Pid for EXIT - % in order to automatically remove any links/linksets if - % the user process dies - link(FromPid), - {reply, ok, S} - end; - -handle_call({unregister_linkset, {Name}}, {FromPid, _FromRef}, S) -> - #su_state{linkset_tbl = Tbl} = S, - ets:delete(Tbl, Name), - {reply, ok, S}; - -handle_call({register_link, {LsName, Sls, Name}}, - {FromPid, _FromRef}, S) -> - #su_state{linkset_tbl = LinksetTbl, link_tbl = LinkTbl} = S, - % check if linkset actually exists - case ets:lookup(LinksetTbl, LsName) of - [#slinkset{}] -> - Link = #slink{name = Name, sls = Sls, state = down, - user_pid = FromPid, key = {LsName, Sls}}, - case ets:insert_new(LinkTbl, Link) of - false -> - {reply, {error, link_exists}, S}; - _ -> - % We need to trap the user Pid for EXIT - % in order to automatically remove any links if - % the user process dies - link(FromPid), - {reply, ok, S} - end; - _ -> - {reply, {error, no_such_linkset}, S} - end; - -handle_call({unregister_link, {LsName, Sls}}, {FromPid, _FromRef}, S) -> - #su_state{link_tbl = LinkTbl} = S, - ets:delete(LinkTbl, {LsName, Sls}), - {reply, ok, S}; - -handle_call({set_link_state, {LsName, Sls, State}}, {FromPid, _}, S) -> - #su_state{link_tbl = LinkTbl} = S, - case ets:lookup(LinkTbl, {LsName, Sls}) of - [] -> - {reply, {error, no_such_link}, S}; - [Link] -> - NewLink = Link#slink{state = State}, - ets:insert(LinkTbl, NewLink), - {reply, ok, S} - end; - -handle_call({bind_service, {SNum, SName}}, {FromPid, _}, - #su_state{service_tbl = ServTbl} = S) -> - NewServ = #service{name = SName, service_nr = SNum, - user_pid = FromPid}, - case ets:insert_new(ServTbl, NewServ) of - false -> - {reply, {error, ets_insert}, S}; - _ -> - {reply, ok, S} - end; -handle_call({unbind_service, {SNum}}, {FromPid, _}, - #su_state{service_tbl = ServTbl} = S) -> - ets:delete(ServTbl, SNum), - {reply, ok, S}. - -handle_cast(Info, S) -> - error_logger:error_report(["unknown handle_cast", - {module, ?MODULE}, - {info, Info}, {state, S}]), - {noreply, S}. - -handle_info({'EXIT', Pid, Reason}, S) -> - io:format("EXIT from Process ~p (~p), cleaning up tables~n", - [Pid, Reason]), - #su_state{linkset_tbl = LinksetTbl, link_tbl = LinkTbl} = S, - ets:match_delete(LinksetTbl, #slinkset{user_pid = Pid}), - ets:match_delete(LinkTbl, #slink{user_pid = Pid}), - {noreply, S}; -handle_info(Info, S) -> - error_logger:error_report(["unknown handle_info", - {module, ?MODULE}, - {info, Info}, {state, S}]), - {noreply, S}. - -terminate(Reason, _S) -> - io:format("terminating ~p with reason ~p", [?MODULE, Reason]), - ok. - -code_change(_OldVsn, State, _Extra) -> - {ok, State}.