import sccp_scrc and sccp_scoc from old osmo_ss7 repository

osmo_ss7 is responsible for the mtp2/mtp3/m2ua/m3ua/ipa type links,
while we collect all actual SCCP related functionality here.
This commit is contained in:
Harald Welte 2011-10-10 12:38:45 +02:00
parent 0335308da7
commit 9b6a39bdd7
5 changed files with 758 additions and 0 deletions

56
README Normal file
View File

@ -0,0 +1,56 @@
= Osmocom Erlang SCCP implementation =
This is a currently still incomplete Erlang SCCP implementation which
is part of the overall Osmocom project (http://osmocom.org/)
The aim is to fully implement SCCP for connectionless and connection-
oriented services, including global title translation. It should be
possible to use this as both STP or SCP, or even as an ITP/SGW.
== Configuration ==
The SCCP stack is configured via the regular OTP application configuration
file.
=== Signalling linksets and links ===
The MTP functionality can be provided by either M3UA or a classic MTP3 (over
M2UA or real MTP2).
A linkset is a group of links, all connected to the same destination (point
code).
Each signalling linkset has to be configured in the config file, providing
the following parameters:
* linkset name
* local point code
* remote point code
Each signalling link has to be configured in the config file, providing the
following parameters:
* linkset name
* SLS
* IP address and port information (for M3UA)
The sccp_links module keeps track of signalling linksets and links by means of
ets tables. It maintains a record of the Erlang process pid responsible for
each respective link.
== Architecture ==
osmo_sccp_app starts osmo_sccp_sup, which in turn starts the individual signalling
links through the respective signalling link provider modules.
It also starts sccp_scrc (the SCCP routing)
One sccp_scoc instance will be started for each SCCP connection.
== Implementing a SCCP-user ==
== Implementing a MTP provider for SCCP ==
This section outlines how to write a MTP transport for the SCCP stack.
FIXME

View File

@ -8,6 +8,8 @@
sccp_link_ipa_client, sccp_link_ipa_client,
sccp_link_m3ua, sccp_link_m3ua,
sccp_routing, sccp_routing,
sccp_scrc,
sccp_scoc,
sccp_user sccp_user
]}, ]},
{registered, [osmo_sccp_app]}, {registered, [osmo_sccp_app]},

17
include/osmo_sccp.hrl Normal file
View File

@ -0,0 +1,17 @@
-record(sigtran_peer, {
ip,
port,
point_code
}).
-record(sigtran_link, {
type,
name,
linkset_name,
sls,
local,
remote
}).

474
src/sccp_scoc.erl Normal file
View File

