megacosessiontcp_impl.erl

一个Megaco实现源代码

%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved via the world wide web at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%%
%%     $Id$
%%
%%----------------------------------------------------------------------
%% Purpose: Send and process a (sequence of) Megaco/H.248 transactions
%%----------------------------------------------------------------------

-module('MegacoSessionTcp_impl').

%% Application internal export
-export([
         init/1,
         handle_info/2,
         terminate/2,
         code_change/3
        ]).

%% Module internal export
-export([
         listen/5,
         connect/5,
         close/4,
         block/4,
         unblock/4
        ]).


-include_lib("megaco/include/megaco.hrl").
-include_lib("megaco_session/include/Megaco.hrl").
-include_lib("megaco_session/include/MegacoSessionIp.hrl").
-include_lib("megaco_session/include/MegacoSessionTcp.hrl").


-record(state,{sup}).

%% Defines:
-define(EXT(Fun, Value), megaco_session_externalizer:Fun(Value, undefined)).
-define(INT(Fun, Value), megaco_session_internalizer:Fun(Value, undefined)).

-define(d(F,A),dbg(F,A)).


%%----------------------------------------------------------
%% Gen server API
%%----------------------------------------------------------

init(_Env) ->
    put(debug, get_debug()),
    ?d("init -> start transport", []),
    case megaco_tcp:start_transport() of
	{ok, SupPid} ->
	    ?d("init -> transport started: ~p",[SupPid]),
	    {ok,#state{sup = SupPid}};
	{error, Reason} ->
	    ?d("init -> transport start failed: ~w",Reason),
	    {stop,{start_transport_failed,Reason}};
	Else ->
	    ?d("init -> Else: ~w",Else),
	    {stop,{unexpected_response_from_start_transport,Else}}
    end.

handle_info(Info, State) ->    
    ?d("handle_info -> entry with"
      "~n   Info: ~p",[Info]),
    {noreply,State}.


terminate(Reason, State) ->
    ?d("terminate -> entry with"
      "~n   Reason: ~p",[Reason]),
    ok.


code_change({down,Vsn}, State, Extra) ->
    {ok,State};
code_change(Vsn,State,Extra) ->
    {ok,State}.


%%----------------------------------------------------------
%% App API
%%----------------------------------------------------------

%% MGC calls this:
listen(State, RequestRef, ReplyTo, ReceiveHandle, Options) when pid(ReplyTo) ->
    ?d("listen -> entry with"
      "~n   RequestRef:    ~w"
      "~n   ReplyTo:       ~w"
      "~n   ReceiveHandle: ~w"
      "~n   Options:       ~w",[RequestRef, ReplyTo, ReceiveHandle, Options]),
    listen_response(ReplyTo, RequestRef, 
		    (catch do_listen(State,ReceiveHandle,Options))),
    {noreply,State}.

do_listen(State,ReceiveHandle,Options) ->
    Options2 = ?INT(tr_IpOptions, Options),
    RH       = ?INT(tr_receive_handle, ReceiveHandle),
    ?d("do_listen -> RH: ~w", [RH]),
    RH2      = RH#megaco_receive_handle{send_mod = megaco_tcp},
    ?d("do_listen -> RH2: ~w", [RH2]),
    Sup      = State#state.sup,
    case megaco_tcp:listen(Sup,[{receive_handle, RH2}|Options2]) of
	ok ->
	    ok;
	Error ->
	    ?d("do_listen -> Error: ~w", [Error]),
	    Error
    end;
do_listen(_State, Error, _Options) ->
    Error.

%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

%% MG calls this:
connect(State, RequestRef, ReplyTo, ReceiveHandle, Options) 
  when pid(ReplyTo) ->
    ?d("connect -> entry with"
      "~n   RequestRef:    ~w"
      "~n   ReplyTo:       ~w"
      "~n   ReceiveHandle: ~w"
      "~n   Options:       ~w",[RequestRef, ReplyTo, ReceiveHandle, Options]),
    case (catch do_connect(State, ReceiveHandle, Options)) of
	{ok, SendHandle, CtrlPid} ->
	    ?d("connect -> performed:"
	      "~n   SendHandle: ~w"
	      "~n   CtrlPid:    ~w",[SendHandle, CtrlPid]),
	    connect_response(ReplyTo, RequestRef, ok, SendHandle, CtrlPid);

	Error ->
	    connect_response(ReplyTo, RequestRef, Error)

    end,
    {noreply,State}.


do_connect(State, RH0, Opts0) ->
    Opts1 = ?INT(tr_IpOptions, Opts0),
    RH1   = ?INT(tr_receive_handle, RH0),
    RH2   = RH1#megaco_receive_handle{send_mod = megaco_tcp},
    Sup   = State#state.sup,
    ?d("do_connect -> call megaco_tcp:connect with"
	"~n   RH2:   ~w"
	"~n   Opts1: ~w",[RH2, Opts1]),
    case megaco_tcp:connect(Sup,[{receive_handle, RH2}| Opts1]) of
	{ok, SendHandle, CtrlPid} ->
	    {ok, ?EXT(tr_send_handle, SendHandle), CtrlPid};
	Error ->
	    Error
    end.

    
%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 


close(State, RequestRef, ReplyTo, SendHandleBin) 
  when pid(ReplyTo), binary(SendHandleBin) ->
    SendHandle = binary_to_term(SendHandleBin),    
    megaco_tcp:close(SendHandle),
    close_response(ReplyTo, RequestRef),
    {noreply,State}.


%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

block(State, RequestRef, ReplyTo, SendHandleBin) 
  when pid(ReplyTo), binary(SendHandleBin) ->
    SendHandle = binary_to_term(SendHandleBin),    
    megaco_tcp:block(SendHandle),
    block_response(ReplyTo, RequestRef),
    {noreply,State}.


%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

unblock(State, RequestRef, ReplyTo, SendHandleBin) 
  when pid(ReplyTo), binary(SendHandleBin) ->
    SendHandle = binary_to_term(SendHandleBin),    
    megaco_tcp:unblock(SendHandle),
    unblock_response(ReplyTo, RequestRef),
    {noreply,State}.

%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
%% Internal callback wrappers
%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

listen_response(ReplyTo, RequestRef, ok) ->
    Status = ?EXT(tr_Status, ok),
    listen_response1(ReplyTo, RequestRef, Status);
listen_response(ReplyTo, RequestRef, {'EXIT',Reason}) ->
    ErrorString = 
	lists:flatten(
	  io_lib:format("Exit while handling listen request: ~p",[Reason])),
    Status = ?EXT(tr_Status, {errorString,ErrorString}),
    listen_response1(RequestRef,id,Status);
listen_response(ReplyTo, RequestRef, {error,Reason}) ->
    ErrorString = 
	lists:flatten(
	  io_lib:format("Error while handling listen request: ~p",[Reason])),
    Status = ?EXT(tr_Status, {errorString,ErrorString}),
    listen_response1(ReplyTo, RequestRef, Status).
    
listen_response1(ReplyTo, RequestRef, Status) ->
    'MegacoSessionTcpUser':listenResponse(ReplyTo, RequestRef, Status).


connect_response(ReplyTo, RequestRef, {'EXIT', Reason}) ->
    error("connect failed (exit): ~p",[Reason]),
    connect_response1(ReplyTo, RequestRef, Reason, 
		      "Exit while handling connect request");
connect_response(ReplyTo, RequestRef, {error, Reason}) ->
    error("connect failed (error): ~p",[Reason]),
    connect_response1(ReplyTo, RequestRef, Reason, 
		      "Error while handling connect request").

connect_response1(ReplyTo, RequestRef, Reason, Str) ->
    ErrorString  = lists:flatten(io_lib:format("~s: ~p",[Str, Reason])),
    DummyHandle  = term_to_binary([]),
    DummyCtrlPid = ReplyTo,
    connect_response(ReplyTo, RequestRef, {errorString, ErrorString}, 
		     DummyHandle, DummyCtrlPid).

connect_response(ReplyTo, RequestRef, Status0, H, C) ->
    Status = ?EXT(tr_Status, Status0),
    'MegacoSessionTcpUser':connectResponse(ReplyTo, RequestRef, Status, H, C).


close_response(ReplyTo, RequestRef) ->
    'MegacoSessionTcpUser':closeResponse(ReplyTo, RequestRef,  ?EXT(tr_Status, ok)).

block_response(ReplyTo, RequestRef) ->
    'MegacoSessionTcpUser':blockResponse(ReplyTo, RequestRef, ?EXT(tr_Status, ok)).

unblock_response(ReplyTo, RequestRef) ->
    'MegacoSessionTcpUser':unblockResponse(ReplyTo, RequestRef, ?EXT(tr_Status, ok)).

%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

error(F,A) -> io:format("ERROR: " ++ F ++ "~n",A).

get_debug() ->
    app_get_env(tcp_debug, false).

app_get_env(Key, Default) ->
    case application:get_env(megaco_session, Key) of
	{ok, Value} ->
	    Value;
	_ ->
	    Default
    end.


dbg(F, A) ->
    dbg(get(debug), F, A).

dbg(true, F, A) ->
    io:format("MSTI-DBG:~w: " ++ F ++ "~n", [self()|A]);
dbg(_, _, _) ->
    ok.