ssl_broker.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,206 行 · 第 1/3 页

			       St#st.proxyport, AOpts, Timeout),
	    debug(St, "ssl_accept_prim: connect_proxy ~w~n", [B]),
	    case B of
		{ok, Socket2} ->
		    StOpts = add_default_tcp_accept_opts(AOpts) ++
			add_default_ssl_opts(SSLOpts),
		    NSt = St#st{opts = StOpts,
				proxysock = Socket2,
				encrypted = true,
				status = open},
		    case get_nodelay(AOpts) of
			true -> setnodelay(ServerName, NSt, true);
			_ -> ok
		    end,
		    debug(St, "transport_accept: ok: client = ~w, fd = ~w~n",
			  [Client, Fd]),
		    {ok, St#st.thissock, NSt};
		{error, Reason} ->
		    {error, Reason, St}
	    end;
	{'EXIT', Reason} ->
	    {error, Reason, St};
	{error, Reason} ->
	    {error, Reason, St}
    end.


%%
%% LOCAL FUNCTIONS
%%

%% 
%% connect_proxy(Fd, ProxyPort, TOpts, Timeout) -> {ok, Socket} | 
%%						   {error, Reason}
%%
connect_proxy(ServerName, TcpModule, Fd, ProxyPort, TOpts, Timeout) ->
    case TcpModule:connect({127, 0, 0, 1}, ProxyPort, TOpts, Timeout) of
	{ok, Socket} ->
	    {ok, Port} = inet:port(Socket),
	    A = ssl_server:proxy_join_prim(ServerName, Fd, Port),
	    case A of
		ok ->
		    {ok, Socket};
		Error ->
		    Error
	    end;
	Error ->
	    Error
    end.


setnodelay(ServerName, St, Bool) ->
    case ssl_server:setnodelay_prim(ServerName, St#st.fd, Bool) of
	ok ->
	    case inet:setopts(St#st.proxysock, [{nodelay, Bool}]) of
		ok ->
		    ok;
		{error, Reason} ->
		    {error, Reason}
	    end;
	{error, Reason} ->
	    {error, Reason}
    end.

%%
%% start_collector()
%%
%% A collector is a little process that keeps messages during change of
%% controlling process. 
%% XXX This is not gen_server compliant :-(.
%%
start_collector() ->
    Pid = spawn_link(?MODULE, collector_init, [self()]),
    {ok, Pid}.

%%
%% release_collector(Collector, NewOwner)
%%
release_collector(Collector, NewOwner) ->
    Collector ! {release, self(), NewOwner},
    receive
	%% Reap collector
	{'EXIT', Collector, normal} ->
	    ok
    end.

%%
%% collector_init(Broker) -> void()
%%
collector_init(Broker) ->
    receive
	{release, Broker, NewOwner} ->
	    transfer_messages(Broker, NewOwner)
    end.

%% 
%% transfer_messages(Pid, NewOwner) -> void()
%%
transfer_messages(Pid, NewOwner) ->    
    receive
	{ssl, Sock, Data} ->
	    NewOwner ! {ssl, Sock, Data},
	    transfer_messages(Pid, NewOwner);
	{ssl_closed, Sock} ->
	    NewOwner ! {ssl_closed, Sock},
	    transfer_messages(Pid, NewOwner);
	{ssl_error, Sock, Reason} ->
	    NewOwner ! {ssl_error, Sock, Reason},
	    transfer_messages(Pid, NewOwner)
    after 0 ->
	    ok
    end.

%%
%% debug(St, Format, Args) -> void() - printouts
%%
debug(St, Format, Args) ->
    debug1(St#st.debug, St#st.brokertype, Format, Args).

debug1(true, Type, Format0, Args) ->
    {_MS, S, MiS} = erlang:now(),
    Secs = S rem 100, 
    MiSecs = MiS div 1000,
    Format = "++++ ~3..0w:~3..0w ssl_broker (~w)[~w]: " ++ Format0, 
    io:format(Format, [Secs, MiSecs, self(), Type| Args]);
debug1(_, _, _, _) ->
    ok.

%%
%% what(Reason) -> What
%% 
what(Reason) when is_atom(Reason) ->
    Reason;
what({'EXIT', Reason}) ->
    what(Reason);
what({What, _Where}) when is_atom(What) ->
    What;
what(Reason) ->
    Reason.


%%
%% OPTIONS
%%
%% Note that `accept' has no options when invoked, but get all its options
%% by inheritance from `listen'. 
%%

are_opt_tags(listener, OptTags) ->
    is_subset(OptTags, listen_opt_tags());
are_opt_tags(acceptor, OptTags) ->
    is_subset(OptTags, accept_opt_tags());
are_opt_tags(connector, OptTags) ->
    is_subset(OptTags, connect_opt_tags()).

listen_opt_tags() ->				
    tcp_listen_opt_tags() ++ ssl_opt_tags().

accept_opt_tags() ->
    tcp_gen_opt_tags().

connect_opt_tags() ->
    tcp_gen_opt_tags() ++ ssl_opt_tags().

tcp_listen_opt_tags() ->				
    tcp_gen_opt_tags() ++ tcp_listen_only_opt_tags().

tcp_gen_opt_tags() ->
    %% All except `reuseaddr' and `deliver'.	
    [nodelay, active, packet, mode, header].	

tcp_listen_only_opt_tags() ->
    [ip, backlog].

ssl_opt_tags() ->
    %% XXX Should remove cachetimeout.
    [verify, depth, certfile, password, cacertfile, ciphers, cachetimeout].

%% Options

%%
%% are_*_opts(Opts) -> true | false
%%
are_connect_opts(Opts) ->
    are_opts(fun is_connect_opt/1, Opts).

are_listen_opts(Opts) ->
    are_opts(fun is_listen_opt/1, Opts).

are_opts(F, Opts) ->
    lists:all(F, transform_opts(Opts)).

%%
%% get_*_opts(Opts) -> Value
%%
get_tcp_accept_opts(Opts) ->
    lists:filter(fun is_tcp_accept_opt/1, transform_opts(Opts)).

get_tcp_connect_opts(Opts) ->
    lists:filter(fun is_tcp_connect_opt/1, transform_opts(Opts)).

get_tcp_listen_opts(Opts) ->
    lists:filter(fun is_tcp_listen_opt/1, transform_opts(Opts)).

get_ssl_opts(Opts) ->
    lists:filter(fun is_ssl_opt/1, transform_opts(Opts)).

get_active(Opts) ->
    get_tagged_opt(active, Opts, true).

get_backlog(Opts) ->
    get_tagged_opt(backlog, Opts, ?DEF_BACKLOG).

get_ip(Opts) ->
    get_tagged_opt(ip, Opts, {0, 0, 0, 0}).

get_port(Opts) ->
    get_tagged_opt(port, Opts, 0).

get_nodelay(Opts) ->
    get_tagged_opt(nodelay, Opts, empty).

%%
%% add_default_*_opts(Opts) -> NOpts
%%

add_default_tcp_accept_opts(Opts) ->
    add_default_opts(Opts, default_tcp_accept_opts()).

add_default_tcp_connect_opts(Opts) ->
    add_default_opts(Opts, default_tcp_connect_opts()).

add_default_tcp_listen_opts(Opts) ->
    add_default_opts(Opts, default_tcp_listen_opts()).

add_default_ssl_opts(Opts) ->
    add_default_opts(Opts, default_ssl_opts()).

add_default_opts(Opts, DefOpts) ->
    TOpts = transform_opts(Opts),
    TOpts ++ [{DTag, DVal} || 
		 {DTag, DVal} <- DefOpts, not lists:keymember(DTag, 1, TOpts)].

default_tcp_accept_opts() ->
    lists:filter(fun is_tcp_accept_opt/1, default_opts()).

default_tcp_connect_opts() ->
    lists:filter(fun is_tcp_connect_opt/1, default_opts()).

default_tcp_listen_opts() ->
    lists:filter(fun is_tcp_listen_opt/1, default_opts()).

default_ssl_opts() ->
    lists:filter(fun is_ssl_opt/1, default_opts()).

default_opts() ->
    [{mode, list}, {packet, 0}, {nodelay, false}, {active, true},
     {backlog, ?DEF_BACKLOG}, {ip, {0, 0, 0, 0}},
     {verify, 0}, {depth, 1}].


%% Transform from old to new options, and also from old gen_tcp
%% options to new ones. All returned options are tagged options.
%%
transform_opts(Opts) ->
    lists:flatmap(fun transform_opt/1, Opts).

transform_opt(binary) -> 		[{mode, binary}];
transform_opt(list) -> 			[{mode, list}];
transform_opt({packet, raw}) ->		[{packet, 0}];
transform_opt(raw) -> 			[];
transform_opt(Opt) -> 			[Opt].

%% NOTE: The is_*_opt/1 functions must be applied on transformed options
%% only.

is_connect_opt(Opt) ->
    is_tcp_connect_opt(Opt) or is_ssl_opt(Opt).

is_listen_opt(Opt) ->
    is_tcp_listen_opt(Opt) or is_ssl_opt(Opt).

is_tcp_accept_opt(Opt) ->
    is_tcp_gen_opt(Opt) or is_ssl_opt(Opt).

is_tcp_connect_opt(Opt) ->
    is_tcp_gen_opt(Opt) or is_tcp_connect_only_opt(Opt).

is_tcp_listen_opt(Opt) ->
    is_tcp_gen_opt(Opt) or is_tcp_listen_only_opt(Opt).

%% General options supported by gen_tcp: All except `reuseaddr' and
%% `deliver'.
is_tcp_gen_opt({mode, list}) -> true;
is_tcp_gen_opt({mode, binary}) -> true;
is_tcp_gen_opt({header, Sz}) when is_integer(Sz), 0 =< Sz -> true; 
is_tcp_gen_opt({packet, Sz}) when is_integer(Sz), 0 =< Sz, Sz =< 4-> true;
is_tcp_gen_opt({packet, sunrm}) -> true;
is_tcp_gen_opt({packet, asn1}) -> true;
is_tcp_gen_opt({packet, cdr}) -> true;
is_tcp_gen_opt({packet, fcgi}) -> true;
is_tcp_gen_opt({packet, line}) -> true;
is_tcp_gen_opt({packet, tpkt}) -> true;
is_tcp_gen_opt({packet, http}) -> true;
is_tcp_gen_opt({packet, httph}) -> true;
is_tcp_gen_opt({nodelay, true}) -> true;
is_tcp_gen_opt({nodelay, false}) -> true;
is_tcp_gen_opt({active, true}) -> true;
is_tcp_gen_opt({active, false}) -> true;
is_tcp_gen_opt({active, once}) -> true;
is_tcp_gen_opt({keepalive, true}) -> true;
is_tcp_gen_opt({keepalive, false}) -> true;
is_tcp_gen_opt({ip, Addr}) -> is_ip_address(Addr);
is_tcp_gen_opt(_Opt) -> false.

is_tcp_listen_only_opt({backlog, Size}) when is_integer(Size), 0 =< Size -> 
    true;
is_tcp_listen_only_opt(_Opt) -> false.

is_tcp_connect_only_opt({port, Port}) when is_integer(Port), 0 =< Port -> true;
is_tcp_connect_only_opt(_Opt) -> false.

%% SSL options

is_ssl_opt({verify, Code}) when 0 =< Code, Code =< 2 -> true;
is_ssl_opt({depth, Depth}) when 0 =< Depth -> true;
is_ssl_opt({certfile, String}) -> is_string(String);
is_ssl_opt({keyfile, String}) -> is_string(String);
is_ssl_opt({password, String}) -> is_string(String);
is_ssl_opt({cacertfile, String}) -> is_string(String);
is_ssl_opt({ciphers, String}) -> is_string(String);
is_ssl_opt({cachetimeout, Timeout}) when Timeout >= 0 -> true;
is_ssl_opt(_Opt) -> false.

%% Various types
is_string(String) when is_list(String) ->
    lists:all(fun (C) when is_integer(C), 0 =< C, C =< 255 -> true; 
		  (_C) -> false end, 
	      String);
is_string(_) ->
    false.

is_ip_address(Addr) when is_tuple(Addr), size(Addr) == 4 ->
    is_string(tuple_to_list(Addr));
is_ip_address(Addr) when is_list(Addr) ->
    is_string(Addr);
is_ip_address(_) ->
    false.

get_tagged_opt(Tag, Opts, Default) ->
    case lists:keysearch(Tag, 1, Opts) of
	{value, {_, Value}} ->
	    Value;
	_Other ->
	    Default
    end.

%%
%%  mk_ssl_optstr(Opts) -> string()
%%
%%  Makes a "command line" string of SSL options
%%
mk_ssl_optstr(Opts) ->
    lists:flatten(lists:map(fun mk_one_ssl_optstr/1, Opts)).

mk_one_ssl_optstr({verify, Code}) ->
    [" -verify ", integer_to_list(Code)];
mk_one_ssl_optstr({depth, Depth}) ->
    [" -depth ", integer_to_list(Depth)];
mk_one_ssl_optstr({certfile, String}) -> 
    [" -certfile ", String];
mk_one_ssl_optstr({keyfile, String}) -> 
    [" -keyfile ", String];
mk_one_ssl_optstr({password, String}) -> 
    [" -password ", String];
mk_one_ssl_optstr({cacertfile, String}) ->
    [" -cacertfile ", String];
mk_one_ssl_optstr({ciphers, String}) -> 
    [" -ciphers ", String];
mk_one_ssl_optstr({cachetimeout, Timeout}) ->
    [" -cachetimeout ", integer_to_list(Timeout)];
mk_one_ssl_optstr(_) ->
    "".

extract_opts(OptTags, Opts) ->
    lists:filter(fun ({Tag, _}) -> lists:member(Tag, OptTags) end, Opts).

replace_opts(NOpts, Opts) ->
    lists:foldl(fun({Key, Val}, Acc) -> 
			lists:keyreplace(Key, 1, Acc, {Key, Val});
		   %% XXX Check. Patch from Chandrashekhar Mullaparthi.
		   (binary, Acc) ->
			lists:keyreplace(mode, 1, Acc, {mode, binary})
		end,
		Opts, NOpts).

%% Misc

is_subset(A, B) ->
    [] == A -- B.