ssl_server.erl

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

		_ ->
		    {noreply, St#st{cons = Cons}}
	    end;
	_ ->
	    case delete_by_pid(Pid, St#st.paccepts) of
		{ok, {ListenFd, _, _}, PAccepts} ->
		    %% decrement ref count in port program
		    send_cmd(St#st.port, ?NOACCEPT, int32(ListenFd)),
		    {noreply, St#st{paccepts = PAccepts}};
		_ ->
		    {noreply, St}
	    end
    end;

%%
%% 'badsig' means bad message to port. Port program is unaffected.
%%
handle_info({'EXIT', Port, badsig}, St) when St#st.port == Port ->
    debug(St, "badsig!!!~n", []),
    {noreply, St};

handle_info({'EXIT', Port, Reason}, St) when St#st.port == Port ->
    {stop, Reason, St};

handle_info(Info, St) ->
    debug(St, "unexpected info: ~w~n", [Info]),
    {noreply, St}.

%%
%% terminate(Reason, St) -> any
%%
terminate(_Reason, _St) ->
    ok.

%% 
%% code_change(OldVsn, St, Extra) -> {ok, NSt}
%%
code_change(_OldVsn, St, _Extra) ->
    {ok, St}.

%%%----------------------------------------------------------------------
%%% Internal functions
%%%----------------------------------------------------------------------

%%
%% Send binary command to sock
%%
send_cmd(Port, Cmd, Args) ->
    Port ! {self(), {command, [Cmd| Args]}}.

%%
%% add(Descr, Cons) -> NCons
%%
add(D, L) -> 
    [D| L].

%%
%% get_by_fd(Fd, Cons) -> {ok, Descr} | not_found
%%
get_by_fd(Fd, Cons) ->
    get_by_pos(Fd, 1, Cons).

%%
%% delete_by_fd(Fd, Cons) -> {ok, OldDesc, NewCons} | not_found.
%%
delete_by_fd(Fd, Cons) ->
    delete_by_pos(Fd, 1, Cons).

%%
%% delete_all_by_fd(Fd, Cons) -> {ok, DelCons, RemCons} | not_found.
%%
delete_all_by_fd(Fd, Cons) ->
    delete_all_by_pos(Fd, 1, Cons).

%%
%% delete_by_intref(IntRef, Cons) -> {ok, OldDesc, NewCons} | not_found.
%%
delete_by_intref(IntRef, Cons) ->
    delete_by_pos({intref, IntRef}, 1, Cons).

%%
%% delete_by_pid(Pid, Cons) -> {ok, OldDesc, NewCons} | not_found.
%%
delete_by_pid(Pid, Cons) ->
    delete_by_pos(Pid, 2, Cons).

%%
%% delete_last_by_fd(Fd, Cons) -> {ok, OldDesc, NCons} | not_found
%%
delete_last_by_fd(Fd, Cons) ->
    case dlbf(Fd, Cons) of 
	{X, L} ->
	    {ok, X, L};
	_Other  ->
	    not_found
    end.

dlbf(Fd, [H]) -> 
    last_elem(Fd, H, []);
dlbf(Fd, [H|T]) ->
    case dlbf(Fd, T) of
	{X, L} -> 
	    {X, [H|L]};
	L -> 
	    last_elem(Fd, H, L)
    end;
dlbf(_Fd, []) ->  
    [].

last_elem(Fd, H, L) when element(1, H) == Fd ->
    {H, L};
last_elem(_, H, L) ->
    [H|L].


%%
%% replace_from_by_fd(Fd, Cons, From) -> {ok, OldDesc, NewList} | not_found
%%
replace_from_by_fd(Fd, Cons, From) ->
    replace_posn_by_pos(Fd, 1, Cons, [{From, 3}]).

%%
%% replace_fd_by_intref(IntRef, Cons, Fd) -> {ok, OldDesc, NewList} | not_f.
%%
replace_fd_by_intref(IntRef, Cons, Fd) ->
    replace_posn_by_pos({intref, IntRef}, 1, Cons, [{Fd, 1}]).

%%
%% replace_fd_from_by_intref(IntRef, Cons, NFd, From) -> 
%%					{ok, OldDesc, NewList} |  not_found
%%
replace_fd_from_by_intref(IntRef, Cons, NFd, From) ->
    replace_posn_by_pos({intref, IntRef}, 1, Cons, [{NFd, 1}, {From, 3}]).


%%
%% All *_by_pos functions
%%

get_by_pos(Key, Pos, [H|_]) when element(Pos, H) == Key -> 
    {ok, H};
get_by_pos(Key, Pos, [_|T]) -> 
    get_by_pos(Key, Pos, T);
get_by_pos(_, _, []) -> 
    not_found.

delete_by_pos(Key, Pos, Cons) ->
    case delete_by_pos1(Key, Pos, {not_found, Cons}) of
	{not_found, _} ->
	    not_found;
	{ODesc, NCons} ->
	    {ok, ODesc, NCons}
    end.
delete_by_pos1(Key, Pos, {_R, [H|T]}) when element(Pos, H) == Key ->
    {H, T};
delete_by_pos1(Key, Pos, {R, [H|T]}) ->
    {R0, T0} = delete_by_pos1(Key, Pos, {R, T}),
    {R0, [H| T0]};
delete_by_pos1(_, _, {R, []}) ->
    {R, []}.

delete_all_by_pos(Key, Pos, Cons) ->
    case lists:foldl(fun(H, {Ds, Rs}) when element(Pos, H) == Key ->
			     {[H|Ds], Rs};
			(H, {Ds, Rs}) ->
			     {Ds, [H|Rs]} 
		     end, {[], []}, Cons) of
	{[], _} ->
	    not_found;
	{DelCons, RemCons} ->
	    {ok, DelCons, RemCons}
    end.

replace_posn_by_pos(Key, Pos, Cons, Repls) ->
    replace_posn_by_pos1(Key, Pos, Cons, Repls, []).

replace_posn_by_pos1(Key, Pos, [H0| T], Repls, Acc)
  when element(Pos, H0) =:= Key ->
    H = lists:foldl(fun({Val, VPos}, Tuple) -> 
			    setelement(VPos, Tuple, Val) 
		    end, H0, Repls), 
    {ok, H0, lists:reverse(Acc, [H| T])};
replace_posn_by_pos1(Key, Pos, [H|T], Repls, Acc) ->
    replace_posn_by_pos1(Key, Pos, T, Repls, [H| Acc]);
replace_posn_by_pos1(_, _, [], _, _) ->
    not_found.

%%
%% Binary/integer conversions
%%
int16(I) ->
    %%[(I bsr 8) band 255, I band 255].
    <<I:16>>.

int32(I) -> 
    %%     [(I bsr 24) band 255,
    %%      (I bsr 16) band 255,
    %%      (I bsr  8) band 255,
    %%      I band 255].
    <<I:32>>.

%% decode_msg(Bin, Format) -> Tuple | integer() | atom() | string() | 
%%				list of binaries()
%%
%% Decode message from binary
%% Format = [spec()]
%% spec() = int16 | int32 | string | atom | bin | bins
%%
%% Notice:  The first byte (op code) of the binary message is removed.
%% Notice:  bins returns a *list* of binaries. 
%%  
decode_msg(<<_, Bin/binary>>, Format) ->
    Dec = dec(Format, Bin),
    if 
	length(Dec) == 1 ->
	    hd(Dec);
	true  ->
	    list_to_tuple(Dec)
    end.

dec([], _) ->
    [];
dec([int16| F], <<N:16, Bin/binary>>) ->
    [N| dec(F, Bin)];
dec([int32| F], <<N:32, Bin/binary>>) ->
    [N| dec(F, Bin)];
dec([string| F], Bin0) ->
    {Cs, Bin1} = dec_string(Bin0),
    [Cs| dec(F, Bin1)];
dec([atom|F], Bin0) ->
    {Cs, Bin1} = dec_string(Bin0),
    [list_to_atom(Cs)| dec(F, Bin1)];

dec([bin|F], Bin) ->
    {Bin1, Bin2} = dec_bin(Bin),
    [Bin1| dec(F, Bin2)].

%% NOTE: This clause is not actually used yet.
%% dec([bins|F], <<N:32, Bin0/binary>>) ->
%%     {Bins, Bin1} = dec_bins(N, Bin0),
%%     [Bins| dec(F, Bin1)].

dec_string(Bin) ->
    dec_string(Bin, []).

dec_string(<<0, Bin/binary>>, RCs) ->
    {lists:reverse(RCs), Bin};
dec_string(<<C, Bin/binary>>, RCs) ->
    dec_string(Bin, [C| RCs]).

dec_bin(<<L:32, Bin0/binary>>) ->
    <<Bin1:L/binary, Bin2/binary>> = Bin0,
    {Bin1, Bin2}.

%% dec_bins(N, Bin) ->
%%     dec_bins(N, Bin, []).

%% dec_bins(0, Bin, Acc) ->
%%     {lists:reverse(Acc), Bin};
%% dec_bins(N, Bin0, Acc) when N > 0 ->
%%     {Bin1, Bin2} = dec_bin(Bin0),
%%     dec_bins(N - 1, Bin2, [Bin1| Acc]).

%%
%% new_intref
%%
new_intref(St) ->
    (St#st.intref + 1) band 16#ffffffff.

%%
%% {Program, Flags} = mk_cmd_line(DefaultProgram)
%%
mk_cmd_line(Default) ->
    {port_program(Default), 
     lists:flatten([debug_flag(), " ", debugdir_flag(), " ", 
		    msgdebug_flag(), " ", proxylsport_flag(), " ", 
		    proxybacklog_flag(), " ", ephemeral_rsa_flag(), " ",
		    ephemeral_dh_flag(), " ",
		    protocol_version_flag(), " "])}.

port_program(Default) ->
    case application:get_env(ssl, port_program) of
	{ok, Program} when list(Program) ->
	    Program;
	_Other ->
	    Default
    end.



%%
%% As this server may be started by the distribution, it is not safe to assume 
%% a working code server, neither a working file server.
%% I try to utilize the most primitive interfaces available to determine
%% the directory of the port_program.
%%
find_priv_bin() ->
    PrivDir = case (catch code:priv_dir(ssl)) of
		  {'EXIT', _} ->
		      %% Code server probably not startet yet
		      {ok, P} = erl_prim_loader:get_path(),
		      ModuleFile = atom_to_list(?MODULE) ++ extension(),
		      Pd = (catch lists:foldl
			    (fun(X,Acc) ->
				     M = filename:join([X, ModuleFile]),
				     %% The file server probably not started
				     %% either, has to use raw interface.
				     case file:raw_read_file_info(M) of 
					 {ok,_} -> 
					     %% Found our own module in the
					     %% path, lets bail out with
					     %% the priv_dir of this directory
					     Y = filename:split(X),
					     throw(filename:join
						   (lists:sublist
						    (Y,length(Y) - 1) 
						    ++ ["priv"])); 
					 _ -> 
					     Acc 
				     end 
			     end,
			     false,P)),
		      case Pd of
			  false ->
			      exit(ssl_priv_dir_indeterminate);
			  _ ->
			      Pd
		      end;
		  Dir ->
		      Dir
	      end,
    filename:join([PrivDir, "bin"]).

extension() ->
    %% erlang:info(machine) returns machine name as text in all uppercase
    "." ++ lists:map(fun(X) ->
			     X + $a - $A
		     end,
		     erlang:system_info(machine)).

debug_flag() ->
    case os:getenv("ERL_SSL_DEBUG") of
	false ->
	    get_env(debug, "-d");
	_ ->
	    "-d"
    end.

msgdebug_flag() ->
    case os:getenv("ERL_SSL_MSGDEBUG") of
	false ->
	    get_env(msgdebug, "-dm");
	_  ->
	    "-dm"
    end.

proxylsport_flag() ->
    case application:get_env(ssl, proxylsport) of
	{ok, PortNum} ->
	    "-pp " ++ integer_to_list(PortNum);
	_Other ->
	    ""
    end.

proxybacklog_flag() ->
    case application:get_env(ssl, proxylsbacklog) of
	{ok, Size} ->
	    "-pb " ++ integer_to_list(Size);
	_Other ->
	    ""
    end.

debugdir_flag() ->
    case os:getenv("ERL_SSL_DEBUG") of
	false ->
	    case application:get_env(ssl, debugdir) of
		{ok, Dir} when list(Dir) ->
		    "-dd " ++ Dir;
		_Other ->
		    ""
	    end;
	_  ->
	    "-dd ./"
    end.
    
ephemeral_rsa_flag() ->
    case application:get_env(ssl, ephemeral_rsa) of
	{ok, true} ->
	    "-ersa ";
	_Other ->
	    ""
    end.

ephemeral_dh_flag() ->
    case application:get_env(ssl, ephemeral_dh) of
	{ok, true} ->
	    "-edh ";
	_Other ->
	    ""
    end.

protocol_version_flag() ->
    case application:get_env(ssl, protocol_version) of
	{ok, []} ->
	    "";
	{ok, Vsns} when list(Vsns) ->
	    case transform_vsns(Vsns) of
		N when (N > 0) ->
		    "-pv " ++ integer_to_list(N);
		_ ->
		    ""
	    end;
	_Other ->
	    ""
    end.

transform_vsns(Vsns) ->
    transform_vsns(Vsns, 0).

transform_vsns([sslv2| Vsns], I) ->
    transform_vsns(Vsns, I bor ?SSLv2);
transform_vsns([sslv3| Vsns], I) ->
    transform_vsns(Vsns, I bor ?SSLv3);
transform_vsns([tlsv1| Vsns], I) ->
    transform_vsns(Vsns, I bor ?TLSv1);
transform_vsns([_ | Vsns], I) ->
    transform_vsns(Vsns, I);
transform_vsns([], I) ->
    I.

protocol_name("SSLv2") -> sslv2;
protocol_name("SSLv3") -> sslv3;
protocol_name("TLSv1") -> tlsv1.

get_env(Key, Val) ->
    case application:get_env(ssl, Key) of
	{ok, true} ->
	    Val;
	_Other ->
	    ""
    end.

ip_to_string({A,B,C,D}) ->
    [integer_to_list(A),$.,integer_to_list(B),$.,
     integer_to_list(C),$.,integer_to_list(D)].

debug(St, Format, Args) ->
    debug1(St#st.debug, Format, Args).

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