move ss7_link into libosm-ss7

This commit is contained in:
Harald Welte 2011-10-10 20:44:10 +02:00
parent ebaeb8d7f2
commit 09145645eb
7 changed files with 32 additions and 578 deletions

View File

@ -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, [
]}
]}.

View File

@ -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]}}.

View File

@ -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.

View File

@ -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

View File

@ -1,109 +0,0 @@
% Osmocom adaptor to interface the IPA core with osmo_sccp
% (C) 2011 by Harald Welte <laforge@gnumonks.org>
%
% 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 <http://www.gnu.org/licenses/>.
-module(ss7_link_ipa_client).
-author('Harald Welte <laforge@gnumonks.org>').
-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)).

View File

@ -1,115 +0,0 @@
% Osmocom adaptor to interface the M3UA core with osmo_sccp
% (C) 2011 by Harald Welte <laforge@gnumonks.org>
%
% 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 <http://www.gnu.org/licenses/>.
-module(ss7_link_m3ua).
-author('Harald Welte <laforge@gnumonks.org>').
-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)).

View File

@ -1,306 +0,0 @@
% Internal SCCP link database keeping
% (C) 2011 by Harald Welte <laforge@gnumonks.org>
%
% 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 <http://www.gnu.org/licenses/>.
-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}.