From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- lib/kernel/src/inet_config.erl | 638 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 638 insertions(+) create mode 100644 lib/kernel/src/inet_config.erl (limited to 'lib/kernel/src/inet_config.erl') diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl new file mode 100644 index 0000000000..b5317f72f5 --- /dev/null +++ b/lib/kernel/src/inet_config.erl @@ -0,0 +1,638 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-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_config). + +-include("inet_config.hrl"). +-include("inet.hrl"). + +-import(lists, [foreach/2, member/2, reverse/1]). + +-export([init/0]). + +-export([do_load_resolv/2]). + +%% +%% Must be called after inet_db:start +%% +%% Order in which to load inet_db data: +%% 1. Hostname (possibly derive domain and search) +%% 2. OS default /etc/resolv.conf, Windows registry etc +%% a) Hosts database +%% b) Resolver options +%% 3. Config (kernel app) +%% 4. Root (otp root) +%% 5. Home (user inetrc) +%% +%% +-spec init() -> 'ok'. +init() -> + OsType = os:type(), + case OsType of + {ose,_} -> + case init:get_argument(loader) of + {ok,[["ose_inet"]]} -> + %% port already started by prim_loader + ok; + _Other -> + %% Setup reserved port for ose_inet driver (only OSE) + case catch erlang:open_port({spawn,"ose_inet"}, [binary]) of + {'EXIT',Why} -> + error("can't open port for ose_inet: ~p", [Why]); + OseInetPort -> + erlang:display({ose_inet_port,OseInetPort}) + end + end; + _ -> + ok + end, + + set_hostname(), + + %% Note: In shortnames (or non-distributed) mode we don't need to know + %% our own domain name. In longnames mode we do and we can't rely on + %% the user to provide it (by means of inetrc), so we need to look + %% for it ourselves. + + do_load_resolv(OsType, erl_dist_mode()), + + case OsType of + {unix,Type} -> + if Type =:= linux -> + %% It may be the case that the domain name was not set + %% because the hostname was short. But NOW we can look it + %% up and get the long name and the domain name from it. + + %% FIXME: The second call to set_hostname will insert + %% a duplicate entry in the search list. + + case inet_db:res_option(domain) of + "" -> + case inet:gethostbyname(inet_db:gethostname()) of + {ok,#hostent{h_name = []}} -> + ok; + {ok,#hostent{h_name = HostName}} -> + set_hostname({ok,HostName}); + _ -> + ok + end; + _ -> + ok + end; + true -> ok + end, + add_dns_lookup(inet_db:res_option(lookup)); + _ -> + ok + end, + + %% Read inetrc file, if it exists. + {RcFile,CfgFiles,CfgList} = read_rc(), + + %% Possibly read config files or system registry + lists:foreach(fun({file,hosts,File}) -> + load_hosts(File, unix); + ({file,Func,File}) -> + load_resolv(File, Func); + ({registry,win32}) -> + case OsType of + {win32,WinType} -> + win32_load_from_registry(WinType); + _ -> + error("can not read win32 system registry~n", []) + end + end, CfgFiles), + + %% Add inetrc config entries + case inet_db:add_rc_list(CfgList) of + ok -> ok; + _ -> error("syntax error in ~s~n", [RcFile]) + end, + + %% Set up a resolver configuration file for inet_res, + %% unless that already has been done + case OsType of + {unix,_} -> + %% The Etc variable enables us to run tests with other + %% configuration files than the normal ones + Etc = case os:getenv("ERL_INET_ETC_DIR") of + false -> ?DEFAULT_ETC; + _EtcDir -> + _EtcDir + end, + case inet_db:res_option(resolv_conf) of + undefined -> + inet_db:set_resolv_conf(filename:join(Etc, + ?DEFAULT_RESOLV)); + _ -> ok + end, + case inet_db:res_option(hosts_file) of + undefined -> + inet_db:set_hosts_file(filename:join(Etc, + ?DEFAULT_HOSTS)); + _ -> ok + end; + _ -> ok + end. + + + +erl_dist_mode() -> + case init:get_argument(sname) of + {ok,[[_SName]]} -> shortnames; + _ -> + case init:get_argument(name) of + {ok,[[_Name]]} -> longnames; + _ -> nonames + end + end. + +do_load_resolv({unix,Type}, longnames) -> + %% The Etc variable enables us to run tests with other + %% configuration files than the normal ones + Etc = case os:getenv("ERL_INET_ETC_DIR") of + false -> ?DEFAULT_ETC; + _EtcDir -> + _EtcDir + end, + load_resolv(filename:join(Etc, ?DEFAULT_RESOLV), resolv), + case Type of + freebsd -> %% we may have to check version (2.2.2) + load_resolv(filename:join(Etc,"host.conf"), host_conf_freebsd); + 'bsd/os' -> + load_resolv(filename:join(Etc,"irs.conf"), host_conf_bsdos); + sunos -> + case os:version() of + {Major,_,_} when Major >= 5 -> + load_resolv(filename:join(Etc,"nsswitch.conf"), + nsswitch_conf); + _ -> + ok + end; + netbsd -> + case os:version() of + {Major,Minor,_} when Major >= 1, Minor >= 4 -> + load_resolv(filename:join(Etc,"nsswitch.conf"), + nsswitch_conf); + _ -> + ok + end; + linux -> + case load_resolv(filename:join(Etc,"host.conf"), + host_conf_linux) of + ok -> + ok; + _ -> + load_resolv(filename:join(Etc,"nsswitch.conf"), + nsswitch_conf) + end; + _ -> + ok + end, + inet_db:set_lookup([native]); + +do_load_resolv({win32,Type}, longnames) -> + win32_load_from_registry(Type), + inet_db:set_lookup([native]); + +do_load_resolv(vxworks, _) -> + vxworks_load_hosts(), + inet_db:set_lookup([file, dns]), + case os:getenv("ERLRESCONF") of + false -> + no_ERLRESCONF; + Resolv -> + load_resolv(Resolv, resolv) + end; + +do_load_resolv({ose,_Type}, _) -> + inet_db:set_lookup([file, dns]), + case os:getenv("NAMESERVER") of + false -> + case os:getenv("RESOLVFILE") of + false -> + erlang:display('Warning: No NAMESERVER or RESOLVFILE specified!'), + no_resolv; + Resolv -> + load_resolv(Resolv, resolv) + end; + Ns -> + {ok,IP} = inet_parse:address(Ns), + inet_db:add_rc_list([{nameserver,IP}]) + end, + case os:getenv("DOMAIN") of + false -> + no_domain; + D -> + ok = inet_db:add_rc_list([{domain,D}]) + end, + case os:getenv("HOSTSFILE") of + false -> + erlang:display('Warning: No HOSTSFILE specified!'), + no_hosts_file; + File -> + load_hosts(File, ose) + end; + +do_load_resolv(_, _) -> + inet_db:set_lookup([native]). + +add_dns_lookup(L) -> + case lists:member(dns,L) of + true -> ok; + _ -> + case application:get_env(kernel,inet_dns_when_nis) of + {ok,true} -> + add_dns_lookup(L,[]); + _ -> + ok + end + end. + +add_dns_lookup([yp|T],Acc) -> + add_dns_lookup(T,[yp,dns|Acc]); +add_dns_lookup([H|T],Acc) -> + add_dns_lookup(T,[H|Acc]); +add_dns_lookup([],Acc) -> + inet_db:set_lookup(reverse(Acc)). + +%% +%% Set the hostname (SHORT) +%% If hostname is long use the suffix as default domain +%% and initalize the search option with the parts of domain +%% +set_hostname() -> + case inet_udp:open(0,[]) of + {ok,U} -> + Res = inet:gethostname(U), + inet_udp:close(U), + set_hostname(Res); + _ -> + set_hostname({ok, []}) + end. + +set_hostname({ok,Name}) when length(Name) > 0 -> + {Host, Domain} = lists:splitwith(fun($.) -> false; + (_) -> true + end, Name), + inet_db:set_hostname(Host), + set_search_dom(Domain); +set_hostname({ok,[]}) -> + inet_db:set_hostname("nohost"), + set_search_dom("nodomain"). + +set_search_dom([$.|Domain]) -> + %% leading . not removed by dropwhile above. + inet_db:set_domain(Domain), + inet_db:ins_search(Domain), + ok; +set_search_dom([]) -> + ok; +set_search_dom(Domain) -> + inet_db:set_domain(Domain), + inet_db:ins_search(Domain), + ok. + +%% +%% Load resolver data +%% +load_resolv(File, Func) -> + case get_file(File) of + {ok,Bin} -> + case inet_parse:Func(File, {chars, Bin}) of + {ok, Ls} -> + inet_db:add_rc_list(Ls); + {error, Reason} -> + error("parse error in file ~s: ~p", [File, Reason]) + end; + Error -> + warning("file not found ~s: ~p~n", [File, Error]) + end. + +%% +%% Load a UNIX hosts file +%% +load_hosts(File,Os) -> + case get_file(File) of + {ok,Bin} -> + case inet_parse:hosts(File,{chars,Bin}) of + {ok, Ls} -> + foreach( + fun({IP, Name, Aliases}) -> + inet_db:add_host(IP, [Name|Aliases]) end, + Ls); + {error, Reason} -> + error("parse error in file ~s: ~p", [File, Reason]) + end; + Error -> + case Os of + unix -> + error("file not found ~s: ~p~n", [File, Error]); + _ -> + %% for windows or nt the hosts file is not always there + %% and we don't require it + ok + end + end. + +%% +%% Load resolver data from Windows registry +%% +win32_load_from_registry(Type) -> + %% The TcpReg variable enables us to run tests with other registry configurations than + %% the normal ones + TcpReg = case os:getenv("ERL_INET_ETC_DIR") of + false -> []; + _TReg -> _TReg + end, + {ok, Reg} = win32reg:open([read]), + {TcpIp,HFileKey} = + case Type of + nt -> + case TcpReg of + [] -> + {"\\hklm\\system\\CurrentControlSet\\Services\\TcpIp\\Parameters", + "DataBasePath" }; + Other -> + {Other,"DataBasePath"} + end; + windows -> + case TcpReg of + [] -> + {"\\hklm\\system\\CurrentControlSet\\Services\\VxD\\MSTCP", + "LMHostFile" }; + Other -> + {Other,"LMHostFile"} + end + end, + Result = + case win32reg:change_key(Reg,TcpIp) of + ok -> + win32_load1(Reg,Type,HFileKey); + {error, _Reason} -> + error("Failed to locate TCP/IP parameters (is TCP/IP installed)?", + []) + end, + win32reg:close(Reg), + Result. + +win32_load1(Reg,Type,HFileKey) -> + Names = [HFileKey, "Domain", "DhcpDomain", + "EnableDNS", "NameServer", "SearchList"], + case win32_get_strings(Reg, Names) of + [DBPath0, Domain, DhcpDomain, + _EnableDNS, NameServers0, Search] -> + inet_db:set_domain( + case Domain of "" -> DhcpDomain; _ -> Domain end), + NameServers = win32_split_line(NameServers0,Type), + AddNs = fun(Addr) -> + case inet_parse:address(Addr) of + {ok, Address} -> + inet_db:add_ns(Address); + {error, _} -> + error("Bad TCP/IP address in registry", []) + end + end, + foreach(AddNs, NameServers), + Searches0 = win32_split_line(Search,Type), + Searches = case member(Domain, Searches0) of + true -> Searches0; + false -> [Domain|Searches0] + end, + foreach(fun(D) -> inet_db:add_search(D) end, Searches), + if Type =:= nt -> + DBPath = win32reg:expand(DBPath0), + load_hosts(filename:join(DBPath, "hosts"),nt); + Type =:= windows -> + load_hosts(filename:join(DBPath0,""),windows) + end, +%% Maybe activate this later as an optimization +%% For now we use native always as the SAFE way +%% case NameServers of +%% [] -> inet_db:set_lookup([native, file]); +%% _ -> inet_db:set_lookup([dns, file, native]) +%% end; + true; + {error, _Reason} -> + error("Failed to read TCP/IP parameters from registry", []) + end. + +win32_split_line(Line,nt) -> inet_parse:split_line(Line); +win32_split_line(Line,windows) -> string:tokens(Line, ","). + +win32_get_strings(Reg, Names) -> + win32_get_strings(Reg, Names, []). + +win32_get_strings(Reg, [Name|Rest], Result) -> + case win32reg:value(Reg, Name) of + {ok, Value} when is_list(Value) -> + win32_get_strings(Reg, Rest, [Value|Result]); + {ok, _NotString} -> + {error, not_string}; + {error, _Reason} -> + win32_get_strings(Reg, Rest, [""|Result]) + end; +win32_get_strings(_, [], Result) -> + lists:reverse(Result). + +%% +%% Load host data from VxWorks hostShow command +%% + +vxworks_load_hosts() -> + HostShow = os:cmd("hostShow"), + case check_hostShow(HostShow) of + Hosts when is_list(Hosts) -> + case inet_parse:hosts_vxworks({chars, Hosts}) of + {ok, Ls} -> + foreach( + fun({IP, Name, Aliases}) -> + inet_db:add_host(IP, [Name|Aliases]) + end, + Ls); + {error,Reason} -> + error("parser error VxWorks hostShow ~s", [Reason]) + end; + _Error -> + error("error in VxWorks hostShow~s~n", [HostShow]) + end. + +%% +%% Check if hostShow yields at least two line; the first one +%% starting with "hostname", the second one starting with +%% "--------". +%% Returns: list of hosts in VxWorks notation +%% rows of 'Name IP [Aliases] \n' +%% if hostShow yielded these two lines, false otherwise. +check_hostShow(HostShow) -> + check_hostShow(["hostname", "--------"], HostShow). + +check_hostShow([], HostShow) -> + HostShow; +check_hostShow([String_match|Rest], HostShow) -> + case lists:prefix(String_match, HostShow) of + true -> + check_hostShow(Rest, next_line(HostShow)); + false -> + false + end. + +next_line([]) -> + []; +next_line([$\n|Rest]) -> + Rest; +next_line([_First|Rest]) -> + next_line(Rest). + +read_rc() -> + {RcFile,CfgList} = read_inetrc(), + case extract_cfg_files(CfgList, [], []) of + {CfgFiles,CfgList1} -> + {RcFile,CfgFiles,CfgList1}; + error -> + {error,[],[]} + end. + + + +extract_cfg_files([E = {file,Type,_File} | Es], CfgFiles, CfgList) -> + extract_cfg_files1(Type, E, Es, CfgFiles, CfgList); +extract_cfg_files([E = {registry,Type} | Es], CfgFiles, CfgList) -> + extract_cfg_files1(Type, E, Es, CfgFiles, CfgList); +extract_cfg_files([E | Es], CfgFiles, CfgList) -> + extract_cfg_files(Es, CfgFiles, [E | CfgList]); +extract_cfg_files([], CfgFiles, CfgList) -> + {reverse(CfgFiles),reverse(CfgList)}. + +extract_cfg_files1(Type, E, Es, CfgFiles, CfgList) -> + case valid_type(Type) of + true -> + extract_cfg_files(Es, [E | CfgFiles], CfgList); + false -> + error("invalid config value ~w in inetrc~n", [Type]), + error + end. + +valid_type(resolv) -> true; +valid_type(host_conf_freebsd) -> true; +valid_type(host_conf_bsdos) -> true; +valid_type(host_conf_linux) -> true; +valid_type(nsswitch_conf) -> true; +valid_type(hosts) -> true; +valid_type(win32) -> true; +valid_type(_) -> false. + +read_inetrc() -> + case application:get_env(inetrc) of + {ok,File} -> + try_get_rc(File); + _ -> + case os:getenv("ERL_INETRC") of + false -> + {nofile,[]}; + File -> + try_get_rc(File) + end + end. + +try_get_rc(File) -> + case get_rc(File) of + error -> {nofile,[]}; + Ls -> {File,Ls} + end. + +get_rc(File) -> + case get_file(File) of + {ok,Bin} -> + case parse_inetrc(Bin) of + {ok,Ls} -> + Ls; + _Error -> + error("parse error in ~s~n", [File]), + error + end; + _Error -> + error("file ~s not found~n", [File]), + error + end. + +%% XXX Check if we really need to prim load the stuff +get_file(File) -> + case erl_prim_loader:get_file(File) of + {ok,Bin,_} -> {ok,Bin}; + Error -> Error + end. + +error(Fmt, Args) -> + error_logger:error_msg("inet_config: " ++ Fmt, Args). + +warning(Fmt, Args) -> + case application:get_env(kernel,inet_warnings) of + %{ok,silent} -> ok; + {ok,on} -> + error_logger:info_msg("inet_config:" ++ Fmt, Args); + _ -> + ok + end. + +%% +%% Parse inetrc, i.e. make a binary of a term list. +%% The extra newline is to let the user ignore the whitespace !!! +%% Ignore leading whitespace before a token (due to bug in erl_scan) ! +%% +parse_inetrc(Bin) -> + Str = binary_to_list(Bin) ++ "\n", + parse_inetrc(Str, 1, []). + +parse_inetrc_skip_line([], _Line, Ack) -> + {ok, reverse(Ack)}; +parse_inetrc_skip_line([$\n|Str], Line, Ack) -> + parse_inetrc(Str, Line+1, Ack); +parse_inetrc_skip_line([_|Str], Line, Ack) -> + parse_inetrc_skip_line(Str, Line, Ack). + +parse_inetrc([$%|Str], Line, Ack) -> + parse_inetrc_skip_line(Str, Line, Ack); +parse_inetrc([$\s|Str], Line, Ack) -> + parse_inetrc(Str, Line, Ack); +parse_inetrc([$\n |Str], Line, Ack) -> + parse_inetrc(Str, Line+1, Ack); +parse_inetrc([$\t|Str], Line, Ack) -> + parse_inetrc(Str, Line, Ack); +parse_inetrc([], _, Ack) -> + {ok, reverse(Ack)}; + + +%% The clauses above are here due to a bug in erl_scan (OTP-1449). + +parse_inetrc(Str, Line, Ack) -> + case erl_scan:tokens([], Str, Line) of + {done, {ok, Tokens, EndLine}, MoreChars} -> + case erl_parse:parse_term(Tokens) of + {ok, Term} -> + parse_inetrc(MoreChars, EndLine, [Term|Ack]); + Error -> + {error, {'parse_inetrc', Error}} + end; + {done, {eof, _}, _} -> + {ok, reverse(Ack)}; + {done, Error, _} -> + {error, {'scan_inetrc', Error}}; + {more, _} -> %% Bug in erl_scan !! + {error, {'scan_inetrc', {eof, Line}}} + end. -- cgit v1.2.3