@ -0,0 +1,474 @@
% ITU-T Q.71x SCCP Connection-oriented Control (SCOC)
% (C) 2010 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(sccp_scoc).
-behaviour(gen_fsm).
-include_lib("osmo_ss7/include/osmo_util.hrl").
-include_lib("osmo_ss7/include/sccp.hrl").
-export([start_link/1]).
-export([init/1, handle_event/3]).
-export([idle/2, conn_pend_in/2, conn_pend_out/2, active/2, disconnect_pending/2,
reset_incoming/2, reset_outgoing/2, bothway_reset/2, wait_conn_conf/2]).
%% gen_fsm callbacks
% Appendix C.4 of Q.714 (all in milliseconds)
-define(CONNECTION_TIMER, 1 *60*100).
-define(TX_INACT_TIMER, 5 *60*100).
-define(RX_INACT_TIMER, 11 *60*100).
-define(RELEASE_TIMER, 10 *100).
-define(RELEASE_REP_TIMER, 10 *100).
-define(INT_TIMER, 1 *60*100).
-define(GUARD_TIMER, 23 *60*100).
-define(RESET_TIMER, 10 *100).
-define(REASSEMBLY_TIMER, 10 *60*100).
-record(state, {
role, % client | server
user_application, % {MonitorRef, pid()}
scrc_pid, % pid()
rx_inact_timer, % TRef
tx_inact_timer, % TRef
local_reference,
remote_reference,
class,
user_pid % pid()
}).
% TODO:
% expedited data
% class 3
% segmentation / reassembly
start_link(InitOpts) ->
gen_fsm:start_link(sccp_scoc, InitOpts, [{debug, [trace]}]).
init(InitOpts) ->
LoopDat = #state{user_pid=proplists:get_value(user_pid, InitOpts),
scrc_pid=proplists:get_value(scrc_pid, InitOpts),
local_reference=proplists:get_value(local_reference, InitOpts)},
io:format("SCOC init Pid=~p LoopDat ~p~n", [self(), LoopDat]),
{ok, idle, LoopDat}.
handle_event(stop, _StateName, LoopDat) ->
io:format("SCOC received stop event~n"),
{stop, normal, LoopDat};
handle_event({timer_expired, tx_inact_timer}, State, LoopDat) ->
% FIXME: T(ias) is expired, send IT message
io:format("T(ias) is expired, send IT message~n", []),
#state{local_reference = LocRef, remote_reference = RemRef,
class = Class} = LoopDat,
Params = [{dst_local_ref, RemRef},{src_local_ref, LocRef},
{protocol_class, Class}, {seq_segm, 0}, {credit, 0}],
Msg = #sccp_msg{msg_type = ?SCCP_MSGT_IT, parameters = Params},
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC','CONNECTION-MSG', request, Msg)),
{next_state, State, LoopDat};
handle_event({timer_expired, rx_inact_timer}, State, LoopDat) ->
io:format("FIXME: T(iar) is expired, release connection~n", []),
% FIXME: Initiate connection release procedure
{next_state, State, LoopDat}.
% helper function to send a primitive to the user
send_user(_LoopDat = #state{user_pid = Pid}, Prim = #primitive{}) ->
Pid ! {sccp, Prim}.
% low-level functions regarding activity timers
restart_tx_inact_timer(LoopDat) ->
Tias = timer:apply_after(?TX_INACT_TIMER, gen_fsm, send_all_state_event,
[self(), {timer_expired, tx_inact_timer}]),
LoopDat#state{tx_inact_timer = Tias}.
restart_rx_inact_timer(LoopDat) ->
Tiar = timer:apply_after(?RX_INACT_TIMER, gen_fsm, send_all_state_event,
[self(), {timer_expired, rx_inact_timer}]),
LoopDat#state{rx_inact_timer = Tiar}.
start_inact_timers(LoopDat) ->
Tias = timer:apply_after(?TX_INACT_TIMER, gen_fsm, send_all_state_event,
[self(), {timer_expired, tx_inact_timer}]),
Tiar = timer:apply_after(?RX_INACT_TIMER, gen_fsm, send_all_state_event,
[self(), {timer_expired, rx_inact_timer}]),
LoopDat#state{rx_inact_timer = Tiar, tx_inact_timer = Tias}.
stop_inact_timers(#state{rx_inact_timer = Tiar, tx_inact_timer = Tias}) ->
timer:cancel(Tiar),
timer:cancel(Tias).
% -spec idle(#primitive{} | ) -> gen_fsm_state_return().
% STATE Idle
% N-CONNECT.req from user
idle(#primitive{subsystem = 'N', gen_name = 'CONNECT',
spec_name = request, parameters = Param}, LoopDat) ->
% local reference already assigned in SCRC when instantiating this SCOC
% FIXME: determine protocol class and credit
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC','CONNECTION', indication, Param)),
% start connection timer
{next_state, conn_pend_out, LoopDat, ?CONNECTION_TIMER};
% RCOC-CONNECTION.req from SCRC
idle(#primitive{subsystem = 'RCOC', gen_name = 'CONNECTION',
spec_name = indication, parameters = Params}, LoopDat) ->
% associate remote reference to connection section
RemRef = proplists:get_value(src_local_ref, Params),
% determine protocol class and FIXME: credit
Class = proplists:get_value(protocol_class, Params),
LoopDat1 = LoopDat#state{remote_reference = RemRef, class = Class},
% send N-CONNECT.ind to user
send_user(LoopDat1, osmo_util:make_prim('N', 'CONNECT', indication, [{scoc_pid, self()}|Params])),
%#primitive{subsystem = 'N', gen_name = 'CONNECT', spec_name = indication}
{next_state, conn_pend_in, LoopDat1};
% RCOC-ROUTING_FAILURE.ind from SCRC
idle(#primitive{subsystem = 'RCOC', gen_name = 'ROUTING FAILURE',
spec_name = indication}, LoopDat) ->
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'CONNECTION REFUSED', indication)),
{next_state, idle, LoopDat};
%FIXME: request type 2 ?!?
% RCOC-RELEASED.ind from SCRC
idle(#primitive{subsystem = 'RCOC', gen_name = 'RELEASED',
spec_name = indication}, LoopDat) ->
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASE COMPLETE', indication)),
{next_state, idle, LoopDat};
% RCOC-RELEASE_COMPLETE.ind from SCRC
idle(#primitive{subsystem = 'RCOC', gen_name = 'RELEASE COMPLETE',
spec_name = indication}, LoopDat) ->
{next_state, idle, LoopDat};
idle(#primitive{subsystem= 'RCOC', gen_name = 'DATA',
spec_name = indication, parameters = Param}, LoopDat) ->
% FIXME: if source reference, send error
send_user(LoopDat, osmo_util:make_prim('N', 'DATA', indication, Param)),
{next_state, idle, LoopDat}.
% STATE Connection pending incoming
conn_pend_in(#primitive{subsystem = 'N', gen_name = 'CONNECT',
spec_name = response, parameters = Param}, LoopDat) ->
io:format("SCOC N-CONNECT.resp LoopDat ~p~n", [LoopDat]),
% assign local reference, SLS, protocol class and credit for inc section
OutParam = [{dst_local_ref, LoopDat#state.remote_reference},
{src_local_ref, LoopDat#state.local_reference},
{protocol_class, LoopDat#state.class}] ++ Param,
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'CONNECTION', confirm, OutParam)),
% start inactivity timers
LoopDat1 = start_inact_timers(LoopDat),
{next_state, active, LoopDat1};
conn_pend_in(any_npdu_type, LoopDat) ->
{next_state, conn_pend_in, LoopDat};
conn_pend_in(#primitive{subsystem = 'N', gen_name = 'DISCONNECT',
spec_name = request, parameters = Param}, LoopDat) ->
% release resourcers (local ref may have to be released an frozen)
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'CONNECTION REFUSED', indication, Param)),
{next_state, idle, LoopDat}.
disc_ind_stop_rel_3(LoopDat) ->
% send N-DISCONNECT.ind to user
send_user(LoopDat, osmo_util:make_prim('N', 'DISCONNECT',indication)),
% stop inactivity timers
stop_inact_timers(LoopDat),
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASED', indication)),
% start release timer
{next_state, disconnect_pending, LoopDat, ?RELEASE_TIMER}.
rel_res_disc_ind_idle_2(LoopDat) ->
% release resources and local reference (freeze)
% send N-DISCONNECT.ind to user
send_user(LoopDat, osmo_util:make_prim('N', 'DISCONNECT', indication)),
{next_state, idle, LoopDat}.
% STATE Connection pending outgoing
conn_pend_out(#primitive{subsystem = 'N', gen_name = 'DISCONNECT',
spec_name = request}, LoopDat) ->
% FIXME: what about the connection timer ?
{next_state, wait_conn_conf, LoopDat};
conn_pend_out(timeout, LoopDat) ->
rel_res_disc_ind_idle_2(LoopDat);
conn_pend_out(routing_failure, LoopDat) ->
rel_res_disc_ind_idle_2(LoopDat);
conn_pend_out(released, LoopDat) ->
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASE COMPLETE', indication)),
rel_res_disc_ind_idle_2(LoopDat);
% other N-PDU Type
conn_pend_out(other_npdu_type, LoopDat) ->
rel_res_disc_ind_idle_2(LoopDat);
conn_pend_out(connection_refused, LoopDat) ->
rel_res_disc_ind_idle_2(LoopDat);
conn_pend_out(connection_confirm, LoopDat) ->
% start inactivity timers
LoopDat1 = start_inact_timers(LoopDat),
% assign protocol class and associate remote reference to connection
% send N-CONNECT.conf to user
send_user(LoopDat1, #primitive{subsystem = 'N', gen_name = 'CONNECT',
spec_name = confirm}),
{next_state, active, LoopDat1}.
stop_c_tmr_rel_idle_5(LoopDat) ->
% stop connection timer (implicit)
% release resources and local reference
{next_state, idle, LoopDat}.
rel_freeze_idle(LoopDat) ->
{next_state, idle, LoopDat}.
% STATE Wait connection confirmed
wait_conn_conf(released, LoopDat) ->
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASE COMPLETE', indication)),
stop_c_tmr_rel_idle_5(LoopDat);
wait_conn_conf(connection_confirm, LoopDat) ->
% stop connection timer (implicit)
% associate remote reference to connection
relsd_tmr_disc_pend_6(LoopDat);
wait_conn_conf(other_npdu_type, LoopDat) ->
% stop connection timer (implicit)
rel_freeze_idle(LoopDat);
wait_conn_conf(timeout, LoopDat) ->
stop_c_tmr_rel_idle_5(LoopDat);
wait_conn_conf(connection_refused, LoopDat) ->
stop_c_tmr_rel_idle_5(LoopDat);
wait_conn_conf(routing_failure, LoopDat) ->
stop_c_tmr_rel_idle_5(LoopDat).
relsd_tmr_disc_pend_6(LoopDat) ->
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASED', indication)),
% start release timer
{next_state, disconnect_pending, LoopDat, ?RELEASE_TIMER}.
% STATE Active
active(#primitive{subsystem = 'N', gen_name = 'DISCONNECT',
spec_name = request}, LoopDat) ->
% stop inactivity timers
start_inact_timers(LoopDat),
relsd_tmr_disc_pend_6(LoopDat);
active(internal_disconnect, LoopDat) ->
disc_ind_stop_rel_3(LoopDat);
active(connection_refused, LoopDat) ->
{next_state, active, LoopDat};
active(connection_confirm, LoopDat) ->
{next_state, active, LoopDat};
active(release_complete, LoopDat) ->
{next_state, active, LoopDat};
active(released, LoopDat) ->
% send N-DISCONNECT.ind to user
send_user(LoopDat, #primitive{subsystem = 'N', gen_name = 'DISCONNECT',
spec_name = indication}),
% release resources and local reference (freeze)
% stop inactivity timers
stop_inact_timers(LoopDat),
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASE COMPLETE', indication)),
{next_state, idle, LoopDat};
active(error, LoopDat) ->
% send N-DISCONNECT.ind to user
send_user(LoopDat, #primitive{subsystem = 'N', gen_name = 'DISCONNECT',
spec_name = indication}),
% release resources and local reference (freeze)
% stop inactivity timers
stop_inact_timers(LoopDat),
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASE COMPLETE', indication)),
{next_state, idle, LoopDat};
active(rcv_inact_tmr_exp, LoopDat) ->
disc_ind_stop_rel_3(LoopDat);
active(routing_failure, LoopDat) ->
% send N-DISCONNECT.ind to user
send_user(LoopDat, #primitive{subsystem = 'N', gen_name = 'DISCONNECT',
spec_name = indication}),
% stop inactivity timers
stop_inact_timers(LoopDat),
% start release timer
{next_state, disconnect_pending, LoopDat, ?RELEASE_TIMER};
% Connection release procedures at destination node
%active(internal_disconnect) ->
% Data transfer procedures
active(#primitive{subsystem = 'N', gen_name = 'DATA',
spec_name = request, parameters = Param}, LoopDat) ->
% FIXME Segment NSDU and assign value to bit M
% FIXME handle protocol class 3
gen_fsm:send_event(LoopDat#state.scrc_pid, {dt1, []}),
% restart send inactivity timer
LoopDat1 = restart_tx_inact_timer(LoopDat),
{next_state, active, LoopDat1};
active(#primitive{subsystem = 'RCOC', gen_name = 'CONNECTION-MSG',
spec_name = indication, parameters = Msg}, LoopDat) ->
% restart receive inactivity timer
LoopDat1 = restart_rx_inact_timer(LoopDat),
% FIXME handle protocol class 3
% FIXME check for M-bit=1 and put data in Rx queue
% N-DATA.ind to user
UserData = proplists:get_value(user_data, Msg#sccp_msg.parameters),
send_user(LoopDat, osmo_util:make_prim('N', 'DATA', indication, {user_data, UserData})),
{next_state, active, LoopDat1};
% Reset procedures
active(#primitive{subsystem = 'N', gen_name = 'RESET',
spec_name = request, parameters = Param}, LoopDat) ->
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RESET', request, Param)),
% start reset timer
% restart send inact timer
LoopDat1 = restart_tx_inact_timer(LoopDat),
% reset variables and discard all queued and unacked msgs
{next_state, reset_outgoing, LoopDat1, ?RESET_TIMER};
active(internal_reset_req, LoopDat) ->
% N-RESET.ind to user
send_user(LoopDat, #primitive{subsystem = 'N', gen_name = 'RESET',
spec_name = indication}),
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RESET', request)),
% start reset timer
% restart send inact timer
LoopDat1 = restart_tx_inact_timer(LoopDat),
% reset variables and discard all queued and unacked msgs
{next_state, bothway_reset, LoopDat1, ?RESET_TIMER};
active(reset_confirm, LoopDat) ->
% discard received message
{next_state, active, LoopDat};
active(reset_req, LoopDat) ->
% restart send inactivity timer
LoopDat1 = restart_tx_inact_timer(LoopDat),
% N-RESET.ind to user
send_user(LoopDat, osmo_util:make_prim('N', 'RESET', indication)),
% reset variables and discard all queued and unacked msgs
{next_state, reset_incoming, LoopDat1}.
rel_res_stop_tmr_12(LoopDat) ->
% release resources and local reference (freeze)
% stop release and interval timers
{next_state, idle, LoopDat}.
% STATE Disconnect pending
disconnect_pending(release_complete, LoopDat) ->
rel_res_stop_tmr_12(LoopDat);
disconnect_pending(released_error, LoopDat) ->
rel_res_stop_tmr_12(LoopDat);
disconnect_pending(routing_failure, LoopDat) ->
{next_state, disconnect_pending, LoopDat};
disconnect_pending(other_npdu_type, LoopDat) ->
% discared received message
{next_state, disconnect_pending, LoopDat};
disconnect_pending(timeout, LoopDat) ->
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASED', indication)),
% start interval timer
% FIXME start repeat release timer
{next_state, disconnect_pending, ?RELEASE_REP_TIMER};
disconnect_pending(intv_tmr_exp, LoopDat) ->
% inform maintenance
rel_res_stop_tmr_12(LoopDat);
% FIXME: this is currently ending up in normal 'timeout' above
disconnect_pending(repeat_release_tmr_exp, LoopDat) ->
gen_fsm:send_event(LoopDat#state.scrc_pid,
osmo_util:make_prim('OCRC', 'RELEASED', indication)),
% FIXME restart repeat release timer
{next_state, disconnect_pending}.
res_out_res_conf_req(LoopDat) ->
% N-RESET.conf to user
send_user(LoopDat, osmo_util:make_prim('N', 'RESET', confirm)),
% stop reset timer (implicit)
% restart receive inactivity timer
LoopDat1 = restart_rx_inact_timer(LoopDat),
% resume data transfer
{next_state, active, LoopDat1}.
% STATE Reset outgoing
reset_outgoing(#primitive{subsystem = 'N', gen_name = 'DATA',
spec_name = request, parameters = Params}, LoopDat) ->
% FIXME received information ?!?
{next_state, reset_outgoing, LoopDat};
reset_outgoing(#primitive{subsystem = 'N', gen_name = 'EXPEDITED DATA',
spec_name = request, parameters = Params}, LoopDat) ->
% FIXME received information ?!?
{next_state, reset_outgoing, LoopDat};
reset_outgoing(timeout, LoopDat) ->
% FIXME check for temporary connection section
% inform maintenance
{next_state, maintenance_Blocking, LoopDat};
%reset_outgoing(error, LoopDat) ->
%reset_outgoing(released, LoopDat) ->
reset_outgoing(other_npdu_type, LoopDat) ->
% discard received message
{next_state, reset_outgoing, LoopDat};
reset_outgoing(reset_confirm, LoopDat) ->
res_out_res_conf_req(LoopDat);
reset_outgoing(reset_request, LoopDat) ->
res_out_res_conf_req(LoopDat).
bway_res_req_resp(LoopDat) ->
{next_state, reset_outgoing, LoopDat}.
bway_res_res_conf_req(LoopDat) ->
% N-RESET.conf to user
send_user(LoopDat, #primitive{subsystem = 'N', gen_name = 'RESET',
spec_name = confirm}),
% stop reset timer (implicit)
% restart receive inactivity timer
LoopDat1 = restart_rx_inact_timer(LoopDat),
{next_state, reset_incoming, LoopDat1}.
% STATE Bothway Reset
bothway_reset(#primitive{subsystem = 'N', gen_name = 'RESET',
spec_name = request, parameters = Params}, LoopDat) ->
bway_res_req_resp(LoopDat);
bothway_reset(#primitive{subsystem = 'N', gen_name = 'RESET',
spec_name = response, parameters = Params}, LoopDat) ->
bway_res_req_resp(LoopDat);
bothway_reset(timeout, LoopDat) ->
% FIXME check for temporary connection section
% inform maintenance
{next_state, maintenance_Blocking, LoopDat};
%bothway_reset(error, LoopDat) ->
%bothway_reset(released, LoopDat) ->
bothway_reset(other_npdu_type, LoopDat) ->
% discard received message
{next_state, bothway_reset, LoopDat}.
% STATE Reset incoming
reset_incoming(#primitive{subsystem = 'N', gen_name = 'RESET',
spec_name = request, parameters = Params}, LoopDat) ->
% received information
{nest_state, reset_incoming, LoopDat};
%reset_incoming(error, LoopDat) ->
%reset_incoming(released, LoopDat) ->
reset_incoming(other_npdu_type, LoopDat) ->
% discard received message
% internal reset request
{next_state, active, LoopDat}.
% FIXME: response or request
%reset_incoming(

209
src/sccp_scrc.erl Normal file
View File

@ -0,0 +1,209 @@
% SCCP routing control procedures (SCRC)
% (C) 2010-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(sccp_scrc).
-behaviour(gen_fsm).
-export([start_link/1, init/1, terminate/3, idle/2]).
-include_lib("osmo_ss7/include/osmo_util.hrl").
-include_lib("osmo_ss7/include/sccp.hrl").
-include_lib("osmo_ss7/include/mtp3.hrl").
-record(scrc_state, {
scoc_conn_ets,
next_local_ref,
user_pid % pid() of the user process
}).
% TODO: Integrate with proper SCCP routing / GTT implementation
tx_prim_to_local_ref(Prim, LocalRef) ->
% determine the Pid to which the primitive must be sent
ConnTable = get(scoc_by_ref),
case ets:lookup(ConnTable, LocalRef) of
[{LocalRef, ScocPid}] ->
gen_fsm:send_event(ScocPid, Prim);
_ ->
io:format("Primitive ~p for unknown local reference ~p~n",
[Prim, LocalRef])
end.
start_link(InitData) ->
% make sure to store the Pid of the caller in the scrc_state
gen_fsm:start_link({local, sccp_scrc}, sccp_scrc,
[{user_pid,self()}|InitData], [{debug, [trace]}]).
% gen_fsm init callback, called by start_link()
init(InitPropList) ->
io:format("SCRC Init PropList~p ~n", [InitPropList]),
UserPid = proplists:get_value(user_pid, InitPropList),
LoopData = #scrc_state{user_pid = UserPid, next_local_ref = 0},
TableRef = ets:new(scoc_by_ref, [set]),
put(scoc_by_ref, TableRef),
{ok, idle, LoopData}.
terminate(Reason, _State, _LoopDat) ->
io:format("SCRC: Terminating with reason ~p~n", [Reason]),
Tref = get(scoc_by_ref),
ets:delete(Tref),
ok.
% helper function to create new SCOC instance
spawn_new_scoc(LoopDat) ->
% create new SCOC instance
UserPid = LoopDat#scrc_state.user_pid,
% Compute the new local reference
LocalRef = LoopDat#scrc_state.next_local_ref + 1,
LoopDat1 = LoopDat#scrc_state{next_local_ref = LocalRef},
% generate proplist for SCRC initialization
ScocPropList = [{scrc_pid, self()}, {user_pid, UserPid}, {local_reference, LocalRef}],
{ok, ScocPid} = sccp_scoc:start_link(ScocPropList),
% insert SCOC instance in connection table
ConnTable = get(scoc_by_ref),
ets:insert_new(ConnTable, {LocalRef, ScocPid}),
{LoopDat1, ScocPid}.
is_cr_or_connless(SccpMsg) when is_record(SccpMsg, sccp_msg) ->
case SccpMsg of
#sccp_msg{msg_type = ?SCCP_MSGT_CR} ->
true;
_ ->
sccp_codec:is_connectionless(SccpMsg)
end.
% deliver message to local SCOC or SCLC
deliver_to_scoc_sclc(LoopDat, Msg) when is_record(Msg, sccp_msg) ->
case Msg of
% special handling for CR message here in SCRC
#sccp_msg{msg_type = ?SCCP_MSGT_CR} ->
% spawn a new SCOC instance/process
{LoopDat1, ScocPid} = spawn_new_scoc(LoopDat),
% send a RCOC-CONNECTING.ind primitive to the new SCOC fsm
UserPrim = osmo_util:make_prim('RCOC','CONNECTION', indication, Msg#sccp_msg.parameters),
io:format("Sending ~p to ~p~n", [UserPrim, ScocPid]),
gen_fsm:send_event(ScocPid, UserPrim),
LoopDat1;
% T(ias) expired on the other end of the connection
%#sccp_msg{msg_type = ?SCCP_MSGT_IT} ->
_ ->
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};
false ->
% connection oriented messages need to go via SCOC instance
#sccp_msg{parameters = Opts} = Msg,
LocalRef = proplists:get_value(dst_local_ref, Opts),
ScocPrim = osmo_util:make_prim('RCOC', 'CONNECTION-MSG', indication, Msg),
case LocalRef of
undefined ->
% FIXME: send SCCP_MSGT_ERR
io:format("Conn-Msg to undefined ref ~p~n", [Msg]);
_ ->
tx_prim_to_local_ref(ScocPrim, LocalRef)
end
end,
LoopDat
end.
% N-CONNECT.req from user: spawn new SCOC and deliver primitive to it
idle(P = #primitive{subsystem = 'N', gen_name = 'CONNECT',
spec_name = request, parameters = Params}, LoopDat) ->
% Start new SCOC instance
{LoopDat1, ScocPid} = spawn_new_scoc(LoopDat),
% Deliver primitive to new SCOC instance
gen_fsm:send_event(ScocPid, P),
{next_state, idle, LoopDat1};
% N-UNITDATA.req from user (normally this is SCLC, but we don't have SCLC)
idle(P= #primitive{subsystem = 'N', gen_name = 'UNITDATA',
spec_name = request, parameters = Params}, LoopDat) ->
% User needs to specify: Protocol Class, Called Party, Calling Party, Data
% FIXME: implement XUDT / LUDT support
% encode the actual SCCP message
EncMsg = sccp_codec:encode_sccp_msgt(?SCCP_MSGT_UDT, Params),
% generate a MTP-TRANSFER.req primitive to the lower layer
send_mtp_transfer_down(LoopDat, EncMsg),
{next_state, idle, LoopDat};
% MTP-TRANSFER.ind from lower layer is passed into SCRC
idle(#primitive{subsystem = 'MTP', gen_name = 'TRANSFER',
spec_name = indication, parameters = Params}, LoopDat) ->
case sccp_routing:route_mtp3_sccp_in(Params) of
{remote} ->
% routing has taken care of it
LoopDat1 = LoopDat;
{local, SccpMsg, _} ->
LoopDat1 = deliver_to_scoc_sclc(LoopDat, SccpMsg)
end,
{next_state, idle, LoopDat1};
idle({sclc_scrc_connless_msg, SccpMsg}, LoopDat) ->
case sccp_routing:route_local_out(SccpMsg) of
{remote, SccpMsg2} ->
% FIXME: get to MTP-TRANSFER.req
LoopDat1 = LoopDat;
{error, _} ->
LoopDat1 = LoopDat;
{local, SccpMsg2} ->
LoopDat1 = deliver_to_scoc_sclc(LoopDat, SccpMsg2)
end,
{next_state, idle, LoopDat};
% connection oriented messages like N-DATA.req from user
idle(#primitive{subsystem = 'OCRC', gen_name = 'CONNECTION-MSG',
spec_name = request, parameters = Msg}, LoopDat) ->
% encode the actual SCCP message
EncMsg = sccp_codec:encode_sccp_msg(Msg),
% generate a MTP-TRANSFER.req primitive to the lower layer
send_mtp_transfer_down(LoopDat, EncMsg),
{next_state, idle, LoopDat};
% SCOC has received confirmation about new incoming connection from user
idle(#primitive{subsystem = 'OCRC', gen_name = 'CONNECTION',
spec_name = confirm, parameters = Params}, LoopDat) ->
% encode the actual SCCP message
EncMsg = sccp_codec:encode_sccp_msgt(?SCCP_MSGT_CC, Params),
% generate a MTP-TRANSFER.req primitive to the lower layer
send_mtp_transfer_down(LoopDat, EncMsg),
{next_state, idle, LoopDat};
% triggered by N-CONNECT.req from user to SCOC:
idle(#primitive{subsystem = 'OCRC', gen_name = 'CONNECTION',
spec_name = indication, parameters = Params}, LoopDat) ->
% encode the actual SCCP message
EncMsg = sccp_codec:encode_sccp_msgt(?SCCP_MSGT_CR, Params),
% generate a MTP-TRANSFER.req primitive to the lower layer
send_mtp_transfer_down(LoopDat, EncMsg),
{next_state, idle, LoopDat}.
send_mtp_transfer_down(LoopDat, EncMsg) ->
Rlbl = #mtp3_routing_label{sig_link_sel = 0, origin_pc = 123, dest_pc = 456},
Mtp3 = #mtp3_msg{network_ind = ?MTP3_NETIND_INTERNATIONAL,
service_ind = ?MTP3_SERV_SCCP,
routing_label = Rlbl, payload = EncMsg},
MtpPrim = #primitive{subsystem = 'MTP', gen_name = 'TRANSFER',
spec_name = request, parameters = Mtp3},
sccp_links:mtp3_tx(Mtp3).