aboutsummaryrefslogtreecommitdiffstats
path: root/lib/kernel/src/inet_gethost_native.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/kernel/src/inet_gethost_native.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/kernel/src/inet_gethost_native.erl')
-rw-r--r--lib/kernel/src/inet_gethost_native.erl626
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)].
+