The R13B03 release.OTP_R13B03

1 files changed, 626 insertions, 0 deletions

diff --git a/lib/kernel/src/inet_gethost_native.erl b/lib/kernel/src/inet_gethost_native.erl
new file mode 100644
index 0000000000..abdbe2b8cf
--- /dev/null
+++ b/lib/kernel/src/inet_gethost_native.erl
@@ -0,0 +1,626 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%% 
+%% 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 online 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.
+%% 
+%% %CopyrightEnd%
+%%
+-module(inet_gethost_native).
+-behaviour(supervisor_bridge).
+
+%% Supervisor bridge exports
+-export([start_link/0, init/1, terminate/2, start_raw/0, run_once/0]).
+
+%% Server export
+-export([server_init/2, main_loop/1]).
+
+%% API exports
+-export([gethostbyname/1, gethostbyname/2, gethostbyaddr/1, control/1]).
+
+%%% Exports for sys:handle_system_msg/6
+-export([system_continue/3, system_terminate/4, system_code_change/4]).
+
+-include_lib("kernel/include/inet.hrl").
+
+-define(PROCNAME_SUP, inet_gethost_native_sup).
+
+-define(OP_GETHOSTBYNAME,1).
+-define(OP_GETHOSTBYADDR,2).
+-define(OP_CANCEL_REQUEST,3).
+-define(OP_CONTROL,4).
+
+-define(PROTO_IPV4,1).
+-define(PROTO_IPV6,2).
+
+%% OP_CONTROL
+-define(SETOPT_DEBUG_LEVEL, 0).
+
+-define(UNIT_ERROR,0).
+-define(UNIT_IPV4,4).
+-define(UNIT_IPV6,16).
+
+-define(PORT_PROGRAM, "inet_gethost").
+-define(DEFAULT_POOLSIZE, 4).
+-define(REQUEST_TIMEOUT, (inet_db:res_option(timeout)*4)).
+
+-define(MAX_TIMEOUT, 16#7FFFFFF).
+-define(INVALID_SERIAL, 16#FFFFFFFF).
+
+%-define(DEBUG,1).
+-ifdef(DEBUG).
+-define(dbg(A,B), io:format(A,B)).
+-else.
+-define(dbg(A,B), noop).
+-endif.
+
+-define(SEND_AFTER(A,B,C),erlang:send_after(A,B,C)).
+-define(CANCEL_TIMER(A),erlang:cancel_timer(A)).
+
+%% In erlang, IPV6 addresses are built as 8-tuples of 16bit values (not 16-tuples of octets).
+%% This macro, meant to be used in guards checks one such 16bit value in the 8-tuple.
+-define(VALID_V6(Part), is_integer(Part), Part < 65536).
+%% The regular IPV4 addresses are represented as 4-tuples of octets, this macro,
+%% meant to be used in guards, check one such octet.
+-define(VALID_V4(Part), is_integer(Part), Part < 256).
+
+% Requests, one per unbique request to the PORT program, may be more than one client!!!
+-record(request, {
+	  rid, % Request id as sent to port
+	  op,
+	  proto,
+	  rdata,
+	  clients = [] % Can be more than one client per request (Pid's). 
+}).
+
+
+% Statistics, not used yet.
+-record(statistics, {
+	  netdb_timeout = 0,
+	  netdb_internal = 0,
+	  port_crash = 0,
+	  notsup = 0,
+	  host_not_found = 0,
+	  try_again = 0,
+	  no_recovery = 0,
+	  no_data = 0
+}).
+
+% The main loopstate...
+-record(state, {
+	  port = noport, % Port() connected to the port program
+	  timeout = 8000, % Timeout value from inet_db:res_option
+	  requests, % Table of request
+	  req_index, % Table of {{op,proto,rdata},rid}
+	  parent,    % The supervisor bridge
+	  pool_size = 4, % Number of C processes in pool.
+	  statistics % Statistics record (records error causes).
+}).
+
+%% The supervisor bridge code
+init([]) -> % Called by supervisor_bridge:start_link
+    Ref = make_ref(),
+    SaveTE = process_flag(trap_exit,true),
+    Pid = spawn_link(?MODULE,server_init,[self(),Ref]),
+    receive
+	Ref ->
+	    process_flag(trap_exit,SaveTE),
+	    {ok, Pid, Pid};
+	{'EXIT', Pid, Message} ->
+	    process_flag(trap_exit,SaveTE),
+	    {error, Message}
+    after 10000 ->
+	    process_flag(trap_exit,SaveTE),
+	    {error, {timeout, ?MODULE}}
+    end.
+
+start_link() ->
+    supervisor_bridge:start_link({local, ?PROCNAME_SUP}, ?MODULE, []).
+
+%% Only used in fallback situations, no supervisor, no bridge, serve only until
+%% no requests present...
+start_raw() ->
+    spawn(?MODULE,run_once,[]).
+
+run_once() ->
+    Port = do_open_port(get_poolsize(), get_extra_args()),
+    Timeout = ?REQUEST_TIMEOUT,
+    {Pid, R, Request} = 
+	receive
+	    {{Pid0,R0}, {?OP_GETHOSTBYNAME, Proto0, Name0}} ->
+		{Pid0, R0, 
+		 [<<1:32, ?OP_GETHOSTBYNAME:8, Proto0:8>>,Name0,0]};
+	    {{Pid1,R1}, {?OP_GETHOSTBYADDR, Proto1, Data1}}  ->
+		{Pid1, R1, 
+		 <<1:32, ?OP_GETHOSTBYADDR:8, Proto1:8, Data1/binary>>}
+	after Timeout ->
+		exit(normal)
+	end,
+    (catch port_command(Port, Request)),
+    receive
+	{Port, {data, <<1:32, BinReply/binary>>}} ->
+	    Pid ! {R, {ok, BinReply}}
+    after Timeout ->
+	    Pid ! {R,{error,timeout}}
+    end.
+
+terminate(_Reason,Pid) ->
+    (catch exit(Pid,kill)),
+    ok.
+
+%%-----------------------------------------------------------------------
+%% Server API
+%%-----------------------------------------------------------------------
+server_init(Starter, Ref) ->
+    process_flag(trap_exit,true),
+    case whereis(?MODULE) of
+	undefined ->
+	    case (catch register(?MODULE,self())) of
+		true ->
+		    Starter ! Ref;
+		_->
+		    exit({already_started,whereis(?MODULE)})
+	    end;
+	Winner ->
+	   exit({already_started,Winner})
+    end,
+    Poolsize = get_poolsize(),
+    Port = do_open_port(Poolsize, get_extra_args()),
+    Timeout = ?REQUEST_TIMEOUT,
+    put(rid,0),
+    put(num_requests,0),
+    RequestTab = ets:new(ign_requests,[{keypos,#request.rid},set,protected]),
+    RequestIndex = ets:new(ign_req_index,[set,protected]),
+    State = #state{port = Port, timeout = Timeout, requests = RequestTab,
+		   req_index = RequestIndex, 
+		   pool_size = Poolsize,
+		   statistics = #statistics{},
+		   parent = Starter},
+    main_loop(State).
+
+main_loop(State) ->
+    receive
+	Any -> 
+	    handle_message(Any,State)
+    end.
+
+handle_message({{Pid,_} = Client, {?OP_GETHOSTBYNAME, Proto, Name} = R}, 
+	       State) when is_pid(Pid) ->
+    NewState = do_handle_call(R,Client,State,
+			      [<<?OP_GETHOSTBYNAME:8, Proto:8>>, Name,0]),
+    main_loop(NewState);
+
+handle_message({{Pid,_} = Client, {?OP_GETHOSTBYADDR, Proto, Data} = R}, 
+	       State) when is_pid(Pid) ->
+    NewState = do_handle_call(R,Client,State,
+			      <<?OP_GETHOSTBYADDR:8, Proto:8, Data/binary>>),
+    main_loop(NewState);
+
+handle_message({{Pid,Ref}, {?OP_CONTROL, Ctl, Data}}, State)
+  when is_pid(Pid) ->
+    catch port_command(State#state.port, 
+		       <<?INVALID_SERIAL:32, ?OP_CONTROL:8, 
+			Ctl:8, Data/binary>>),
+    Pid ! {Ref, ok},
+    main_loop(State);
+
+handle_message({{Pid,Ref}, restart_port}, State)
+  when is_pid(Pid) ->
+    NewPort=restart_port(State),
+    Pid ! {Ref, ok},
+    main_loop(State#state{port=NewPort});
+
+handle_message({Port, {data, Data}}, State = #state{port = Port}) ->
+    NewState = case Data of
+		   <<RID:32, BinReply/binary>> ->
+		       case BinReply of
+			   <<Unit, _/binary>> when Unit =:= ?UNIT_ERROR;
+						   Unit =:= ?UNIT_IPV4;
+						   Unit =:= ?UNIT_IPV6 ->
+			       case pick_request(State,RID) of
+				   false ->
+				       State;
+				   Req ->
+				       lists:foreach(fun({P,R,TR}) ->
+							     ?CANCEL_TIMER(TR),
+							     P ! {R,
+								  {ok,
+								   BinReply}}
+						     end,
+						     Req#request.clients),
+				       State
+			       end;
+			   _UnitError ->
+			       %% Unexpected data, let's restart it, 
+			       %% it must be broken.
+			       NewPort=restart_port(State),
+			       State#state{port=NewPort}
+		       end;
+		   _BasicFormatError ->
+		       NewPort=restart_port(State),
+		       State#state{port=NewPort}
+	       end,    
+    main_loop(NewState);
+	
+handle_message({'EXIT',Port,_Reason}, State = #state{port = Port}) -> 
+    ?dbg("Port died.~n",[]),
+    NewPort=restart_port(State),
+    main_loop(State#state{port=NewPort});
+
+handle_message({Port,eof}, State = #state{port = Port}) ->
+    ?dbg("Port eof'ed.~n",[]),
+    NewPort=restart_port(State),
+    main_loop(State#state{port=NewPort});
+
+handle_message({timeout, Pid, RID}, State) ->
+    case pick_client(State,RID,Pid) of
+	false ->
+	    false;
+	{more, {P,R,_}} ->
+	    P ! {R,{error,timeout}};
+	{last, {LP,LR,_}} ->
+	    LP ! {LR, {error,timeout}},
+	    %% Remove the whole request structure...
+	    pick_request(State, RID),
+	    %% Also cancel the request to the port program...
+	    (catch port_command(State#state.port, 
+				<<RID:32,?OP_CANCEL_REQUEST>>))
+    end,
+    main_loop(State);
+
+handle_message({system, From, Req}, State) ->
+	    sys:handle_system_msg(Req, From, State#state.parent, ?MODULE, [], 
+				  State);
+
+handle_message(_, State) -> % Stray messages from dying ports etc.
+    main_loop(State).
+
+
+do_handle_call(R,Client0,State,RData) ->
+    Req = find_request(State,R),
+    Timeout = State#state.timeout,
+    {P,Ref} = Client0,
+    TR = ?SEND_AFTER(Timeout,self(),{timeout, P, Req#request.rid}),
+    Client = {P,Ref,TR},
+    case Req#request.clients of
+	[] ->
+	    RealRData = [<<(Req#request.rid):32>>|RData],
+	    (catch port_command(State#state.port, RealRData)),
+	    ets:insert(State#state.requests,Req#request{clients = [Client]});
+	Tail ->
+	    ets:insert(State#state.requests,Req#request{clients = [Client | Tail]})
+    end,
+    State.
+
+find_request(State, R = {Op, Proto, Data}) ->
+    case ets:lookup(State#state.req_index,R) of
+	[{R, Rid}] ->
+	    [Ret] = ets:lookup(State#state.requests,Rid),
+	    Ret;
+	[] ->
+	    NRid = get_rid(),
+	    Req = #request{rid = NRid, op = Op, proto = Proto, rdata = Data},
+	    ets:insert(State#state.requests, Req),
+	    ets:insert(State#state.req_index,{R,NRid}),
+	    put(num_requests,get(num_requests) + 1),
+	    Req
+    end.
+    
+pick_request(State, RID) ->
+    case ets:lookup(State#state.requests, RID) of
+	[] ->
+	    false;
+	[#request{rid = RID, op = Op, proto = Proto, rdata = Data}=R] ->
+	    ets:delete(State#state.requests,RID),
+	    ets:delete(State#state.req_index,{Op,Proto,Data}),
+	    put(num_requests,get(num_requests) - 1),
+	    R
+    end.
+
+pick_client(State,RID,Clid) ->
+    case ets:lookup(State#state.requests, RID) of
+	[] ->
+	    false;
+	[R] ->
+	    case R#request.clients of
+		[SoleClient] ->
+		    {last, SoleClient}; % Note, not removed, the caller 
+					% should cleanup request data
+		CList ->
+		    case lists:keysearch(Clid,1,CList) of
+			{value, Client} ->
+			    NCList = lists:keydelete(Clid,1,CList),
+			    ets:insert(State#state.requests, 
+				       R#request{clients = NCList}),
+			    {more, Client};
+			false ->
+			    false
+		    end
+	    end
+    end.
+
+get_rid () ->
+    New = (get(rid) + 1) rem 16#7FFFFFF,
+    put(rid,New),
+    New.
+
+
+foreach(Fun,Table) ->
+    foreach(Fun,Table,ets:first(Table)).
+
+foreach(_Fun,_Table,'$end_of_table') ->
+    ok;
+foreach(Fun,Table,Key) ->
+    [Object] = ets:lookup(Table,Key),
+    Fun(Object),
+    foreach(Fun,Table,ets:next(Table,Key)).
+
+restart_port(#state{port = Port, requests = Requests}) ->
+    (catch port_close(Port)),
+    NewPort = do_open_port(get_poolsize(), get_extra_args()),
+    foreach(fun(#request{rid = Rid, op = Op, proto = Proto, rdata = Rdata}) ->
+		    case Op of 
+			?OP_GETHOSTBYNAME ->
+			    port_command(NewPort,[<<Rid:32,?OP_GETHOSTBYNAME:8,
+						  Proto:8>>,
+						  Rdata,0]);
+			?OP_GETHOSTBYADDR ->
+			    port_command(NewPort,
+					 <<Rid:32,?OP_GETHOSTBYADDR:8, Proto:8,
+					 Rdata/binary>>)
+		    end
+	    end,
+	    Requests),
+    NewPort.
+			    
+    
+
+do_open_port(Poolsize, ExtraArgs) ->
+    try 
+	open_port({spawn, 
+		   ?PORT_PROGRAM++" "++integer_to_list(Poolsize)++" "++
+		   ExtraArgs},
+		  [{packet,4},eof,binary,overlapped_io])
+    catch
+	error:_ ->
+	    open_port({spawn, 
+		       ?PORT_PROGRAM++" "++integer_to_list(Poolsize)++
+		       " "++ExtraArgs},
+		      [{packet,4},eof,binary])
+    end.
+
+get_extra_args() ->
+    FirstPart = case application:get_env(kernel, gethost_prioritize) of
+		    {ok, false} ->
+			" -ng";
+		    _ ->
+			""
+		end,
+    case application:get_env(kernel, gethost_extra_args) of
+	{ok, L} when is_list(L) ->
+	    FirstPart++" "++L;
+	_ ->
+	    FirstPart++""
+    end.
+
+get_poolsize() ->
+    case application:get_env(kernel, gethost_poolsize) of
+	{ok,I} when is_integer(I) ->
+	    I;
+	_ ->
+	    ?DEFAULT_POOLSIZE
+    end.
+
+%%------------------------------------------------------------------
+%% System messages callbacks
+%%------------------------------------------------------------------
+
+system_continue(_Parent, _, State) ->
+    main_loop(State).
+
+system_terminate(Reason, _Parent, _, _State) ->
+    exit(Reason).
+
+system_code_change(State, _Module, _OldVsn, _Extra) ->
+    {ok, State}. %% Nothing to do in this version.
+
+
+%%-----------------------------------------------------------------------
+%% Client API
+%%-----------------------------------------------------------------------
+
+gethostbyname(Name) ->
+    gethostbyname(Name, inet).
+
+gethostbyname(Name, inet) when is_list(Name) ->
+    getit(?OP_GETHOSTBYNAME, ?PROTO_IPV4, Name);
+gethostbyname(Name, inet6) when is_list(Name) ->
+    getit(?OP_GETHOSTBYNAME, ?PROTO_IPV6, Name);
+gethostbyname(Name, Type) when is_atom(Name) ->
+    gethostbyname(atom_to_list(Name), Type);
+gethostbyname(_, _)  ->
+    {error, formerr}.
+
+gethostbyaddr({A,B,C,D}) when ?VALID_V4(A), ?VALID_V4(B), ?VALID_V4(C), ?VALID_V4(D) ->
+    getit(?OP_GETHOSTBYADDR, ?PROTO_IPV4, <<A,B,C,D>>);
+gethostbyaddr({A,B,C,D,E,F,G,H}) when ?VALID_V6(A), ?VALID_V6(B), ?VALID_V6(C), ?VALID_V6(D),
+				      ?VALID_V6(E), ?VALID_V6(F), ?VALID_V6(G), ?VALID_V6(H) ->
+    getit(?OP_GETHOSTBYADDR, ?PROTO_IPV6, <<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16>>);
+gethostbyaddr(Addr) when is_list(Addr) ->
+    case inet_parse:address(Addr) of
+        {ok, IP} -> gethostbyaddr(IP);
+        _Error -> {error, formerr}
+    end;
+gethostbyaddr(Addr) when is_atom(Addr) ->
+    gethostbyaddr(atom_to_list(Addr));
+gethostbyaddr(_) -> {error, formerr}.
+
+control({debug_level, Level}) when is_integer(Level) ->
+    getit(?OP_CONTROL, ?SETOPT_DEBUG_LEVEL, <<Level:32>>);
+control(soft_restart) ->
+    getit(restart_port);
+control(_) -> {error, formerr}.
+
+getit(Op, Proto, Data) ->
+    getit({Op, Proto, Data}).
+
+getit(Req) ->
+    Pid = ensure_started(),
+    Ref = make_ref(),
+    Pid ! {{self(),Ref}, Req},
+    receive
+	{Ref, {ok,BinHostent}} ->
+	    parse_address(BinHostent);
+	{Ref, Error} -> 
+	    Error
+    after 5000 ->
+	    Ref2 = erlang:monitor(process,Pid),
+	    Res2 = receive
+		       {Ref, {ok,BinHostent}} ->
+			   parse_address(BinHostent);
+		       {Ref, Error} -> 
+			   Error;
+		       {'DOWN', Ref2, process, 
+			Pid, Reason} ->
+			   {error, Reason}
+		   end,
+	    catch erlang:demonitor(Ref2),
+	    receive {'DOWN',Ref2,_,_,_} -> ok after 0 -> ok end,
+	    Res2
+    end.
+
+do_start(Sup, C) ->
+    {Child,_,_,_,_,_} = C,
+    case supervisor:start_child(Sup,C) of
+	{ok,_} ->
+	    ok;
+	{error, {already_started, Pid}} when is_pid(Pid) ->
+	    ok;
+	{error, {{already_started, Pid}, _Child}} when is_pid(Pid) ->
+	    ok;
+	{error, already_present} ->
+	    supervisor:delete_child(Sup, Child),
+	    do_start(Sup, C)
+    end.
+
+ensure_started() ->
+    case whereis(?MODULE) of
+	undefined -> 
+	    C = {?PROCNAME_SUP, {?MODULE, start_link, []}, temporary, 
+		 1000, worker, [?MODULE]},
+	    case whereis(kernel_safe_sup) of
+		undefined ->
+		    case whereis(net_sup) of
+			undefined ->
+			    %% Icky fallback, run once without supervisor
+			    start_raw();
+			_ ->
+			    do_start(net_sup,C),
+			    case whereis(?MODULE) of
+				undefined ->
+				    exit({could_not_start_server, ?MODULE});
+				Pid0 ->
+				    Pid0
+			    end
+		    end;
+		_ ->
+		    do_start(kernel_safe_sup,C),
+		    case whereis(?MODULE) of
+			undefined ->
+			    exit({could_not_start_server, ?MODULE});
+			Pid1 ->
+			    Pid1
+		    end
+	    end;
+	Pid -> 
+	    Pid
+    end.
+
+parse_address(BinHostent) ->
+    case catch 
+	begin
+	    case BinHostent of
+		<<?UNIT_ERROR, Errstring/binary>> -> 
+		    {error, list_to_atom(listify(Errstring))};
+		<<?UNIT_IPV4, Naddr:32, T0/binary>> ->
+		    {T1,Addresses} = pick_addresses_v4(Naddr, T0),
+		    [Name | Names] = pick_names(T1),
+		    {ok, #hostent{h_addr_list = Addresses, h_addrtype = inet,
+				  h_aliases = Names, h_length = ?UNIT_IPV4, 
+				  h_name = Name}};
+		<<?UNIT_IPV6, Naddr:32, T0/binary>> ->
+		    {T1,Addresses} = pick_addresses_v6(Naddr, T0),
+		    [Name | Names] = pick_names(T1),
+		    {ok, #hostent{h_addr_list = Addresses, h_addrtype = inet6,
+				  h_aliases = Names, h_length = ?UNIT_IPV6, 
+				  h_name = Name}};
+		_Else ->
+		    {error, {internal_error, {malformed_response, BinHostent}}}
+	    end
+	end of
+	{'EXIT', Reason} ->
+	    Reason;
+	Normal ->
+	    Normal
+    end.
+	    
+listify(Bin) ->
+    N = byte_size(Bin) - 1,
+    <<Bin2:N/binary, Ch>> = Bin,
+    case Ch of
+	0 ->
+	    listify(Bin2);
+	_ ->
+	    binary_to_list(Bin)
+    end.
+    
+pick_addresses_v4(0,Tail) ->
+    {Tail,[]};
+pick_addresses_v4(N,<<A,B,C,D,Tail/binary>>) ->
+    {NTail, OList} = pick_addresses_v4(N-1,Tail),
+    {NTail, [{A,B,C,D} | OList]}.
+
+pick_addresses_v6(0,Tail) ->
+    {Tail,[]};
+pick_addresses_v6(Num,<<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,
+		  Tail/binary>>) ->
+    {NTail, OList} = pick_addresses_v6(Num-1,Tail),
+    {NTail, [{A,B,C,D,E,F,G,H} | OList]}.
+
+ndx(Ch,Bin) ->
+    ndx(Ch,0,byte_size(Bin),Bin).
+
+ndx(_,N,N,_) ->
+    undefined;
+ndx(Ch,I,N,Bin) ->
+    case Bin of
+	<<_:I/binary,Ch,_/binary>> ->
+	    I;
+	_ ->
+	    ndx(Ch,I+1,N,Bin)
+    end.
+
+pick_names(<<Length:32,Namelist/binary>>) ->
+    pick_names(Length,Namelist).
+
+pick_names(0,<<>>) ->
+    [];
+pick_names(0,_) ->
+    exit({error,format_error});
+pick_names(_N,<<>>) ->
+    exit({error,format_error});
+pick_names(N,Bin) ->
+    Ndx = ndx(0,Bin),
+    <<Str:Ndx/binary,0,Rest/binary>> = Bin,
+    [binary_to_list(Str)|pick_names(N-1,Rest)].
+