diff --git a/src/mgw_nat.erl b/src/mgw_nat.erl index b35b763..0f3e644 100644 --- a/src/mgw_nat.erl +++ b/src/mgw_nat.erl @@ -85,11 +85,13 @@ mangle_rx_mtp3_serv(_L, From, ?MTP3_SERV_SCCP, Mtp3 = #mtp3_msg{payload = Payloa {ok, Sccp} = sccp_codec:parse_sccp_msg(Payload), io:format("SCCP Decode: ~p~n", [Sccp]), SccpMangled = mangle_rx_sccp(From, Sccp#sccp_msg.msg_type, Sccp), - if SccpMangled == Sccp -> + SccpMasqued = sccp_masq:sccp_masq_msg(From, SccpMangled#sccp_msg.msg_type, + SccpMangled), + if SccpMasqued == Sccp -> Mtp3; true -> - io:format("SCCP Encode In: ~p~n", [SccpMangled]), - Payload_out = sccp_codec:encode_sccp_msg(SccpMangled), + io:format("SCCP Encode In: ~p~n", [SccpMasqued]), + Payload_out = sccp_codec:encode_sccp_msg(SccpMasqued), io:format("SCCP Encode Out: ~p~n", [Payload_out]), % return modified MTP3 payload Mtp3#mtp3_msg{payload = Payload_out} diff --git a/src/mgw_nat_usr.erl b/src/mgw_nat_usr.erl index 562c07a..0743aad 100644 --- a/src/mgw_nat_usr.erl +++ b/src/mgw_nat_usr.erl @@ -37,6 +37,7 @@ stop() -> %% Callback functions of the OTP behavior init(Params) -> + sccp_masq:init(), apply(sctp_handler, init, Params). handle_cast(stop, LoopData) -> diff --git a/src/sccp_masq.erl b/src/sccp_masq.erl new file mode 100644 index 0000000..6c14dbd --- /dev/null +++ b/src/sccp_masq.erl @@ -0,0 +1,146 @@ +% ITU-T Q.71x SCCP UDT stateful masquerading + +% (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_masq). +-author('Harald Welte '). +-include("sccp.hrl"). + +-export([sccp_masq_msg/3, init/0]). + +-compile([export_all]). + +-record(sccp_masq_rec, { + digits_in, % list of GT digits + digits_out, % list of GT digits + last_access % timestamp of last usage + }). + +% Convert a list of digits to an integer value +digit_list2int(Int, []) -> + Int; +digit_list2int(Int, [Digit|Tail]) -> + digit_list2int(Int*10 + Digit, Tail). +digit_list2int(Digits) when is_list(Digits) -> + digit_list2int(0, Digits). + +% Convert an integer value into a list of decimal digits +int2digit_list(0, Digits) when is_list(Digits) -> + Digits; +int2digit_list(Int, Digits) when is_integer(Int), is_list(Digits) -> + Digit = Int rem 10, + int2digit_list(Int div 10, [Digit|Digits]). +int2digit_list(Int) when is_integer(Int) -> + int2digit_list(Int, []). + +-define(MASQ_GT_BASE, 12340000). +-define(MASQ_GT_MAX, 9999). + +% alloc + insert a new masquerade state record in our tables +masq_alloc(DigitsOrig) -> + masq_try_alloc(DigitsOrig, 0). +masq_try_alloc(_DigitsOrig, Offset) when Offset > ?MASQ_GT_MAX -> + undef; +masq_try_alloc(DigitsOrig, Offset) -> + Try = ?MASQ_GT_BASE + Offset, + TryDigits = int2digit_list(Try), + EtsRet = ets:insert_new(get(sccp_masq_orig), + #sccp_masq_rec{digits_in = DigitsOrig, + digits_out = TryDigits}), + case EtsRet of + false -> + masq_try_alloc(DigitsOrig, Offset+1); + _ -> + ets:insert(get(sccp_masq_rev), + #sccp_masq_rec{digits_in = TryDigits, + digits_out = DigitsOrig}), + TryDigits + end. + +% lookup a masqerade state record +lookup_masq_addr(orig, GtDigits) -> + case ets:lookup(get(sccp_masq_orig), GtDigits) of + [#sccp_masq_rec{digits_out = DigitsOut}] -> + DigitsOut; + _ -> + % allocate a new masq GT + masq_alloc(GtDigits) + end; +lookup_masq_addr(rev, GtDigits) -> + case ets:lookup(get(sccp_masq_rev), GtDigits) of + [#sccp_masq_rec{digits_out = DigitsOut}] -> + DigitsOut; + _ -> + % we do not allocate entries in the reverse direction + undef + end. + + +% Masquerade the CALLING address in first STP(G-MSC) -> HLR/VLR/MSC dir +mangle_rx_calling(from_stp, Addr = #sccp_addr{global_title = GT}) -> + GtOrig = GT#global_title.phone_number, + GtReplace = lookup_masq_addr(orig, GtOrig), + case GtReplace of + undef -> + io:format("SCCP MASQ: Unable to rewrite in original direction (out of GT addrs?)~n"), + Addr; + _ -> + io:format("SCCP MASQ (STP->MSC) rewrite ~p~n", [GtReplace]), + GTout = GT#global_title{phone_number = GtReplace}, + Addr#sccp_addr{global_title = GTout} + end; +mangle_rx_calling(_From, Addr) -> + Addr. + +mangle_rx_called(from_msc, Addr = #sccp_addr{global_title = GT}) -> + GtOrig = GT#global_title.phone_number, + GtReplace = lookup_masq_addr(rev, GtOrig), + case GtReplace of + undef -> + io:format("SCCP MASQ: Unable to rewrite in original direction (unknown GT ~p)~n", [GT]), + Addr; + _ -> + io:format("SCCP MASQ (MSC->STP) rewrite ~p~n", [GtReplace]), + GTout = GT#global_title{phone_number = GtReplace}, + Addr#sccp_addr{global_title = GTout} + end; +mangle_rx_called(_From, Addr) -> + Addr. + + +sccp_masq_msg(From, ?SCCP_MSGT_UDT, Msg = #sccp_msg{parameters = Opts}) -> + CalledParty = proplists:get_value(called_party_addr, Opts), + CalledPartyNew = mangle_rx_called(From, CalledParty), + CallingParty = proplists:get_value(calling_party_addr, Opts), + CallingPartyNew = mangle_rx_calling(From, CallingParty), + Opts1 = lists:keyreplace(called_party_addr, 1, Opts, + {called_party_addr, CalledPartyNew}), + Opts2 = lists:keyreplace(calling_party_addr, 1, Opts1, + {calling_party_addr, CallingPartyNew}), + Msg#sccp_msg{parameters = Opts2}; +sccp_masq_msg(_From, _MsgType, Msg) -> + Msg. + +init() -> + Orig = ets:new(sccp_masq_orig, [ordered_set, + {keypos, #sccp_masq_rec.digits_in}]), + Rev = ets:new(sccp_masq_rev, [ordered_set, + {keypos, #sccp_masq_rec.digits_in}]), + put(sccp_masq_orig, Orig), + put(sccp_masq_rev, Rev), + ok.