diff --git a/ebin/osmo_sccp.app b/ebin/osmo_sccp.app index 8f9698d..000ce84 100644 --- a/ebin/osmo_sccp.app +++ b/ebin/osmo_sccp.app @@ -2,9 +2,16 @@ [{description, "Osmocom SCCP Server"}, {vsn, "1"}, {modules, [ osmo_sccp, - osmo_sccp_sup + osmo_sccp_app, + osmo_sccp_sup, + sccp_links, + sccp_link_ipa_client, + sccp_link_m3ua, + sccp_routing, + sccp_user ]}, - {registered, []}, + {registered, [osmo_sccp_app]}, + {mod, {osmo_sccp_app, []}}, {applications, []}, {env, [ ]} diff --git a/src/osmo_sccp_sup.erl b/src/osmo_sccp_sup.erl index b327478..7f8590e 100644 --- a/src/osmo_sccp_sup.erl +++ b/src/osmo_sccp_sup.erl @@ -20,26 +20,30 @@ -module(osmo_sccp_sup). -behavior(supervisor). --export([start_link/0]). +-export([start_link/0, add_mtp_link/1]). -export([init/1]). -include("osmo_sccp.hrl"). start_link() -> - supervisor:start_link({local, ?MODULE}, ?MODULE, []). + supervisor:start_link({local, ?MODULE}, ?MODULE, [{debug, [trace]}]). init(Args) -> ScrcChild = {sccp_scrc, {sccp_scrc, start_link, [Args]}, - permanent, 2000, worker, [sccp_scrc, sccp_codec]}, - ScrcChild = {sccp_sclc, {sccp_sclc, start_link, [Args]}, - permanent, 2000, worker, [sccp_sclc, sccp_codec]}, - {ok,{{one_for_one,60,600}, [ScrcChild|SclcChild]}}. + permanent, 2000, worker, [sccp_scrc, sccp_codec, sccp_routing]}, + UserChild = {sccp_user, {sccp_user, start_link, []}, + permanent, 2000, worker, [sccp_user]}, + LinksChild = {sccp_links, {sccp_links, start_link, []}, + permanent, 2000, worker, [sccp_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(#sigtran_link{type = m3ua, name = Name, +add_mtp_link(L=#sigtran_link{type = m3ua, name = Name, local = Local, remote = Remote}) -> ChildName = list_to_atom("sccp_link_m3ua_" ++ Name), - ChildSpec = {ChildName, {sccp_link_m3ua, start_link, [Args]}, + ChildSpec = {ChildName, {sccp_link_m3ua, start_link, [L]}, permanent, infinity, worker, [sccp_link_m3ua]}, supervisor:start_child(?MODULE, ChildSpec); add_mtp_link([]) -> diff --git a/src/sccp_link_ipa_client.erl b/src/sccp_link_ipa_client.erl new file mode 100644 index 0000000..a4c197e --- /dev/null +++ b/src/sccp_link_ipa_client.erl @@ -0,0 +1,109 @@ +% 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(sccp_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 = sccp_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 = sccp_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/sccp_link_m3ua.erl b/src/sccp_link_m3ua.erl index 9b26379..698488f 100644 --- a/src/sccp_link_m3ua.erl +++ b/src/sccp_link_m3ua.erl @@ -37,7 +37,7 @@ }). start_link(Args) -> - gen_server:start_link(?MODULE, 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}) -> @@ -100,6 +100,9 @@ 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})}, diff --git a/src/sccp_links.erl b/src/sccp_links.erl index e9b1662..48ac00c 100644 --- a/src/sccp_links.erl +++ b/src/sccp_links.erl @@ -20,6 +20,8 @@ -module(sccp_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]). @@ -30,7 +32,8 @@ % 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([get_pid_for_link/2]). +-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} @@ -59,10 +62,10 @@ % initialization code start_link() -> - gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + gen_server:start_link({local, ?MODULE}, ?MODULE, [], [{debug, [trace]}]). init(_Arg) -> - LinksetTbl = ets:new(sccp_linksets, [ordered_set, + LinksetTbl = ets:new(sccp_linksets, [ordered_set, named_table, {keypos, #slinkset.name}]), % create a named table so we can query without reference directly @@ -103,6 +106,69 @@ get_pid_for_link(LinksetName, Sls) -> {error, no_such_link} end. +% Resolve linkset name directly connected to given point code +get_linkset_for_dpc(Dpc) -> + Ret = ets:match_object(sccp_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. + +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(sccp_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(sccp_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}}, @@ -132,7 +198,7 @@ handle_call({register_link, {LsName, Sls, Name}}, % check if linkset actually exists case ets:lookup(LinksetTbl, LsName) of [#slinkset{}] -> - Link = #slink{name = Name, sls = Sls, + Link = #slink{name = Name, sls = Sls, state = down, user_pid = FromPid, key = {LsName, Sls}}, case ets:insert_new(LinkTbl, Link) of false -> diff --git a/src/sccp_routing.erl b/src/sccp_routing.erl index 46c10a4..d171993 100644 --- a/src/sccp_routing.erl +++ b/src/sccp_routing.erl @@ -28,18 +28,25 @@ pointcode_is_local(Pc) -> % FIXME: use SCRC routing information - true. + LocalPc = osmo_util:pointcode2int(itu, {1,2,4}), + case Pc of + LocalPc -> + true; + _ -> + false + end. % local helper function msg_return_or_cr_refusal(SccpMsg, RetCause, RefCause) -> case sccp_codec:is_connectionless(SccpMsg) of - false -> + true -> % if CL -> message return procedure message_return(SccpMsg, RetCause); - true -> + false -> % if CR -> connection refusal connection_refusal(SccpMsg, RefCause) - end. + end, + {error, routing}. % local outgoing CL or CR message route_local_out(SccpMsg) when is_record(SccpMsg, sccp_msg) -> @@ -140,8 +147,19 @@ route_local_out_action(2, SccpMsg, CalledParty) -> % Acccording to 2.3.2 Action (3) route_local_out_action(3, SccpMsg, CalledParty) -> % The same actions as Action (1) apply, without checking the SSN. - % FIXME - ok; + #sccp_addr{global_title = Gt, point_code = Pc} = CalledParty, + case pointcode_is_local(Pc) of + true -> + % pass to either SCOC or SCLC + {local, SccpMsg}; + false -> + % If the DPC is not the node itself and the remote DPC, SCCP + % and SSN are available, then the MTP-TRANSFER request + % primitive is invoked unless the compatibility test returns + % the message to SCLC or unless the message is discarded by the + % traffic limitation mechanism; + {remote, SccpMsg} + end; % Acccording to 2.3.2 Action (4) route_local_out_action(4, SccpMsg, CalledParty) ->