1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2005-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 : Handle ASN.1 BER encoding of Megaco/H.248
24%%----------------------------------------------------------------------
25
26-module(megaco_binary_encoder_lib).
27
28%% API
29-export([
30	 version_of/4,
31	 decode_message/5, decode_message_dynamic/4,
32	 decode_mini_message/4, decode_mini_message_dynamic/4,
33	 encode_message/5,
34	 encode_transaction/5,
35	 encode_action_requests/5,
36	 encode_action_request/5,
37	 encode_action_reply/5
38	]).
39
40-include_lib("megaco/src/engine/megaco_message_internal.hrl").
41
42
43%%----------------------------------------------------------------------
44%% Detect (check) which version a message is
45%% Return {ok, Version} | {error, Reason}
46%%----------------------------------------------------------------------
47
48version_of(_EC, Binary, dynamic, [AsnModV1|_AsnMods])
49  when is_binary(Binary) andalso is_atom(AsnModV1) ->
50    case (catch AsnModV1:decode_message_version(Binary)) of
51	{ok, PartialMsg} ->
52	    V = (PartialMsg#'MegacoMessage'.mess)#'Message'.version,
53	    {ok, V};
54	Error ->
55	    Error
56    end;
57version_of(_EC, Binary, 1, AsnMods)
58  when is_binary(Binary) andalso is_list(AsnMods) ->
59    version_of(AsnMods, Binary, []);
60version_of(_EC, Binary, 2, [AsnModV1, AsnModV2, AsnModV3])
61  when is_binary(Binary) ->
62    version_of([AsnModV2, AsnModV1, AsnModV3], Binary, []);
63version_of(_EC, Binary, 3, [AsnModV1, AsnModV2, AsnModV3])
64  when is_binary(Binary) ->
65    version_of([AsnModV3, AsnModV1, AsnModV2], Binary, []).
66
67version_of([], _Binary, Err) ->
68    {error, {decode_failed, lists:reverse(Err)}};
69version_of([AsnMod|AsnMods], Binary, Errs) when is_atom(AsnMod) ->
70    case (catch AsnMod:decode('MegacoMessage', Binary)) of
71	{ok, M} ->
72	    V = (M#'MegacoMessage'.mess)#'Message'.version,
73	    {ok, V};
74	Err ->
75	    version_of(AsnMods, Binary, [Err|Errs])
76    end.
77
78
79%%----------------------------------------------------------------------
80%% Convert a 'MegacoMessage' record into a binary
81%% Return {ok, Binary} | {error, Reason}
82%%----------------------------------------------------------------------
83
84encode_message([native], MegaMsg, AsnMod, _TransMod, binary)
85  when is_record(MegaMsg, 'MegacoMessage') ->
86    AsnMod:encode('MegacoMessage', MegaMsg);
87encode_message(EC, MegaMsg, AsnMod, TransMod, binary)
88  when is_list(EC) andalso is_record(MegaMsg, 'MegacoMessage') ->
89    case (catch TransMod:tr_message(MegaMsg, encode, EC)) of
90	{'EXIT', Reason} ->
91	    {error, Reason};
92	MegaMsg2 ->
93	    AsnMod:encode('MegacoMessage', MegaMsg2)
94    end;
95encode_message(EC, MegaMsg, AsnMod, TransMod, io_list) ->
96    case encode_message(EC, MegaMsg, AsnMod, TransMod, binary) of
97	{ok, Bin} when is_binary(Bin) ->
98	    {ok, Bin};
99	{ok, DeepIoList} ->
100	    Bin = erlang:list_to_binary(DeepIoList),
101	    {ok, Bin};
102	{error, Reason} ->
103	    {error, Reason}
104    end;
105encode_message(EC, MegaMsg, _AsnMod, _TransMod, _Type)
106  when is_record(MegaMsg, 'MegacoMessage')  ->
107    {error, {bad_encoding_config, EC}};
108encode_message(_EC, MegaMsg, _AsnMod, _TransMod, _Type) ->
109    {error, {no_megaco_message, MegaMsg}}.
110
111
112%%----------------------------------------------------------------------
113%% Convert a transaction (or transactions in the case of ack) record(s)
114%% into a binary
115%% Return {ok, Binary} | {error, Reason}
116%%----------------------------------------------------------------------
117
118%% Should handle encoding of all types of transactions:
119%% TransactionAck, TransactionPending, TransactionRequest
120%% and TransactionReply
121encode_transaction(EC, {Tag, _} = Trans, AsnMod, TransMod, Type)
122  when (Tag == transactionResponseAck) ->
123    do_encode_transaction(EC, Trans, AsnMod, TransMod, Type);
124encode_transaction(EC, {Tag, _} = Trans, AsnMod, TransMod, Type)
125  when (Tag == transactionPending) ->
126    do_encode_transaction(EC, Trans, AsnMod, TransMod, Type);
127encode_transaction(EC, {Tag, _} = Trans, AsnMod, TransMod, Type)
128  when (Tag == transactionRequest) ->
129    do_encode_transaction(EC, Trans, AsnMod, TransMod, Type);
130%% TransactionReply has been changed as of v3 so we cannot use
131%% the record definition in this common module.
132encode_transaction(EC, {Tag, _} = Trans, AsnMod, TransMod, Type)
133  when (Tag == transactionReply) ->
134    do_encode_transaction(EC, Trans, AsnMod, TransMod, Type);
135encode_transaction(_EC, T, _AsnMod, _TransMod, _Type) ->
136    {error, {no_megaco_transaction, T}}.
137
138-spec do_encode_transaction(EC :: list(),
139			    Trans :: tuple(),
140			    AnsMod :: atom(),
141			    TransMod :: atom(),
142			    Type :: atom()) ->
143    {'ok', binary()} | {'error', any()}.
144-dialyzer({nowarn_function, do_encode_transaction/5}). % Future compat
145do_encode_transaction([native], _Trans, _AsnMod, _TransMod, binary) ->
146    %% asn1rt:encode(AsnMod, element(1, T), T);
147    {error, not_implemented};
148do_encode_transaction(EC, _Trans, _AsnMod, _TransMod, binary)
149  when is_list(EC) ->
150    %% T2 = TransMod:tr_transaction(Trans, encode, EC),
151    %% asn1rt:encode(AsnMod, element(1, T), T2);
152    {error, not_implemented};
153do_encode_transaction(EC, Trans, AsnMod, TransMod, io_list) ->
154    case do_encode_transaction(EC, Trans, AsnMod, TransMod, binary) of
155	{ok, Bin} when is_binary(Bin) ->
156	    {ok, Bin};
157	{ok, DeepIoList} ->
158	    Bin = erlang:list_to_binary(DeepIoList),
159	    {ok, Bin};
160	{error, Reason} ->
161	    {error, Reason}
162    end;
163do_encode_transaction(EC, _Trans, _AsnMod, _TransMod, _Type) ->
164    {error, {bad_encoding_config, EC}}.
165
166
167%%----------------------------------------------------------------------
168%% Convert a list of ActionRequest record's into a binary
169%% Return {ok, DeepIoList} | {error, Reason}
170%%----------------------------------------------------------------------
171-spec encode_action_requests(EC :: list(),
172			     ARs :: list(),
173			     AnsMod :: atom(),
174			     TransMod :: atom(),
175			     Type :: atom()) ->
176    {'ok', binary()} | {'error', any()}.
177-dialyzer({nowarn_function, encode_action_requests/5}). % Future compat
178encode_action_requests([native], _ARs, _AsnMod, _TransMod, binary) ->
179    %% asn1rt:encode(AsnMod, element(1, T), T);
180    {error, not_implemented};
181encode_action_requests(_EC, _ARs0, _AsnMod, _TransMod, binary) ->
182    {error, not_implemented};
183encode_action_requests(EC, ARs, AsnMod, TransMod, io_list) ->
184    case encode_action_requests(EC, ARs, AsnMod, TransMod, binary) of
185	{ok, Bin} when is_binary(Bin) ->
186	    {ok, Bin};
187	{ok, DeepIoList} ->
188	    Bin = erlang:list_to_binary(DeepIoList),
189	    {ok, Bin};
190	{error, Reason} ->
191	    {error, Reason}
192    end;
193encode_action_requests(EC, _ARs, _AsnMod, _TransMod, _Type) ->
194    {error, {bad_encoding_config, EC}}.
195
196
197%%----------------------------------------------------------------------
198%% Convert a ActionRequest record into a binary
199%% Return {ok, DeepIoList} | {error, Reason}
200%%----------------------------------------------------------------------
201
202-spec encode_action_request(EC :: list(),
203			    AR :: tuple(),
204			    AnsMod :: atom(),
205			    TransMod :: atom(),
206			    Type :: atom()) ->
207    {'ok', binary()} | {'error', any()}.
208-dialyzer({nowarn_function, encode_action_request/5}). % Future compat
209encode_action_request([native], _AR, _AsnMod, _TransMod, binary) ->
210    %% asn1rt:encode(AsnMod, element(1, T), T);
211    {error, not_implemented};
212encode_action_request(_EC, _AR, _AsnMod, _TransMod, binary) ->
213    {error, not_implemented};
214encode_action_request(EC, AR, AsnMod, TransMod, io_list) ->
215    case encode_action_request(EC, AR, AsnMod, TransMod, binary) of
216	{ok, Bin} when is_binary(Bin) ->
217	    {ok, Bin};
218	{ok, DeepIoList} ->
219	    Bin = erlang:list_to_binary(DeepIoList),
220	    {ok, Bin};
221	{error, Reason} ->
222	    {error, Reason}
223    end;
224encode_action_request(EC, _AR, _AsnMod, _TransMod, _Type) ->
225    {error, {bad_encoding_config, EC}}.
226
227
228%%----------------------------------------------------------------------
229%% Convert a ActionReply record into a binary
230%% Return {ok, DeepIoList} | {error, Reason}
231%%----------------------------------------------------------------------
232
233-dialyzer({nowarn_function, encode_action_reply/5}). % Future compat
234encode_action_reply([native], _ARs, _AsnMod, _TransMod, binary) ->
235    %% asn1rt:encode(AsnMod, element(1, T), T);
236    {error, not_implemented};
237encode_action_reply(_EC, _ARs0, _AsnMod, _TransMod, binary) ->
238    {error, not_implemented};
239encode_action_reply(EC, ARs, AsnMod, TransMod, io_list) ->
240    case encode_action_reply(EC, ARs, AsnMod, TransMod, binary) of
241	{ok, Bin} when is_binary(Bin) ->
242	    {ok, Bin};
243	{ok, DeepIoList} ->
244	    Bin = erlang:list_to_binary(DeepIoList),
245	    {ok, Bin};
246	{error, Reason} ->
247	    {error, Reason}
248    end;
249encode_action_reply(EC, _ARs, _AsnMod, _TransMod, _Type) ->
250    {error, {bad_encoding_config, EC}}.
251
252
253%%----------------------------------------------------------------------
254%% Convert a binary into a 'MegacoMessage' record
255%% Return {ok, MegacoMessageRecord} | {error, Reason}
256%%----------------------------------------------------------------------
257
258decode_message_dynamic(EC, Bin,
259		       [{AsnModV1, TransModV1},
260			{AsnModV2, TransModV2},
261			{AsnModV3, TransModV3}], Form)
262  when is_list(EC) andalso is_binary(Bin) ->
263    case AsnModV1:decode_message_version(Bin) of
264	{ok, PartialMsg} ->
265	    V = (PartialMsg#'MegacoMessage'.mess)#'Message'.version,
266	    case V of
267		1 ->
268		    decode_message(EC, Bin, AsnModV1, TransModV1, Form);
269		2 ->
270		    decode_message(EC, Bin, AsnModV2, TransModV2, Form);
271		3 ->
272		    decode_message(EC, Bin, AsnModV3, TransModV3, Form)
273	    end;
274	{error, Reason} ->
275	    {error, Reason}
276    end;
277decode_message_dynamic(EC, Bin, _Mods, _Type)
278  when is_binary(Bin) ->
279    {error, {bad_encoding_config, EC}};
280decode_message_dynamic(_EC, _BadBin, _Mods, _Type) ->
281    {error, no_binary}.
282
283
284decode_message(EC, Bin, AsnMod, TransMod, _) ->
285    case AsnMod:decode('MegacoMessage', Bin) of
286	{ok, MegaMsg} ->
287	    case EC of
288		[native] ->
289		    {ok, MegaMsg};
290		_ ->
291		    {ok, TransMod:tr_message(MegaMsg, decode, EC)}
292	    end;
293	{error, Reason} ->
294	    {error, Reason}
295    end.
296
297
298%%----------------------------------------------------------------------
299%% Convert a binary into a partial 'MegacoMessage' record
300%% I.e. only version and Mid is fully decoded.
301%% Return {ok, MegacoMessageRecord} | {error, Reason}
302%%----------------------------------------------------------------------
303
304decode_mini_message(_, Bin, Mod, _) ->
305    case (catch Mod:decode_message_mId(Bin)) of
306	{ok, #'MegacoMessage'{mess = Mess} = MegaMsg} ->
307	    Mess2 = Mess#'Message'{messageBody = undefined},
308	    {ok, MegaMsg#'MegacoMessage'{mess = Mess2}};
309	Error ->
310	    Error
311    end.
312
313
314decode_mini_message_dynamic(EC, Bin, [Mod1, Mod2, Mod3], Form) ->
315    case Mod1:decode_message_version(Bin) of
316	{ok, PartialMsg} ->
317	    V = (PartialMsg#'MegacoMessage'.mess)#'Message'.version,
318	    case V of
319		1 ->
320		    decode_mini_message(EC, Bin, Mod1, Form);
321		2 ->
322		    decode_mini_message(EC, Bin, Mod2, Form);
323		3 ->
324		    decode_mini_message(EC, Bin, Mod3, Form)
325	    end;
326	Error ->
327	    Error
328    end.
329
330