From cc40877d653300e12b6c146932b9395c783f52b7 Mon Sep 17 00:00:00 2001 From: Harald Welte Date: Fri, 29 Apr 2011 08:55:56 +0200 Subject: [PATCH] sccp_links and sccp_user as registries for MTP links and local subsystems --- src/sccp_links.erl | 180 +++++++++++++++++++++++++++++++++++++++++++++ src/sccp_user.erl | 120 ++++++++++++++++++++++++++++++ 2 files changed, 300 insertions(+) create mode 100644 src/sccp_links.erl create mode 100644 src/sccp_user.erl diff --git a/src/sccp_links.erl b/src/sccp_links.erl new file mode 100644 index 0000000..09a4321 --- /dev/null +++ b/src/sccp_links.erl @@ -0,0 +1,180 @@ +% 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(sccp_links). +-behaviour(gen_server). + +% 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([get_pid_for_link/3]). + +-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(su_state, { + linkset_tbl, + link_tbl +}). + + +% initialization code + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, []). + +init(_Arg) -> + LinksetTbl = ets:new(sccp_linksets, [ordered_set, + {keypos, #slinkset.name}]), + + % create a named table so we can query without reference directly + % within client/caller process + LinkTbl = ets:new(sccp_link_table, [ordered_set, named_table, + {keypos, #slink.key}]), + #su_state{linkset_tbl = LinksetTbl, link_tbl = LinkTbl}. + +% 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}}). + +% 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(LinkTable, LinksetName, Sls) -> + case ets:lookup(sccp_link_table, {LinksetName, Sls}) of + [#slink{user_pid = Pid}] -> + % FIXME: check the link state + {ok, Pid}; + _ -> + {error, no_such_link} + end. + +% server side code + +handle_call({register_linkset, {LocalPc, RemotePc, Name}}, From, S) -> + #su_state{linkset_tbl = Tbl} = S, + Ls = #slinkset{local_pc = LocalPc, remote_pc = RemotePc, + name = Name, user_pid = From}, + case ets:insert_new(Tbl, Ls) of + false -> + {reply, {error, ets_insert}, S}; + _ -> + % FIXME: We need to trap the user Pid for EXIT + % in order to automatically remove any links/linksets if + % the user process dies + {reply, ok, S} + end; + +handle_call({unregister_linkset, {Name}}, From, S) -> + #su_state{linkset_tbl = Tbl} = S, + ets:delete(Tbl, Name), + {reply, ok, S}; + +handle_call({register_link, {LsName, Sls, Name}}, From, S) -> + #su_state{linkset_tbl = LinksetTbl, link_tbl = LinkTbl} = S, + % check if linkset actually exists + case ets:loookup(LinksetTbl, LsName) of + [#slinkset{}] -> + Link = #slink{name = Name, sls = Sls, + user_pid = From, key = {LsName, Sls}}, + case ets:insert_new(LinkTbl, Link) of + false -> + {reply, {error, link_exists}, S}; + _ -> + % FIXME: We need to trap the user Pid for EXIT + % in order to automatically remove any links if + % the user process dies + {reply, ok, S} + end; + _ -> + {reply, {error, no_such_linkset}, S} + end; + +handle_call({unregister_link, {LsName, Sls}}, From, S) -> + #su_state{link_tbl = LinkTbl} = S, + ets:delete(LinkTbl, {LsName, Sls}), + {reply, ok, S}; + +handle_call({set_link_state, {LsName, Sls, State}}, From, S) -> + #su_state{linkset_tbl = LinksetTbl, 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_cast(Info, S) -> + error_logger:error_report(["unknown handle_cast", + {module, ?MODULE}, + {info, Info}, {state, S}]), + {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}. diff --git a/src/sccp_user.erl b/src/sccp_user.erl new file mode 100644 index 0000000..9404973 --- /dev/null +++ b/src/sccp_user.erl @@ -0,0 +1,120 @@ +% SCCP user interface procedures + +% (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_user). +-behaviour(gen_server). + +%-include_lib("osmo_ss7/osmo_util.hrl"). +%-include_lib("osmo_ss7/sccp.hrl"). +%-include_lib("osmo_ss7/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([bind_ssn/2, unbind_ssn/2, pid_for_ssn/2, local_ssn_avail/2]). + +-record(scu_state, { + user_table +}). + +-record(scu_record, { + ssn_pc, + user_pid +}). + +% initialization code + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, []). + +init(_Arg) -> + UserTbl = ets:new(sccp_user_tbl, [ordered_set, named_table, + {keypos, #scu_record.ssn_pc}]), + #scu_state{user_table = UserTbl}. + +% client side code + +bind_ssn(Ssn, Pc) -> + gen_server:call(?MODULE, {bind_ssn, Ssn, Pc}). + +unbind_ssn(Ssn, Pc) -> + gen_server:call(?MODULE, {unbind_ssn, Ssn, Pc}). + +% determine the pid registered for a given {Ssn, PC} +pid_for_ssn(Ssn, Pc) -> + % as this is only a read access, we read the ets table directly + % rather than going through call/2 + case ets:lookup(sccp_user_tbl, {Ssn, Pc}) of + [#scu_record{user_pid = UserPid}] -> + {ok, UserPid}; + _ -> + {error, no_such_ssn} + end. + +local_ssn_avail(Ssn, Pc) -> + case pid_for_ssn(Ssn, Pc) of + {ok, UserPid} -> + true; + _ -> + false + end. + +% server side code + +% bind a {SSN, PC} tuple to the pid of the caller +handle_call({bind_ssn, Ssn, Pc}, From, S) -> + #scu_state{user_table = Tbl} = S, + NewRec = #scu_record{ssn_pc= {Ssn, Pc}, user_pid = From}, + case ets:insert_new(Tbl, NewRec) of + false -> + {reply, {error, ets_insert}, S}; + Error -> + {reply, ok, S} + end; + +% unbind a {SSN, PC} tuple from the pid of the caller +handle_call({unbind_ssn, Ssn, Pc}, From, S) -> + #scu_state{user_table = Tbl} = S, + DelRec = #scu_record{ssn_pc= {Ssn, Pc}, user_pid = From}, + ets:delete_object(Tbl, DelRec), + {reply, ok, S}. + +handle_cast(Info, S) -> + error_logger:error_report(["unknown handle_cast", + {module, ?MODULE}, + {info, Info}, {state, S}]), + {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}.