From eee3eac368e41ded214f6762170fe6528f753fb8 Mon Sep 17 00:00:00 2001 From: Harald Welte Date: Sat, 12 Mar 2011 10:34:33 +0100 Subject: [PATCH] [PATCH] ONW_VFUK / Camel Phase mangling: Add pcap-based testing And use the routines from osmo_ss7_pcap instead of our own local copy. --- ebin/mgw_nat.app | 2 +- src/mgw_nat_act_vfuk_onw.erl | 7 ++- src/mgw_nat_test.erl | 85 ----------------------------- test/mgw_nat_act_vfuk_onw_tests.erl | 19 ++++++- 4 files changed, 22 insertions(+), 91 deletions(-) delete mode 100644 src/mgw_nat_test.erl diff --git a/ebin/mgw_nat.app b/ebin/mgw_nat.app index b8babd3..cb15f6a 100644 --- a/ebin/mgw_nat.app +++ b/ebin/mgw_nat.app @@ -1,7 +1,7 @@ {application, mgw_nat, [{description, "Media Gateway NAT"}, {vsn, "1"}, - {modules, [mgw_nat_app, mgw_nat_sup, mgw_nat_usr, mgw_nat, mgw_nat_test, + {modules, [mgw_nat_app, mgw_nat_sup, mgw_nat_usr, mgw_nat, sccp_masq, map_masq, sctp_handler, mgw_nat_act_bow_onw, mgw_nat_act_vfuk_onw]}, {registered, [mgw_nat_app]}, diff --git a/src/mgw_nat_act_vfuk_onw.erl b/src/mgw_nat_act_vfuk_onw.erl index 8be7b3f..8f6cd39 100644 --- a/src/mgw_nat_act_vfuk_onw.erl +++ b/src/mgw_nat_act_vfuk_onw.erl @@ -34,7 +34,8 @@ rewrite_actor(sctp, From, Path, 2, DataBin) -> Val catch error:Error -> % some parser error, simply forward msg unmodified - io:format("MGW NAT mangling Error: ~p~n", [Error]), + error_logger:error_report([{error, Error}, + {stacktrace, erlang:get_stacktrace()}]), DataBin end; @@ -47,7 +48,7 @@ rewrite_actor(_Level, _From, _Path, _MsgType, Msg) -> Msg. -mangle_map_camel_phase(from_stp, Path, MapDec) -> +mangle_map_camel_phase(from_stp, _Path, MapDec) -> MapDec; mangle_map_camel_phase(from_msc, Path, MapDec) -> % Resolve the Global Title of the SCCP Called Addr @@ -55,7 +56,7 @@ mangle_map_camel_phase(from_msc, Path, MapDec) -> CalledAddr = proplists:get_value(called_party_addr, SccpPars), #global_title{phone_number = PhoneNum} = CalledAddr#sccp_addr.global_title, PhoneNumInt = osmo_util:digit_list2int(PhoneNum), - {ok, CamelPatchTbl} = application:get_env(camel_phase_patch_table), + {ok, CamelPatchTbl} = application:get_env(mgw_nat, camel_phase_patch_table), case lists:keyfind(PhoneNumInt, 1, CamelPatchTbl) of false -> MapDec; diff --git a/src/mgw_nat_test.erl b/src/mgw_nat_test.erl deleted file mode 100644 index f0c8680..0000000 --- a/src/mgw_nat_test.erl +++ /dev/null @@ -1,85 +0,0 @@ -% MGW Nat testing code - -% (C) 2011 by Harald Welte -% (C) 2011 OnWaves -% -% 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(mgw_nat_test). --author("Harald Welte "). --export([pcap_apply/3]). - --define(NODEBUG, 1). - --include_lib("eunit/include/eunit.hrl"). --include_lib("epcap/include/epcap_net.hrl"). - -pcap_apply(File, Filter, Args) -> - epcap:start([{file, File}, {filter, Filter}]), - loop(Args). - -loop(Args) -> - receive - [{pkthdr, {_,_,_,{datalink,Datalink}}}, {packet, Packet}] -> - Decaps = epcap_net:decapsulate_dlt(Datalink, Packet), - handle_pkt_cb(Decaps, Args), - loop(Args); - {epcap, eof} -> - ?debugFmt("EOF from PCAP~n", []), - epcap:stop(); - Default -> - ?debugFmt("Unknown ~p from PCAP~n", [Default]) - end. - - -handle_pkt_cb([Ether, IP, Hdr, Payload], Args) -> - ?debugFmt("~p:~n ~p/~p~n", [IP, Hdr, Payload]), - case Hdr of - #sctp{chunks = Chunks} -> - handle_sctp_chunks(Chunks, [Ether, IP, Hdr], Args); - _ -> - ok - end. - -handle_sctp_chunks([], _Path, _Args) -> - ok; -handle_sctp_chunks([Head|Tail], Path, Args) -> - RewriteFn = proplists:get_value(rewrite_fn, Args), - case Head of - #sctp_chunk{type = 0, payload=#sctp_chunk_data{ppi=2, data=Data}} -> - %mgw_nat:mangle_rx_data(l, from_stp, Data, fun handle_rewrite_cb/5); - put(rewrite_cb, RewriteFn), - shim_rw_actor(sctp, from_msc, Path, 2, Data); - _ -> - ok - end, - handle_sctp_chunks(Tail, Path, Args). - -% Rewrite at SCTP (root) level: -shim_rw_actor(sctp, From, Path, 2, DataBin) -> - ?debugFmt("sctp:~p:~p~n", [From, DataBin]), - mgw_nat:mangle_rx_data(From, Path, DataBin, fun shim_rw_actor/5); -shim_rw_actor(Proto, From, Path, MsgType, Msg) -> - ?debugFmt(" IN:~p:~p:~p~n", [Proto, From, Msg]), - Fn = get(rewrite_cb), - MsgOut = Fn(Proto, From, Path, MsgType, Msg), - case MsgOut of - Msg -> - MsgOut; - _ -> - %io:format("OUT:~p:~p:~p~n", [Proto, From, MsgOut]), - MsgOut - end. diff --git a/test/mgw_nat_act_vfuk_onw_tests.erl b/test/mgw_nat_act_vfuk_onw_tests.erl index 9724ea8..9ab88fc 100644 --- a/test/mgw_nat_act_vfuk_onw_tests.erl +++ b/test/mgw_nat_act_vfuk_onw_tests.erl @@ -57,7 +57,7 @@ asn1_NOVALUE}}}}]}}). setup() -> - application:set_env(undefined, camel_phase_patch_table, [ + application:set_env(mgw_nat, camel_phase_patch_table, [ % destination, phase-tuple-list { 443859078046778, [phase1] } ]). @@ -65,15 +65,30 @@ setup() -> teardown(_) -> application:unset_env(undefined, camel_phase_patch_table). +% Test the tuple walker and camelph_twalk_cb() directly, as we don't have a +% SCCP header in front of the MAP message and thus we cannot call +% mangle_map_camel_phase() directly camelphase_twalk() -> ?assertEqual(?MAP_DEC_OUT, osmo_util:tuple_walk(?MAP_DEC_IN, fun mgw_nat_act_vfuk_onw:camelph_twalk_cb/3, [[phase1]])). +test_pcap(File) -> + Args = [{rewrite_fn, fun mgw_nat_act_vfuk_onw:rewrite_actor/5}], + case file:read_file_info(File) of + {ok, _Info} -> + {ok, NrPkts} = ?debugTime("PCAP", osmo_ss7_pcap:pcap_apply(File, "", Args)), + ?debugFmt("Parsed ~p PCAP packets~n", [NrPkts]); + {error, _Reason} -> + ?debugFmt("Skipping PCAP based tests as no ~p could be found~n", + [File]) + end. + camel_phase_test_() -> {setup, fun setup/0, fun teardown/1, - [ ?_test(camelphase_twalk()) ] + [ ?_test(camelphase_twalk()), + ?_test(test_pcap("../priv/map.pcap")) ] }.