From 50dfc196ca84d17a99a10231bb682aeda3366ae2 Mon Sep 17 00:00:00 2001 From: Harald Welte Date: Tue, 17 Jan 2012 15:11:37 +0100 Subject: SUA: add functions for SUA <-> SCCP conversion --- include/sua.hrl | 7 +- src/sua_codec.erl | 26 +++--- src/sua_sccp_conv.erl | 238 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 257 insertions(+), 14 deletions(-) create mode 100644 src/sua_sccp_conv.erl diff --git a/include/sua.hrl b/include/sua.hrl index 87341f9..94e5f98 100644 --- a/include/sua.hrl +++ b/include/sua.hrl @@ -81,7 +81,7 @@ -define(SUA_IEI_S7_HOP_CTR, 16#0101). -define(SUA_IEI_SRC_ADDR, 16#0102). --define(SUA_IEI_DEST_ADDRA, 16#0103). +-define(SUA_IEI_DEST_ADDR, 16#0103). -define(SUA_IEI_SRC_REF, 16#0104). -define(SUA_IEI_DEST_REF, 16#0105). -define(SUA_IEI_CAUSE, 16#0106). @@ -110,6 +110,11 @@ -define(SUA_IEI_HOST, 16#8005). -define(SUA_IEI_IPv6, 16#8006). +-define(SUA_RI_GT, 1). +-define(SUA_RI_SSN_PC, 2). +-define(SUA_RI_HOST, 3). +-define(SUA_RI_SSN_IP, 4). + -record(sua_msg, { version :: 0..255, msg_class :: 0..255, diff --git a/src/sua_codec.erl b/src/sua_codec.erl index bec88a5..bb34ed6 100644 --- a/src/sua_codec.erl +++ b/src/sua_codec.erl @@ -21,22 +21,22 @@ -author('Harald Welte '). -include("sua.hrl"). --export([parse_msg/1, encode_msg/1]). +-export([parse_msg/1, encode_msg/1, parse_xua_opts/1, encode_xua_opts/1]). parse_msg(DataBin) when is_binary(DataBin) -> <> = DataBin, - OptList = parse_sua_opts(Remain), + OptList = parse_xua_opts(Remain), #sua_msg{version = Version, msg_class = MsgClass, msg_type = MsgType, msg_length = MsgLen-4, payload = OptList}; parse_msg(Data) when is_list(Data) -> parse_msg(list_to_binary(Data)). -parse_sua_opts(OptBin) when is_binary(OptBin) -> - parse_sua_opts(OptBin, []). +parse_xua_opts(OptBin) when is_binary(OptBin) -> + parse_xua_opts(OptBin, []). -parse_sua_opts(<<>>, OptList) when is_list(OptList) -> +parse_xua_opts(<<>>, OptList) when is_list(OptList) -> OptList; -parse_sua_opts(OptBin, OptList) when is_binary(OptBin), is_list(OptList) -> +parse_xua_opts(OptBin, OptList) when is_binary(OptBin), is_list(OptList) -> <> = OptBin, Length = LengthIncHdr - 4, PadLength = get_num_pad_bytes(Length), @@ -55,7 +55,7 @@ parse_sua_opts(OptBin, OptList) when is_binary(OptBin), is_list(OptList) -> NextOpts = <<>> end, NewOpt = {Tag, {Length, Value}}, - parse_sua_opts(NextOpts, OptList ++ [NewOpt]). + parse_xua_opts(NextOpts, OptList ++ [NewOpt]). parse_sua_opt(Opt, Msg) -> {Opt, Msg}. @@ -63,18 +63,18 @@ parse_sua_opt(Opt, Msg) -> encode_msg(#sua_msg{version = Version, msg_class = MsgClass, msg_type = MsgType, payload = OptList}) -> - OptBin = encode_sua_opts(OptList), + OptBin = encode_xua_opts(OptList), MsgLen = byte_size(OptBin) + 8, <>. -encode_sua_opts(OptList) when is_list(OptList) -> - encode_sua_opts(OptList, <<>>). +encode_xua_opts(OptList) when is_list(OptList) -> + encode_xua_opts(OptList, <<>>). -encode_sua_opts([], Bin) -> +encode_xua_opts([], Bin) -> Bin; -encode_sua_opts([{Iei, Attr}|Tail], Bin) -> +encode_xua_opts([{Iei, Attr}|Tail], Bin) -> OptBin = encode_sua_opt(Iei, Attr), - encode_sua_opts(Tail, <>). + encode_xua_opts(Tail, <>). encode_sua_opt(Iei, Data) when is_integer(Iei), is_binary(Data) -> Length = byte_size(Data) + 4, diff --git a/src/sua_sccp_conv.erl b/src/sua_sccp_conv.erl new file mode 100644 index 0000000..2483ba5 --- /dev/null +++ b/src/sua_sccp_conv.erl @@ -0,0 +1,238 @@ +% Conversion between SUA messages and #sccp_msg{} + +% (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 . + +% FIXME: this currently only supports connection-less SCCP + +-module(sua_sccp_conv). +-author('Harald Welte '). + +-include("sua.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(Class, Type, M). +sua_to_sccp(?SUA_MSGC_CL, ?SUA_CL_CLDT, Sua) -> + Params = sua_to_sccp_params(Sua), + #sccp_msg{msg_type = ?SCCP_MSGT_UDT, + parameters = Params}; +sua_to_sccp(?SUA_MSGC_CL, ?SUA_CL_CLDR, Sua) -> + Params = sua_to_sccp_params(Sua), + #sccp_msg{msg_type = ?SCCP_MSGT_UDTS, + parameters = Params}. + +sccp_to_sua(M=#sccp_msg{msg_type = Type, parameters = Params}) -> + sccp_to_sua(Type, Params). +sccp_to_sua(Type, Params) when Type == ?SCCP_MSGT_UDT; + Type == ?SCCP_MSGT_XUDT; + Type == ?SCCP_MSGT_LUDT -> + Opts = sccp_to_sua_params(Params), + #sua_msg{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{msg_class = ?SUA_MSGC_CL, msg_type = ?SUA_CL_CLDR, + payload = Opts}. + + +% CLDT parameters: +% ?SUA_IEI_ROUTE_CTX, ?SUA_IEI_PROTO_CLASS, ?SUA_IEI_SRC_ADDR, +% ?SUA_IEI_DEST_ADDR, ?SUA_IEI_SEQ_CTRL, ?SUA_IEI_S7_HOP_CTR, +% ?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(Class, Type, Payload). +sua_to_sccp_params(Class, Type, Payload) -> + sua_to_sccp_params(Class, Type, Payload, []). +sua_to_sccp_params(Class, Type, [], List) -> + List; +sua_to_sccp_params(Class, Type, [{ParTag, ParVal}|Remain], List) -> + NewPars = sua_to_sccp_param(Class, Type, ParTag, ParVal), + sua_to_sccp_params(Class, Type, Remain, List ++ NewPars). + +% convert an individual SUA parameter to a SCCP option +sua_to_sccp_param(_, _, ?SUA_IEI_PROTO_CLASS, Remain) -> + <<_:24, RetErr:1, _:5, Class:2>> = Remain, + [{?SCCP_PNC_PROTOCOL_CLASS, Class}]; +sua_to_sccp_param(_, _, ?SUA_IEI_SRC_ADDR, Remain) -> + Addr = sua_to_sccp_addr(Remain), + [{?SCCP_PNC_CALLING_PARTY_ADDRESS, Addr}]; +sua_to_sccp_param(_, _, ?SUA_IEI_DEST_ADDR, Remain) -> + Addr = sua_to_sccp_addr(Remain), + [{?SCCP_PNC_CALLED_PARTY_ADDRESS, Addr}]; +sua_to_sccp_param(_, _, ?SUA_IEI_SEQ_CTRL, Remain) -> + [{?SCCP_PNC_SEQUENCING, Remain}]; +sua_to_sccp_param(_, _, ?SUA_IEI_S7_HOP_CTR, Remain) -> + <<_:24, HopCtr:8>> = Remain, + [{?SCCP_PNC_HOP_COUNTER, HopCtr}]; +sua_to_sccp_param(_, _, ?SUA_IEI_IMPORTANCE, Remain) -> + <<_:24, Imp:8>> = Remain, + [{?SCCP_PNC_IMPORTANCE, Imp}]; +sua_to_sccp_param(_, _, ?SUA_IEI_DATA, Remain) -> + [{?SCCP_PNC_DATA, Remain}]. + +sccp_to_sua_params(#sccp_msg{msg_type=Type, parameters=Params}) -> + sccp_to_sua_params(Type, Params). +sccp_to_sua_params(Type, Params) when is_list(Params) -> + sccp_to_sua_params(Type, Params, []). +sccp_to_sua_params(Type, [], List) -> + List; +sccp_to_sua_params(Type, [{ParTag, ParVal}|Tail], List) -> + NewPars = sccp_to_sua_param(Type, ParTag, ParVal), + sccp_to_sua_params(Type, Tail, List ++ NewPars). + +sccp_to_sua_param(_, ?SCCP_PNC_PROTOCOL_CLASS, Class) -> + [{?SUA_IEI_PROTO_CLASS, <<0:24, 0:1, 0:5, Class:2>>}]; +sccp_to_sua_param(_, ?SCCP_PNC_CALLING_PARTY_ADDRESS, Addr) -> + AddrSua = sccp_to_sua_addr(Addr), + [{?SUA_IEI_SRC_ADDR, AddrSua}]; +sccp_to_sua_param(_, ?SCCP_PNC_CALLED_PARTY_ADDRESS, Addr) -> + AddrSua = sccp_to_sua_addr(Addr), + [{?SUA_IEI_DEST_ADDR, AddrSua}]; +sccp_to_sua_param(_, ?SCCP_PNC_SEQUENCING, Par) -> + [{?SUA_IEI_SEQ_CTRL, Par}]; +sccp_to_sua_param(_, ?SCCP_PNC_HOP_COUNTER, Hop) -> + [{?SUA_IEI_S7_HOP_CTR, <<0:24, Hop:8>>}]; +sccp_to_sua_param(_, ?SCCP_PNC_IMPORTANCE, Imp) -> + [{?SUA_IEI_IMPORTANCE, <<0:24, Imp:8>>}]; +sccp_to_sua_param(_, ?SCCP_PNC_DATA, Data) -> + [{?SUA_IEI_DATA, Data}]. + +sua_to_sccp_addr(SuaBin) -> + <> = SuaBin, + ParList = addr_pars_to_list(Remain), + case GTinc of + 1 -> + GTopt = proplists:get_value(?SUA_IEI_GT, ParList), + GT = parse_sua_gt(GTopt); + 0 -> + GT = undefined + end, + case PCinc of + 1 -> + PCopt = proplists:get_value(?SUA_IEI_PC, ParList), + PC = parse_sua_pc(PCopt); + 0 -> + PC = undefined + end, + case SSNinc of + 1 -> + SSNopt = proplists:get_value(?SUA_IEI_SSN, ParList), + SSN = parse_sua_ssn(SSNopt); + 0 -> + SSN = undefined + end, + case RoutInd of + ?SUA_RI_GT -> + RoutSSN = 0; + ?SUA_RI_SSN_PC -> + RoutSSN = 1 + end, + #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). + +sccp_to_sua_addr(Addr) when is_record(Addr, sccp_addr) -> + #sccp_addr{route_on_ssn = RoutOnSsn, point_code = PC, ssn = SSN, + global_title = GT} = Addr, + case GT of + #global_title{} -> + GTopt = encode_sua_gt(GT), + GTinc = 1; + _ -> + GTopt = [], + GTinc = 0 + end, + case PC of + Int when is_integer(Int) -> + PCopt = encode_sua_pc(PC), + PCinc = 1; + _ -> + PCopt = [], + PCinc = 0 + end, + case SSN of + Int2 when is_integer(Int2) -> + SSNopt = encode_sua_ssn(SSN), + SSNinc = 1; + _ -> + SSNopt = [], + SSNinc = 0 + end, + case RoutOnSsn of + 0 -> + RoutInd = ?SUA_RI_GT; + 1 -> + RoutInd = ?SUA_RI_SSN_PC + end, + Tail = sua_codec:encode_xua_opts(GTopt ++ PCopt ++ SSNopt), + <>. + +parse_sua_gt(Bin) -> + <<_:24, GTI:8, NoDigits:8, TransType:8, NumPlan:8, NAI:8, Remain/binary>> = Bin, + Number = parse_sua_gt_digits(NoDigits, Remain), + #global_title{gti = GTI, nature_of_addr_ind = NAI, + trans_type = TransType, encoding = fixme, + numbering_plan = NumPlan, + phone_number = Number}. +encode_sua_gt(Gt) when is_record(Gt, global_title) -> + #global_title{gti = GTI, nature_of_addr_ind = NAI, + trans_type = TransType, encoding = Encoding, + numbering_plan = NumPlan, + phone_number = Number} = Gt, + NoDigits = count_digits(Number), + DigitBin = encode_sua_gt_digits(Number), + <<0:24, GTI:8, NoDigits:8, TransType:8, NumPlan:8, NAI:8, DigitBin/binary>>. + +count_digits(Number) when is_integer(Number) -> + BcdList = osmo_util:int2digit_list(Number), + count_digits(BcdList); +count_digits(Number) when is_list(Number) -> + length(Number). + + +parse_sua_gt_digits(NoDigits, Remain) -> + % as opposed to ISUP/SCCP, we can have more than one nibble padding, + OddEven = NoDigits rem 1, + case OddEven of + 0 -> + ByteLen = NoDigits/2; + 1 -> + ByteLen = NoDigits/2 + 1 + end, + <> = Remain, + isup_codec:parse_isup_party(Bin, OddEven). +encode_sua_gt_digits(Digits) when is_list(Digits); is_integer(Digits) -> + % Assume that overall option encoder will do the padding... + isup_codec:encode_isup_party(Digits). + +parse_sua_pc(<>) -> + PC. +encode_sua_pc(Pc) when is_integer(Pc) -> + <>. + +parse_sua_ssn(<<_:24, SSN:8>>) -> + SSN. +encode_sua_ssn(Ssn) when is_integer(Ssn) -> + <<0:24, Ssn:8>>. -- cgit v1.2.3