1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2010-2016. 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: A fun implementation of user callbacks
24%%----------------------------------------------------------------------
25
26-module(megaco_mess_otp8212_test).
27
28-behaviour(megaco_user).
29
30%% Megaco user callback exports
31-export([
32         handle_connect/2, handle_connect/3,
33         handle_disconnect/3,
34         %% handle_syntax_error/3,        handle_syntax_error/4,
35         %% handle_message_error/3,       handle_message_error/4,
36         handle_trans_request/3,       %% handle_trans_request/4,
37         %% handle_trans_long_request/3,  handle_trans_long_request/4,
38         %% handle_trans_reply/4,         handle_trans_reply/5,
39         %% handle_trans_ack/4,           handle_trans_ack/5,
40	 handle_unexpected_trans/3,    handle_unexpected_trans/4 %% ,
41         %% handle_trans_request_abort/4, handle_trans_request_abort/5,
42         %% handle_segment_reply/5,       handle_segment_reply/6
43        ]).
44
45%% Megaco encoder callback exports
46-export([
47	 encode_message/3,
48	 decode_message/3
49	]).
50
51%% Megaco transport callback exports
52-export([
53	 send_message/2
54	]).
55
56-include("megaco_test_lib.hrl").
57-include_lib("megaco/include/megaco.hrl").
58-include_lib("megaco/include/megaco_message_v1.hrl").
59
60
61%%----------------------------------------------------------------------
62%% Megaco user callback
63%%----------------------------------------------------------------------
64
65%% -- handle_connect/2 --
66
67handle_connect(_, _) ->
68    %% i("handle_connect -> entry"),
69    ok.
70
71handle_connect(_, _, otp8212_extra) ->
72    %% i("handle_connect -> entry"),
73    ok;
74handle_connect(_, _, {otp8212_extra, _}) ->
75    %% i("handle_connect -> entry"),
76    ok.
77
78handle_disconnect(Conn, _, {user_disconnect, {otp8212_done, Pid}}) ->
79    %% i("handle_disconnect -> entry"),
80    Pid ! {disconnected, Conn},
81    ok.
82
83handle_trans_request(_, _, _) -> %% incoming SC
84    %% i("handle_trans_request -> entry"),
85    {discard_ack, ["sc reply"]}.
86
87handle_unexpected_trans(_ConnHandle, _ProtocolVersion, _Trans) ->
88%%     i("handle_unexpected_trans -> entry with"
89%%       "~n   ConnHandle: ~p"
90%%       "~n   ProtocolVersion: ~p"
91%%       "~n   Trans: ~p", [ConnHandle, ProtocolVersion, Trans]),
92    ok.
93handle_unexpected_trans(_ConnHandle, _ProtocolVersion, _Trans, {otp8212_extra, Pid}) ->
94%%     i("handle_unexpected_trans -> entry with"
95%%       "~n   ConnHandle: ~p"
96%%       "~n   ProtocolVersion: ~p"
97%%       "~n   Trans: ~p", [ConnHandle, ProtocolVersion, Trans]),
98    Pid ! {handle_unexpected_trans, otp8212_extra},
99    ok.
100
101
102%%----------------------------------------------------------------------
103%% Megaco encoder callback
104%%----------------------------------------------------------------------
105
106
107%% Should only be encoding MGC's outgoing request, which we expect
108%% has transaction id = 1.
109
110-define(REQUEST(Id, A),
111        #'MegacoMessage'
112        {mess
113         = #'Message'
114           {version = 1,
115            mId = {deviceName,"MGC"},
116            messageBody
117            = {transactions, [{transactionRequest,
118                               #'TransactionRequest'{transactionId = Id,
119                                                     actions = A}}]}}}).
120
121-define(REPLY(A),
122        #'MegacoMessage'
123        {mess
124         = #'Message'
125           {version = 1,
126            mId = {deviceName,"MGC"},
127            messageBody
128            = {transactions,
129               [{transactionReply,
130                 #'TransactionReply'{transactionResult
131                                     = {actionReplies, [A]}}}]}}}).
132
133request() ->
134    list_to_binary("!/1 MGC T=1{C=-{SC=ROOT{SV{MT=RS,RE=\"901\"}}}}").
135
136sc_reply() ->
137    list_to_binary("!/1 MGC P=19731{C=-{SC=root}}").
138
139encode_message(_, _, ?REQUEST(1, "action request")) ->
140    %% i("encode_message -> entry with request"),
141    {ok,  request()};
142
143encode_message(_, _, ?REPLY("sc reply")) ->
144    %% i("encode_message -> entry with reply"),
145    {ok, sc_reply()}.
146
147decode_message(_, V248, Bin) ->
148    %% i("decode_message -> entry"),
149    megaco_compact_text_encoder:decode_message([], V248, Bin).
150
151
152%%----------------------------------------------------------------------
153%% Megaco transport callback
154%%----------------------------------------------------------------------
155
156%% Outgoing SC reply.
157%% send_message(otp8212_scr, _) ->
158%%     i("send_message(scr) -> entry"),
159%%     ok;
160
161%% Outgoing request: fake reception of the the reply.
162send_message({RH, ControlPid, _, WrongMidStr}, _) ->
163    %% i("send_message -> entry"),
164    spawn(fun() -> receive_reply(200, RH, ControlPid, WrongMidStr) end),
165    ok.
166
167receive_reply(After, RH, ControlPid, WrongMidStr) ->
168    timer:sleep(After),
169    %% i("receive_reply -> issue reply"),
170    megaco:process_received_message(RH, ControlPid,
171				    otp8212_sendhandle,
172				    reply(WrongMidStr),
173				    {otp8212_extra, ControlPid}).
174
175reply(WrongMidStr) ->  %% note "wrong" mid.
176    list_to_binary("!/1 " ++ WrongMidStr ++ " P=1{C=-{SC=root}}").
177
178%% i(F) ->
179%%     i(F, []).
180
181%% i(F, A) ->
182%%     io:format(F ++ "~n", A).
183