diff --git a/ebin/mgw_nat.app b/ebin/mgw_nat.app index cb15f6a..677cb2a 100644 --- a/ebin/mgw_nat.app +++ b/ebin/mgw_nat.app @@ -8,7 +8,7 @@ {mod, {mgw_nat_app, []}}, {applications, []}, {env, [ - {rewrite_actor, bow_onw }, + {rewrite_act_mod, mgw_nat_act_bow_onw }, % SCCP static rewrite rules {sccp_rewrite_tbl, [ diff --git a/src/mgw_nat_usr.erl b/src/mgw_nat_usr.erl index 9dd3d65..8f1f68f 100644 --- a/src/mgw_nat_usr.erl +++ b/src/mgw_nat_usr.erl @@ -50,11 +50,10 @@ init(_Params) -> {ok, MscRemoteIp} = application:get_env(msc_remote_ip), {ok, StpRemoteIp} = application:get_env(stp_remote_ip), {ok, StpRemotePort} = application:get_env(stp_remote_port), - {ok, RewriteActor} = application:get_env(rewrite_actor), - HandleFn = get_handle_fn(RewriteActor), - io:format("Starting mgw_nat_usr with rewrite actor ~p~n", [RewriteActor]), + {ok, RewriteActMod} = application:get_env(rewrite_act_mod), + io:format("Starting mgw_nat_usr with rewrite actor module ~p~n", [RewriteActMod]), SctpHdlrArgs = [MscLocalIp, MscLocalPort, MscRemoteIp, - StpRemoteIp, StpRemotePort, HandleFn], + StpRemoteIp, StpRemotePort, RewriteActMod], apply(sctp_handler, init, SctpHdlrArgs). handle_cast(stop, LoopData) -> @@ -66,8 +65,14 @@ handle_cast(sccp_masq_reset, LoopData) -> handle_cast(sccp_masq_dump, LoopData) -> sccp_masq:dump(), + {noreply, LoopData}; + +handle_cast(reload_config, LoopData) -> + {ok, RewriteActMod} = application:get_env(rewrite_act_mod), + RewriteActMod:reload_config(), {noreply, LoopData}. + terminate(_Reason, _LoopData) -> ok. @@ -75,10 +80,3 @@ terminate(_Reason, _LoopData) -> handle_info({sctp, Sock, Ip, Port, Data}, LoopData) -> NewL = sctp_handler:handle_sctp(LoopData, {sctp, Sock, Ip, Port, Data}), {noreply, NewL}. - - -% return rewrite_actor function reference -get_handle_fn(bow_onw) -> - fun mgw_nat_act_bow_onw:rewrite_actor/5; -get_handle_fn(vfuk_onw) -> - fun mgw_nat_act_vfuk_onw:rewrite_actor/5. diff --git a/src/sctp_handler.erl b/src/sctp_handler.erl index 0a8630c..2dce55c 100644 --- a/src/sctp_handler.erl +++ b/src/sctp_handler.erl @@ -36,13 +36,13 @@ {msc_sock, msc_local_ip, msc_remote_ip, msc_remote_port, msc_local_port, msc_assoc_id, stp_sock, stp_remote_ip, stp_remote_port, stp_assoc_id, - handle_fn + rewrite_act_mod }). -define(COMMON_SOCKOPTS, [{active, once}, {reuseaddr, true}]). % initialize the sockets towards MSC (listening) and STP (connect) -init(MscLocalIP, MscLocalPort, MscRemoteIP, StpRemoteIP, StpRemotePort, HandleFn) -> +init(MscLocalIP, MscLocalPort, MscRemoteIP, StpRemoteIP, StpRemotePort, RewriteActMod) -> {ok, MscSock} = gen_sctp:open([{ip, MscLocalIP},{port,MscLocalPort}] ++ ?COMMON_SOCKOPTS), io:format("Listening for MSC on ~w:~w. ~w~n", @@ -52,7 +52,7 @@ init(MscLocalIP, MscLocalPort, MscRemoteIP, StpRemoteIP, StpRemotePort, HandleFn L = #loop_data{msc_sock = MscSock, msc_local_ip = MscLocalIP, msc_remote_ip = MscRemoteIP, stp_sock = StpSock, stp_remote_ip = StpRemoteIP, - stp_remote_port = StpRemotePort, handle_fn = HandleFn}, + stp_remote_port = StpRemotePort, rewrite_act_mod = RewriteActMod}, {ok, L}. % initiate a connection to STP as a client @@ -63,7 +63,7 @@ initiate_stp_connection(#loop_data{stp_sock = Sock, stp_remote_ip = IP, stp_remo % main loop function handle_sctp(L = #loop_data{msc_sock=MscSock, msc_remote_ip=MscRemoteIp, msc_remote_port=MscRemotePort, stp_sock=StpSock, stp_remote_ip=StpRemoteIp, stp_remote_port=StpRemotePort, - handle_fn=HandleFn}, + rewrite_act_mod=RewriteActMod}, Sctp) -> io:format("Entering receive loop ~p~n", [L]), io:format("======================================================================~n"), @@ -104,13 +104,13 @@ handle_sctp(L = #loop_data{msc_sock=MscSock, msc_remote_ip=MscRemoteIp, msc_remo % MSC data {sctp, MscSock, MscRemoteIp, MscRemotePort, {[Anc], Data}} -> io:format("MSC rx data: ~p ~p~n", [Anc, Data]), - handle_rx_data(HandleFn, L, from_msc, Anc, Data), + handle_rx_data(RewriteActMod, L, from_msc, Anc, Data), inet:setopts(MscSock, [{active, once}]), NewL = L; % STP data {sctp, StpSock, StpRemoteIp, StpRemotePort, {[Anc], Data}} -> io:format("STP rx data: ~p ~p~n", [Anc, Data]), - handle_rx_data(HandleFn, L, from_stp, Anc, Data), + handle_rx_data(RewriteActMod, L, from_stp, Anc, Data), inet:setopts(StpSock, [{active, once}]), NewL = L; {sctp, _Sock, RemoteIp, _Remote_port, {_Anc, Data}} @@ -127,9 +127,9 @@ handle_sctp(L = #loop_data{msc_sock=MscSock, msc_remote_ip=MscRemoteIp, msc_remo % handle incoming data on one of the SCTP sockets -handle_rx_data(Fn, L, From, SRInf = #sctp_sndrcvinfo{ppid = 2, +handle_rx_data(Mod, L, From, SRInf = #sctp_sndrcvinfo{ppid = 2, stream = Stream}, Data) when is_binary(Data) -> - DataOut = Fn(sctp, From, [L, SRInf], 2, Data), + DataOut = Mod:rewrite_actor(sctp, From, [L, SRInf], 2, Data), % send mangled data to other peer case From of from_msc -> @@ -149,5 +149,5 @@ handle_rx_data(Fn, L, From, SRInf = #sctp_sndrcvinfo{ppid = 2, end, ok = gen_sctp:send(Sock, SndRcvInfo, DataOut); -handle_rx_data(_Fn, _L, From, SRInfo, Data) when is_binary(Data) -> +handle_rx_data(_Mod, _L, From, SRInfo, Data) when is_binary(Data) -> io:format("Unhandled Rx Data from SCTP from ~p: ~p, ~p~n", [From, SRInfo, Data]).