1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2007-2019. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%
22%%----------------------------------------------------------------------
23%% Purpose: This module takes the role of the main megaco module for
24%%          the transport module. It is used when  delivering
25%%          received messages. The purpose is to be able to do
26%%          various forms of filtering before passing the message
27%%          the the megaco stack (by calling the megaco module).
28%%          It can be controlled with the following flags:
29%%          allow_recv_message - Shall the received message be
30%%                               delivered.
31%%          extra_transport_info - Provide extra info from the transport
32%%                                 module.
33%%----------------------------------------------------------------------
34-module(megaco_test_deliver).
35
36
37%%----------------------------------------------------------------------
38%% Include files
39%%----------------------------------------------------------------------
40-include_lib("megaco/src/udp/megaco_udp.hrl").
41-include("megaco_test_lib.hrl").
42
43
44%%----------------------------------------------------------------------
45%% External exports
46%%----------------------------------------------------------------------
47-export([
48	 process_received_message/4, process_received_message/5,
49	 receive_message/4, receive_message/5
50	]).
51
52
53
54%%======================================================================
55%% External functions
56%%======================================================================
57
58process_received_message(ReceiveHandle, ControlPid, SendHandle, BinMsg) ->
59    i("process_received_message -> entry with"
60      "~n   ReceiveHandle: ~p"
61      "~n   ControlPid:    ~p"
62      "~n   SendHandle:    ~p",
63      [ReceiveHandle, ControlPid, SendHandle]),
64    case allow_recv_message() of
65	true ->
66	    i("process_received_message -> allowed recv msg"),
67	    case extra_transport_info() of
68		{value, Extra} ->
69		    i("process_received_message -> extra_transport_info: "
70		      "~n   Extra: ~p", [Extra]),
71		    megaco:process_received_message(ReceiveHandle, ControlPid,
72						    SendHandle, BinMsg,
73						    Extra);
74		_ ->
75		    i("process_received_message -> no extra_transport_info"),
76		    megaco:process_received_message(ReceiveHandle, ControlPid,
77						    SendHandle, BinMsg)
78	    end;
79	false ->
80	    i("process_received_message -> recv msg not allowed"),
81	    ok;
82	{false, Reason} ->
83	    i("process_received_message -> recv msg not allowed"
84	      "~n   Reason: ~p", [Reason]),
85	    exit(Reason)
86    end.
87
88
89process_received_message(ReceiveHandle, ControlPid, SendHandle, BinMsg, Extra) ->
90    i("process_received_message -> entry with"
91      "~n   ReceiveHandle: ~p"
92      "~n   ControlPid:    ~p"
93      "~n   SendHandle:    ~p"
94      "~n   Extra:         ~p",
95      [ReceiveHandle, ControlPid, SendHandle, Extra]),
96    case allow_recv_message() of
97	true ->
98	    i("process_received_message -> allowed recv msg"),
99	    megaco:process_received_message(ReceiveHandle, ControlPid,
100					    SendHandle, BinMsg,
101					    Extra);
102	false ->
103	    i("process_received_message -> recv msg not allowed"),
104	    ok;
105	{false, Reason} ->
106	    i("process_received_message -> recv msg not allowed"
107	      "~n   Reason: ~p", [Reason]),
108	    exit(Reason)
109    end.
110
111receive_message(ReceiveHandle, ControlPid, SendHandle, BinMsg) ->
112    i("receive_message -> entry with"
113      "~n   ReceiveHandle: ~p"
114      "~n   ControlPid:    ~p"
115      "~n   SendHandle:    ~p",
116      [ReceiveHandle, ControlPid, SendHandle]),
117    case allow_recv_message() of
118	true ->
119	    i("receive_message -> allowed recv msg"),
120	    case extra_transport_info() of
121		{value, Extra} ->
122		    i("receive_message -> extra_transport_info: "
123		      "~n   Extra: ~p", [Extra]),
124		    megaco:receive_message(ReceiveHandle, ControlPid,
125					   SendHandle, BinMsg, Extra);
126		_ ->
127		    i("receive_message -> no extra_transport_info"),
128		    megaco:receive_message(ReceiveHandle, ControlPid,
129					   SendHandle, BinMsg)
130	    end;
131	false ->
132	    i("receive_message -> recv msg not allowed"),
133	    ok;
134	{false, Reason} ->
135	    i("receive_message -> recv msg not allowed"
136	      "~n   Reason: ~p", [Reason]),
137	    exit(Reason)
138    end.
139
140receive_message(ReceiveHandle, ControlPid, SendHandle, BinMsg, Extra) ->
141    i("receive_message -> entry with"
142      "~n   ReceiveHandle: ~p"
143      "~n   ControlPid:    ~p"
144      "~n   SendHandle:    ~p"
145      "~n   Extra:         ~p",
146      [ReceiveHandle, ControlPid, SendHandle, Extra]),
147    case allow_recv_message() of
148	true ->
149	    i("receive_message -> allowed recv msg"),
150	    megaco:receive_message(ReceiveHandle, ControlPid,
151				   SendHandle, BinMsg,
152				   Extra);
153	false ->
154	    i("receive_message -> recv msg not allowed"),
155	    ok;
156	{false, Reason} ->
157	    i("receive_message -> recv msg not allowed"
158	      "~n   Reason: ~p", [Reason]),
159	    exit(Reason)
160    end.
161
162
163%%======================================================================
164%% Internal functions
165%%======================================================================
166
167allow_recv_message() ->
168    case megaco_tc_controller:lookup(allow_recv_message) of
169	{error, _} ->
170	    true;
171	{value, Else} ->
172	    Else;
173	false ->
174	    true
175    end.
176
177extra_transport_info() ->
178    case megaco_tc_controller:lookup(extra_transport_info) of
179	{error, _} ->
180	    false;
181	Else ->
182	    Else
183    end.
184
185i(F) ->
186    i(F, []).
187
188i(F, A) ->
189    io:format("*** [~s] ~p ~w:" ++ F ++ "~n", [?FTS(), self(), ?MODULE | A]).
190