From 92e783d1098e99161401ab08cccd3a08356749cd Mon Sep 17 00:00:00 2001 From: Harald Welte Date: Sun, 1 Apr 2012 19:52:01 +0200 Subject: rename sua_codec to generic xua_codec SUA/M3UA/M2UA/M2PA actaully all uses almost the same message format, so it makes sense to write one generic xua_codec and derive from that. The current SUA implementation didn't actually contain anything SUA specific, so we can just rename it and use xua_codec directly from the users. --- src/sctp_sua.erl | 23 +++++++------ src/sua_asp.erl | 23 +++++++------ src/sua_codec.erl | 92 --------------------------------------------------- src/sua_sccp_conv.erl | 13 ++++---- src/xua_codec.erl | 92 +++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 123 insertions(+), 120 deletions(-) delete mode 100644 src/sua_codec.erl create mode 100644 src/xua_codec.erl (limited to 'src') diff --git a/src/sctp_sua.erl b/src/sctp_sua.erl index 0d35780..b5a455b 100644 --- a/src/sctp_sua.erl +++ b/src/sctp_sua.erl @@ -23,6 +23,7 @@ -include_lib("kernel/include/inet_sctp.hrl"). -include("osmo_util.hrl"). +-include("xua.hrl"). -include("sua.hrl"). -include("m3ua.hrl"). @@ -77,29 +78,29 @@ prim_up(Prim, State, LoopDat) -> % sctp_core indicates that ew have received some data... rx_sctp(#sctp_sndrcvinfo{ppid = ?SUA_PPID}, Data, State, LoopDat) -> Asp = LoopDat#sua_state.asp_pid, - Sua = sua_codec:parse_msg(Data), + Sua = xua_codec:parse_msg(Data), case Sua of - #sua_msg{msg_class = ?M3UA_MSGC_MGMT, + #xua_msg{msg_class = ?M3UA_MSGC_MGMT, msg_type = ?M3UA_MSGT_MGMT_NTFY} -> Prim = osmo_util:make_prim('M','NOTIFY',indication,Sua), {ok, Prim, LoopDat}; - #sua_msg{msg_class = ?M3UA_MSGC_MGMT, + #xua_msg{msg_class = ?M3UA_MSGC_MGMT, msg_type = ?M3UA_MSGT_MGMT_ERR} -> Prim = osmo_util:make_prim('M','ERROR',indication,Sua), {ok, Prim, LoopDat}; - #sua_msg{msg_class = ?M3UA_MSGC_SSNM} -> + #xua_msg{msg_class = ?M3UA_MSGC_SSNM} -> % FIXME {ignore, LoopDat}; - #sua_msg{msg_class = ?M3UA_MSGC_ASPSM} -> + #xua_msg{msg_class = ?M3UA_MSGC_ASPSM} -> gen_fsm:send_event(Asp, Sua), {ignore, LoopDat}; - #sua_msg{msg_class = ?M3UA_MSGC_ASPTM} -> + #xua_msg{msg_class = ?M3UA_MSGC_ASPTM} -> gen_fsm:send_event(Asp, Sua), {ignore, LoopDat}; - #sua_msg{msg_class = ?SUA_MSGC_CL} -> + #xua_msg{msg_class = ?SUA_MSGC_CL} -> Prim = sua_to_prim(Sua, LoopDat), {ok, Prim, LoopDat}; - %#sua_msg{msg_class = ?SUA_MSGC_C0} -> + %#xua_msg{msg_class = ?SUA_MSGC_C0} -> _ -> % do something with link related msgs io:format("SUA Unknown message ~p in state ~p~n", [Sua, State]), @@ -107,8 +108,8 @@ rx_sctp(#sctp_sndrcvinfo{ppid = ?SUA_PPID}, Data, State, LoopDat) -> end. % MTP-TRANSFER.req has arrived at sctp_core, encapsulate+tx it -mtp_xfer(Sua, LoopDat) when is_record(Sua, sua_msg) -> - SuaBin = sua_codec:encode_msg(Sua), +mtp_xfer(Sua, LoopDat) when is_record(Sua, xua_msg) -> + SuaBin = xua_codec:encode_msg(Sua), tx_sctp(1, SuaBin), LoopDat. @@ -137,6 +138,6 @@ asp_prim_to_user(Prim, [SctpPid]) -> gen_fsm:send_event(SctpPid, Prim). -sua_to_prim(Sua, LoopDat) when is_record(Sua, sua_msg) -> +sua_to_prim(Sua, LoopDat) when is_record(Sua, xua_msg) -> Sccp = sua_sccp_conv:sua_to_sccp(Sua), osmo_util:make_prim('N','UNITADATA',indication, Sccp). diff --git a/src/sua_asp.erl b/src/sua_asp.erl index 79a4fd3..d75d688 100644 --- a/src/sua_asp.erl +++ b/src/sua_asp.erl @@ -24,6 +24,7 @@ -include("osmo_util.hrl"). -include("m3ua.hrl"). -include("sua.hrl"). +-include("xua.hrl"). -export([init/1]). @@ -33,44 +34,44 @@ init([]) -> {ok, we_have_no_state}. gen_xua_msg(MsgClass, MsgType, Params) -> - #sua_msg{version = 1, msg_class = MsgClass, msg_type = MsgType, payload = Params}. + #xua_msg{version = 1, msg_class = MsgClass, msg_type = MsgType, payload = Params}. -asp_down(#sua_msg{version = 1, msg_class = MsgClass, msg_type = MsgType}, +asp_down(#xua_msg{version = 1, msg_class = MsgClass, msg_type = MsgType}, LoopDat, Mld) when MsgClass == ?M3UA_MSGC_ASPSM; MsgClass == ?M3UA_MSGC_ASPTM -> % convert from SUA to xua_msg and call into master module xua_asp_fsm:asp_down({xua_msg, MsgClass, MsgType}, Mld); -asp_down(SuaMsg, LoopDat, Mld) when is_record(SuaMsg, sua_msg) -> +asp_down(SuaMsg, LoopDat, Mld) when is_record(SuaMsg, xua_msg) -> rx_sua(SuaMsg, asp_down, Mld). -asp_inactive(#sua_msg{version = 1, msg_class = MsgClass, msg_type = MsgType}, +asp_inactive(#xua_msg{version = 1, msg_class = MsgClass, msg_type = MsgType}, LoopDat, Mld) when MsgClass == ?M3UA_MSGC_ASPSM; MsgClass == ?M3UA_MSGC_ASPTM -> % convert from SUA to xua_msg and call into master module xua_asp_fsm:asp_inactive({xua_msg, MsgClass, MsgType}, Mld); -asp_inactive(SuaMsg, LoopDat, Mld) when is_record(SuaMsg, sua_msg) -> +asp_inactive(SuaMsg, LoopDat, Mld) when is_record(SuaMsg, xua_msg) -> rx_sua(SuaMsg, asp_inactive, Mld). -asp_active(#sua_msg{version = 1, msg_class = MsgClass, msg_type = MsgType}, +asp_active(#xua_msg{version = 1, msg_class = MsgClass, msg_type = MsgType}, LoopDat, Mld) when MsgClass == ?M3UA_MSGC_ASPSM; MsgClass == ?M3UA_MSGC_ASPTM -> % convert from SUA to xua_msg and call into master module xua_asp_fsm:asp_active({xua_msg, MsgClass, MsgType}, Mld); -asp_active(SuaMsg, LoopDat, Mld) when is_record(SuaMsg, sua_msg) -> +asp_active(SuaMsg, LoopDat, Mld) when is_record(SuaMsg, xua_msg) -> rx_sua(SuaMsg, asp_active, Mld). -rx_sua(Msg = #sua_msg{version = 1, msg_class = ?M3UA_MSGC_ASPSM, +rx_sua(Msg = #xua_msg{version = 1, msg_class = ?M3UA_MSGC_ASPSM, msg_type = ?M3UA_MSGT_ASPSM_BEAT}, State, LoopDat) -> % Send BEAT_ACK using the same payload as the BEAT msg - xua_asp_fsm:send_sctp_to_peer(LoopDat, Msg#sua_msg{msg_type = ?M3UA_MSGT_ASPSM_BEAT_ACK}), + xua_asp_fsm:send_sctp_to_peer(LoopDat, Msg#xua_msg{msg_type = ?M3UA_MSGT_ASPSM_BEAT_ACK}), {next_state, State, LoopDat}; -%rx_sua(Msg = #sua_msg{version = 1, msg_class = ?M3UA_MSGC_SSNM, +%rx_sua(Msg = #xua_msg{version = 1, msg_class = ?M3UA_MSGC_SSNM, %msg_type = MsgType, payload = Params}, State, LoopDat) -> % transform to classic MTP primitive and send up to the user %Mtp = map_ssnm_to_mtp_prim(MsgType), %send_prim_to_user(LoopDat, Mtp), %{next_state, State, LoopDat}; -rx_sua(Msg = #sua_msg{}, State, LoopDat) -> +rx_sua(Msg = #xua_msg{}, State, LoopDat) -> io:format("SUA Unknown messge ~p in state ~p~n", [Msg, State]), {next_state, State, LoopDat}. diff --git a/src/sua_codec.erl b/src/sua_codec.erl deleted file mode 100644 index ee7830c..0000000 --- a/src/sua_codec.erl +++ /dev/null @@ -1,92 +0,0 @@ -% RFC 3868 SUA SCCP Adaption Layer coding / decoding - -% (C) 2012 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(sua_codec). --author('Harald Welte '). --include("sua.hrl"). - --export([parse_msg/1, encode_msg/1, parse_xua_opts/1, encode_xua_opts/1]). - -parse_msg(DataBin) when is_binary(DataBin) -> - <> = DataBin, - RemainLen = MsgLen - 4, - OptList = parse_xua_opts(Remain), - #sua_msg{version = Version, msg_class = MsgClass, msg_type = MsgType, - payload = OptList}; -parse_msg(Data) when is_list(Data) -> - parse_msg(list_to_binary(Data)). - -parse_xua_opts(OptBin) when is_binary(OptBin) -> - parse_xua_opts(OptBin, []). - -parse_xua_opts(<<>>, OptList) when is_list(OptList) -> - OptList; -parse_xua_opts(OptBin, OptList) when is_binary(OptBin), is_list(OptList) -> - <> = OptBin, - Length = LengthIncHdr - 4, - PadLength = get_num_pad_bytes(Length), - %io:format("Tag ~w, LenInHdr ~w, Len ~w, PadLen ~w, Remain ~w(~p)~n", - % [Tag, LengthIncHdr, Length, PadLength, byte_size(Remain), Remain]), - <> = Remain, - % this is ridiculous, we cannot use "<>" as the last part would not match an - % empty binary <<>> anymore. Without the "0:PadLengh" this works - % perfectly fine. Now we need some complicated construct and check if - % the resulting list would be empty :(( - if - byte_size(PadNextOpts) > PadLength -> - <<0:PadLength/integer-unit:8, NextOpts/binary>> = PadNextOpts; - true -> - NextOpts = <<>> - end, - NewOpt = {Tag, {Length, Value}}, - parse_xua_opts(NextOpts, OptList ++ [NewOpt]). - - - -encode_msg(#sua_msg{version = Version, msg_class = MsgClass, - msg_type = MsgType, payload = OptList}) -> - OptBin = encode_xua_opts(OptList), - MsgLen = byte_size(OptBin) + 8, - <>. - -encode_xua_opts(OptList) when is_list(OptList) -> - encode_xua_opts(OptList, <<>>). - -encode_xua_opts([], Bin) -> - Bin; -encode_xua_opts([{Iei, Attr}|Tail], Bin) -> - OptBin = encode_xua_opt(Iei, Attr), - encode_xua_opts(Tail, <>). - -encode_xua_opt(Iei, {LenIn, Data}) when is_integer(Iei), is_binary(Data) -> - Length = LenIn + 4, - PadLen = get_num_pad_bytes(Length), - <>; -encode_xua_opt(Iei, Data) when is_integer(Iei), is_binary(Data) -> - Length = byte_size(Data) + 4, - PadLen = get_num_pad_bytes(Length), - <>. - -% compute the number of pad bits required after a binary parameter -get_num_pad_bytes(BinLenBytes) -> - case BinLenBytes rem 4 of - 0 -> 0; - Val -> 4 - Val - end. diff --git a/src/sua_sccp_conv.erl b/src/sua_sccp_conv.erl index beaac5d..9c12128 100644 --- a/src/sua_sccp_conv.erl +++ b/src/sua_sccp_conv.erl @@ -23,11 +23,12 @@ -author('Harald Welte '). -include("sua.hrl"). +-include("xua.hrl"). -include("sccp.hrl"). -export([sua_to_sccp/1, sccp_to_sua/1]). -sua_to_sccp(M=#sua_msg{msg_class = Class, msg_type = Type}) -> +sua_to_sccp(M=#xua_msg{msg_class = Class, msg_type = Type}) -> sua_to_sccp(Class, Type, M). sua_to_sccp(?SUA_MSGC_CL, ?SUA_CL_CLDT, Sua) -> Params = sua_to_sccp_params(Sua), @@ -44,13 +45,13 @@ sccp_to_sua(Type, Params) when Type == ?SCCP_MSGT_UDT; Type == ?SCCP_MSGT_XUDT; Type == ?SCCP_MSGT_LUDT -> Opts = sccp_to_sua_params(Type, Params), - #sua_msg{version = 1, msg_class = ?SUA_MSGC_CL, + #xua_msg{version = 1, msg_class = ?SUA_MSGC_CL, msg_type = ?SUA_CL_CLDT, payload = Opts}; sccp_to_sua(Type, Params) when Type == ?SCCP_MSGT_UDTS; Type == ?SCCP_MSGT_XUDTS; Type == ?SCCP_MSGT_LUDTS -> Opts = sccp_to_sua_params(Params), - #sua_msg{version=1, msg_class = ?SUA_MSGC_CL, + #xua_msg{version=1, msg_class = ?SUA_MSGC_CL, msg_type = ?SUA_CL_CLDR, payload = Opts}. @@ -60,7 +61,7 @@ sccp_to_sua(Type, Params) when Type == ?SCCP_MSGT_UDTS; % ?SUA_IEI_IMPORTANCE, ?SUA_IEI_MSG_PRIO, ?SUA_IEI_CORR_ID, % ?SUA_IEI_SEGMENTATION, ?SUA_IEI_DATA -sua_to_sccp_params(#sua_msg{msg_class=Class, msg_type=Type, payload=Payload}) -> +sua_to_sccp_params(#xua_msg{msg_class=Class, msg_type=Type, payload=Payload}) -> sua_to_sccp_params(Class, Type, Payload). sua_to_sccp_params(Class, Type, Payload) -> sua_to_sccp_params(Class, Type, Payload, []). @@ -154,7 +155,7 @@ sua_to_sccp_addr(SuaBin) -> #sccp_addr{route_on_ssn = RoutSSN, point_code = PC, ssn = SSN, global_title = GT}. addr_pars_to_list(Bin) -> - sua_codec:parse_xua_opts(Bin). + xua_codec:parse_xua_opts(Bin). sccp_to_sua_addr(Addr) when is_record(Addr, sccp_addr) -> #sccp_addr{route_on_ssn = RoutOnSsn, point_code = PC, ssn = SSN, @@ -189,7 +190,7 @@ sccp_to_sua_addr(Addr) when is_record(Addr, sccp_addr) -> 1 -> RoutInd = ?SUA_RI_SSN_PC end, - Tail = sua_codec:encode_xua_opts(GTopt ++ PCopt ++ SSNopt), + Tail = xua_codec:encode_xua_opts(GTopt ++ PCopt ++ SSNopt), <>. parse_sua_gt(Bin) -> diff --git a/src/xua_codec.erl b/src/xua_codec.erl new file mode 100644 index 0000000..8da94a2 --- /dev/null +++ b/src/xua_codec.erl @@ -0,0 +1,92 @@ +% RFC 3868 SUA SCCP Adaption Layer coding / decoding + +% (C) 2012 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(xua_codec). +-author('Harald Welte '). +-include("xua.hrl"). + +-export([parse_msg/1, encode_msg/1, parse_xua_opts/1, encode_xua_opts/1]). + +parse_msg(DataBin) when is_binary(DataBin) -> + <> = DataBin, + RemainLen = MsgLen - 4, + OptList = parse_xua_opts(Remain), + #xua_msg{version = Version, msg_class = MsgClass, msg_type = MsgType, + payload = OptList}; +parse_msg(Data) when is_list(Data) -> + parse_msg(list_to_binary(Data)). + +parse_xua_opts(OptBin) when is_binary(OptBin) -> + parse_xua_opts(OptBin, []). + +parse_xua_opts(<<>>, OptList) when is_list(OptList) -> + OptList; +parse_xua_opts(OptBin, OptList) when is_binary(OptBin), is_list(OptList) -> + <> = OptBin, + Length = LengthIncHdr - 4, + PadLength = get_num_pad_bytes(Length), + %io:format("Tag ~w, LenInHdr ~w, Len ~w, PadLen ~w, Remain ~w(~p)~n", + % [Tag, LengthIncHdr, Length, PadLength, byte_size(Remain), Remain]), + <> = Remain, + % this is ridiculous, we cannot use "<>" as the last part would not match an + % empty binary <<>> anymore. Without the "0:PadLengh" this works + % perfectly fine. Now we need some complicated construct and check if + % the resulting list would be empty :(( + if + byte_size(PadNextOpts) > PadLength -> + <<0:PadLength/integer-unit:8, NextOpts/binary>> = PadNextOpts; + true -> + NextOpts = <<>> + end, + NewOpt = {Tag, {Length, Value}}, + parse_xua_opts(NextOpts, OptList ++ [NewOpt]). + + + +encode_msg(#xua_msg{version = Version, msg_class = MsgClass, + msg_type = MsgType, payload = OptList}) -> + OptBin = encode_xua_opts(OptList), + MsgLen = byte_size(OptBin) + 8, + <>. + +encode_xua_opts(OptList) when is_list(OptList) -> + encode_xua_opts(OptList, <<>>). + +encode_xua_opts([], Bin) -> + Bin; +encode_xua_opts([{Iei, Attr}|Tail], Bin) -> + OptBin = encode_xua_opt(Iei, Attr), + encode_xua_opts(Tail, <>). + +encode_xua_opt(Iei, {LenIn, Data}) when is_integer(Iei), is_binary(Data) -> + Length = LenIn + 4, + PadLen = get_num_pad_bytes(Length), + <>; +encode_xua_opt(Iei, Data) when is_integer(Iei), is_binary(Data) -> + Length = byte_size(Data) + 4, + PadLen = get_num_pad_bytes(Length), + <>. + +% compute the number of pad bits required after a binary parameter +get_num_pad_bytes(BinLenBytes) -> + case BinLenBytes rem 4 of + 0 -> 0; + Val -> 4 - Val + end. -- cgit v1.2.3