diff options
Diffstat (limited to 'lib/kernel/src')
82 files changed, 9566 insertions, 5913 deletions
diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 9db6014a7d..2b72f78dcf 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2010. All Rights Reserved. +# Copyright Ericsson AB 1996-2016. 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/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# 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. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -103,11 +104,12 @@ MODULES = \ inet_sctp \ kernel \ kernel_config \ + local_udp \ + local_tcp \ net \ net_adm \ net_kernel \ os \ - packages \ pg2 \ ram_file \ rpc \ @@ -118,11 +120,15 @@ MODULES = \ user_sup \ wrap_log_reader -HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl +HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ + ../include/dist.hrl ../include/dist_util.hrl \ + ../include/net_address.hrl + INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ - net_address.hrl inet_dns.hrl inet_res.hrl \ + erl_epmd.hrl hipe_ext_format.hrl \ + inet_dns.hrl inet_res.hrl \ inet_boot.hrl inet_config.hrl inet_int.hrl \ - dist.hrl dist_util.hrl inet_dns_record_adts.hrl + inet_dns_record_adts.hrl ERL_FILES= $(MODULES:%=%.erl) @@ -146,7 +152,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) ifeq ($(NATIVE_LIBS_ENABLED),yes) ERL_COMPILE_FLAGS += +native endif -ERL_COMPILE_FLAGS += -I../include +ERL_COMPILE_FLAGS += -I../include -Werror # ---------------------------------------------------- # Targets @@ -168,13 +174,13 @@ docs: # ---------------------------------------------------- ../../hipe/main/hipe.hrl: ../../hipe/vsn.mk ../../hipe/main/hipe.hrl.src - sed -e "s;%VSN%;$(HIPE_VSN);" ../../hipe/main/hipe.hrl.src > ../../hipe/main/hipe.hrl + $(vsn_verbose)sed -e "s;%VSN%;$(HIPE_VSN);" ../../hipe/main/hipe.hrl.src > ../../hipe/main/hipe.hrl $(APP_TARGET): $(APP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(KERNEL_VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(KERNEL_VSN);' $< > $@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - sed -e 's;%VSN%;$(KERNEL_VSN);' $< > $@ + $(vsn_verbose)sed -e 's;%VSN%;$(KERNEL_VSN);' $< > $@ EPMD_FLAGS = -Depmd_port_no=$(EPMD_PORT_NO) \ @@ -184,10 +190,10 @@ EPMD_FLAGS = -Depmd_port_no=$(EPMD_PORT_NO) \ -Derlang_daemon_port=$(EPMD_PORT_NO) $(ESRC)/inet_dns_record_adts.hrl: $(ESRC)/inet_dns_record_adts.pl - LANG=C $(PERL) $< > $@ + $(gen_verbose)LANG=C $(PERL) $< > $@ $(EBIN)/erl_epmd.beam: $(ESRC)/erl_epmd.erl - $(ERLC) $(ERL_COMPILE_FLAGS) $(EPMD_FLAGS) -o$(EBIN) $< + $(V_ERLC) $(ERL_COMPILE_FLAGS) $(EPMD_FLAGS) -o$(EBIN) $< # ---------------------------------------------------- # Release Target @@ -195,13 +201,13 @@ $(EBIN)/erl_epmd.beam: $(ESRC)/erl_epmd.erl include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src - $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/include - $(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + $(INSTALL_DIR) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) "$(RELSYSDIR)/src" + $(INSTALL_DIR) "$(RELSYSDIR)/include" + $(INSTALL_DATA) $(HRL_FILES) "$(RELSYSDIR)/include" + $(INSTALL_DIR) "$(RELSYSDIR)/ebin" + $(INSTALL_DATA) $(TARGET_FILES) "$(RELSYSDIR)/ebin" release_docs_spec: @@ -215,7 +221,7 @@ $(EBIN)/code_server.beam: ../include/file.hrl $(EBIN)/disk_log.beam: disk_log.hrl $(EBIN)/disk_log_1.beam: disk_log.hrl ../include/file.hrl $(EBIN)/disk_log_server.beam: disk_log.hrl -$(EBIN)/dist_util.beam: dist_util.hrl dist.hrl +$(EBIN)/dist_util.beam: ../include/dist_util.hrl ../include/dist.hrl $(EBIN)/erl_boot_server.beam: inet_boot.hrl $(EBIN)/erl_epmd.beam: inet_int.hrl erl_epmd.hrl $(EBIN)/file.beam: ../include/file.hrl @@ -226,7 +232,7 @@ $(EBIN)/global.beam: ../../stdlib/include/ms_transform.hrl $(EBIN)/hipe_unified_loader.beam: ../../hipe/main/hipe.hrl hipe_ext_format.hrl $(EBIN)/inet.beam: ../include/inet.hrl inet_int.hrl ../include/inet_sctp.hrl $(EBIN)/inet6_tcp.beam: inet_int.hrl -$(EBIN)/inet6_tcp_dist.beam: net_address.hrl dist.hrl dist_util.hrl +$(EBIN)/inet6_tcp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet6_udp.beam: inet_int.hrl $(EBIN)/inet6_sctp.beam: inet_int.hrl $(EBIN)/inet_config.beam: inet_config.hrl ../include/inet.hrl @@ -237,10 +243,12 @@ $(EBIN)/inet_hosts.beam: ../include/inet.hrl $(EBIN)/inet_parse.beam: ../include/file.hrl $(EBIN)/inet_res.beam: ../include/inet.hrl inet_res.hrl inet_dns.hrl inet_int.hrl $(EBIN)/inet_tcp.beam: inet_int.hrl -$(EBIN)/inet_udp_dist.beam: net_address.hrl dist.hrl dist_util.hrl +$(EBIN)/inet_udp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet_udp.beam: inet_int.hrl $(EBIN)/inet_sctp.beam: inet_int.hrl ../include/inet_sctp.hrl -$(EBIN)/net_kernel.beam: net_address.hrl +$(EBIN)/local_udp.beam: inet_int.hrl +$(EBIN)/local_tcp.beam: inet_int.hrl +$(EBIN)/net_kernel.beam: ../include/net_address.hrl $(EBIN)/os.beam: ../include/file.hrl $(EBIN)/ram_file.beam: ../include/file.hrl $(EBIN)/wrap_log_reader.beam: disk_log.hrl ../include/file.hrl diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index d9db23d652..bc6be2f8f5 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -1,76 +1,100 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(application). --export([start/1, start/2, start_boot/1, start_boot/2, stop/1, +-export([ensure_all_started/1, ensure_all_started/2, start/1, start/2, + start_boot/1, start_boot/2, stop/1, load/1, load/2, unload/1, takeover/2, which_applications/0, which_applications/1, loaded_applications/0, permit/2]). +-export([ensure_started/1, ensure_started/2]). -export([set_env/3, set_env/4, unset_env/2, unset_env/3]). --export([get_env/1, get_env/2, get_all_env/0, get_all_env/1]). +-export([get_env/1, get_env/2, get_env/3, get_all_env/0, get_all_env/1]). -export([get_key/1, get_key/2, get_all_key/0, get_all_key/1]). -export([get_application/0, get_application/1, info/0]). -export([start_type/0]). --export([behaviour_info/1]). +-export_type([start_type/0]). %%%----------------------------------------------------------------- +-type start_type() :: 'normal' + | {'takeover', Node :: node()} + | {'failover', Node :: node()}. -type restart_type() :: 'permanent' | 'transient' | 'temporary'. --type application_opt() :: {'description', string()} - | {'vsn', string()} - | {'id', string()} - | {'modules', [atom() | {atom(), any()}]} - | {'registered', [atom()]} - | {'applications', [atom()]} - | {'included_applications', [atom()]} - | {'env', [{atom(), any()}]} - | {'start_phases', [{atom(), any()}] | 'undefined'} - | {'maxT', timeout()} % max timeout - | {'maxP', integer() | 'infinity'} % max processes - | {'mod', {atom(), any()}}. --type application_spec() :: {'application', atom(), [application_opt()]}. +-type application_opt() :: {'description', Description :: string()} + | {'vsn', Vsn :: string()} + | {'id', Id :: string()} + | {'modules', [Module :: module()]} + | {'registered', Names :: [Name :: atom()]} + | {'applications', [Application :: atom()]} + | {'included_applications', [Application :: atom()]} + | {'env', [{Par :: atom(), Val :: term()}]} + | {'start_phases', + [{Phase :: atom(), PhaseArgs :: term()}] | 'undefined'} + | {'maxT', MaxT :: timeout()} % max timeout + | {'maxP', + MaxP :: pos_integer() | 'infinity'} % max processes + | {'mod', Start :: {Module :: module(), StartArgs :: term()}}. +-type application_spec() :: {'application', + Application :: atom(), + AppSpecKeys :: [application_opt()]}. + +-type(tuple_of(_T) :: tuple()). %%------------------------------------------------------------------ --spec behaviour_info(atom()) -> 'undefined' | [{atom(), byte()}]. +-callback start(StartType :: start_type(), StartArgs :: term()) -> + {'ok', pid()} | {'ok', pid(), State :: term()} | {'error', Reason :: term()}. -behaviour_info(callbacks) -> - [{start,2},{stop,1}]; -behaviour_info(_Other) -> - undefined. +-callback stop(State :: term()) -> + term(). %%%----------------------------------------------------------------- %%% This module is API towards application_controller and %%% application_master. %%%----------------------------------------------------------------- --spec load(Application :: atom() | application_spec()) -> - 'ok' | {'error', term()}. +-spec load(AppDescr) -> 'ok' | {'error', Reason} when + AppDescr :: Application | (AppSpec :: application_spec()), + Application :: atom(), + Reason :: term(). load(Application) -> - load(Application, []). - --spec load(Application :: atom() | application_spec(), - Distributed :: any()) -> 'ok' | {'error', term()}. + load1(Application, []). + +-spec load(AppDescr, Distributed) -> 'ok' | {'error', Reason} when + AppDescr :: Application | (AppSpec :: application_spec()), + Application :: atom(), + Distributed :: {Application,Nodes} + | {Application,Time,Nodes} + | 'default', + Nodes :: [node() | tuple_of(node())], + Time :: pos_integer(), + Reason :: term(). load(Application, DistNodes) -> + load1(Application, DistNodes). + +%% Workaround due to specs. +load1(Application, DistNodes) -> case application_controller:load_application(Application) of ok when DistNodes =/= [] -> AppName = get_appl_name(Application), @@ -85,18 +109,64 @@ load(Application, DistNodes) -> Else end. --spec unload(Application :: atom()) -> 'ok' | {'error', term()}. +-spec unload(Application) -> 'ok' | {'error', Reason} when + Application :: atom(), + Reason :: term(). unload(Application) -> application_controller:unload_application(Application). --spec start(Application :: atom()) -> 'ok' | {'error', term()}. + +-spec ensure_all_started(Application) -> {'ok', Started} | {'error', Reason} when + Application :: atom(), + Started :: [atom()], + Reason :: term(). +ensure_all_started(Application) -> + ensure_all_started(Application, temporary). + +-spec ensure_all_started(Application, Type) -> {'ok', Started} | {'error', Reason} when + Application :: atom(), + Type :: restart_type(), + Started :: [atom()], + Reason :: term(). +ensure_all_started(Application, Type) -> + case ensure_all_started(Application, Type, []) of + {ok, Started} -> + {ok, lists:reverse(Started)}; + {error, Reason, Started} -> + _ = [stop(App) || App <- Started], + {error, Reason} + end. + +ensure_all_started(Application, Type, Started) -> + case start(Application, Type) of + ok -> + {ok, [Application | Started]}; + {error, {already_started, Application}} -> + {ok, Started}; + {error, {not_started, Dependency}} -> + case ensure_all_started(Dependency, Type, Started) of + {ok, NewStarted} -> + ensure_all_started(Application, Type, NewStarted); + Error -> + Error + end; + {error, Reason} -> + {error, {Application, Reason}, Started} + end. + + +-spec start(Application) -> 'ok' | {'error', Reason} when + Application :: atom(), + Reason :: term(). start(Application) -> start(Application, temporary). --spec start(Application :: atom() | application_spec(), - RestartType :: restart_type()) -> any(). +-spec start(Application, Type) -> 'ok' | {'error', Reason} when + Application :: atom(), + Type :: restart_type(), + Reason :: term(). start(Application, RestartType) -> case load(Application) of @@ -109,6 +179,28 @@ start(Application, RestartType) -> Error end. +-spec ensure_started(Application) -> 'ok' | {'error', Reason} when + Application :: atom(), + Reason :: term(). + +ensure_started(Application) -> + ensure_started(Application, temporary). + +-spec ensure_started(Application, Type) -> 'ok' | {'error', Reason} when + Application :: atom(), + Type :: restart_type(), + Reason :: term(). + +ensure_started(Application, RestartType) -> + case start(Application, RestartType) of + ok -> + ok; + {error, {already_started, Application}} -> + ok; + Error -> + Error + end. + -spec start_boot(Application :: atom()) -> 'ok' | {'error', term()}. start_boot(Application) -> @@ -120,12 +212,18 @@ start_boot(Application) -> start_boot(Application, RestartType) -> application_controller:start_boot_application(Application, RestartType). --spec takeover(Application :: atom(), RestartType :: restart_type()) -> any(). +-spec takeover(Application, Type) -> 'ok' | {'error', Reason} when + Application :: atom(), + Type :: restart_type(), + Reason :: term(). takeover(Application, RestartType) -> dist_ac:takeover_application(Application, RestartType). --spec permit(Application :: atom(), Bool :: boolean()) -> 'ok' | {'error', term()}. +-spec permit(Application, Permission) -> 'ok' | {'error', Reason} when + Application :: atom(), + Permission :: boolean(), + Reason :: term(). permit(Application, Bool) -> case Bool of @@ -142,105 +240,164 @@ permit(Application, Bool) -> LocalResult end. --spec stop(Application :: atom()) -> 'ok' | {'error', term()}. +-spec stop(Application) -> 'ok' | {'error', Reason} when + Application :: atom(), + Reason :: term(). stop(Application) -> application_controller:stop_application(Application). --spec which_applications() -> [{atom(), string(), string()}]. +-spec which_applications() -> [{Application, Description, Vsn}] when + Application :: atom(), + Description :: string(), + Vsn :: string(). which_applications() -> application_controller:which_applications(). --spec which_applications(timeout()) -> [{atom(), string(), string()}]. +-spec which_applications(Timeout) -> [{Application, Description, Vsn}] when + Timeout :: timeout(), + Application :: atom(), + Description :: string(), + Vsn :: string(). which_applications(infinity) -> application_controller:which_applications(infinity); which_applications(Timeout) when is_integer(Timeout), Timeout>=0 -> application_controller:which_applications(Timeout). --spec loaded_applications() -> [{atom(), string(), string()}]. +-spec loaded_applications() -> [{Application, Description, Vsn}] when + Application :: atom(), + Description :: string(), + Vsn :: string(). loaded_applications() -> application_controller:loaded_applications(). --spec info() -> any(). +-spec info() -> term(). info() -> application_controller:info(). --spec set_env(Application :: atom(), Key :: atom(), Value :: any()) -> 'ok'. +-spec set_env(Application, Par, Val) -> 'ok' when + Application :: atom(), + Par :: atom(), + Val :: term(). set_env(Application, Key, Val) -> application_controller:set_env(Application, Key, Val). --spec set_env(Application :: atom(), Key :: atom(), - Value :: any(), Timeout :: timeout()) -> 'ok'. +-spec set_env(Application, Par, Val, Opts) -> 'ok' when + Application :: atom(), + Par :: atom(), + Val :: term(), + Opts :: [{timeout, timeout()} | {persistent, boolean()}]. set_env(Application, Key, Val, infinity) -> - application_controller:set_env(Application, Key, Val, infinity); + set_env(Application, Key, Val, [{timeout, infinity}]); set_env(Application, Key, Val, Timeout) when is_integer(Timeout), Timeout>=0 -> - application_controller:set_env(Application, Key, Val, Timeout). + set_env(Application, Key, Val, [{timeout, Timeout}]); +set_env(Application, Key, Val, Opts) when is_list(Opts) -> + application_controller:set_env(Application, Key, Val, Opts). --spec unset_env(atom(), atom()) -> 'ok'. +-spec unset_env(Application, Par) -> 'ok' when + Application :: atom(), + Par :: atom(). unset_env(Application, Key) -> application_controller:unset_env(Application, Key). --spec unset_env(atom(), atom(), timeout()) -> 'ok'. +-spec unset_env(Application, Par, Opts) -> 'ok' when + Application :: atom(), + Par :: atom(), + Opts :: [{timeout, timeout()} | {persistent, boolean()}]. unset_env(Application, Key, infinity) -> - application_controller:unset_env(Application, Key, infinity); + unset_env(Application, Key, [{timeout, infinity}]); unset_env(Application, Key, Timeout) when is_integer(Timeout), Timeout>=0 -> - application_controller:unset_env(Application, Key, Timeout). + unset_env(Application, Key, [{timeout, Timeout}]); +unset_env(Application, Key, Opts) when is_list(Opts) -> + application_controller:unset_env(Application, Key, Opts). --spec get_env(atom()) -> 'undefined' | {'ok', term()}. +-spec get_env(Par) -> 'undefined' | {'ok', Val} when + Par :: atom(), + Val :: term(). get_env(Key) -> application_controller:get_pid_env(group_leader(), Key). --spec get_env(atom(), atom()) -> 'undefined' | {'ok', term()}. +-spec get_env(Application, Par) -> 'undefined' | {'ok', Val} when + Application :: atom(), + Par :: atom(), + Val :: term(). get_env(Application, Key) -> application_controller:get_env(Application, Key). --spec get_all_env() -> [] | [{atom(), any()}]. +-spec get_env(Application, Par, Def) -> Val when + Application :: atom(), + Par :: atom(), + Def :: term(), + Val :: term(). + +get_env(Application, Key, Def) -> + case get_env(Application, Key) of + {ok, Val} -> + Val; + undefined -> + Def + end. + +-spec get_all_env() -> Env when + Env :: [{Par :: atom(), Val :: term()}]. get_all_env() -> application_controller:get_pid_all_env(group_leader()). --spec get_all_env(atom()) -> [] | [{atom(), any()}]. +-spec get_all_env(Application) -> Env when + Application :: atom(), + Env :: [{Par :: atom(), Val :: term()}]. get_all_env(Application) -> application_controller:get_all_env(Application). --spec get_key(atom()) -> 'undefined' | {'ok', term()}. +-spec get_key(Key) -> 'undefined' | {'ok', Val} when + Key :: atom(), + Val :: term(). get_key(Key) -> application_controller:get_pid_key(group_leader(), Key). --spec get_key(atom(), atom()) -> 'undefined' | {'ok', term()}. +-spec get_key(Application, Key) -> 'undefined' | {'ok', Val} when + Application :: atom(), + Key :: atom(), + Val :: term(). get_key(Application, Key) -> application_controller:get_key(Application, Key). --spec get_all_key() -> 'undefined' | [] | {'ok', [{atom(),any()},...]}. +-spec get_all_key() -> [] | {'ok', Keys} when + Keys :: [{Key :: atom(),Val :: term()},...]. get_all_key() -> application_controller:get_pid_all_key(group_leader()). --spec get_all_key(atom()) -> 'undefined' | {'ok', [{atom(),any()},...]}. +-spec get_all_key(Application) -> 'undefined' | Keys when + Application :: atom(), + Keys :: {'ok', [{Key :: atom(),Val :: term()},...]}. get_all_key(Application) -> application_controller:get_all_key(Application). --spec get_application() -> 'undefined' | {'ok', atom()}. +-spec get_application() -> 'undefined' | {'ok', Application} when + Application :: atom(). get_application() -> application_controller:get_application(group_leader()). --spec get_application(Pid :: pid()) -> 'undefined' | {'ok', atom()} - ; (Module :: atom()) -> 'undefined' | {'ok', atom()}. +-spec get_application(PidOrModule) -> 'undefined' | {'ok', Application} when + PidOrModule :: (Pid :: pid()) | (Module :: module()), + Application :: atom(). get_application(Pid) when is_pid(Pid) -> case process_info(Pid, group_leader) of @@ -252,8 +409,8 @@ get_application(Pid) when is_pid(Pid) -> get_application(Module) when is_atom(Module) -> application_controller:get_application_module(Module). --spec start_type() -> 'undefined' | 'local' | 'normal' - | {'takeover', node()} | {'failover', node()}. +-spec start_type() -> StartType | 'undefined' | 'local' when + StartType :: start_type(). start_type() -> application_controller:start_type(group_leader()). diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index 7c1f059875..0e61153613 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(application_controller). @@ -40,7 +41,7 @@ -export([test_change_apps/2]). -import(lists, [zf/2, map/2, foreach/2, foldl/3, - keysearch/3, keydelete/3, keyreplace/4]). + keyfind/3, keydelete/3, keyreplace/4]). -include("application_master.hrl"). @@ -128,8 +129,13 @@ %% AppName = atom() %% Application = App | AppName %%----------------------------------------------------------------- + +-type appname() :: atom(). + -record(state, {loading = [], starting = [], start_p_false = [], running = [], control = [], started = [], start_req = [], conf_data}). +-type state() :: #state{}. + %%----------------------------------------------------------------- %% loading = [{AppName, From}] - Load not yet finished %% starting = [{AppName, RestartType, Type, From}] - Start not @@ -157,7 +163,7 @@ %% appl_opt() = {description, string()} | %% {vsn, string()} | %% {id, string()}, | -%% {modules, [Module|{Module,Vsn}]} | +%% {modules, [Module]} | %% {registered, [atom()]} | %% {applications, [atom()]} | %% {included_applications, [atom()]} | @@ -167,7 +173,6 @@ %% {maxP, integer()|infinity} | %% {mod, {Module, term()}} %% Module = atom() -%% Vsn = term() %% Purpose: Starts the application_controller. This process starts all %% application masters for the applications. %% The kernel application is the only application that is @@ -243,7 +248,7 @@ start_boot_application(Application, RestartType) -> {{error, {already_loaded, AppName}}, _} -> gen_server:call(?AC, {start_application, AppName, RestartType}, infinity); {{error,{bad_environment_value,Env}}, permanent} -> - Txt = io_lib:format("Bad environment variable: ~p Application: ~p", + Txt = io_lib:format("Bad environment variable: ~tp Application: ~p", [Env, Application]), exit({error, list_to_atom(lists:flatten(Txt))}); {Error, _} -> @@ -441,7 +446,7 @@ get_application_module(Module) -> get_application_module(Module, AppModules). get_application_module(Module, [[AppName, Modules]|AppModules]) -> - case in_modules(Module, Modules) of + case lists:member(Module, Modules) of true -> {ok, AppName}; false -> @@ -450,16 +455,6 @@ get_application_module(Module, [[AppName, Modules]|AppModules]) -> get_application_module(_Module, []) -> undefined. -%% 'modules' key in .app is a list of Module or {Module,Vsn} -in_modules(Module, [Module|_Modules]) -> - true; -in_modules(Module, [{Module, _Vsn}|_Modules]) -> - true; -in_modules(Module, [_Module|Modules]) -> - in_modules(Module, Modules); -in_modules(_Module, []) -> - false. - permit_application(ApplName, Flag) -> gen_server:call(?AC, {permit_application, ApplName, Flag}, @@ -467,14 +462,16 @@ permit_application(ApplName, Flag) -> set_env(AppName, Key, Val) -> - gen_server:call(?AC, {set_env, AppName, Key, Val}). -set_env(AppName, Key, Val, Timeout) -> - gen_server:call(?AC, {set_env, AppName, Key, Val}, Timeout). + gen_server:call(?AC, {set_env, AppName, Key, Val, []}). +set_env(AppName, Key, Val, Opts) -> + Timeout = proplists:get_value(timeout, Opts, 5000), + gen_server:call(?AC, {set_env, AppName, Key, Val, Opts}, Timeout). unset_env(AppName, Key) -> - gen_server:call(?AC, {unset_env, AppName, Key}). -unset_env(AppName, Key, Timeout) -> - gen_server:call(?AC, {unset_env, AppName, Key}, Timeout). + gen_server:call(?AC, {unset_env, AppName, Key, []}). +unset_env(AppName, Key, Opts) -> + Timeout = proplists:get_value(timeout, Opts, 5000), + gen_server:call(?AC, {unset_env, AppName, Key, Opts}, Timeout). %%%----------------------------------------------------------------- %%% call-back functions from gen_server @@ -494,32 +491,37 @@ init(Init, Kernel) -> %% called during start-up of any app. case check_conf_data(ConfData) of ok -> - ets:new(ac_tab, [set, public, named_table]), + _ = ets:new(ac_tab, [set, public, named_table, + {read_concurrency,true}]), S = #state{conf_data = ConfData}, {ok, KAppl} = make_appl(Kernel), case catch load(S, KAppl) of {'EXIT', LoadError} -> Reason = {'load error', LoadError}, Init ! {ack, self(), {error, to_string(Reason)}}; + {error, Error} -> + Init ! {ack, self(), {error, to_string(Error)}}; {ok, NewS} -> Init ! {ack, self(), ok}, gen_server:enter_loop(?MODULE, [], NewS, {local, ?AC}) end; {error, ErrorStr} -> - Str = lists:flatten(io_lib:format("invalid config data: ~s", [ErrorStr])), + Str = lists:flatten(io_lib:format("invalid config data: ~ts", [ErrorStr])), Init ! {ack, self(), {error, to_string(Str)}} end; {error, {File, Line, Str}} -> ReasonStr = lists:flatten(io_lib:format("error in config file " - "~p (~w): ~s", + "~tp (~w): ~ts", [File, Line, Str])), Init ! {ack, self(), {error, to_string(ReasonStr)}} end. -%% Check the syntax of the .config file [{ApplicationName, [{Parameter, Value}]}]. +%% Check the syntax of the .config file +%% [{ApplicationName, [{Parameter, Value}]}]. + check_conf_data([]) -> ok; check_conf_data(ConfData) when is_list(ConfData) -> @@ -541,17 +543,17 @@ check_conf_data(ConfData) when is_list(ConfData) -> end; {AppName, List} when is_list(List) -> ErrMsg = "application: " - ++ lists:flatten(io_lib:format("~p",[AppName])) + ++ lists:flatten(io_lib:format("~tp",[AppName])) ++ "; application name must be an atom", {error, ErrMsg}; {AppName, _List} -> ErrMsg = "application: " - ++ lists:flatten(io_lib:format("~p",[AppName])) + ++ lists:flatten(io_lib:format("~tp",[AppName])) ++ "; parameters must be a list", {error, ErrMsg}; Else -> ErrMsg = "invalid application name: " ++ - lists:flatten(io_lib:format(" ~p",[Else])), + lists:flatten(io_lib:format(" ~tp",[Else])), {error, ErrMsg} end; check_conf_data(_ConfData) -> @@ -563,8 +565,8 @@ check_para_kernel([]) -> ok; check_para_kernel([{distributed, Apps} | ParaList]) when is_list(Apps) -> case check_distributed(Apps) of - {error, ErrorMsg} -> - {error, ErrorMsg}; + {error, _ErrorMsg} = Error -> + Error; _ -> check_para_kernel(ParaList) end; @@ -574,10 +576,10 @@ check_para_kernel([{Para, _Val} | ParaList]) when is_atom(Para) -> check_para_kernel(ParaList); check_para_kernel([{Para, _Val} | _ParaList]) -> {error, "application: kernel; invalid parameter: " ++ - lists:flatten(io_lib:format("~p",[Para]))}; + lists:flatten(io_lib:format("~tp",[Para]))}; check_para_kernel(Else) -> {error, "application: kernel; invalid parameter list: " ++ - lists:flatten(io_lib:format("~p",[Else]))}. + lists:flatten(io_lib:format("~tp",[Else]))}. check_distributed([]) -> @@ -598,11 +600,24 @@ check_para([{Para, _Val} | ParaList], AppName) when is_atom(Para) -> check_para(ParaList, AppName); check_para([{Para, _Val} | _ParaList], AppName) -> {error, "application: " ++ AppName ++ "; invalid parameter: " ++ - lists:flatten(io_lib:format("~p",[Para]))}; + lists:flatten(io_lib:format("~tp",[Para]))}; check_para([Else | _ParaList], AppName) -> {error, "application: " ++ AppName ++ "; invalid parameter: " ++ - lists:flatten(io_lib:format("~p",[Else]))}. + lists:flatten(io_lib:format("~tp",[Else]))}. + +-type calls() :: 'info' | 'prep_config_change' | 'which_applications' + | {'config_change' | 'control_application' | + 'load_application' | 'start_type' | 'stop_application' | + 'unload_application', term()} + | {'change_application_data', _, _} + | {'permit_application', atom() | {'application',atom(),_},_} + | {'start_application', _, _} + | {'unset_env', _, _, _} + | {'set_env', _, _, _, _}. + +-spec handle_call(calls(), {pid(), term()}, state()) -> + {'noreply', state()} | {'reply', term(), state()}. handle_call({load_application, Application}, From, S) -> case catch do_load_application(Application, S) of @@ -615,9 +630,9 @@ handle_call({load_application, Application}, From, S) -> false -> {reply, ok, NewS} end; - {error, Error} -> - {reply, {error, Error}, S}; - {'EXIT',R} -> + {error, _} = Error -> + {reply, Error, S}; + {'EXIT', R} -> {reply, {error, R}, S} end; @@ -642,7 +657,7 @@ handle_call({start_application, AppName, RestartType}, From, S) -> %% Incase of erroneous variables do not start the application, %% if the application is permanent crash the node. %% Check if the application is already starting. - case lists:keysearch(AppName, 1, Start_req) of + case lists:keyfind(AppName, 1, Start_req) of false -> case catch check_start_cond(AppName, RestartType, Started, Running) of {ok, Appl} -> @@ -671,13 +686,12 @@ handle_call({start_application, AppName, RestartType}, From, S) -> {reply, ok, SS} end end; - {error, R} -> - {reply, {error, R}, S} + {error, _R} = Error -> + {reply, Error, S} end; - {value, {AppName, _FromX}} -> + {AppName, _FromX} -> SS = S#state{start_req = [{AppName, From} | Start_req]}, {noreply, SS} - end; handle_call({permit_application, AppName, Bool}, From, S) -> @@ -751,11 +765,11 @@ handle_call({permit_application, AppName, Bool}, From, S) -> {noreply, SS}; %%========================== - %% unpermit the applicaition + %% unpermit the application %%========================== %% running {false, _, _, _, _, {value, {_AppName, Id}}} -> - {value, {_AppName2, Type}} = keysearch(AppName, 1, Started), + {_AppName2, Type} = lists:keyfind(AppName, 1, Started), stop_appl(AppName, Id, Type), NRunning = keydelete(AppName, 1, Running), {reply, ok, S#state{running = NRunning}}; @@ -785,9 +799,9 @@ handle_call({permit_application, AppName, Bool}, From, S) -> handle_call({stop_application, AppName}, _From, S) -> #state{running = Running, started = Started} = S, - case keysearch(AppName, 1, Running) of - {value, {_AppName, Id}} -> - {value, {_AppName2, Type}} = keysearch(AppName, 1, Started), + case lists:keyfind(AppName, 1, Running) of + {_AppName, Id} -> + {_AppName2, Type} = lists:keyfind(AppName, 1, Started), stop_appl(AppName, Id, Type), NRunning = keydelete(AppName, 1, Running), NStarted = keydelete(AppName, 1, Started), @@ -813,16 +827,16 @@ handle_call({change_application_data, Applications, Config}, _From, S) -> end, []), case catch do_change_apps(Applications, Config, OldAppls) of - {error, R} -> - {reply, {error, R}, S}; + {error, _} = Error -> + {reply, Error, S}; {'EXIT', R} -> {reply, {error, R}, S}; - NewAppls -> + {NewAppls, NewConfig} -> lists:foreach(fun(Appl) -> ets:insert(ac_tab, {{loaded, Appl#appl.name}, Appl}) end, NewAppls), - {reply, ok, S#state{conf_data = Config}} + {reply, ok, S#state{conf_data = NewConfig}} end; handle_call(prep_config_change, _From, S) -> @@ -848,13 +862,25 @@ handle_call(which_applications, _From, S) -> end, S#state.running), {reply, Reply, S}; -handle_call({set_env, AppName, Key, Val}, _From, S) -> +handle_call({set_env, AppName, Key, Val, Opts}, _From, S) -> ets:insert(ac_tab, {{env, AppName, Key}, Val}), - {reply, ok, S}; + case proplists:get_value(persistent, Opts, false) of + true -> + Fun = fun(Env) -> lists:keystore(Key, 1, Env, {Key, Val}) end, + {reply, ok, S#state{conf_data = change_app_env(S#state.conf_data, AppName, Fun)}}; + false -> + {reply, ok, S} + end; -handle_call({unset_env, AppName, Key}, _From, S) -> +handle_call({unset_env, AppName, Key, Opts}, _From, S) -> ets:delete(ac_tab, {env, AppName, Key}), - {reply, ok, S}; + case proplists:get_value(persistent, Opts, false) of + true -> + Fun = fun(Env) -> lists:keydelete(Key, 1, Env) end, + {reply, ok, S#state{conf_data = change_app_env(S#state.conf_data, AppName, Fun)}}; + false -> + {reply, ok, S} + end; handle_call({control_application, AppName}, {Pid, _Tag}, S) -> Control = S#state.control, @@ -868,10 +894,10 @@ handle_call({control_application, AppName}, {Pid, _Tag}, S) -> handle_call({start_type, AppName}, _From, S) -> Starting = S#state.starting, - StartType = case keysearch(AppName, 1, Starting) of + StartType = case lists:keyfind(AppName, 1, Starting) of false -> local; - {value, {_AppName, _RestartType, Type, _F}} -> + {_AppName, _RestartType, Type, _F} -> Type end, {reply, StartType, S}; @@ -885,6 +911,9 @@ handle_call(info, _From, S) -> {starting, S#state.starting}], {reply, Reply, S}. +-spec handle_cast({'application_started', appname(), _}, state()) -> + {'noreply', state()} | {'stop', string(), state()}. + handle_cast({application_started, AppName, Res}, S) -> handle_application_started(AppName, Res, S). @@ -892,7 +921,7 @@ handle_application_started(AppName, Res, S) -> #state{starting = Starting, running = Running, started = Started, start_req = Start_req} = S, Start_reqN = reply_to_requester(AppName, Start_req, Res), - {value, {_AppName, RestartType, _Type, _From}} = keysearch(AppName, 1, Starting), + {_AppName, RestartType, _Type, _From} = lists:keyfind(AppName, 1, Starting), case Res of {ok, Id} -> case AppName of @@ -907,7 +936,6 @@ handle_application_started(AppName, Res, S) -> running = NRunning, started = NStarted, start_req = Start_reqN}, - %% The permission may have been changed during start Perm = application:get_env(kernel, permissions), case {Perm, Id} of @@ -918,10 +946,10 @@ handle_application_started(AppName, Res, S) -> case lists:member({AppName, false}, Perms) of true -> #state{running = StopRunning, started = StopStarted} = NewS, - case keysearch(AppName, 1, StopRunning) of - {value, {_AppName, Id}} -> - {value, {_AppName2, Type}} = - keysearch(AppName, 1, StopStarted), + case lists:keyfind(AppName, 1, StopRunning) of + {_AppName, Id} -> + {_AppName2, Type} = + lists:keyfind(AppName, 1, StopStarted), stop_appl(AppName, Id, Type), NStopRunning = keydelete(AppName, 1, StopRunning), cntrl(AppName, NewS, {ac_application_stopped, AppName}), @@ -936,12 +964,8 @@ handle_application_started(AppName, Res, S) -> _ -> {noreply, NewS} end; - - - - - {error, R} when RestartType =:= temporary -> - notify_cntrl_started(AppName, undefined, S, {error, R}), + {error, R} = Error when RestartType =:= temporary -> + notify_cntrl_started(AppName, undefined, S, Error), info_exited(AppName, R, RestartType), {noreply, S#state{starting = keydelete(AppName, 1, Starting), start_req = Start_reqN}}; @@ -966,8 +990,8 @@ handle_application_started(AppName, Res, S) -> Reason = {application_start_failure, AppName, R}, {stop, to_string(Reason), S} end; - {error, R} -> %% permanent - notify_cntrl_started(AppName, undefined, S, {error, R}), + {error, R} = Error -> %% permanent + notify_cntrl_started(AppName, undefined, S, Error), info_exited(AppName, R, RestartType), Reason = {application_start_failure, AppName, R}, {stop, to_string(Reason), S}; @@ -977,6 +1001,9 @@ handle_application_started(AppName, Res, S) -> {stop, to_string(Reason), S} end. +-spec handle_info(term(), state()) -> + {'noreply', state()} | {'stop', string(), state()}. + handle_info({ac_load_application_reply, AppName, Res}, S) -> case keysearchdelete(AppName, 1, S#state.loading) of {value, {_AppName, From}, Loading} -> @@ -994,12 +1021,12 @@ handle_info({ac_load_application_reply, AppName, Res}, S) -> handle_info({ac_start_application_reply, AppName, Res}, S) -> Start_req = S#state.start_req, - case keysearch(AppName, 1, Starting = S#state.starting) of - {value, {_AppName, RestartType, Type, From}} -> + case lists:keyfind(AppName, 1, Starting = S#state.starting) of + {_AppName, RestartType, Type, From} -> case Res of start_it -> {true, Appl} = get_loaded(AppName), - spawn_starter(From, Appl, S, Type), + spawn_starter(From, Appl, S, Type), {noreply, S}; {started, Node} -> handle_application_started(AppName, @@ -1013,23 +1040,19 @@ handle_info({ac_start_application_reply, AppName, Res}, S) -> S#state{starting = keydelete(AppName, 1, Starting), started = [{AppName, RestartType} | Started], start_req = Start_reqN}}; - {takeover, Node} -> + {takeover, _Node} = Takeover -> {true, Appl} = get_loaded(AppName), - spawn_starter(From, Appl, S, {takeover, Node}), + spawn_starter(From, Appl, S, Takeover), NewStarting1 = keydelete(AppName, 1, Starting), - NewStarting = [{AppName, RestartType, {takeover, Node}, From} | NewStarting1], + NewStarting = [{AppName, RestartType, Takeover, From} | NewStarting1], {noreply, S#state{starting = NewStarting}}; - {error, Reason} when RestartType =:= permanent -> - Start_reqN = - reply_to_requester(AppName, Start_req, - {error, Reason}), + {error, Reason} = Error when RestartType =:= permanent -> + Start_reqN = reply_to_requester(AppName, Start_req, Error), {stop, to_string(Reason), S#state{start_req = Start_reqN}}; - {error, Reason} -> - Start_reqN = - reply_to_requester(AppName, Start_req, - {error, Reason}), + {error, _Reason} = Error -> + Start_reqN = reply_to_requester(AppName, Start_req, Error), {noreply, S#state{starting = - keydelete(AppName, 1, Starting), + keydelete(AppName, 1, Starting), start_req = Start_reqN}} end; false -> @@ -1040,8 +1063,8 @@ handle_info({ac_change_application_req, AppName, Msg}, S) -> Running = S#state.running, Started = S#state.started, Starting = S#state.starting, - case {keysearch(AppName, 1, Running), keysearch(AppName, 1, Started)} of - {{value, {AppName, Id}}, {value, {_AppName2, Type}}} -> + case {keyfind(AppName, 1, Running), keyfind(AppName, 1, Started)} of + {{AppName, Id}, {_AppName2, Type}} -> case Msg of {started, Node} -> stop_appl(AppName, Id, Type), @@ -1134,17 +1157,17 @@ handle_info({'EXIT', Pid, Reason}, S) -> ets:match_delete(ac_tab, {{application_master, '_'}, Pid}), NRunning = keydelete(Pid, 2, S#state.running), NewS = S#state{running = NRunning}, - case keysearch(Pid, 2, S#state.running) of - {value, {AppName, _AmPid}} -> + case lists:keyfind(Pid, 2, S#state.running) of + {AppName, _AmPid} -> cntrl(AppName, S, {ac_application_stopped, AppName}), - case keysearch(AppName, 1, S#state.started) of - {value, {_AppName, temporary}} -> + case lists:keyfind(AppName, 1, S#state.started) of + {_AppName, temporary} -> info_exited(AppName, Reason, temporary), {noreply, NewS}; - {value, {_AppName, transient}} when Reason =:= normal -> + {_AppName, transient} when Reason =:= normal -> info_exited(AppName, Reason, transient), {noreply, NewS}; - {value, {_AppName, Type}} -> + {_AppName, Type} -> info_exited(AppName, Reason, Type), {stop, to_string({application_terminated, AppName, Reason}), NewS} end; @@ -1155,6 +1178,8 @@ handle_info({'EXIT', Pid, Reason}, S) -> handle_info(_, S) -> {noreply, S}. +-spec terminate(term(), state()) -> 'ok'. + terminate(Reason, S) -> case application:get_env(kernel, shutdown_func) of {ok, {M, F}} -> @@ -1162,16 +1187,35 @@ terminate(Reason, S) -> _ -> ok end, + ShutdownTimeout = + case application:get_env(kernel, shutdown_timeout) of + undefined -> infinity; + {ok,T} -> T + end, foreach(fun({_AppName, Id}) when is_pid(Id) -> + Ref = erlang:monitor(process, Id), + unlink(Id), exit(Id, shutdown), receive + %% Proc died before link {'EXIT', Id, _} -> ok + after 0 -> + receive + {'DOWN', Ref, process, Id, _} -> ok + after ShutdownTimeout -> + exit(Id, kill), + receive + {'DOWN', Ref, process, Id, _} -> ok + end + end end; (_) -> ok end, S#state.running), - ets:delete(ac_tab). + true = ets:delete(ac_tab), + ok. +-spec code_change(term(), state(), term()) -> {'ok', state()}. code_change(_OldVsn, State, _Extra) -> {ok, State}. @@ -1181,8 +1225,8 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%%----------------------------------------------------------------- cntrl(AppName, #state{control = Control}, Msg) -> - case keysearch(AppName, 1, Control) of - {value, {_AppName, Pid}} -> + case lists:keyfind(AppName, 1, Control) of + {_AppName, Pid} -> Pid ! Msg, true; false -> @@ -1282,8 +1326,8 @@ check_start_cond(AppName, RestartType, Started, Running) -> end. do_start(AppName, RT, Type, From, S) -> - RestartType = case keysearch(AppName, 1, S#state.started) of - {value, {_AppName2, OldRT}} -> + RestartType = case lists:keyfind(AppName, 1, S#state.started) of + {_AppName2, OldRT} -> get_restart_type(RT, OldRT); false -> RT @@ -1295,12 +1339,12 @@ do_start(AppName, RT, Type, From, S) -> {true, Appl} = get_loaded(AppName), Start_req = S#state.start_req, spawn_starter(undefined, Appl, S, Type), - Starting = case keysearch(AppName, 1, S#state.starting) of + Starting = case lists:keymember(AppName, 1, S#state.starting) of false -> %% UW: don't know if this is necessary [{AppName, RestartType, Type, From} | S#state.starting]; - _ -> + true -> S#state.starting end, S#state{starting = Starting, @@ -1340,10 +1384,10 @@ start_appl(Appl, S, Type) -> end end, Appl#appl.apps), case application_master:start_link(ApplData, Type) of - {ok, Pid} -> - {ok, Pid}; - {error, Reason} -> - throw({error, Reason}) + {ok, _Pid} = Ok -> + Ok; + {error, _Reason} = Error -> + throw(Error) end end. @@ -1408,7 +1452,9 @@ make_appl(Name) when is_atom(Name) -> {ok, [Application]} -> {ok, make_appl_i(Application)}; {error, Reason} -> - {error, {file:format_error(Reason), FName}} + {error, {file:format_error(Reason), FName}}; + error -> + {error, "bad encoding"} end end; make_appl(Application) -> @@ -1417,12 +1463,17 @@ make_appl(Application) -> prim_consult(FullName) -> case erl_prim_loader:get_file(FullName) of {ok, Bin, _} -> - case erl_scan:string(binary_to_list(Bin)) of - {ok, Tokens, _EndLine} -> - prim_parse(Tokens, []); - {error, Reason, _EndLine} -> - {error, Reason} - end; + case file_binary_to_list(Bin) of + {ok, String} -> + case erl_scan:string(String) of + {ok, Tokens, _EndLine} -> + prim_parse(Tokens, []); + {error, Reason, _EndLine} -> + {error, Reason} + end; + error -> + error + end; error -> {error, enoent} end. @@ -1435,15 +1486,15 @@ prim_parse(Tokens, Acc) -> case erl_parse:parse_term(Tokens2 ++ [Dot]) of {ok, Term} -> prim_parse(Rest, [Term | Acc]); - {error, Reason} -> - {error, Reason} + {error, _R} = Error -> + Error end; {Tokens2, []} -> case erl_parse:parse_term(Tokens2) of {ok, Term} -> {ok, lists:reverse([Term | Acc])}; - {error, Reason} -> - {error, Reason} + {error, _R} = Error -> + Error end end. @@ -1456,7 +1507,7 @@ make_appl_i({application, Name, Opts}) when is_atom(Name), is_list(Opts) -> Apps = get_opt(applications, Opts, []), Mod = case get_opt(mod, Opts, []) of - {M,A} when is_atom(M) -> {M,A}; + {M,_A}=MA when is_atom(M) -> MA; [] -> []; Other -> throw({error, {badstartspec, Other}}) end, @@ -1465,8 +1516,8 @@ make_appl_i({application, Name, Opts}) when is_atom(Name), is_list(Opts) -> MaxP = get_opt(maxP, Opts, infinity), MaxT = get_opt(maxT, Opts, infinity), IncApps = get_opt(included_applications, Opts, []), - {#appl_data{name = Name, regs = Regs, mod = Mod, phases = Phases, mods = Mods, - inc_apps = IncApps, maxP = MaxP, maxT = MaxT}, + {#appl_data{name = Name, regs = Regs, mod = Mod, phases = Phases, + mods = Mods, inc_apps = IncApps, maxP = MaxP, maxT = MaxT}, Env, IncApps, Descr, Id, Vsn, Apps}; make_appl_i({application, Name, Opts}) when is_list(Opts) -> throw({error,{invalid_name,Name}}); @@ -1495,24 +1546,25 @@ do_change_apps(Applications, Config, OldAppls) -> %% Report errors, but do not terminate %% (backwards compatible behaviour) lists:foreach(fun({error, {SysFName, Line, Str}}) -> - Str2 = lists:flatten(io_lib:format("~p: ~w: ~s~n", + Str2 = lists:flatten(io_lib:format("~tp: ~w: ~ts~n", [SysFName, Line, Str])), error_logger:format(Str2, []) end, Errors), - map(fun(Appl) -> - AppName = Appl#appl.name, - case is_loaded_app(AppName, Applications) of - {true, Application} -> - do_change_appl(make_appl(Application), - Appl, SysConfig); + {map(fun(Appl) -> + AppName = Appl#appl.name, + case is_loaded_app(AppName, Applications) of + {true, Application} -> + do_change_appl(make_appl(Application), + Appl, SysConfig); - %% ignored removed apps - handled elsewhere - false -> - Appl - end - end, OldAppls). + %% ignored removed apps - handled elsewhere + false -> + Appl + end + end, OldAppls), + SysConfig}. is_loaded_app(AppName, [{application, AppName, App} | _]) -> {true, {application, AppName, App}}; @@ -1545,12 +1597,12 @@ do_change_appl({ok, {ApplData, Env, IncApps, Descr, Id, Vsn, Apps}}, vsn=Vsn, inc_apps=IncApps, apps=Apps}; -do_change_appl({error, R}, _Appl, _ConfData) -> - throw({error, R}). +do_change_appl({error, _R} = Error, _Appl, _ConfData) -> + throw(Error). get_opt(Key, List, Default) -> - case keysearch(Key, 1, List) of - {value, {_Key, Val}} -> Val; + case lists:keyfind(Key, 1, List) of + {_Key, Val} -> Val; _ -> Default end. @@ -1565,7 +1617,6 @@ conv([Key, Val | T]) -> [{make_term(Key), make_term(Val)} | conv(T)]; conv(_) -> []. -%%% Fix some day: eliminate the duplicated code here make_term(Str) -> case erl_scan:string(Str) of {ok, Tokens, _} -> @@ -1573,19 +1624,20 @@ make_term(Str) -> {ok, Term} -> Term; {error, {_,M,Reason}} -> - error_logger:format("application_controller: ~s: ~s~n", - [M:format_error(Reason), Str]), - throw({error, {bad_environment_value, Str}}) + handle_make_term_error(M, Reason, Str) end; {error, {_,M,Reason}, _} -> - error_logger:format("application_controller: ~s: ~s~n", - [M:format_error(Reason), Str]), - throw({error, {bad_environment_value, Str}}) + handle_make_term_error(M, Reason, Str) end. +handle_make_term_error(Mod, Reason, Str) -> + error_logger:format("application_controller: ~ts: ~ts~n", + [Mod:format_error(Reason), Str]), + throw({error, {bad_environment_value, Str}}). + get_env_i(Name, #state{conf_data = ConfData}) when is_list(ConfData) -> - case keysearch(Name, 1, ConfData) of - {value, {_Name, Env}} -> Env; + case lists:keyfind(Name, 1, ConfData) of + {_Name, Env} -> Env; _ -> [] end; get_env_i(_Name, _) -> []. @@ -1605,8 +1657,15 @@ merge_env([{App, AppEnv1} | T], Env2, Res) -> merge_env([], Env2, Res) -> Env2 ++ Res. - - +%% Changes the environment for the given application +%% If there is no application, an empty one is created +change_app_env(Env, App, Fun) -> + case get_env_key(App, Env) of + {value, AppEnv, RestEnv} -> + [{App, Fun(AppEnv)} | RestEnv]; + _ -> + [{App, Fun([])} | Env] + end. %% Merges envs for an application. Env2 overrides Env1 merge_app_env(Env1, Env2) -> @@ -1671,13 +1730,12 @@ do_config_change([], _EnvBefore, Errors) -> {error, Errors}; do_config_change([{App, _Id} | Apps], EnvBefore, Errors) -> AppEnvNow = lists:sort(application:get_all_env(App)), - AppEnvBefore = case lists:keysearch(App, 1, EnvBefore) of + AppEnvBefore = case lists:keyfind(App, 1, EnvBefore) of false -> []; - {value, {App, AppEnvBeforeT}} -> + {App, AppEnvBeforeT} -> lists:sort(AppEnvBeforeT) end, - Res = case AppEnvNow of AppEnvBefore -> @@ -1697,12 +1755,12 @@ do_config_change([{App, _Id} | Apps], EnvBefore, Errors) -> %% if the cb-function is not defined {'EXIT', {undef, _}} -> ok; - {error, Error} -> - {error, Error}; + {error, _} = Error -> + Error; Else -> {error, Else} end; - {ok,[]} -> + {ok, []} -> {error, {module_not_defined, App}}; undefined -> {error, {application_not_found, App}} @@ -1716,9 +1774,7 @@ do_config_change([{App, _Id} | Apps], EnvBefore, Errors) -> {error, NewError} -> do_config_change(Apps, EnvBefore,[NewError | Errors]) end. - - - + %%----------------------------------------------------------------- %% Check if the configuration is changed in anyway. @@ -1732,21 +1788,17 @@ do_config_diff([], AppEnvBefore, {Changed, New}) -> do_config_diff(AppEnvNow, [], {Changed, New}) -> {Changed, AppEnvNow++New, []}; do_config_diff([{Env, Value} | AppEnvNow], AppEnvBefore, {Changed, New}) -> - case lists:keysearch(Env, 1, AppEnvBefore) of - {value, {Env, Value}} -> + case lists:keyfind(Env, 1, AppEnvBefore) of + {Env, Value} -> do_config_diff(AppEnvNow, lists:keydelete(Env,1,AppEnvBefore), {Changed, New}); - {value, {Env, _OtherValue}} -> + {Env, _OtherValue} -> do_config_diff(AppEnvNow, lists:keydelete(Env,1,AppEnvBefore), {[{Env, Value} | Changed], New}); false -> do_config_diff(AppEnvNow, AppEnvBefore, {Changed, [{Env, Value}|New]}) end. - - - - %%----------------------------------------------------------------- %% Read the .config files. %%----------------------------------------------------------------- @@ -1812,8 +1864,12 @@ load_file(File) -> {ok, Bin, _FileName} -> %% Make sure that there is some whitespace at the end of the string %% (so that reading a file with no NL following the "." will work). - Str = binary_to_list(Bin) ++ " ", - scan_file(Str); + case file_binary_to_list(Bin) of + {ok, String} -> + scan_file(String ++ " "); + error -> + {error, {none, scan_file, "bad encoding"}} + end; error -> {error, {none, open_file, "configuration file not found"}} end. @@ -1901,14 +1957,13 @@ reply_to_requester(AppName, Start_req, Res) -> %% Update the environment variable permission for an application. %%----------------------------------------------------------------- update_permissions(AppName, Bool) -> - case ets:lookup(ac_tab, {env, kernel, permissions}) of + T = {env, kernel, permissions}, + case ets:lookup(ac_tab, T) of [] -> - ets:insert(ac_tab, {{env, kernel, permissions}, - [{AppName, Bool}]}); + ets:insert(ac_tab, {T, [{AppName, Bool}]}); [{_, Perm}] -> Perm2 = lists:keydelete(AppName, 1, Perm), - ets:insert(ac_tab, {{env, kernel, permissions}, - [{AppName, Bool}| Perm2]}) + ets:insert(ac_tab, {T, [{AppName, Bool}|Perm2]}) end. %%----------------------------------------------------------------- @@ -1921,10 +1976,10 @@ test_change_apps(Apps, Conf) -> test_do_change_appl([], _, _) -> ok; test_do_change_appl([A|Apps], [], [R|Res]) -> - do_change_appl(R, #appl{name = A}, []), + _ = do_change_appl(R, #appl{name = A}, []), test_do_change_appl(Apps, [], Res); test_do_change_appl([A|Apps], [C|Conf], [R|Res]) -> - do_change_appl(R, #appl{name = A}, C), + _ = do_change_appl(R, #appl{name = A}, C), test_do_change_appl(Apps, Conf, Res). test_make_apps([], Res) -> @@ -1932,15 +1987,30 @@ test_make_apps([], Res) -> test_make_apps([A|Apps], Res) -> test_make_apps(Apps, [make_appl(A) | Res]). +file_binary_to_list(Bin) -> + Enc = case epp:read_encoding_from_binary(Bin) of + none -> epp:default_encoding(); + Encoding -> Encoding + end, + case catch unicode:characters_to_list(Bin, Enc) of + String when is_list(String) -> + {ok, String}; + _ -> + error + end. + %%----------------------------------------------------------------- %% String conversion %% Exit reason needs to be a printable string %% (and of length <200, but init now does the chopping). %%----------------------------------------------------------------- + +-spec to_string(term()) -> string(). + to_string(Term) -> case io_lib:printable_list(Term) of true -> Term; false -> - lists:flatten(io_lib:write(Term)) + lists:flatten(io_lib:format("~134217728p", [Term])) end. diff --git a/lib/kernel/src/application_master.erl b/lib/kernel/src/application_master.erl index 679fefaed9..5da2b0b06c 100644 --- a/lib/kernel/src/application_master.erl +++ b/lib/kernel/src/application_master.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,7 +28,7 @@ -include("application_master.hrl"). --record(state, {child, appl_data, children = [], procs = 0, gleader}). +-record(state, {child, appl_data, children = [], procs = 0, gleader, req=[]}). %%----------------------------------------------------------------- %% Func: start_link/1 @@ -76,13 +77,8 @@ call(AppMaster, Req) -> {'DOWN', Ref, process, _, _Info} -> ok; {Tag, Res} -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, process, _, _Info} -> - Res - after 0 -> - Res - end + erlang:demonitor(Ref, [flush]), + Res end. %%%----------------------------------------------------------------- @@ -108,9 +104,9 @@ call(AppMaster, Req) -> %%% The reason for not using the logical structrure is that %%% the application start function is synchronous, and %%% that the AM is GL. This means that if AM executed the start -%%% function, and this function uses spawn_request/1 -%%% or io, deadlock would occur. Therefore, this function is -%%% executed by the process X. Also, AM needs three loops; +%%% function, and this function uses io, deadlock would occur. +%%% Therefore, this function is executed by the process X. +%%% Also, AM needs three loops; %%% init_loop (waiting for the start function to return) %%% main_loop %%% terminate_loop (waiting for the process to die) @@ -130,7 +126,7 @@ init(Parent, Starter, ApplData, Type) -> State = #state{appl_data = ApplData, gleader = OldGleader}, case start_it(State, Type) of {ok, Pid} -> % apply(M,F,A) returned ok - set_timer(ApplData#appl_data.maxT), + ok = set_timer(ApplData#appl_data.maxT), unlink(Starter), proc_lib:init_ack(Starter, {ok,self()}), main_loop(Parent, State#state{child = Pid}); @@ -210,22 +206,25 @@ terminate_loop(Child, State) -> %%----------------------------------------------------------------- %% The Application Master is linked to *all* processes in the group -%% (application). +%% (application). %%----------------------------------------------------------------- handle_msg({get_child, Tag, From}, State) -> - From ! {Tag, get_child_i(State#state.child)}, - State; + get_child_i(State, Tag, From); handle_msg({stop, Tag, From}, State) -> catch terminate(normal, State), From ! {Tag, ok}, exit(normal); +handle_msg({child, Ref, GrandChild, Mod}, #state{req=Reqs0}=State) -> + {value, {_, Tag, From}, Reqs} = lists:keytake(Ref, 1, Reqs0), + From ! {Tag, {GrandChild, Mod}}, + State#state{req=Reqs}; handle_msg(_, State) -> State. - -terminate(Reason, State) -> - terminate_child(State#state.child, State), - kill_children(State#state.children), +terminate(Reason, State = #state{child=Child, children=Children, req=Reqs}) -> + _ = [From ! {Tag, error} || {_, Tag, From} <- Reqs], + terminate_child(Child, State), + kill_children(Children), exit(Reason). @@ -347,8 +346,8 @@ start_supervisor(Type, M, A) -> loop_it(Parent, Child, Mod, AppState) -> receive - {Parent, get_child} -> - Parent ! {self(), Child, Mod}, + {Parent, get_child, Ref} -> + Parent ! {child, Ref, Child, Mod}, loop_it(Parent, Child, Mod, AppState); {Parent, terminate} -> NewAppState = prep_stop(Mod, AppState), @@ -387,10 +386,15 @@ prep_stop(Mod, AppState) -> NewAppState end. -get_child_i(Child) -> - Child ! {self(), get_child}, - receive - {Child, GrandChild, Mod} -> {GrandChild, Mod} +get_child_i(#state{child=Child, req=Reqs}=State, Tag, From) -> + Ref = erlang:make_ref(), + case erlang:is_process_alive(Child) of + true -> + Child ! {self(), get_child, Ref}, + State#state{req=[{Ref, Tag, From}|Reqs]}; + false -> + From ! {Tag, error}, + State end. terminate_child_i(Child, State) -> @@ -423,4 +427,6 @@ kill_all_procs_1([], _, 0) -> ok; kill_all_procs_1([], _, _) -> kill_all_procs(). set_timer(infinity) -> ok; -set_timer(Time) -> timer:exit_after(Time, timeout). +set_timer(Time) -> + {ok, _} = timer:exit_after(Time, timeout), + ok. diff --git a/lib/kernel/src/application_master.hrl b/lib/kernel/src/application_master.hrl index cd6d12c33c..b03074dbce 100644 --- a/lib/kernel/src/application_master.hrl +++ b/lib/kernel/src/application_master.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/kernel/src/application_starter.erl b/lib/kernel/src/application_starter.erl index 8d839e4662..f51f9bbc45 100644 --- a/lib/kernel/src/application_starter.erl +++ b/lib/kernel/src/application_starter.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% %% ---------------------------------------------------------------------- @@ -42,8 +43,8 @@ start([], _Type, _Apps) -> ok; start([{Phase,_PhaseArgs}|Phases], Type, Apps) -> case start_apps(Phase, Type, Apps) of - {error, Error} -> - {error, Error}; + {error, _} = Error -> + Error; _ -> start(Phases, Type, Apps) end. @@ -56,8 +57,8 @@ start_apps(_Phase, _Type, []) -> ok; start_apps(Phase, Type, [App | Apps]) -> case catch run_start_phase(Phase, Type, App) of - {error, Error} -> - {error, Error}; + {error, _} = Error -> + Error; _ -> start_apps(Phase, Type, Apps) end. @@ -91,10 +92,10 @@ run_the_phase(Phase, Type, App, Mod) -> {ok, Sp} -> Sp end, - case lists:keysearch(Phase, 1, Start_phases) of + case lists:keyfind(Phase, 1, Start_phases) of false -> ok; - {value, {Phase, PhaseArgs}} -> + {Phase, PhaseArgs} -> case catch Mod:start_phase(Phase, Type, PhaseArgs) of ok -> ok; diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index 62c0bef0cc..40feee6bf0 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(auth). @@ -37,10 +38,12 @@ -define(COOKIE_ETS_PROTECTION, protected). +-type cookie() :: atom(). -record(state, { - our_cookie, %% Our own cookie - other_cookies %% The send-cookies of other nodes + our_cookie :: cookie(), %% Our own cookie + other_cookies :: ets:tab() %% The send-cookies of other nodes }). +-type state() :: #state{}. -include("../include/file.hrl"). @@ -48,12 +51,15 @@ %% Exported functions %%---------------------------------------------------------------------- +-spec start_link() -> {'ok',pid()} | {'error', term()} | 'ignore'. + start_link() -> gen_server:start_link({local, auth}, auth, [], []). %%--Deprecated interface------------------------------------------------ --spec is_auth(Node :: node()) -> 'yes' | 'no'. +-spec is_auth(Node) -> 'yes' | 'no' when + Node :: node(). is_auth(Node) -> case net_adm:ping(Node) of @@ -61,24 +67,29 @@ is_auth(Node) -> pang -> no end. --spec cookie() -> atom(). +-spec cookie() -> Cookie when + Cookie :: cookie(). cookie() -> get_cookie(). --spec cookie(Cookies :: [atom(),...] | atom()) -> 'true'. +-spec cookie(TheCookie) -> 'true' when + TheCookie :: Cookie | [Cookie], + Cookie :: cookie(). cookie([Cookie]) -> set_cookie(Cookie); cookie(Cookie) -> set_cookie(Cookie). --spec node_cookie(Cookies :: [atom(),...]) -> 'yes' | 'no'. +-spec node_cookie(Cookies :: [node() | cookie(),...]) -> 'yes' | 'no'. node_cookie([Node, Cookie]) -> node_cookie(Node, Cookie). --spec node_cookie(Node :: node(), Cookie :: atom()) -> 'yes' | 'no'. +-spec node_cookie(Node, Cookie) -> 'yes' | 'no' when + Node :: node(), + Cookie :: cookie(). node_cookie(Node, Cookie) -> set_cookie(Node, Cookie), @@ -86,24 +97,24 @@ node_cookie(Node, Cookie) -> %%--"New" interface----------------------------------------------------- --spec get_cookie() -> atom(). +-spec get_cookie() -> 'nocookie' | cookie(). get_cookie() -> get_cookie(node()). --spec get_cookie(Node :: node()) -> atom(). +-spec get_cookie(Node :: node()) -> 'nocookie' | cookie(). get_cookie(_Node) when node() =:= nonode@nohost -> nocookie; get_cookie(Node) -> gen_server:call(auth, {get_cookie, Node}). --spec set_cookie(Cookie :: atom()) -> 'true'. +-spec set_cookie(Cookie :: cookie()) -> 'true'. set_cookie(Cookie) -> set_cookie(node(), Cookie). --spec set_cookie(Node :: node(), Cookie :: atom()) -> 'true'. +-spec set_cookie(Node :: node(), Cookie :: cookie()) -> 'true'. set_cookie(_Node, _Cookie) when node() =:= nonode@nohost -> erlang:error(distribution_not_started); @@ -117,11 +128,13 @@ sync_cookie() -> -spec print(Node :: node(), Format :: string(), Args :: [_]) -> 'ok'. -print(Node,Format,Args) -> - (catch gen_server:cast({auth,Node},{print,Format,Args})). +print(Node, Format, Args) -> + (catch gen_server:cast({auth, Node}, {print, Format, Args})). %%--gen_server callbacks------------------------------------------------ +-spec init([]) -> {'ok', state()}. + init([]) -> process_flag(trap_exit, true), {ok, init_cookie()}. @@ -130,6 +143,13 @@ init([]) -> %% The net kernel will let all message to the auth server %% through as is +-type calls() :: 'echo' | 'sync_cookie' + | {'get_cookie', node()} + | {'set_cookie', node(), term()}. + +-spec handle_call(calls(), {pid(), term()}, state()) -> + {'reply', 'hello' | 'true' | 'nocookie' | cookie(), state()}. + handle_call({get_cookie, Node}, {_From,_Tag}, State) when Node =:= node() -> {reply, State#state.our_cookie, State}; handle_call({get_cookie, Node}, {_From,_Tag}, State) -> @@ -145,7 +165,7 @@ handle_call({set_cookie, Node, Cookie}, {_From,_Tag}, State) %% %% Happens when the distribution is brought up and -%% Someone wight have set up the cookie for our new nodename. +%% someone might have set up the cookie for our new node name. %% handle_call({set_cookie, Node, Cookie}, {_From,_Tag}, State) -> @@ -153,9 +173,9 @@ handle_call({set_cookie, Node, Cookie}, {_From,_Tag}, State) -> {reply, true, State}; handle_call(sync_cookie, _From, State) -> - case ets:lookup(State#state.other_cookies,node()) of + case ets:lookup(State#state.other_cookies, node()) of [{_N,C}] -> - ets:delete(State#state.other_cookies,node()), + ets:delete(State#state.other_cookies, node()), {reply, true, State#state{our_cookie = C}}; [] -> {reply, true, State} @@ -164,13 +184,22 @@ handle_call(sync_cookie, _From, State) -> handle_call(echo, _From, O) -> {reply, hello, O}. +%% +%% handle_cast/2 +%% + +-spec handle_cast({'print', string(), [term()]}, state()) -> + {'noreply', state()}. + handle_cast({print,What,Args}, O) -> %% always allow print outs - error_logger:error_msg(What,Args), + error_logger:error_msg(What, Args), {noreply, O}. %% A series of bad messages that may come (from older distribution versions). +-spec handle_info(term(), state()) -> {'noreply', state()}. + handle_info({From,badcookie,net_kernel,{From,spawn,_M,_F,_A,_Gleader}}, O) -> auth:print(node(From) ,"~n** Unauthorized spawn attempt to ~w **~n", [node()]), @@ -184,14 +213,14 @@ handle_info({From,badcookie,net_kernel,{From,spawn_link,_M,_F,_A,_Gleader}}, O) {noreply, O}; handle_info({_From,badcookie,ddd_server,_Mess}, O) -> %% Ignore bad messages to the ddd server, they will be resent - %% If the authentication is succesful + %% If the authentication is successful {noreply, O}; handle_info({From,badcookie,rex,_Msg}, O) -> auth:print(getnode(From), - "~n** Unauthorized rpc attempt to ~w **~n",[node()]), + "~n** Unauthorized rpc attempt to ~w **~n", [node()]), disconnect_node(node(From)), {noreply, O}; -%% These two messages has to do with the old auth:is_auth() call (net_adm:ping) +%% These two messages have to do with the old auth:is_auth() call (net_adm:ping) handle_info({From,badcookie,net_kernel,{'$gen_call',{From,Tag},{is_auth,_Node}}}, O) -> %% ho ho From ! {Tag, no}, {noreply, O}; @@ -215,12 +244,16 @@ handle_info({From,badcookie,Name,Mess}, Opened) -> end end, {noreply, Opened}; -handle_info(_, O)-> % Ignore anything else especially EXIT signals +handle_info(_, O) -> % Ignore anything else especially EXIT signals {noreply, O}. +-spec code_change(term(), state(), term()) -> {'ok', state()}. + code_change(_OldVsn, State, _Extra) -> {ok, State}. +-spec terminate(term(), state()) -> 'ok'. + terminate(_Reason, _State) -> ok. @@ -260,7 +293,7 @@ init_cookie() -> end; _Other -> #state{our_cookie = nocookie, - other_cookies = ets:new(cookies,[?COOKIE_ETS_PROTECTION])} + other_cookies = ets:new(cookies, [?COOKIE_ETS_PROTECTION])} end. read_cookie() -> @@ -292,7 +325,7 @@ read_cookie(Name, Size) -> {ok, File} -> case file:read(File, Size) of {ok, List} -> - file:close(File), + ok = file:close(File), check_cookie(List, []); {error, Reason} -> make_error(Name, Reason) @@ -338,24 +371,28 @@ check_cookie1([], Result) -> %% Creates a new, random cookie. create_cookie(Name) -> - {_, S1, S2} = now(), - Seed = S2*10000+S1, + Seed = abs(erlang:monotonic_time() + bxor erlang:unique_integer()), Cookie = random_cookie(20, Seed, []), case file:open(Name, [write, raw]) of {ok, File} -> R1 = file:write(File, Cookie), - file:close(File), + ok = file:close(File), R2 = file:raw_write_file_info(Name, make_info(Name)), case {R1, R2} of {ok, ok} -> ok; - {{error,_Reason}, _} -> - {error, "Failed to create cookie file"}; + {{error,Reason}, _} -> + {error, + lists:flatten( + io_lib:format("Failed to write to cookie file '~ts': ~p", [Name, Reason]))}; {ok, {error, Reason}} -> {error, "Failed to change mode: " ++ atom_to_list(Reason)} end; - {error,_Reason} -> - {error, "Failed to create cookie file"} + {error,Reason} -> + {error, + lists:flatten( + io_lib:format("Failed to create cookie file '~ts': ~p", [Name, Reason]))} end. random_cookie(0, _, Result) -> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index ffe58ae7a9..8d0a2fbf66 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,11 +28,15 @@ get_path/0, load_file/1, ensure_loaded/1, + ensure_modules_loaded/1, load_abs/1, load_abs/2, load_binary/3, load_native_partial/2, load_native_sticky/3, + atomic_load/1, + prepare_loading/1, + finish_loading/1, delete/1, purge/1, soft_purge/1, @@ -59,118 +64,151 @@ del_path/1, replace_path/2, rehash/0, - start_link/0, start_link/1, + start_link/0, which/1, where_is_file/1, where_is_file/2, - set_primary_archive/3, - clash/0]). + set_primary_archive/4, + clash/0, + get_mode/0]). --include_lib("kernel/include/file.hrl"). +-deprecated({rehash,0,next_major_release}). -%% User interface. -%% -%% objfile_extension() -> ".beam" -%% set_path(Dir*) -> true -%% get_path() -> Dir* -%% add_path(Dir) -> true | {error, What} -%% add_patha(Dir) -> true | {error, What} -%% add_pathz(Dir) -> true | {error, What} -%% add_paths(DirList) -> true | {error, What} -%% add_pathsa(DirList) -> true | {error, What} -%% add_pathsz(DirList) -> true | {error, What} -%% del_path(Dir) -> true | {error, What} -%% replace_path(Name,Dir) -> true | {error, What} -%% load_file(File) -> {error,What} | {module, Mod} -%% load_abs(File) -> {error,What} | {module, Mod} -%% load_abs(File,Mod) -> {error,What} | {module, Mod} -%% load_binary(Mod,File,Bin) -> {error,What} | {module,Mod} -%% ensure_loaded(Module) -> {error,What} | {module, Mod} -%% delete(Module) -%% purge(Module) kills all procs running old code -%% soft_purge(Module) -> true | false -%% is_loaded(Module) -> {file, File} | false -%% all_loaded() -> {Module, File}* -%% get_object_code(Mod) -> error | {Mod, Bin, Filename} -%% stop() -> true -%% root_dir() -%% compiler_dir() -%% lib_dir() -%% priv_dir(Name) -%% stick_dir(Dir) -> ok | error -%% unstick_dir(Dir) -> ok | error -%% is_sticky(Module) -> true | false -%% which(Module) -> Filename -%% set_primary_archive((FileName, Bin, FileInfo) -> ok | {error, Reason} -%% clash() -> -> print out +-export_type([load_error_rsn/0, load_ret/0]). +-export_type([prepared_code/0]). + +-include_lib("kernel/include/file.hrl"). %%---------------------------------------------------------------------------- %% Some types for basic exported functions of this module %%---------------------------------------------------------------------------- --type load_error_rsn() :: 'badfile' | 'native_code' | 'nofile' | 'not_purged' - | 'sticky_directory'. % for some functions only --type load_ret() :: {'error', load_error_rsn()} | {'module', atom()}. +-type load_error_rsn() :: 'badfile' + | 'nofile' + | 'not_purged' + | 'on_load_failure' + | 'sticky_directory'. +-type load_ret() :: {'error', What :: load_error_rsn()} + | {'module', Module :: module()}. -type loaded_ret_atoms() :: 'cover_compiled' | 'preloaded'. --type loaded_filename() :: file:filename() | loaded_ret_atoms(). +-type loaded_filename() :: (Filename :: file:filename()) | loaded_ret_atoms(). + +-define(PREPARED, '$prepared$'). +-opaque prepared_code() :: + {?PREPARED,[{module(),{binary(),string(),_}}]}. + + +%%% BIFs + +-export([get_chunk/2, is_module_native/1, make_stub_module/3, module_md5/1]). + +-spec get_chunk(Bin, Chunk) -> + binary() | undefined when + Bin :: binary(), + Chunk :: string(). + +get_chunk(_, _) -> + erlang:nif_error(undef). + +-spec is_module_native(Module) -> true | false | undefined when + Module :: module(). + +is_module_native(_) -> + erlang:nif_error(undef). + +-spec make_stub_module(Module, Beam, Info) -> Module when + Module :: module(), + Beam :: binary(), + Info :: {list(), list(), binary()}. + +make_stub_module(_, _, _) -> + erlang:nif_error(undef). + +-spec module_md5(binary()) -> binary() | undefined. + +module_md5(_) -> + erlang:nif_error(undef). + +%%% End of BIFs %%---------------------------------------------------------------------------- %% User interface %%---------------------------------------------------------------------------- --spec objfile_extension() -> file:filename(). +-spec objfile_extension() -> nonempty_string(). objfile_extension() -> init:objfile_extension(). --spec load_file(Module :: atom()) -> load_ret(). +-spec load_file(Module) -> load_ret() when + Module :: module(). load_file(Mod) when is_atom(Mod) -> call({load_file,Mod}). --spec ensure_loaded(Module :: atom()) -> load_ret(). +-spec ensure_loaded(Module) -> {module, Module} | {error, What} when + Module :: module(), + What :: embedded | badfile | nofile | on_load_failure. ensure_loaded(Mod) when is_atom(Mod) -> call({ensure_loaded,Mod}). %% XXX File as an atom is allowed only for backwards compatibility. --spec load_abs(Filename :: file:filename()) -> load_ret(). -load_abs(File) when is_list(File); is_atom(File) -> call({load_abs,File,[]}). +-spec load_abs(Filename) -> load_ret() when + Filename :: file:filename(). +load_abs(File) when is_list(File); is_atom(File) -> + Mod = list_to_atom(filename:basename(File)), + call({load_abs,File,Mod}). %% XXX Filename is also an atom(), e.g. 'cover_compiled' --spec load_abs(Filename :: loaded_filename(), Module :: atom()) -> load_ret(). -load_abs(File,M) when (is_list(File) orelse is_atom(File)), is_atom(M) -> +-spec load_abs(Filename :: loaded_filename(), Module :: module()) -> load_ret(). +load_abs(File, M) when (is_list(File) orelse is_atom(File)), is_atom(M) -> call({load_abs,File,M}). %% XXX Filename is also an atom(), e.g. 'cover_compiled' --spec load_binary(Module :: atom(), Filename :: loaded_filename(), Binary :: binary()) -> load_ret(). -load_binary(Mod,File,Bin) +-spec load_binary(Module, Filename, Binary) -> + {module, Module} | {error, What} when + Module :: module(), + Filename :: loaded_filename(), + Binary :: binary(), + What :: badarg | load_error_rsn(). +load_binary(Mod, File, Bin) when is_atom(Mod), (is_list(File) orelse is_atom(File)), is_binary(Bin) -> call({load_binary,Mod,File,Bin}). --spec load_native_partial(Module :: atom(), Binary :: binary()) -> load_ret(). -load_native_partial(Mod,Bin) when is_atom(Mod), is_binary(Bin) -> +-spec load_native_partial(Module :: module(), Binary :: binary()) -> load_ret(). +load_native_partial(Mod, Bin) when is_atom(Mod), is_binary(Bin) -> call({load_native_partial,Mod,Bin}). --spec load_native_sticky(Module :: atom(), Binary :: binary(), WholeModule :: 'false' | binary()) -> load_ret(). -load_native_sticky(Mod,Bin,WholeModule) +-spec load_native_sticky(Module :: module(), Binary :: binary(), WholeModule :: 'false' | binary()) -> load_ret(). +load_native_sticky(Mod, Bin, WholeModule) when is_atom(Mod), is_binary(Bin), (is_binary(WholeModule) orelse WholeModule =:= false) -> call({load_native_sticky,Mod,Bin,WholeModule}). --spec delete(Module :: atom()) -> boolean(). +-spec delete(Module) -> boolean() when + Module :: module(). delete(Mod) when is_atom(Mod) -> call({delete,Mod}). --spec purge/1 :: (Module :: atom()) -> boolean(). +-spec purge(Module) -> boolean() when + Module :: module(). purge(Mod) when is_atom(Mod) -> call({purge,Mod}). --spec soft_purge(Module :: atom()) -> boolean(). +-spec soft_purge(Module) -> boolean() when + Module :: module(). soft_purge(Mod) when is_atom(Mod) -> call({soft_purge,Mod}). --spec is_loaded(Module :: atom()) -> {'file', loaded_filename()} | 'false'. +-spec is_loaded(Module) -> {'file', Loaded} | false when + Module :: module(), + Loaded :: loaded_filename(). is_loaded(Mod) when is_atom(Mod) -> call({is_loaded,Mod}). --spec get_object_code(Module :: atom()) -> {atom(), binary(), file:filename()} | 'error'. +-spec get_object_code(Module) -> {Module, Binary, Filename} | error when + Module :: module(), + Binary :: binary(), + Filename :: file:filename(). get_object_code(Mod) when is_atom(Mod) -> call({get_object_code, Mod}). --spec all_loaded() -> [{atom(), loaded_filename()}]. +-spec all_loaded() -> [{Module, Loaded}] when + Module :: module(), + Loaded :: loaded_filename(). all_loaded() -> call(all_loaded). -spec stop() -> no_return(). @@ -183,83 +221,413 @@ root_dir() -> call({dir,root_dir}). lib_dir() -> call({dir,lib_dir}). %% XXX is_list() is for backwards compatibility -- take out in future version --spec lib_dir(App :: atom()) -> file:filename() | {'error', 'bad_name'}. +-spec lib_dir(Name) -> file:filename() | {'error', 'bad_name'} when + Name :: atom(). lib_dir(App) when is_atom(App) ; is_list(App) -> call({dir,{lib_dir,App}}). --spec lib_dir(App :: atom(), SubDir :: atom()) -> file:filename() | {'error', 'bad_name'}. +-spec lib_dir(Name, SubDir) -> file:filename() | {'error', 'bad_name'} when + Name :: atom(), + SubDir :: atom(). lib_dir(App, SubDir) when is_atom(App), is_atom(SubDir) -> call({dir,{lib_dir,App,SubDir}}). -spec compiler_dir() -> file:filename(). compiler_dir() -> call({dir,compiler_dir}). %% XXX is_list() is for backwards compatibility -- take out in future version --spec priv_dir(Appl :: atom()) -> file:filename() | {'error', 'bad_name'}. +-spec priv_dir(Name) -> file:filename() | {'error', 'bad_name'} when + Name :: atom(). priv_dir(App) when is_atom(App) ; is_list(App) -> call({dir,{priv_dir,App}}). --spec stick_dir(Directory :: file:filename()) -> 'ok' | 'error'. +-spec stick_dir(Dir) -> 'ok' | 'error' when + Dir :: file:filename(). stick_dir(Dir) when is_list(Dir) -> call({stick_dir,Dir}). --spec unstick_dir(Directory :: file:filename()) -> 'ok' | 'error'. +-spec unstick_dir(Dir) -> 'ok' | 'error' when + Dir :: file:filename(). unstick_dir(Dir) when is_list(Dir) -> call({unstick_dir,Dir}). --spec stick_mod(Module :: atom()) -> 'true'. +-spec stick_mod(Module :: module()) -> 'true'. stick_mod(Mod) when is_atom(Mod) -> call({stick_mod,Mod}). --spec unstick_mod(Module :: atom()) -> 'true'. +-spec unstick_mod(Module :: module()) -> 'true'. unstick_mod(Mod) when is_atom(Mod) -> call({unstick_mod,Mod}). --spec is_sticky(Module :: atom()) -> boolean(). +-spec is_sticky(Module) -> boolean() when + Module :: module(). is_sticky(Mod) when is_atom(Mod) -> call({is_sticky,Mod}). --spec set_path(Directories :: [file:filename()]) -> 'true' | {'error', term()}. +-spec set_path(Path) -> 'true' | {'error', What} when + Path :: [Dir :: file:filename()], + What :: 'bad_directory'. set_path(PathList) when is_list(PathList) -> call({set_path,PathList}). --spec get_path() -> [file:filename()]. +-spec get_path() -> Path when + Path :: [Dir :: file:filename()]. get_path() -> call(get_path). --spec add_path(Directory :: file:filename()) -> 'true' | {'error', term()}. +-type add_path_ret() :: 'true' | {'error', 'bad_directory'}. +-spec add_path(Dir) -> add_path_ret() when + Dir :: file:filename(). add_path(Dir) when is_list(Dir) -> call({add_path,last,Dir}). --spec add_pathz(Directory :: file:filename()) -> 'true' | {'error', term()}. +-spec add_pathz(Dir) -> add_path_ret() when + Dir :: file:filename(). add_pathz(Dir) when is_list(Dir) -> call({add_path,last,Dir}). --spec add_patha(Directory :: file:filename()) -> 'true' | {'error', term()}. +-spec add_patha(Dir) -> add_path_ret() when + Dir :: file:filename(). add_patha(Dir) when is_list(Dir) -> call({add_path,first,Dir}). --spec add_paths(Directories :: [file:filename()]) -> 'ok'. +-spec add_paths(Dirs) -> 'ok' when + Dirs :: [Dir :: file:filename()]. add_paths(Dirs) when is_list(Dirs) -> call({add_paths,last,Dirs}). --spec add_pathsz(Directories :: [file:filename()]) -> 'ok'. +-spec add_pathsz(Dirs) -> 'ok' when + Dirs :: [Dir :: file:filename()]. add_pathsz(Dirs) when is_list(Dirs) -> call({add_paths,last,Dirs}). --spec add_pathsa(Directories :: [file:filename()]) -> 'ok'. +-spec add_pathsa(Dirs) -> 'ok' when + Dirs :: [Dir :: file:filename()]. add_pathsa(Dirs) when is_list(Dirs) -> call({add_paths,first,Dirs}). -%% XXX Contract's input argument differs from add_path/1 -- why? --spec del_path(Name :: file:filename() | atom()) -> boolean() | {'error', 'bad_name'}. +-spec del_path(NameOrDir) -> boolean() | {'error', What} when + NameOrDir :: Name | Dir, + Name :: atom(), + Dir :: file:filename(), + What :: 'bad_name'. del_path(Name) when is_list(Name) ; is_atom(Name) -> call({del_path,Name}). --type replace_path_error() :: {'error', 'bad_directory' | 'bad_name' | {'badarg',_}}. --spec replace_path(Name:: atom(), Dir :: file:filename()) -> 'true' | replace_path_error(). -replace_path(Name, Dir) when (is_atom(Name) or is_list(Name)) and - (is_atom(Dir) or is_list(Dir)) -> +-spec replace_path(Name, Dir) -> 'true' | {'error', What} when + Name:: atom(), + Dir :: file:filename(), + What :: 'bad_directory' | 'bad_name' | {'badarg',_}. +replace_path(Name, Dir) when (is_atom(Name) orelse is_list(Name)), + (is_atom(Dir) orelse is_list(Dir)) -> call({replace_path,Name,Dir}). -spec rehash() -> 'ok'. -rehash() -> call(rehash). +rehash() -> + cache_warning(), + ok. + +-spec get_mode() -> 'embedded' | 'interactive'. +get_mode() -> call(get_mode). + +%%% +%%% Loading of several modules in parallel. +%%% + +-spec ensure_modules_loaded([Module]) -> + 'ok' | {'error',[{Module,What}]} when + Module :: module(), + What :: badfile | nofile | on_load_failure. + +ensure_modules_loaded(Modules) when is_list(Modules) -> + case prepare_ensure(Modules, []) of + Ms when is_list(Ms) -> + ensure_modules_loaded_1(Ms); + error -> + error(function_clause, [Modules]) + end. + +ensure_modules_loaded_1(Ms0) -> + Ms = lists:usort(Ms0), + {Prep,Error0} = load_mods(Ms), + {OnLoad,Normal} = partition_on_load(Prep), + Error1 = case finish_loading(Normal, true) of + ok -> Error0; + {error,Err} -> Err ++ Error0 + end, + ensure_modules_loaded_2(OnLoad, Error1). + +ensure_modules_loaded_2([{M,_}|Ms], Errors) -> + case ensure_loaded(M) of + {module,M} -> + ensure_modules_loaded_2(Ms, Errors); + {error,Err} -> + ensure_modules_loaded_2(Ms, [{M,Err}|Errors]) + end; +ensure_modules_loaded_2([], []) -> + ok; +ensure_modules_loaded_2([], [_|_]=Errors) -> + {error,Errors}. + +prepare_ensure([M|Ms], Acc) when is_atom(M) -> + case erlang:module_loaded(M) of + true -> + prepare_ensure(Ms, Acc); + false -> + prepare_ensure(Ms, [M|Acc]) + end; +prepare_ensure([], Acc) -> + Acc; +prepare_ensure(_, _) -> + error. + +-spec atomic_load(Modules) -> 'ok' | {'error',[{Module,What}]} when + Modules :: [Module | {Module, Filename, Binary}], + Module :: module(), + Filename :: file:filename(), + Binary :: binary(), + What :: 'badfile' | 'nofile' | 'on_load_not_allowed' | 'duplicated' | + 'not_purged' | 'sticky_directory' | 'pending_on_load'. + +atomic_load(Modules) -> + case do_prepare_loading(Modules) of + {ok,Prep} -> + finish_loading(Prep, false); + {error,_}=Error -> + Error; + badarg -> + error(function_clause, [Modules]) + end. + +-spec prepare_loading(Modules) -> + {'ok',Prepared} | {'error',[{Module,What}]} when + Modules :: [Module | {Module, Filename, Binary}], + Module :: module(), + Filename :: file:filename(), + Binary :: binary(), + Prepared :: prepared_code(), + What :: 'badfile' | 'nofile' | 'on_load_not_allowed' | 'duplicated'. + +prepare_loading(Modules) -> + case do_prepare_loading(Modules) of + {ok,Prep} -> + {ok,{?PREPARED,Prep}}; + {error,_}=Error -> + Error; + badarg -> + error(function_clause, [Modules]) + end. + +-spec finish_loading(Prepared) -> 'ok' | {'error',[{Module,What}]} when + Prepared :: prepared_code(), + Module :: module(), + What :: 'not_purged' | 'sticky_directory' | 'pending_on_load'. + +finish_loading({?PREPARED,Prepared}=Arg) when is_list(Prepared) -> + case verify_prepared(Prepared) of + ok -> + finish_loading(Prepared, false); + error -> + error(function_clause, [Arg]) + end. + +partition_load([Item|T], Bs, Ms) -> + case Item of + {M,File,Bin} when is_atom(M) andalso + is_list(File) andalso + is_binary(Bin) -> + partition_load(T, [Item|Bs], Ms); + M when is_atom(M) -> + partition_load(T, Bs, [Item|Ms]); + _ -> + error + end; +partition_load([], Bs, Ms) -> + {Bs,Ms}. + +do_prepare_loading(Modules) -> + case partition_load(Modules, [], []) of + {ModBins,Ms} -> + case prepare_loading_1(ModBins, Ms) of + {error,_}=Error -> + Error; + Prep when is_list(Prep) -> + {ok,Prep} + end; + error -> + badarg + end. + +prepare_loading_1(ModBins, Ms) -> + %% erlang:finish_loading/1 *will* detect duplicates. + %% However, we want to detect all errors that can be detected + %% by only examining the input data before call the LastAction + %% fun. + case prepare_check_uniq(ModBins, Ms) of + ok -> + prepare_loading_2(ModBins, Ms); + Error -> + Error + end. + +prepare_loading_2(ModBins, Ms) -> + {Prep0,Error0} = load_bins(ModBins), + {Prep1,Error1} = load_mods(Ms), + case Error0 ++ Error1 of + [] -> + prepare_loading_3(Prep0 ++ Prep1); + [_|_]=Error -> + {error,Error} + end. + +prepare_loading_3(Prep) -> + case partition_on_load(Prep) of + {[_|_]=OnLoad,_} -> + Error = [{M,on_load_not_allowed} || {M,_} <- OnLoad], + {error,Error}; + {[],_} -> + Prep + end. + +prepare_check_uniq([{M,_,_}|T], Ms) -> + prepare_check_uniq(T, [M|Ms]); +prepare_check_uniq([], Ms) -> + prepare_check_uniq_1(lists:sort(Ms), []). + +prepare_check_uniq_1([M|[M|_]=Ms], Acc) -> + prepare_check_uniq_1(Ms, [{M,duplicated}|Acc]); +prepare_check_uniq_1([_|Ms], Acc) -> + prepare_check_uniq_1(Ms, Acc); +prepare_check_uniq_1([], []) -> + ok; +prepare_check_uniq_1([], [_|_]=Errors) -> + {error,Errors}. + +partition_on_load(Prep) -> + P = fun({_,{Bin,_,_}}) -> + erlang:has_prepared_code_on_load(Bin) + end, + lists:partition(P, Prep). + +verify_prepared([{M,{Prep,Name,_Native}}|T]) + when is_atom(M), is_binary(Prep), is_list(Name) -> + try erlang:has_prepared_code_on_load(Prep) of + false -> + verify_prepared(T); + _ -> + error + catch + error:_ -> + error + end; +verify_prepared([]) -> + ok; +verify_prepared(_) -> + error. + +finish_loading(Prepared0, EnsureLoaded) -> + Prepared = [{M,{Bin,File}} || {M,{Bin,File,_}} <- Prepared0], + Native0 = [{M,Code} || {M,{_,_,Code}} <- Prepared0, + Code =/= undefined], + case call({finish_loading,Prepared,EnsureLoaded}) of + ok -> + finish_loading_native(Native0); + {error,Errors}=E when EnsureLoaded -> + S0 = sofs:relation(Errors), + S1 = sofs:domain(S0), + R0 = sofs:relation(Native0), + R1 = sofs:drestriction(R0, S1), + Native = sofs:to_external(R1), + finish_loading_native(Native), + E; + {error,_}=E -> + E + end. + +finish_loading_native([{Mod,Code}|Ms]) -> + _ = load_native_partial(Mod, Code), + finish_loading_native(Ms); +finish_loading_native([]) -> + ok. + +load_mods([]) -> + {[],[]}; +load_mods(Mods) -> + Path = get_path(), + F = prepare_loading_fun(), + {ok,{Succ,Error0}} = erl_prim_loader:get_modules(Mods, F, Path), + Error = [case E of + badfile -> {M,E}; + _ -> {M,nofile} + end || {M,E} <- Error0], + {Succ,Error}. + +load_bins([]) -> + {[],[]}; +load_bins(BinItems) -> + F = prepare_loading_fun(), + do_par(F, BinItems). + +-type prep_fun_type() :: fun((module(), file:filename(), binary()) -> + {ok,_} | {error,_}). + +-spec prepare_loading_fun() -> prep_fun_type(). + +prepare_loading_fun() -> + GetNative = get_native_fun(), + fun(Mod, FullName, Beam) -> + case erlang:prepare_loading(Mod, Beam) of + Prepared when is_binary(Prepared) -> + {ok,{Prepared,FullName,GetNative(Beam)}}; + {error,_}=Error -> + Error + end + end. + +get_native_fun() -> + Architecture = erlang:system_info(hipe_architecture), + try hipe_unified_loader:chunk_name(Architecture) of + ChunkTag -> + fun(Beam) -> code:get_chunk(Beam, ChunkTag) end + catch _:_ -> + fun(_) -> undefined end + end. + +do_par(Fun, L) -> + {_,Ref} = spawn_monitor(do_par_fun(Fun, L)), + receive + {'DOWN',Ref,process,_,Res} -> + Res + end. + +-spec do_par_fun(prep_fun_type(), list()) -> fun(() -> no_return()). + +do_par_fun(Fun, L) -> + fun() -> + _ = [spawn_monitor(do_par_fun_2(Fun, Item)) || + Item <- L], + exit(do_par_recv(length(L), [], [])) + end. + +-spec do_par_fun_2(prep_fun_type(), + {module(),file:filename(),binary()}) -> + fun(() -> no_return()). + +do_par_fun_2(Fun, Item) -> + fun() -> + {Mod,Filename,Bin} = Item, + try Fun(Mod, Filename, Bin) of + {ok,Res} -> + exit({good,{Mod,Res}}); + {error,Error} -> + exit({bad,{Mod,Error}}) + catch + _:Error -> + exit({bad,{Mod,Error}}) + end + end. + +do_par_recv(0, Good, Bad) -> + {Good,Bad}; +do_par_recv(N, Good, Bad) -> + receive + {'DOWN',_,process,_,{good,Res}} -> + do_par_recv(N-1, [Res|Good], Bad); + {'DOWN',_,process,_,{bad,Res}} -> + do_par_recv(N-1, Good, [Res|Bad]) + end. %%----------------------------------------------------------------- call(Req) -> - code_server:call(code_server, Req). + code_server:call(Req). -spec start_link() -> {'ok', pid()} | {'error', 'crash'}. start_link() -> - start_link([stick]). - --spec start_link(Flags :: [atom()]) -> {'ok', pid()} | {'error', 'crash'}. -start_link(Flags) -> - do_start(Flags). + do_start(). %%----------------------------------------------------------------- %% In the init phase, code must not use any modules not yet loaded, @@ -271,45 +639,49 @@ start_link(Flags) -> %% us, so the module is loaded. %%----------------------------------------------------------------- -do_start(Flags) -> - %% The following module_info/1 calls are here to ensure - %% that the modules are loaded prior to their use elsewhere in - %% the code_server. - %% Otherwise a deadlock may occur when the code_server is starting. - code_server:module_info(module), - packages:module_info(module), - catch hipe_unified_loader:load_hipe_modules(), - gb_sets:module_info(module), - gb_trees:module_info(module), - - ets:module_info(module), - os:module_info(module), - filename:module_info(module), - lists:module_info(module), - - Mode = get_mode(Flags), - case init:get_argument(root) of - {ok,[[Root0]]} -> - Root = filename:join([Root0]), % Normalize. Use filename - case code_server:start_link([Root,Mode]) of - {ok,_Pid} = Ok2 -> - if - Mode =:= interactive -> - case lists:member(stick, Flags) of - true -> do_stick_dirs(); - _ -> ok - end; - true -> - ok - end, - Ok2; - Other -> - Other - end; - Other -> - error_logger:error_msg("Can not start code server ~w ~n",[Other]), - {error, crash} - end. +do_start() -> + maybe_warn_for_cache(), + load_code_server_prerequisites(), + + {ok,[[Root0]]} = init:get_argument(root), + Mode = start_get_mode(), + Root = filename:join([Root0]), % Normalize. + Res = code_server:start_link([Root,Mode]), + + maybe_stick_dirs(Mode), + + %% Quietly load native code for all modules loaded so far. + Architecture = erlang:system_info(hipe_architecture), + load_native_code_for_all_loaded(Architecture), + Res. + +%% Make sure that all modules that the code_server process calls +%% (directly or indirectly) are loaded. Otherwise the code_server +%% process will deadlock. + +load_code_server_prerequisites() -> + %% Please keep the alphabetical order. + Needed = [binary, + ets, + filename, + gb_sets, + gb_trees, + hipe_unified_loader, + lists, + os, + unicode], + _ = [M = M:module_info(module) || M <- Needed], + ok. + +maybe_stick_dirs(interactive) -> + case init:get_argument(nostick) of + {ok,[[]]} -> + ok; + _ -> + do_stick_dirs() + end; +maybe_stick_dirs(_) -> + ok. do_stick_dirs() -> do_s(compiler), @@ -324,23 +696,16 @@ do_s(Lib) -> %% The return value is intentionally ignored. Missing %% directories is not a fatal error. (In embedded systems, %% there is usually no compiler directory.) - stick_dir(filename:append(Dir, "ebin")), + _ = stick_dir(filename:append(Dir, "ebin")), ok end. -get_mode(Flags) -> - case lists:member(embedded, Flags) of - true -> +start_get_mode() -> + case init:get_argument(mode) of + {ok,[["embedded"]]} -> embedded; - _Otherwise -> - case init:get_argument(mode) of - {ok,[["embedded"]]} -> - embedded; - {ok,[["minimal"]]} -> - minimal; - _Else -> - interactive - end + _ -> + interactive end. %% Find out which version of a particular module we would @@ -348,10 +713,9 @@ get_mode(Flags) -> %% In that case return the name of the file which contains %% the loaded object code --type which_ret_atoms() :: loaded_ret_atoms() | 'non_existing'. - --spec which(Module :: atom()) -> file:filename() | which_ret_atoms(). - +-spec which(Module) -> Which when + Module :: module(), + Which :: file:filename() | loaded_ret_atoms() | non_existing. which(Module) when is_atom(Module) -> case is_loaded(Module) of false -> @@ -361,7 +725,7 @@ which(Module) when is_atom(Module) -> end. which2(Module) -> - Base = to_path(Module), + Base = atom_to_list(Module), File = filename:basename(Base) ++ objfile_extension(), Path = get_path(), which(File, filename:dirname(Base), Path). @@ -391,44 +755,31 @@ which(File, Base, [Directory|Tail]) -> %% Search the code path for a specific file. Try to locate %% it in the code path cache if possible. --spec where_is_file(Filename :: file:filename()) -> - 'non_existing' | file:filename(). - +-spec where_is_file(Filename) -> non_existing | Absname when + Filename :: file:filename(), + Absname :: file:filename(). where_is_file(File) when is_list(File) -> - case call({is_cached,File}) of - no -> - Path = get_path(), - which(File, ".", Path); - Dir -> - filename:join(Dir, File) - end. + Path = get_path(), + which(File, ".", Path). -spec where_is_file(Path :: file:filename(), Filename :: file:filename()) -> file:filename() | 'non_existing'. where_is_file(Path, File) when is_list(Path), is_list(File) -> - CodePath = get_path(), - if - Path =:= CodePath -> - case call({is_cached, File}) of - no -> - which(File, ".", Path); - Dir -> - filename:join(Dir, File) - end; - true -> - which(File, ".", Path) - end. + which(File, ".", Path). -spec set_primary_archive(ArchiveFile :: file:filename(), ArchiveBin :: binary(), - FileInfo :: #file_info{}) + FileInfo :: file:file_info(), + ParserFun :: fun()) -> 'ok' | {'error', atom()}. -set_primary_archive(ArchiveFile0, ArchiveBin, FileInfo) - when is_list(ArchiveFile0), is_binary(ArchiveBin), is_record(FileInfo, file_info) -> +set_primary_archive(ArchiveFile0, ArchiveBin, #file_info{} = FileInfo, + ParserFun) + when is_list(ArchiveFile0), is_binary(ArchiveBin) -> ArchiveFile = filename:absname(ArchiveFile0), - case call({set_primary_archive, ArchiveFile, ArchiveBin, FileInfo}) of + case call({set_primary_archive, ArchiveFile, ArchiveBin, FileInfo, + ParserFun}) of {ok, []} -> ok; {ok, _Mode, Ebins} -> @@ -457,7 +808,7 @@ search([{Dir, File} | Tail]) -> false -> search(Tail); {Dir2, File} -> - io:format("** ~s hides ~s~n", + io:format("** ~ts hides ~ts~n", [filename:join(Dir, File), filename:join(Dir2, File)]), [clash | search(Tail)] @@ -473,24 +824,78 @@ decorate([], _) -> []; decorate([File|Tail], Dir) -> [{Dir, File} | decorate(Tail, Dir)]. -filter(_Ext, Dir, {error,_}) -> - io:format("** Bad path can't read ~s~n", [Dir]), []; +filter(_Ext, Dir, error) -> + io:format("** Bad path can't read ~ts~n", [Dir]), []; filter(Ext, _, {ok,Files}) -> filter2(Ext, length(Ext), Files). filter2(_Ext, _Extlen, []) -> []; -filter2(Ext, Extlen,[File|Tail]) -> - case has_ext(Ext,Extlen, File) of +filter2(Ext, Extlen, [File|Tail]) -> + case has_ext(Ext, Extlen, File) of true -> [File | filter2(Ext, Extlen, Tail)]; false -> filter2(Ext, Extlen, Tail) end. -has_ext(Ext, Extlen,File) -> +has_ext(Ext, Extlen, File) -> L = length(File), case catch lists:nthtail(L - Extlen, File) of Ext -> true; _ -> false end. -to_path(X) -> - filename:join(packages:split(X)). +%%% +%%% Warning for deprecated code path cache. +%%% + +maybe_warn_for_cache() -> + case init:get_argument(code_path_cache) of + {ok, _} -> + cache_warning(); + error -> + ok + end. + +cache_warning() -> + W = "The code path cache functionality has been removed", + error_logger:warning_report(W). + +%%% +%%% Silently load native code for all modules loaded so far. +%%% + +load_native_code_for_all_loaded(undefined) -> + ok; +load_native_code_for_all_loaded(Architecture) -> + try hipe_unified_loader:chunk_name(Architecture) of + ChunkTag -> + Loaded = all_loaded(), + _ = spawn(fun() -> load_all_native(Loaded, ChunkTag) end), + ok + catch + _:_ -> + ok + end. + +load_all_native(Loaded, ChunkTag) -> + catch load_all_native_1(Loaded, ChunkTag). + +load_all_native_1([{_,preloaded}|T], ChunkTag) -> + load_all_native_1(T, ChunkTag); +load_all_native_1([{Mod,BeamFilename}|T], ChunkTag) -> + case code:is_module_native(Mod) of + false -> + %% prim_file is faster than file and the file server may + %% not be started yet. + {ok,Beam} = prim_file:read_file(BeamFilename), + case code:get_chunk(Beam, ChunkTag) of + undefined -> + ok; + NativeCode when is_binary(NativeCode) -> + _ = load_native_partial(Mod, NativeCode), + ok + end; + true -> ok + end, + load_all_native_1(T, ChunkTag); +load_all_native_1([], _) -> + ok. diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 7aeddb73d1..59b26176bf 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -21,26 +22,33 @@ %% This file holds the server part of the code_server. -export([start_link/1, - call/2, - system_continue/3, - system_terminate/4, + call/1, system_code_change/4, error_msg/2, info_msg/2 ]). -include_lib("kernel/include/file.hrl"). +-include_lib("stdlib/include/ms_transform.hrl"). -import(lists, [foreach/2]). --record(state,{supervisor, - root, - path, - moddb, - namedb, - cache = no_cache, - mode=interactive, - on_load = []}). +-type on_load_action() :: + fun((term(), state()) -> {'reply',term(),state()} | + {'noreply',state()}). + +-type on_load_item() :: {{pid(),reference()},module(), + [{pid(),on_load_action()}]}. + +-record(state, {supervisor :: pid(), + root :: file:name_all(), + path :: [file:name_all()], + moddb :: ets:tab(), + namedb :: ets:tab(), + mode = interactive :: 'interactive' | 'embedded', + on_load = [] :: [on_load_item()]}). +-type state() :: #state{}. +-spec start_link([term()]) -> {'ok', pid()}. start_link(Args) -> Ref = make_ref(), Parent = self(), @@ -55,26 +63,25 @@ start_link(Args) -> %% Init the code_server process. %% ----------------------------------------------------------- -init(Ref, Parent, [Root,Mode0]) -> +init(Ref, Parent, [Root,Mode]) -> register(?MODULE, self()), process_flag(trap_exit, true), Db = ets:new(code, [private]), - foreach(fun (M) -> ets:insert(Db, {M,preloaded}) end, erlang:pre_loaded()), - ets:insert(Db, init:fetch_loaded()), - - Mode = - case Mode0 of - minimal -> interactive; - _ -> Mode0 - end, + foreach(fun (M) -> + %% Pre-loaded modules are always sticky. + ets:insert(Db, [{M,preloaded},{{sticky,M},true}]) + end, erlang:pre_loaded()), + Loaded0 = init:fetch_loaded(), + Loaded = [{M,filename:join([P])} || {M,P} <- Loaded0], %Normalize. + ets:insert(Db, Loaded), IPath = case Mode of interactive -> LibDir = filename:append(Root, "lib"), {ok,Dirs} = erl_prim_loader:list_dir(LibDir), - {Paths,_Libs} = make_path(LibDir,Dirs), + Paths = make_path(LibDir, Dirs), UserLibPaths = get_user_lib_dirs(), ["."] ++ UserLibPaths ++ Paths; _ -> @@ -82,22 +89,15 @@ init(Ref, Parent, [Root,Mode0]) -> end, Path = add_loader_path(IPath, Mode), - State0 = #state{root = Root, - path = Path, - moddb = Db, - namedb = init_namedb(Path), - mode = Mode}, - - State = - case init:get_argument(code_path_cache) of - {ok, _} -> - create_cache(State0); - error -> - State0 - end, + State = #state{supervisor = Parent, + root = Root, + path = Path, + moddb = Db, + namedb = init_namedb(Path), + mode = Mode}, Parent ! {Ref,{ok,self()}}, - loop(State#state{supervisor=Parent}). + loop(State). get_user_lib_dirs() -> case os:getenv("ERL_LIBS") of @@ -116,7 +116,7 @@ get_user_lib_dirs() -> get_user_lib_dirs_1([Dir|DirList]) -> case erl_prim_loader:list_dir(Dir) of {ok, Dirs} -> - {Paths,_Libs} = make_path(Dir, Dirs), + Paths = make_path(Dir, Dirs), %% Only add paths trailing with ./ebin. [P || P <- Paths, filename:basename(P) =:= "ebin"] ++ get_user_lib_dirs_1(DirList); @@ -133,11 +133,16 @@ split_paths([C|T], S, Path, Paths) -> split_paths([], _S, Path, Paths) -> lists:reverse(Paths, [lists:reverse(Path)]). -call(Name, Req) -> - Name ! {code_call, self(), Req}, +-spec call(term()) -> term(). +call(Req) -> + Ref = erlang:monitor(process, ?MODULE), + ?MODULE ! {code_call, self(), Req}, receive {?MODULE, Reply} -> - Reply + erlang:demonitor(Ref,[flush]), + Reply; + {'DOWN',Ref,process,_,_} -> + exit({'DOWN',code_server,Req}) end. reply(Pid, Res) -> @@ -146,9 +151,9 @@ reply(Pid, Res) -> loop(#state{supervisor=Supervisor}=State0) -> receive {code_call, Pid, Req} -> - case handle_call(Req, {Pid, call}, State0) of + case handle_call(Req, Pid, State0) of {reply, Res, State} -> - reply(Pid, Res), + _ = reply(Pid, Res), loop(State); {noreply, State} -> loop(State); @@ -159,8 +164,8 @@ loop(#state{supervisor=Supervisor}=State0) -> system_terminate(Reason, Supervisor, [], State0); {system, From, Msg} -> handle_system_msg(running,Msg, From, Supervisor, State0); - {'DOWN',Ref,process,_,Res} -> - State = finish_on_load(Ref, Res, State0), + {'DOWN',Ref,process,Pid,Res} -> + State = finish_on_load({Pid,Ref}, Res, State0), loop(State); _Msg -> loop(State0) @@ -169,8 +174,8 @@ loop(#state{supervisor=Supervisor}=State0) -> %%%%%%%%%%%%%%%%%%%%%%%%%%% %% System upgrade -handle_system_msg(SysState,Msg,From,Parent,Misc) -> - case do_sys_cmd(SysState,Msg,Parent, Misc) of +handle_system_msg(SysState, Msg, From, Parent, Misc) -> + case do_sys_cmd(SysState, Msg, Parent, Misc) of {suspended, Reply, NMisc} -> gen_reply(From, Reply), suspend_loop(suspended, Parent, NMisc); @@ -207,7 +212,7 @@ do_sys_cmd(SysState, {debug, _What}, _Parent, Misc) -> do_sys_cmd(suspended, {change_code, Module, Vsn, Extra}, _Parent, Misc0) -> {Res, Misc} = case catch ?MODULE:system_code_change(Misc0, Module, Vsn, Extra) of - {ok, Misc1} -> {ok, Misc1}; + {ok, _} = Ok -> Ok; Else -> {{error, Else}, Misc0} end, {suspended, Res, Misc}; @@ -218,9 +223,10 @@ system_continue(_Parent, _Debug, State) -> loop(State). system_terminate(_Reason, _Parent, _Debug, _State) -> -% error_msg("~p terminating: ~p~n ",[?MODULE,Reason]), + %% error_msg("~p terminating: ~p~n ", [?MODULE, Reason]), exit(shutdown). +-spec system_code_change(state(), module(), term(), term()) -> {'ok', state()}. system_code_change(State, _Module, _OldVsn, _Extra) -> {ok, State}. @@ -228,269 +234,145 @@ system_code_change(State, _Module, _OldVsn, _Extra) -> %% The gen_server call back functions. %% -handle_call({stick_dir,Dir}, {_From,_Tag}, S) -> +handle_call({stick_dir,Dir}, _From, S) -> {reply,stick_dir(Dir, true, S),S}; -handle_call({unstick_dir,Dir}, {_From,_Tag}, S) -> +handle_call({unstick_dir,Dir}, _From, S) -> {reply,stick_dir(Dir, false, S),S}; -handle_call({stick_mod,Mod}, {_From,_Tag}, S) -> +handle_call({stick_mod,Mod}, _From, S) -> {reply,stick_mod(Mod, true, S),S}; -handle_call({unstick_mod,Mod}, {_From,_Tag}, S) -> +handle_call({unstick_mod,Mod}, _From, S) -> {reply,stick_mod(Mod, false, S),S}; -handle_call({dir,Dir},{_From,_Tag}, S) -> +handle_call({dir,Dir}, _From, S) -> Root = S#state.root, Resp = do_dir(Root,Dir,S#state.namedb), {reply,Resp,S}; -handle_call({load_file,Mod}, Caller, St) -> - case modp(Mod) of - false -> - {reply,{error,badarg},St}; - true -> - load_file(Mod, Caller, St) - end; - -handle_call({add_path,Where,Dir0}, {_From,_Tag}, S=#state{cache=Cache0}) -> - case Cache0 of - no_cache -> - {Resp,Path} = add_path(Where, Dir0, S#state.path, S#state.namedb), - {reply,Resp,S#state{path=Path}}; - _ -> - Dir = absname(Dir0), %% Cache always expands the path - {Resp,Path} = add_path(Where, Dir, S#state.path, S#state.namedb), - Cache=update_cache([Dir],Where,Cache0), - {reply,Resp,S#state{path=Path,cache=Cache}} - end; +handle_call({load_file,Mod}, From, St) when is_atom(Mod) -> + load_file(Mod, From, St); -handle_call({add_paths,Where,Dirs0}, {_From,_Tag}, S=#state{cache=Cache0}) -> - case Cache0 of - no_cache -> - {Resp,Path} = add_paths(Where,Dirs0,S#state.path,S#state.namedb), - {reply,Resp, S#state{path=Path}}; - _ -> - %% Cache always expands the path - Dirs = [absname(Dir) || Dir <- Dirs0], - {Resp,Path} = add_paths(Where, Dirs, S#state.path, S#state.namedb), - Cache=update_cache(Dirs,Where,Cache0), - {reply,Resp,S#state{cache=Cache,path=Path}} - end; +handle_call({add_path,Where,Dir0}, _From, + #state{namedb=Namedb,path=Path0}=S) -> + {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; -handle_call({set_path,PathList}, {_From,_Tag}, S) -> - Path = S#state.path, - {Resp, NewPath,NewDb} = set_path(PathList, Path, S#state.namedb), - {reply,Resp,rehash_cache(S#state{path = NewPath, namedb=NewDb})}; +handle_call({add_paths,Where,Dirs0}, _From, + #state{namedb=Namedb,path=Path0}=S) -> + {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; -handle_call({del_path,Name}, {_From,_Tag}, S) -> - {Resp,Path} = del_path(Name,S#state.path,S#state.namedb), - {reply,Resp,rehash_cache(S#state{path = Path})}; +handle_call({set_path,PathList}, _From, + #state{path=Path0,namedb=Namedb}=S) -> + {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb), + {reply,Resp,S#state{path=Path,namedb=NewDb}}; -handle_call({replace_path,Name,Dir}, {_From,_Tag}, S) -> - {Resp,Path} = replace_path(Name,Dir,S#state.path,S#state.namedb), - {reply,Resp,rehash_cache(S#state{path = Path})}; +handle_call({del_path,Name}, _From, + #state{path=Path0,namedb=Namedb}=S) -> + {Resp,Path} = del_path(Name, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; -handle_call(rehash, {_From,_Tag}, S0) -> - S = create_cache(S0), - {reply,ok,S}; +handle_call({replace_path,Name,Dir}, _From, + #state{path=Path0,namedb=Namedb}=S) -> + {Resp,Path} = replace_path(Name, Dir, Path0, Namedb), + {reply,Resp,S#state{path=Path}}; -handle_call(get_path, {_From,_Tag}, S) -> +handle_call(get_path, _From, S) -> {reply,S#state.path,S}; %% Messages to load, delete and purge modules/files. -handle_call({load_abs,File,Mod}, Caller, S) -> +handle_call({load_abs,File,Mod}, From, S) when is_atom(Mod) -> case modp(File) of false -> {reply,{error,badarg},S}; true -> - load_abs(File, Mod, Caller, S) + load_abs(File, Mod, From, S) end; -handle_call({load_binary,Mod,File,Bin}, Caller, S) -> - do_load_binary(Mod, File, Bin, Caller, S); +handle_call({load_binary,Mod,File,Bin}, From, S) when is_atom(Mod) -> + do_load_binary(Mod, File, Bin, From, S); -handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) -> - Result = (catch hipe_unified_loader:load(Mod,Bin)), - Status = hipe_result_to_status(Result), +handle_call({load_native_partial,Mod,Bin}, _From, S) -> + Architecture = erlang:system_info(hipe_architecture), + Result = (catch hipe_unified_loader:load(Mod, Bin, Architecture)), + Status = hipe_result_to_status(Result, S), {reply,Status,S}; -handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> - Result = (catch hipe_unified_loader:load_module(Mod,Bin,WholeModule)), - Status = hipe_result_to_status(Result), +handle_call({load_native_sticky,Mod,Bin,WholeModule}, _From, S) -> + Architecture = erlang:system_info(hipe_architecture), + Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule, + Architecture)), + Status = hipe_result_to_status(Result, S), {reply,Status,S}; -handle_call({ensure_loaded,Mod0}, Caller, St0) -> - Fun = fun (M, St) -> - case erlang:module_loaded(M) of - true -> - {reply,{module,M},St}; - false when St#state.mode =:= interactive -> - load_file(M, Caller, St); - false -> - {reply,{error,embedded},St} - end - end, - do_mod_call(Fun, Mod0, {error,badarg}, St0); - -handle_call({delete,Mod0}, {_From,_Tag}, S) -> - Fun = fun (M, St) -> - case catch erlang:delete_module(M) of - true -> - ets:delete(St#state.moddb, M), - {reply,true,St}; - _ -> - {reply,false,St} - end - end, - do_mod_call(Fun, Mod0, false, S); +handle_call({ensure_loaded,Mod}, From, St) when is_atom(Mod) -> + case erlang:module_loaded(Mod) of + true -> + {reply,{module,Mod},St}; + false when St#state.mode =:= interactive -> + ensure_loaded(Mod, From, St); + false -> + {reply,{error,embedded},St} + end; -handle_call({purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_purge(M),St} - end, Mod0, false, St0); +handle_call({delete,Mod}, _From, St) when is_atom(Mod) -> + case catch erlang:delete_module(Mod) of + true -> + ets:delete(St#state.moddb, Mod), + {reply,true,St}; + _ -> + {reply,false,St} + end; + +handle_call({purge,Mod}, _From, St) when is_atom(Mod) -> + {reply,do_purge(Mod),St}; -handle_call({soft_purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_soft_purge(M),St} - end, Mod0, true, St0); +handle_call({soft_purge,Mod}, _From, St) when is_atom(Mod) -> + {reply,do_soft_purge(Mod),St}; -handle_call({is_loaded,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,is_loaded(M, St#state.moddb),St} - end, Mod0, false, St0); +handle_call({is_loaded,Mod}, _From, St) when is_atom(Mod) -> + {reply,is_loaded(Mod, St#state.moddb),St}; -handle_call(all_loaded, {_From,_Tag}, S) -> +handle_call(all_loaded, _From, S) -> Db = S#state.moddb, {reply,all_loaded(Db),S}; -handle_call({get_object_code,Mod0}, {_From,_Tag}, St0) -> - Fun = fun(M, St) -> - Path = St#state.path, - case mod_to_bin(Path, atom_to_list(M)) of - {_,Bin,FName} -> {reply,{M,Bin,FName},St}; - Error -> {reply,Error,St} - end - end, - do_mod_call(Fun, Mod0, error, St0); +handle_call({get_object_code,Mod}, _From, St) when is_atom(Mod) -> + Path = St#state.path, + case mod_to_bin(Path, Mod) of + {_,Bin,FName} -> {reply,{Mod,Bin,FName},St}; + Error -> {reply,Error,St} + end; -handle_call({is_sticky, Mod}, {_From,_Tag}, S) -> +handle_call({is_sticky, Mod}, _From, S) -> Db = S#state.moddb, {reply, is_sticky(Mod,Db), S}; -handle_call(stop,{_From,_Tag}, S) -> +handle_call(stop,_From, S) -> {stop,normal,stopped,S}; -handle_call({is_cached,_File}, {_From,_Tag}, S=#state{cache=no_cache}) -> - {reply, no, S}; - -handle_call({set_primary_archive, File, ArchiveBin, FileInfo}, {_From,_Tag}, S=#state{mode=Mode}) -> - case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo) of +handle_call({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}, + _From, S=#state{mode=Mode}) -> + case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo, + ParserFun) of {ok, Files} -> {reply, {ok, Mode, Files}, S}; - {error, Reason} -> - {reply, {error, Reason}, S} + {error, _Reason} = Error -> + {reply, Error, S} end; -handle_call({is_cached,File}, {_From,_Tag}, S=#state{cache=Cache}) -> - ObjExt = objfile_extension(), - Ext = filename:extension(File), - Type = case Ext of - ObjExt -> obj; - ".app" -> app; - _ -> undef - end, - if Type =:= undef -> - {reply, no, S}; - true -> - Key = {Type,list_to_atom(filename:rootname(File, Ext))}, - case ets:lookup(Cache, Key) of - [] -> - {reply, no, S}; - [{Key,Dir}] -> - {reply, Dir, S} - end - end; +handle_call(get_mode, _From, S=#state{mode=Mode}) -> + {reply, Mode, S}; + +handle_call({finish_loading,Prepared,EnsureLoaded}, _From, S) -> + {reply,finish_loading(Prepared, EnsureLoaded, S),S}; -handle_call(Other,{_From,_Tag}, S) -> +handle_call(Other,_From, S) -> error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]), {noreply,S}. -do_mod_call(Action, Module, _Error, St) when is_atom(Module) -> - Action(Module, St); -do_mod_call(Action, Module, Error, St) -> - try list_to_atom(Module) of - Atom when is_atom(Atom) -> - Action(Atom, St) - catch - error:badarg -> - {reply,Error,St} - end. - -%% -------------------------------------------------------------- -%% Cache functions -%% -------------------------------------------------------------- - -create_cache(St = #state{cache = no_cache}) -> - Cache = ets:new(code_cache, [protected]), - rehash_cache(Cache, St); -create_cache(St) -> - rehash_cache(St). - -rehash_cache(St = #state{cache = no_cache}) -> - St; -rehash_cache(St = #state{cache = OldCache}) -> - ets:delete(OldCache), - Cache = ets:new(code_cache, [protected]), - rehash_cache(Cache, St). - -rehash_cache(Cache, St = #state{path = Path}) -> - Exts = [{obj,objfile_extension()}, {app,".app"}], - {Cache,NewPath} = locate_mods(lists:reverse(Path), first, Exts, Cache, []), - St#state{cache = Cache, path=NewPath}. - -update_cache(Dirs, Where, Cache0) -> - Exts = [{obj,objfile_extension()}, {app,".app"}], - {Cache, _} = locate_mods(Dirs, Where, Exts, Cache0, []), - Cache. - -locate_mods([Dir0|Path], Where, Exts, Cache, Acc) -> - Dir = absname(Dir0), %% Cache always expands the path - case erl_prim_loader:list_dir(Dir) of - {ok, Files} -> - Cache = filter_mods(Files, Where, Exts, Dir, Cache), - locate_mods(Path, Where, Exts, Cache, [Dir|Acc]); - error -> - locate_mods(Path, Where, Exts, Cache, Acc) - end; -locate_mods([], _, _, Cache, Path) -> - {Cache,Path}. - -filter_mods([File|Rest], Where, Exts, Dir, Cache) -> - Ext = filename:extension(File), - Root = list_to_atom(filename:rootname(File, Ext)), - case lists:keysearch(Ext, 2, Exts) of - {value,{Type,_}} -> - Key = {Type,Root}, - case Where of - first -> - true = ets:insert(Cache, {Key,Dir}); - last -> - case ets:lookup(Cache, Key) of - [] -> - true = ets:insert(Cache, {Key,Dir}); - _ -> - ignore - end - end; - false -> - ok - end, - filter_mods(Rest, Where, Exts, Dir, Cache); - -filter_mods([], _, _, _, Cache) -> - Cache. - %% -------------------------------------------------------------- %% Path handling functions. %% -------------------------------------------------------------- @@ -498,27 +380,25 @@ filter_mods([], _, _, _, Cache) -> %% %% Create the initial path. %% -make_path(BundleDir,Bundles0) -> +make_path(BundleDir, Bundles0) -> Bundles = choose_bundles(Bundles0), - make_path(BundleDir,Bundles,[],[]). + make_path(BundleDir, Bundles, []). choose_bundles(Bundles) -> ArchiveExt = archive_extension(), - Bs = lists:sort([create_bundle(B,ArchiveExt) || B <- Bundles]), + Bs = lists:sort([create_bundle(B, ArchiveExt) || B <- Bundles]), [FullName || {_Name,_NumVsn,FullName} <- choose(lists:reverse(Bs), [], ArchiveExt)]. -create_bundle(FullName,ArchiveExt) -> - BaseName = filename:basename(FullName,ArchiveExt), - case split(BaseName, "-") of - Toks when length(Toks) > 1 -> - VsnStr = lists:last(Toks), +create_bundle(FullName, ArchiveExt) -> + BaseName = filename:basename(FullName, ArchiveExt), + case split_base(BaseName) of + {Name, VsnStr} -> case vsn_to_num(VsnStr) of {ok, VsnNum} -> - Name = join(lists:sublist(Toks,length(Toks)-1),"-"), {Name,VsnNum,FullName}; false -> - {FullName, [0], FullName} + {FullName,[0],FullName} end; _ -> {FullName,[0],FullName} @@ -569,8 +449,8 @@ join([], _) -> []. choose([{Name,NumVsn,NewFullName}=New|Bs], Acc, ArchiveExt) -> - case lists:keysearch(Name,1,Acc) of - {value, {_, NV, OldFullName}} when NV =:= NumVsn -> + case lists:keyfind(Name, 1, Acc) of + {_, NV, OldFullName} when NV =:= NumVsn -> case filename:extension(OldFullName) =:= ArchiveExt of false -> choose(Bs,Acc, ArchiveExt); @@ -578,7 +458,7 @@ choose([{Name,NumVsn,NewFullName}=New|Bs], Acc, ArchiveExt) -> Acc2 = lists:keystore(Name, 1, Acc, New), choose(Bs,Acc2, ArchiveExt) end; - {value, {_, _, _}} -> + {_, _, _} -> choose(Bs,Acc, ArchiveExt); false -> choose(Bs,[{Name,NumVsn,NewFullName}|Acc], ArchiveExt) @@ -586,41 +466,44 @@ choose([{Name,NumVsn,NewFullName}=New|Bs], Acc, ArchiveExt) -> choose([],Acc, _ArchiveExt) -> Acc. -make_path(_,[],Res,Bs) -> - {Res,Bs}; -make_path(BundleDir,[Bundle|Tail],Res,Bs) -> - Dir = filename:append(BundleDir,Bundle), - Ebin = filename:append(Dir,"ebin"), +make_path(_, [], Res) -> + Res; +make_path(BundleDir, [Bundle|Tail], Res) -> + Dir = filename:append(BundleDir, Bundle), + Ebin = filename:append(Dir, "ebin"), %% First try with /ebin - case erl_prim_loader:read_file_info(Ebin) of - {ok,#file_info{type=directory}} -> - make_path(BundleDir,Tail,[Ebin|Res],[Bundle|Bs]); - _ -> + case is_dir(Ebin) of + true -> + make_path(BundleDir, Tail, [Ebin|Res]); + false -> %% Second try with archive Ext = archive_extension(), - Base = filename:basename(Dir, Ext), - Ebin2 = filename:join([filename:dirname(Dir), Base ++ Ext, Base, "ebin"]), + Base = filename:basename(Bundle, Ext), + Ebin2 = filename:join([BundleDir, Base ++ Ext, Base, "ebin"]), Ebins = - case split(Base, "-") of - Toks when length(Toks) > 1 -> - AppName = join(lists:sublist(Toks,length(Toks)-1),"-"), - Ebin3 = filename:join([filename:dirname(Dir), Base ++ Ext, AppName, "ebin"]), + case split_base(Base) of + {AppName,_} -> + Ebin3 = filename:join([BundleDir, Base ++ Ext, + AppName, "ebin"]), [Ebin3, Ebin2, Dir]; _ -> [Ebin2, Dir] end, - try_ebin_dirs(Ebins,BundleDir,Tail,Res,Bundle, Bs) + case try_ebin_dirs(Ebins) of + {ok,FoundEbin} -> + make_path(BundleDir, Tail, [FoundEbin|Res]); + error -> + make_path(BundleDir, Tail, Res) + end end. -try_ebin_dirs([Ebin | Ebins],BundleDir,Tail,Res,Bundle,Bs) -> - case erl_prim_loader:read_file_info(Ebin) of - {ok,#file_info{type=directory}} -> - make_path(BundleDir,Tail,[Ebin|Res],[Bundle|Bs]); - _ -> - try_ebin_dirs(Ebins,BundleDir,Tail,Res,Bundle,Bs) +try_ebin_dirs([Ebin|Ebins]) -> + case is_dir(Ebin) of + true -> {ok,Ebin}; + false -> try_ebin_dirs(Ebins) end; -try_ebin_dirs([],BundleDir,Tail,Res,_Bundle,Bs) -> - make_path(BundleDir,Tail,Res,Bs). +try_ebin_dirs([]) -> + error. %% @@ -738,19 +621,34 @@ exclude(Dir,Path) -> %% %% get_name(Dir) -> - get_name2(get_name1(Dir), []). + get_name_from_splitted(filename:split(Dir)). + +get_name_from_splitted([DirName,"ebin"]) -> + discard_after_hyphen(DirName); +get_name_from_splitted([DirName]) -> + discard_after_hyphen(DirName); +get_name_from_splitted([_|T]) -> + get_name_from_splitted(T); +get_name_from_splitted([]) -> + "". %No name. + +discard_after_hyphen("-"++_) -> + []; +discard_after_hyphen([H|T]) -> + [H|discard_after_hyphen(T)]; +discard_after_hyphen([]) -> + []. -get_name1(Dir) -> - case lists:reverse(filename:split(Dir)) of - ["ebin",DirName|_] -> DirName; - [DirName|_] -> DirName; - _ -> "" % No name ! +split_base(BaseName) -> + case split(BaseName, "-") of + [_, _|_] = Toks -> + Vsn = lists:last(Toks), + AllButLast = lists:droplast(Toks), + {join(AllButLast, "-"),Vsn}; + [_|_] -> + BaseName end. -get_name2([$-|_],Acc) -> lists:reverse(Acc); -get_name2([H|T],Acc) -> get_name2(T,[H|Acc]); -get_name2(_,Acc) -> lists:reverse(Acc). - check_path(Path) -> PathChoice = init:code_path_choice(), ArchiveExt = archive_extension(), @@ -759,23 +657,23 @@ check_path(Path) -> do_check_path([], _PathChoice, _ArchiveExt, Acc) -> {ok, lists:reverse(Acc)}; do_check_path([Dir | Tail], PathChoice, ArchiveExt, Acc) -> - case catch erl_prim_loader:read_file_info(Dir) of - {ok, #file_info{type=directory}} -> + case is_dir(Dir) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir | Acc]); - _ when PathChoice =:= strict -> + false when PathChoice =:= strict -> %% Be strict. Only use dir as explicitly stated {error, bad_directory}; - _ when PathChoice =:= relaxed -> + false when PathChoice =:= relaxed -> %% Be relaxed case catch lists:reverse(filename:split(Dir)) of {'EXIT', _} -> {error, bad_directory}; ["ebin", App] -> Dir2 = filename:join([App ++ ArchiveExt, App, "ebin"]), - case erl_prim_loader:read_file_info(Dir2) of - {ok, #file_info{type = directory}} -> + case is_dir(Dir2) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir2 | Acc]); - _ -> + false -> {error, bad_directory} end; ["ebin", App, OptArchive | RevTop] -> @@ -795,10 +693,10 @@ do_check_path([Dir | Tail], PathChoice, ArchiveExt, Acc) -> Top = lists:reverse([OptArchive | RevTop]), filename:join(Top ++ [App ++ ArchiveExt, App, "ebin"]) end, - case erl_prim_loader:read_file_info(Dir2) of - {ok, #file_info{type = directory}} -> + case is_dir(Dir2) of + true -> do_check_path(Tail, PathChoice, ArchiveExt, [Dir2 | Acc]); - _ -> + false -> {error, bad_directory} end; _ -> @@ -835,30 +733,25 @@ add_path(_,_,Path,_) -> %% then the table is created :-) %% do_add(first,Dir,Path,NameDb) -> - update(Dir,NameDb), + update(Dir, NameDb), [Dir|lists:delete(Dir,Path)]; do_add(last,Dir,Path,NameDb) -> case lists:member(Dir,Path) of true -> Path; false -> - maybe_update(Dir,NameDb), + maybe_update(Dir, NameDb), Path ++ [Dir] end. %% Do not update if the same name already exists ! -maybe_update(Dir,NameDb) -> - case lookup_name(get_name(Dir),NameDb) of - false -> update(Dir,NameDb); - _ -> false - end. +maybe_update(Dir, NameDb) -> + (lookup_name(get_name(Dir), NameDb) =:= false) andalso update(Dir, NameDb). update(_Dir, false) -> - ok; -update(Dir,NameDb) -> - replace_name(Dir,NameDb). - - + true; +update(Dir, NameDb) -> + replace_name(Dir, NameDb). %% %% Set a completely new path. @@ -902,7 +795,7 @@ init_namedb(Path) -> Db. init_namedb([P|Path], Db) -> - insert_name(P, Db), + insert_dir(P, Db), init_namedb(Path, Db); init_namedb([], _) -> ok. @@ -915,59 +808,45 @@ clear_namedb([], _) -> ok. -endif. -insert_name(Dir, Db) -> - case get_name(Dir) of - Dir -> false; - Name -> insert_name(Name, Dir, Db) - end. +%% Dir must be a complete pathname (not only a name). +insert_dir(Dir, Db) -> + Splitted = filename:split(Dir), + case get_name_from_splitted(Splitted) of + Name when Name /= "ebin", Name /= "." -> + Name; + _ -> + SplittedAbsName = filename:split(absname(Dir)), + Name = get_name_from_splitted(SplittedAbsName) + end, + AppDir = filename:join(del_ebin_1(Splitted)), + do_insert_name(Name, AppDir, Db). insert_name(Name, Dir, Db) -> AppDir = del_ebin(Dir), + do_insert_name(Name, AppDir, Db). + +do_insert_name(Name, AppDir, Db) -> {Base, SubDirs} = archive_subdirs(AppDir), ets:insert(Db, {Name, AppDir, Base, SubDirs}), true. archive_subdirs(AppDir) -> - IsDir = - fun(RelFile) -> - File = filename:join([AppDir, RelFile]), - case erl_prim_loader:read_file_info(File) of - {ok, #file_info{type = directory}} -> - false; - _ -> - true - end - end, - {Base, ArchiveDirs} = all_archive_subdirs(AppDir), - {Base, lists:filter(IsDir, ArchiveDirs)}. - -all_archive_subdirs(AppDir) -> - Ext = archive_extension(), Base = filename:basename(AppDir), - Dirs = - case split(Base, "-") of - Toks when length(Toks) > 1 -> - Base2 = join(lists:sublist(Toks,length(Toks)-1),"-"), - [Base2, Base]; - _ -> - [Base] + Dirs = case split_base(Base) of + {Name, _} -> [Name, Base]; + _ -> [Base] end, + Ext = archive_extension(), try_archive_subdirs(AppDir ++ Ext, Base, Dirs). try_archive_subdirs(Archive, Base, [Dir | Dirs]) -> - ArchiveDir = filename:join([Archive, Dir]), + ArchiveDir = filename:append(Archive, Dir), case erl_prim_loader:list_dir(ArchiveDir) of {ok, Files} -> - IsDir = - fun(RelFile) -> - File = filename:join([ArchiveDir, RelFile]), - case erl_prim_loader:read_file_info(File) of - {ok, #file_info{type = directory}} -> - true; - _ -> - false - end - end, + IsDir = fun(RelFile) -> + File = filename:append(ArchiveDir, RelFile), + is_dir(File) + end, {Dir, lists:filter(IsDir, Files)}; _ -> try_archive_subdirs(Archive, Base, Dirs) @@ -981,7 +860,7 @@ try_archive_subdirs(_Archive, Base, []) -> %% the complete directory name. %% del_path(Name0,Path,NameDb) -> - case catch to_list(Name0)of + case catch filename:join([to_list(Name0)]) of {'EXIT',_} -> {{error,bad_name},Path}; Name -> @@ -1060,26 +939,33 @@ check_pars(Name,Dir) -> {error,bad_name} end. - del_ebin(Dir) -> - case filename:basename(Dir) of - "ebin" -> - Dir2 = filename:dirname(Dir), - Dir3 = filename:dirname(Dir2), - Ext = archive_extension(), - case filename:extension(Dir3) of - E when E =:= Ext -> - %% Strip archive extension - filename:join([filename:dirname(Dir3), - filename:basename(Dir3, Ext)]); - _ -> - Dir2 - end; - _ -> - Dir - end. - + filename:join(del_ebin_1(filename:split(Dir))). +del_ebin_1([Parent,App,"ebin"]) -> + case filename:basename(Parent) of + [] -> + %% Parent is the root directory + [Parent,App]; + _ -> + Ext = archive_extension(), + case filename:basename(Parent, Ext) of + Parent -> + %% Plain directory. + [Parent,App]; + Archive -> + %% Archive. + [Archive] + end + end; +del_ebin_1(Path = [_App,"ebin"]) -> + del_ebin_1(filename:split(absname(filename:join(Path)))); +del_ebin_1(["ebin"]) -> + del_ebin_1(filename:split(absname("ebin"))); +del_ebin_1([H|T]) -> + [H|del_ebin_1(T)]; +del_ebin_1([]) -> + []. replace_name(Dir, Db) -> case get_name(Dir) of @@ -1187,15 +1073,7 @@ get_mods([File|Tail], Extension) -> get_mods([], _) -> []. is_sticky(Mod, Db) -> - case erlang:module_loaded(Mod) of - true -> - case ets:lookup(Db, {sticky,Mod}) of - [] -> false; - _ -> true - end; - false -> - false - end. + erlang:module_loaded(Mod) andalso (ets:lookup(Db, {sticky, Mod}) =/= []). add_paths(Where,[Dir|Tail],Path,NameDb) -> {_,NPath} = add_path(Where,Dir,Path,NameDb), @@ -1203,15 +1081,14 @@ add_paths(Where,[Dir|Tail],Path,NameDb) -> add_paths(_,_,Path,_) -> {ok,Path}. - -do_load_binary(Module, File, Binary, Caller, St) -> - case modp(Module) andalso modp(File) andalso is_binary(Binary) of +do_load_binary(Module, File, Binary, From, St) -> + case modp(File) andalso is_binary(Binary) of true -> - case erlang:module_loaded(to_atom(Module)) of + case erlang:module_loaded(Module) of true -> do_purge(Module); false -> ok end, - try_load_module(File, Module, Binary, Caller, St); + try_load_module(File, Module, Binary, From, St); false -> {reply,{error,badarg},St} end. @@ -1220,131 +1097,126 @@ modp(Atom) when is_atom(Atom) -> true; modp(List) when is_list(List) -> int_list(List); modp(_) -> false. - -load_abs(File, Mod0, Caller, St) -> +load_abs(File, Mod, From, St) -> Ext = objfile_extension(), FileName0 = lists:concat([File, Ext]), FileName = absname(FileName0), - Mod = if Mod0 =:= [] -> - list_to_atom(filename:basename(FileName0, Ext)); - true -> - Mod0 - end, case erl_prim_loader:get_file(FileName) of {ok,Bin,_} -> - try_load_module(FileName, Mod, Bin, Caller, St); + try_load_module(FileName, Mod, Bin, From, St); error -> {reply,{error,nofile},St} end. -try_load_module(Mod, Dir, Caller, St) -> - File = filename:append(Dir, to_path(Mod) ++ - objfile_extension()), - case erl_prim_loader:get_file(File) of - error -> - {reply,error,St}; - {ok,Binary,FName} -> - try_load_module(absname(FName), Mod, Binary, Caller, St) - end. - -try_load_module(File, Mod, Bin, {From,_}=Caller, St0) -> - M = to_atom(Mod), - case pending_on_load(M, From, St0) of - no -> - try_load_module_1(File, M, Bin, Caller, St0); - {yes,St} -> - {noreply,St} - end. +try_load_module(File, Mod, Bin, From, St) -> + Action = fun(_, S) -> + try_load_module_1(File, Mod, Bin, From, S) + end, + handle_pending_on_load(Action, Mod, From, St). -try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) -> +try_load_module_1(File, Mod, Bin, From, #state{moddb=Db}=St) -> case is_sticky(Mod, Db) of true -> %% Sticky file reject the load - error_msg("Can't load module that resides in sticky dir\n",[]), + error_msg("Can't load module '~w' that resides in sticky dir\n",[Mod]), {reply,{error,sticky_directory},St}; false -> - case catch load_native_code(Mod, Bin) of - {module,Mod} -> - ets:insert(Db, {Mod,File}), - {reply,{module,Mod},St}; - no_native -> - case erlang:load_module(Mod, Bin) of - {module,Mod} -> - ets:insert(Db, {Mod,File}), - post_beam_load(Mod), - {reply,{module,Mod},St}; - {error,on_load} -> - handle_on_load(Mod, File, Caller, St); - {error,What} -> - error_msg("Loading of ~s failed: ~p\n", [File, What]), - {reply,{error,What},St} - end; - Error -> - error_msg("Native loading of ~s failed: ~p\n", - [File,Error]), - {reply,ok,St} - end + Architecture = erlang:system_info(hipe_architecture), + try_load_module_2(File, Mod, Bin, From, Architecture, St) end. -load_native_code(Mod, Bin) -> - %% During bootstrapping of Open Source Erlang, we don't have any hipe - %% loader modules, but the Erlang emulator might be hipe enabled. - %% Therefore we must test for that the loader modules are available - %% before trying to to load native code. - case erlang:module_loaded(hipe_unified_loader) of - false -> no_native; - true -> hipe_unified_loader:load_native_code(Mod, Bin) +try_load_module_2(File, Mod, Bin, From, undefined, St) -> + try_load_module_3(File, Mod, Bin, From, undefined, St); +try_load_module_2(File, Mod, Bin, From, Architecture, + #state{moddb=Db}=St) -> + case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of + {module,Mod} = Module -> + ets:insert(Db, [{{native,Mod},true},{Mod,File}]), + {reply,Module,St}; + no_native -> + try_load_module_3(File, Mod, Bin, From, Architecture, St); + Error -> + error_msg("Native loading of ~ts failed: ~p\n", [File,Error]), + {reply,ok,St} end. -hipe_result_to_status(Result) -> +try_load_module_3(File, Mod, Bin, From, Architecture, St0) -> + Action = fun({module,_}=Module, #state{moddb=Db}=S) -> + ets:insert(Db, {Mod,File}), + post_beam_load([Mod], Architecture, S), + {reply,Module,S}; + ({error,on_load_failure}=Error, S) -> + {reply,Error,S}; + ({error,What}=Error, S) -> + error_msg("Loading of ~ts failed: ~p\n", [File, What]), + {reply,Error,S} + end, + Res = erlang:load_module(Mod, Bin), + handle_on_load(Res, Action, Mod, From, St0). + +hipe_result_to_status(Result, #state{moddb=Db}) -> case Result of - {module,_} -> Result; - _ -> {error,Result} + {module,Mod} -> + ets:insert(Db, [{{native,Mod},true}]), + Result; + _ -> + {error,Result} end. -post_beam_load(Mod) -> - case erlang:module_loaded(hipe_unified_loader) of - false -> ok; - true -> hipe_unified_loader:post_beam_load(Mod) - end. +post_beam_load(_, undefined, _) -> + %% HiPE is disabled. + ok; +post_beam_load(Mods0, _Architecture, #state{moddb=Db}) -> + %% post_beam_load/2 can potentially be very expensive because it + %% blocks multi-scheduling. Therefore, we only want to call + %% it with modules that are known to have native code loaded. + Mods = [M || M <- Mods0, ets:member(Db, {native,M})], + hipe_unified_loader:post_beam_load(Mods). int_list([H|T]) when is_integer(H) -> int_list(T); int_list([_|_]) -> false; int_list([]) -> true. - -load_file(Mod, Caller, #state{path=Path,cache=no_cache}=St) -> +ensure_loaded(Mod, From, St0) -> + Action = fun(_, S) -> + case erlang:module_loaded(Mod) of + true -> + {reply,{module,Mod},S}; + false -> + load_file_1(Mod, From, S) + end + end, + handle_pending_on_load(Action, Mod, From, St0). + +load_file(Mod, From, St0) -> + Action = fun(_, S) -> + load_file_1(Mod, From, S) + end, + handle_pending_on_load(Action, Mod, From, St0). + +load_file_1(Mod, From, #state{path=Path}=St) -> case mod_to_bin(Path, Mod) of error -> {reply,{error,nofile},St}; {Mod,Binary,File} -> - try_load_module(File, Mod, Binary, Caller, St) - end; -load_file(Mod, Caller, #state{cache=Cache}=St0) -> - Key = {obj,Mod}, - case ets:lookup(Cache, Key) of - [] -> - St = rehash_cache(St0), - case ets:lookup(St#state.cache, Key) of - [] -> - {reply,{error,nofile},St}; - [{Key,Dir}] -> - try_load_module(Mod, Dir, Caller, St) - end; - [{Key,Dir}] -> - try_load_module(Mod, Dir, Caller, St0) + try_load_module_1(File, Mod, Binary, From, St) end. mod_to_bin([Dir|Tail], Mod) -> - File = filename:append(Dir, to_path(Mod) ++ objfile_extension()), + File = filename:append(Dir, atom_to_list(Mod) ++ objfile_extension()), case erl_prim_loader:get_file(File) of error -> mod_to_bin(Tail, Mod); - {ok,Bin,FName} -> - {Mod,Bin,absname(FName)} + {ok,Bin,_} -> + case filename:pathtype(File) of + absolute -> + {Mod,Bin,File}; + _ -> + {Mod,Bin,absname(File)} + end end; mod_to_bin([], Mod) -> %% At last, try also erl_prim_loader's own method - File = to_path(Mod) ++ objfile_extension(), + File = to_list(Mod) ++ objfile_extension(), case erl_prim_loader:get_file(File) of error -> error; % No more alternatives ! @@ -1388,109 +1260,158 @@ absname_vr([[X, $:]|Name], _, _AbsBase) -> absname(filename:join(Name), Dcwd). -%% do_purge(Module) -%% Kill all processes running code from *old* Module, and then purge the -%% module. Return true if any processes killed, else false. +is_loaded(M, Db) -> + case ets:lookup(Db, M) of + [{M,File}] -> {file,File}; + [] -> false + end. do_purge(Mod) -> - do_purge(processes(), to_atom(Mod), false). + {_WasOld, DidKill} = erts_code_purger:purge(Mod), + DidKill. -do_purge([P|Ps], Mod, Purged) -> - case erlang:check_process_code(P, Mod) of - true -> - Ref = erlang:monitor(process, P), - exit(P, kill), - receive - {'DOWN',Ref,process,_Pid,_} -> ok - end, - do_purge(Ps, Mod, true); - false -> - do_purge(Ps, Mod, Purged) - end; -do_purge([], Mod, Purged) -> - catch erlang:purge_module(Mod), - Purged. +do_soft_purge(Mod) -> + erts_code_purger:soft_purge(Mod). -%% do_soft_purge(Module) -%% Purge old code only if no procs remain that run old code -%% Return true in that case, false if procs remain (in this -%% case old code is not purged) +is_dir(Path) -> + case erl_prim_loader:read_file_info(Path) of + {ok,#file_info{type=directory}} -> true; + _ -> false + end. -do_soft_purge(Mod) -> - catch do_soft_purge(processes(), Mod). +%%% +%%% Loading of multiple modules in parallel. +%%% + +finish_loading(Prepared, EnsureLoaded, #state{moddb=Db}=St) -> + Ps = [fun(L) -> finish_loading_ensure(L, EnsureLoaded) end, + fun(L) -> abort_if_pending_on_load(L, St) end, + fun(L) -> abort_if_sticky(L, Db) end, + fun(L) -> do_finish_loading(L, St) end], + run(Ps, Prepared). + +finish_loading_ensure(Prepared, true) -> + {ok,[P || {M,_}=P <- Prepared, not erlang:module_loaded(M)]}; +finish_loading_ensure(Prepared, false) -> + {ok,Prepared}. + +abort_if_pending_on_load(L, #state{on_load=[]}) -> + {ok,L}; +abort_if_pending_on_load(L, #state{on_load=OnLoad}) -> + Pending = [{M,pending_on_load} || + {M,_} <- L, + lists:keymember(M, 2, OnLoad)], + case Pending of + [] -> {ok,L}; + [_|_] -> {error,Pending} + end. -do_soft_purge([P|Ps], Mod) -> - case erlang:check_process_code(P, Mod) of - true -> throw(false); - false -> do_soft_purge(Ps, Mod) - end; -do_soft_purge([], Mod) -> - catch erlang:purge_module(Mod), - true. +abort_if_sticky(L, Db) -> + Sticky = [{M,sticky_directory} || {M,_} <- L, is_sticky(M, Db)], + case Sticky of + [] -> {ok,L}; + [_|_] -> {error,Sticky} + end. -is_loaded(M, Db) -> - case ets:lookup(Db, M) of - [{M,File}] -> {file,File}; - [] -> false +do_finish_loading(Prepared, #state{moddb=Db}=St) -> + MagicBins = [B || {_,{B,_}} <- Prepared], + case erlang:finish_loading(MagicBins) of + ok -> + MFs = [{M,F} || {M,{_,F}} <- Prepared], + true = ets:insert(Db, MFs), + Ms = [M || {M,_} <- MFs], + Architecture = erlang:system_info(hipe_architecture), + post_beam_load(Ms, Architecture, St), + ok; + {Reason,Ms} -> + {error,[{M,Reason} || M <- Ms]} + end. + +run([F], Data) -> + F(Data); +run([F|Fs], Data0) -> + case F(Data0) of + {ok,Data} -> + run(Fs, Data); + {error,_}=Error -> + Error end. %% ------------------------------------------------------- %% The on_load functionality. %% ------------------------------------------------------- -handle_on_load(Mod, File, {From,_}, #state{on_load=OnLoad0}=St0) -> +handle_on_load({error,on_load}, Action, Mod, From, St0) -> + #state{on_load=OnLoad0} = St0, Fun = fun() -> Res = erlang:call_on_load_function(Mod), exit(Res) end, - {_,Ref} = spawn_monitor(Fun), - OnLoad = [{Ref,Mod,File,[From]}|OnLoad0], + PidRef = spawn_monitor(Fun), + PidAction = {From,Action}, + OnLoad = [{PidRef,Mod,[PidAction]}|OnLoad0], St = St0#state{on_load=OnLoad}, - {noreply,St}. + {noreply,St}; +handle_on_load(Res, Action, _, _, St) -> + Action(Res, St). -pending_on_load(_, _, #state{on_load=[]}) -> - no; -pending_on_load(Mod, From, #state{on_load=OnLoad0}=St) -> - case lists:keymember(Mod, 2, OnLoad0) of +handle_pending_on_load(Action, Mod, From, #state{on_load=OnLoad0}=St) -> + case lists:keyfind(Mod, 2, OnLoad0) of false -> - no; - true -> - OnLoad = pending_on_load_1(Mod, From, OnLoad0), - {yes,St#state{on_load=OnLoad}} + Action(ok, St); + {{From,_Ref},Mod,_Pids} -> + %% The on_load function tried to make an external + %% call to its own module. That would be a deadlock. + %% Fail the call. (The call is probably from error_handler, + %% and it will ignore the actual error reason and cause + %% an undef execption.) + {reply,{error,deadlock},St}; + {_,_,_} -> + OnLoad = handle_pending_on_load_1(Mod, {From,Action}, OnLoad0), + {noreply,St#state{on_load=OnLoad}} end. -pending_on_load_1(Mod, From, [{Ref,Mod,File,Pids}|T]) -> - [{Ref,Mod,File,[From|Pids]}|T]; -pending_on_load_1(Mod, From, [H|T]) -> - [H|pending_on_load_1(Mod, From, T)]; -pending_on_load_1(_, _, []) -> []. +handle_pending_on_load_1(Mod, From, [{PidRef,Mod,Pids}|T]) -> + [{PidRef,Mod,[From|Pids]}|T]; +handle_pending_on_load_1(Mod, From, [H|T]) -> + [H|handle_pending_on_load_1(Mod, From, T)]; +handle_pending_on_load_1(_, _, []) -> []. -finish_on_load(Ref, OnLoadRes, #state{on_load=OnLoad0,moddb=Db}=State) -> - case lists:keyfind(Ref, 1, OnLoad0) of +finish_on_load(PidRef, OnLoadRes, #state{on_load=OnLoad0}=St0) -> + case lists:keyfind(PidRef, 1, OnLoad0) of false -> %% Since this process in general silently ignores messages %% it doesn't understand, it should also ignore a 'DOWN' %% message with an unknown reference. - State; - {Ref,Mod,File,WaitingPids} -> - finish_on_load_1(Mod, File, OnLoadRes, WaitingPids, Db), - OnLoad = [E || {R,_,_,_}=E <- OnLoad0, R =/= Ref], - State#state{on_load=OnLoad} + St0; + {PidRef,Mod,Waiting} -> + St = finish_on_load_1(Mod, OnLoadRes, Waiting, St0), + OnLoad = [E || {R,_,_}=E <- OnLoad0, R =/= PidRef], + St#state{on_load=OnLoad} end. -finish_on_load_1(Mod, File, OnLoadRes, WaitingPids, Db) -> +finish_on_load_1(Mod, OnLoadRes, Waiting, St) -> Keep = OnLoadRes =:= ok, - erlang:finish_after_on_load(Mod, Keep), + erts_code_purger:finish_after_on_load(Mod, Keep), Res = case Keep of false -> - finish_on_load_report(Mod, OnLoadRes), + _ = finish_on_load_report(Mod, OnLoadRes), {error,on_load_failure}; true -> - ets:insert(Db, {Mod,File}), {module,Mod} end, - [reply(Pid, Res) || Pid <- WaitingPids], - ok. + finish_on_load_2(Waiting, Res, St). + +finish_on_load_2([{Pid,Action}|T], Res, St0) -> + case Action(Res, St0) of + {reply,Rep,St} -> + _ = reply(Pid, Rep), + finish_on_load_2(T, Res, St); + {noreply,St} -> + finish_on_load_2(T, Res, St) + end; +finish_on_load_2([], _, St) -> + St. finish_on_load_report(_Mod, Atom) when is_atom(Atom) -> %% No error reports for atoms. @@ -1515,26 +1436,16 @@ finish_on_load_report(Mod, Term) -> %% ------------------------------------------------------- all_loaded(Db) -> - all_l(Db, ets:slot(Db, 0), 1, []). - -all_l(_Db, '$end_of_table', _, Acc) -> - Acc; -all_l(Db, ModInfo, N, Acc) -> - NewAcc = strip_mod_info(ModInfo,Acc), - all_l(Db, ets:slot(Db, N), N + 1, NewAcc). + Ms = ets:fun2ms(fun({M,_}=T) when is_atom(M) -> T end), + ets:select(Db, Ms). - -strip_mod_info([{{sticky,_},_}|T], Acc) -> strip_mod_info(T, Acc); -strip_mod_info([H|T], Acc) -> strip_mod_info(T, [H|Acc]); -strip_mod_info([], Acc) -> Acc. - -% error_msg(Format) -> -% error_msg(Format,[]). +-spec error_msg(io:format(), [term()]) -> 'ok'. error_msg(Format, Args) -> Msg = {notify,{error, group_leader(), {self(), Format, Args}}}, error_logger ! Msg, ok. +-spec info_msg(io:format(), [term()]) -> 'ok'. info_msg(Format, Args) -> Msg = {notify,{info_msg, group_leader(), {self(), Format, Args}}}, error_logger ! Msg, @@ -1548,9 +1459,3 @@ archive_extension() -> to_list(X) when is_list(X) -> X; to_list(X) when is_atom(X) -> atom_to_list(X). - -to_atom(X) when is_atom(X) -> X; -to_atom(X) when is_list(X) -> list_to_atom(X). - -to_path(X) -> - filename:join(packages:split(X)). diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 7f1b5f9ec6..9b44021872 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -44,6 +45,8 @@ %% To be used for debugging only: -export([pid2name/1]). +-export_type([continuation/0]). + -type dlog_state_error() :: 'ok' | {'error', term()}. -record(state, {queue = [], @@ -64,15 +67,16 @@ %%-define(PROFILE(C), C). -define(PROFILE(C), void). --compile({inline,[{log_loop,4},{log_end_sync,2},{replies,2},{rflat,1}]}). +-compile({inline,[{log_loop,5},{log_end_sync,2},{replies,2},{rflat,1}]}). %%%---------------------------------------------------------------------- %%% Contract type specifications %%%---------------------------------------------------------------------- +-opaque continuation() :: #continuation{}. + -type bytes() :: binary() | [byte()]. --type log() :: term(). % XXX: refine -type file_error() :: term(). % XXX: refine -type invalid_header() :: term(). % XXX: refine @@ -87,27 +91,30 @@ -type open_error_rsn() :: 'no_such_log' | {'badarg', term()} - | {'size_mismatch', dlog_size(), dlog_size()} - | {'arg_mismatch', dlog_optattr(), term(), term()} - | {'name_already_open', log()} - | {'open_read_write', log()} - | {'open_read_only', log()} - | {'need_repair', log()} - | {'not_a_log_file', string()} - | {'invalid_index_file', string()} + | {'size_mismatch', CurrentSize :: dlog_size(), + NewSize :: dlog_size()} + | {'arg_mismatch', OptionName :: dlog_optattr(), + CurrentValue :: term(), Value :: term()} + | {'name_already_open', Log :: log()} + | {'open_read_write', Log :: log()} + | {'open_read_only', Log :: log()} + | {'need_repair', Log :: log()} + | {'not_a_log_file', FileName :: file:filename()} + | {'invalid_index_file', FileName :: file:filename()} | {'invalid_header', invalid_header()} | {'file_error', file:filename(), file_error()} - | {'node_already_open', log()}. + | {'node_already_open', Log :: log()}. -type dist_error_rsn() :: 'nodedown' | open_error_rsn(). --type ret() :: {'ok', log()} - | {'repaired', log(), {'recovered', non_neg_integer()}, - {'badbytes', non_neg_integer()}}. +-type ret() :: {'ok', Log :: log()} + | {'repaired', Log :: log(), + {'recovered', Rec :: non_neg_integer()}, + {'badbytes', Bad :: non_neg_integer()}}. -type open_ret() :: ret() | {'error', open_error_rsn()}. -type dist_open_ret() :: {[{node(), ret()}], [{node(), {'error', dist_error_rsn()}}]}. --type all_open_ret() :: open_ret() | dist_open_ret(). --spec open(Args :: dlog_options()) -> all_open_ret(). +-spec open(ArgL) -> open_ret() | dist_open_ret() when + ArgL :: dlog_options(). open(A) -> disk_log_server:open(check_arg(A, #arg{options = A})). @@ -116,40 +123,57 @@ open(A) -> | {'full', log()} | {'invalid_header', invalid_header()} | {'file_error', file:filename(), file_error()}. --spec log(Log :: log(), Term :: term()) -> 'ok' | {'error', log_error_rsn()}. +-spec log(Log, Term) -> ok | {error, Reason :: log_error_rsn()} when + Log :: log(), + Term :: term(). log(Log, Term) -> req(Log, {log, term_to_binary(Term)}). --spec blog(Log :: log(), Bytes :: bytes()) -> 'ok' | {'error', log_error_rsn()}. +-spec blog(Log, Bytes) -> ok | {error, Reason :: log_error_rsn()} when + Log :: log(), + Bytes :: bytes(). blog(Log, Bytes) -> req(Log, {blog, check_bytes(Bytes)}). --spec log_terms(Log :: log(), Terms :: [term()]) -> 'ok' | {'error', term()}. +-spec log_terms(Log, TermList) -> ok | {error, Resaon :: log_error_rsn()} when + Log :: log(), + TermList :: [term()]. log_terms(Log, Terms) -> Bs = terms2bins(Terms), req(Log, {log, Bs}). --spec blog_terms(Log :: log(), Bytes :: [bytes()]) -> 'ok' | {'error', term()}. +-spec blog_terms(Log, BytesList) -> + ok | {error, Reason :: log_error_rsn()} when + Log :: log(), + BytesList :: [bytes()]. blog_terms(Log, Bytess) -> Bs = check_bytes_list(Bytess, Bytess), req(Log, {blog, Bs}). -type notify_ret() :: 'ok' | {'error', 'no_such_log'}. --spec alog(Log :: log(), Term :: term()) -> notify_ret(). +-spec alog(Log, Term) -> notify_ret() when + Log :: log(), + Term :: term(). alog(Log, Term) -> notify(Log, {alog, term_to_binary(Term)}). --spec alog_terms(Log :: log(), Terms :: [term()]) -> notify_ret(). +-spec alog_terms(Log, TermList) -> notify_ret() when + Log :: log(), + TermList :: [term()]. alog_terms(Log, Terms) -> Bs = terms2bins(Terms), notify(Log, {alog, Bs}). --spec balog(Log :: log(), Bytes :: bytes()) -> notify_ret(). +-spec balog(Log, Bytes) -> notify_ret() when + Log :: log(), + Bytes :: bytes(). balog(Log, Bytes) -> notify(Log, {balog, check_bytes(Bytes)}). --spec balog_terms(Log :: log(), Bytes :: [bytes()]) -> notify_ret(). +-spec balog_terms(Log, ByteList) -> notify_ret() when + Log :: log(), + ByteList :: [bytes()]. balog_terms(Log, Bytess) -> Bs = check_bytes_list(Bytess, Bytess), notify(Log, {balog, Bs}). @@ -157,18 +181,22 @@ balog_terms(Log, Bytess) -> -type close_error_rsn() ::'no_such_log' | 'nonode' | {'file_error', file:filename(), file_error()}. --spec close(Log :: log()) -> 'ok' | {'error', close_error_rsn()}. +-spec close(Log) -> 'ok' | {'error', close_error_rsn()} when + Log :: log(). close(Log) -> req(Log, close). -type lclose_error_rsn() :: 'no_such_log' | {'file_error', file:filename(), file_error()}. --spec lclose(Log :: log()) -> 'ok' | {'error', lclose_error_rsn()}. +-spec lclose(Log) -> 'ok' | {'error', lclose_error_rsn()} when + Log :: log(). lclose(Log) -> lclose(Log, node()). --spec lclose(Log :: log(), Node :: node()) -> 'ok' | {'error', lclose_error_rsn()}. +-spec lclose(Log, Node) -> 'ok' | {'error', lclose_error_rsn()} when + Log :: log(), + Node :: node(). lclose(Log, Node) -> lreq(Log, close, Node). @@ -178,29 +206,49 @@ lclose(Log, Node) -> | {'invalid_header', invalid_header()} | {'file_error', file:filename(), file_error()}. --spec truncate(Log :: log()) -> 'ok' | {'error', trunc_error_rsn()}. +-spec truncate(Log) -> 'ok' | {'error', trunc_error_rsn()} when + Log :: log(). truncate(Log) -> req(Log, {truncate, none, truncate, 1}). --spec truncate(Log :: log(), Head :: term()) -> 'ok' | {'error', trunc_error_rsn()}. +-spec truncate(Log, Head) -> 'ok' | {'error', trunc_error_rsn()} when + Log :: log(), + Head :: term(). truncate(Log, Head) -> req(Log, {truncate, {ok, term_to_binary(Head)}, truncate, 2}). --spec btruncate(Log :: log(), Head :: bytes()) -> 'ok' | {'error', trunc_error_rsn()}. +-spec btruncate(Log, BHead) -> 'ok' | {'error', trunc_error_rsn()} when + Log :: log(), + BHead :: bytes(). btruncate(Log, Head) -> req(Log, {truncate, {ok, check_bytes(Head)}, btruncate, 2}). --spec reopen(Log :: log(), Filename :: file:filename()) -> 'ok' | {'error', term()}. +-type reopen_error_rsn() :: no_such_log + | nonode + | {read_only_mode, log()} + | {blocked_log, log()} + | {same_file_name, log()} | + {invalid_index_file, file:filename()} + | {invalid_header, invalid_header()} + | {'file_error', file:filename(), file_error()}. + +-spec reopen(Log, File) -> 'ok' | {'error', reopen_error_rsn()} when + Log :: log(), + File :: file:filename(). reopen(Log, NewFile) -> req(Log, {reopen, NewFile, none, reopen, 2}). --spec reopen(Log :: log(), Filename :: file:filename(), Head :: term()) -> - 'ok' | {'error', term()}. +-spec reopen(Log, File, Head) -> 'ok' | {'error', reopen_error_rsn()} when + Log :: log(), + File :: file:filename(), + Head :: term(). reopen(Log, NewFile, NewHead) -> req(Log, {reopen, NewFile, {ok, term_to_binary(NewHead)}, reopen, 3}). --spec breopen(Log :: log(), Filename :: file:filename(), Head :: bytes()) -> - 'ok' | {'error', term()}. +-spec breopen(Log, File, BHead) -> 'ok' | {'error', reopen_error_rsn()} when + Log :: log(), + File :: file:filename(), + BHead :: bytes(). breopen(Log, NewFile, NewHead) -> req(Log, {reopen, NewFile, {ok, check_bytes(NewHead)}, breopen, 3}). @@ -210,21 +258,37 @@ breopen(Log, NewFile, NewHead) -> | {'invalid_header', invalid_header()} | {'file_error', file:filename(), file_error()}. --spec inc_wrap_file(Log :: log()) -> 'ok' | {'error', inc_wrap_error_rsn()}. +-spec inc_wrap_file(Log) -> 'ok' | {'error', inc_wrap_error_rsn()} when + Log :: log(). inc_wrap_file(Log) -> req(Log, inc_wrap_file). --spec change_size(Log :: log(), Size :: dlog_size()) -> 'ok' | {'error', term()}. +-spec change_size(Log, Size) -> 'ok' | {'error', Reason} when + Log :: log(), + Size :: dlog_size(), + Reason :: no_such_log | nonode | {read_only_mode, Log} + | {blocked_log, Log} + | {new_size_too_small, CurrentSize :: pos_integer()} + | {badarg, size} + | {file_error, file:filename(), file_error()}. change_size(Log, NewSize) -> req(Log, {change_size, NewSize}). --spec change_notify(Log :: log(), Pid :: pid(), Notify :: boolean()) -> - 'ok' | {'error', term()}. +-spec change_notify(Log, Owner, Notify) -> 'ok' | {'error', Reason} when + Log :: log(), + Owner :: pid(), + Notify :: boolean(), + Reason :: no_such_log | nonode | {blocked_log, Log} + | {badarg, notify} | {not_owner, Owner}. change_notify(Log, Pid, NewNotify) -> req(Log, {change_notify, Pid, NewNotify}). --spec change_header(Log :: log(), Head :: {atom(), term()}) -> - 'ok' | {'error', term()}. +-spec change_header(Log, Header) -> 'ok' | {'error', Reason} when + Log :: log(), + Header :: {head, dlog_head_opt()} + | {head_func, MFA :: {atom(), atom(), list()}}, + Reason :: no_such_log | nonode | {read_only_mode, Log} + | {blocked_log, Log} | {badarg, head}. change_header(Log, NewHead) -> req(Log, {change_header, NewHead}). @@ -232,17 +296,21 @@ change_header(Log, NewHead) -> | {'blocked_log', log()} | {'file_error', file:filename(), file_error()}. --spec sync(Log :: log()) -> 'ok' | {'error', sync_error_rsn()}. +-spec sync(Log) -> 'ok' | {'error', sync_error_rsn()} when + Log :: log(). sync(Log) -> req(Log, sync). -type block_error_rsn() :: 'no_such_log' | 'nonode' | {'blocked_log', log()}. --spec block(Log :: log()) -> 'ok' | {'error', block_error_rsn()}. +-spec block(Log) -> 'ok' | {'error', block_error_rsn()} when + Log :: log(). block(Log) -> block(Log, true). --spec block(Log :: log(), QueueLogRecords :: boolean()) -> 'ok' | {'error', term()}. +-spec block(Log, QueueLogRecords) -> 'ok' | {'error', block_error_rsn()} when + Log :: log(), + QueueLogRecords :: boolean(). block(Log, QueueLogRecords) -> req(Log, {block, QueueLogRecords}). @@ -250,19 +318,48 @@ block(Log, QueueLogRecords) -> | {'not_blocked', log()} | {'not_blocked_by_pid', log()}. --spec unblock(Log :: log()) -> 'ok' | {'error', unblock_error_rsn()}. +-spec unblock(Log) -> 'ok' | {'error', unblock_error_rsn()} when + Log :: log(). unblock(Log) -> req(Log, unblock). --spec format_error(Error :: term()) -> string(). +-spec format_error(Error) -> io_lib:chars() when + Error :: term(). format_error(Error) -> do_format_error(Error). --spec info(Log :: log()) -> [{atom(), any()}] | {'error', term()}. +-type dlog_info() :: {name, Log :: log()} + | {file, File :: file:filename()} + | {type, Type :: dlog_type()} + | {format, Format :: dlog_format()} + | {size, Size :: dlog_size()} + | {mode, Mode :: dlog_mode()} + | {owners, [{pid(), Notify :: boolean()}]} + | {users, Users :: non_neg_integer()} + | {status, Status :: + ok | {blocked, QueueLogRecords :: boolean()}} + | {node, Node :: node()} + | {distributed, Dist :: local | [node()]} + | {head, Head :: none + | {head, term()} + | (MFA :: {atom(), atom(), list()})} + | {no_written_items, NoWrittenItems ::non_neg_integer()} + | {full, Full :: boolean} + | {no_current_bytes, non_neg_integer()} + | {no_current_items, non_neg_integer()} + | {no_items, non_neg_integer()} + | {current_file, pos_integer()} + | {no_overflows, {SinceLogWasOpened :: non_neg_integer(), + SinceLastInfo :: non_neg_integer()}}. +-spec info(Log) -> InfoList | {'error', no_such_log} when + Log :: log(), + InfoList :: [dlog_info()]. info(Log) -> sreq(Log, info). --spec pid2name(Pid :: pid()) -> {'ok', log()} | 'undefined'. +-spec pid2name(Pid) -> {'ok', Log} | 'undefined' when + Pid :: pid(), + Log :: log(). pid2name(Pid) -> disk_log_server:start(), case ets:lookup(?DISK_LOG_PID_TABLE, Pid) of @@ -274,13 +371,31 @@ pid2name(Pid) -> %% It retuns a {Cont2, ObjList} | eof | {error, Reason} %% The initial continuation is the atom 'start' --spec chunk(Log :: log(), Cont :: any()) -> - {'error', term()} | 'eof' | {any(), [any()]} | {any(), [any()], integer()}. +-type chunk_error_rsn() :: no_such_log + | {format_external, log()} + | {blocked_log, log()} + | {badarg, continuation} + | {not_internal_wrap, log()} + | {corrupt_log_file, FileName :: file:filename()} + | {file_error, file:filename(), file_error()}. + +-type chunk_ret() :: {Continuation2 :: continuation(), Terms :: [term()]} + | {Continuation2 :: continuation(), + Terms :: [term()], + Badbytes :: non_neg_integer()} + | eof + | {error, Reason :: chunk_error_rsn()}. + +-spec chunk(Log, Continuation) -> chunk_ret() when + Log :: log(), + Continuation :: start | continuation(). chunk(Log, Cont) -> chunk(Log, Cont, infinity). --spec chunk(Log :: log(), Cont :: any(), N :: pos_integer() | 'infinity') -> - {'error', term()} | 'eof' | {any(), [any()]} | {any(), [any()], integer()}. +-spec chunk(Log, Continuation, N) -> chunk_ret() when + Log :: log(), + Continuation :: start | continuation(), + N :: pos_integer() | infinity. chunk(Log, Cont, infinity) -> %% There cannot be more than ?MAX_CHUNK_SIZE terms in a chunk. ichunk(Log, Cont, ?MAX_CHUNK_SIZE); @@ -346,13 +461,24 @@ ichunk_bad_end([B | Bs], Mode, Log, C, Bad, A) -> ichunk_bad_end(Bs, Mode, Log, C, Bad, [T | A]) end. --spec bchunk(Log :: log(), Cont :: any()) -> - {'error', any()} | 'eof' | {any(), [binary()]} | {any(), [binary()], integer()}. +-type bchunk_ret() :: {Continuation2 :: continuation(), + Binaries :: [binary()]} + | {Continuation2 :: continuation(), + Binaries :: [binary()], + Badbytes :: non_neg_integer()} + | eof + | {error, Reason :: chunk_error_rsn()}. + +-spec bchunk(Log, Continuation) -> bchunk_ret() when + Log :: log(), + Continuation :: start | continuation(). bchunk(Log, Cont) -> bchunk(Log, Cont, infinity). --spec bchunk(Log :: log(), Cont :: any(), N :: 'infinity' | pos_integer()) -> - {'error', any()} | 'eof' | {any(), [binary()]} | {any(), [binary()], integer()}. +-spec bchunk(Log, Continuation, N) -> bchunk_ret() when + Log :: log(), + Continuation :: start | continuation(), + N :: pos_integer() | infinity. bchunk(Log, Cont, infinity) -> %% There cannot be more than ?MAX_CHUNK_SIZE terms in a chunk. bichunk(Log, Cont, ?MAX_CHUNK_SIZE); @@ -375,8 +501,14 @@ bichunk_end({C = #continuation{}, R, Bad}) -> bichunk_end(R) -> R. --spec chunk_step(Log :: log(), Cont :: any(), N :: integer()) -> - {'ok', any()} | {'error', term()}. +-spec chunk_step(Log, Continuation, Step) -> + {'ok', any()} | {'error', Reason} when + Log :: log(), + Continuation :: start | continuation(), + Step :: integer(), + Reason :: no_such_log | end_of_log | {format_external, Log} + | {blocked_log, Log} | {badarg, continuation} + | {file_error, file:filename(), file_error()}. chunk_step(Log, Cont, N) when is_integer(N) -> ichunk_step(Log, Cont, N). @@ -387,14 +519,18 @@ ichunk_step(_Log, More, N) when is_record(More, continuation) -> ichunk_step(_Log, _, _) -> {error, {badarg, continuation}}. --spec chunk_info(More :: any()) -> - [{'node', node()},...] | {'error', {'no_continuation', any()}}. +-spec chunk_info(Continuation) -> InfoList | {error, Reason} when + Continuation :: continuation(), + InfoList :: [{node, Node :: node()}, ...], + Reason :: {no_continuation, Continuation}. chunk_info(More = #continuation{}) -> [{node, node(More#continuation.pid)}]; chunk_info(BadCont) -> {error, {no_continuation, BadCont}}. --spec accessible_logs() -> {[_], [_]}. +-spec accessible_logs() -> {[LocalLog], [DistributedLog]} when + LocalLog :: log(), + DistributedLog :: log(). accessible_logs() -> disk_log_server:accessible_logs(). @@ -555,7 +691,7 @@ handle({From, {log, B}}, S) -> L when L#log.mode =:= read_only -> reply(From, {error, {read_only_mode, L#log.name}}, S); L when L#log.status =:= ok, L#log.format =:= internal -> - log_loop(S, From, [B], []); + log_loop(S, From, [B], [], iolist_size(B)); L when L#log.status =:= ok, L#log.format =:= external -> reply(From, {error, {format_external, L#log.name}}, S); L when L#log.status =:= {blocked, false} -> @@ -570,7 +706,7 @@ handle({From, {blog, B}}, S) -> L when L#log.mode =:= read_only -> reply(From, {error, {read_only_mode, L#log.name}}, S); L when L#log.status =:= ok -> - log_loop(S, From, [B], []); + log_loop(S, From, [B], [], iolist_size(B)); L when L#log.status =:= {blocked, false} -> reply(From, {error, {blocked_log, L#log.name}}, S); L when L#log.blocked_by =:= From -> @@ -584,7 +720,7 @@ handle({alog, B}, S) -> notify_owners({read_only,B}), loop(S); L when L#log.status =:= ok, L#log.format =:= internal -> - log_loop(S, [], [B], []); + log_loop(S, [], [B], [], iolist_size(B)); L when L#log.status =:= ok -> notify_owners({format_external, B}), loop(S); @@ -600,7 +736,7 @@ handle({balog, B}, S) -> notify_owners({read_only,B}), loop(S); L when L#log.status =:= ok -> - log_loop(S, [], [B], []); + log_loop(S, [], [B], [], iolist_size(B)); L when L#log.status =:= {blocked, false} -> notify_owners({blocked_log, B}), loop(S); @@ -899,38 +1035,40 @@ handle(_, S) -> loop(S). sync_loop(From, S) -> - log_loop(S, [], [], From). + log_loop(S, [], [], From, 0). + +-define(MAX_LOOK_AHEAD, 64*1024). %% Inlined. -log_loop(S, Pids, _Bins, _Sync) when S#state.cache_error =/= ok -> +log_loop(#state{cache_error = CE}=S, Pids, _Bins, _Sync, _Sz) when CE =/= ok -> loop(cache_error(S, Pids)); -log_loop(S, Pids, Bins, Sync) when S#state.messages =:= [] -> +log_loop(#state{}=S, Pids, Bins, Sync, Sz) when Sz > ?MAX_LOOK_AHEAD -> + loop(log_end(S, Pids, Bins, Sync)); +log_loop(#state{messages = []}=S, Pids, Bins, Sync, Sz) -> receive Message -> - log_loop(Message, Pids, Bins, Sync, S, get(log)) + log_loop(Message, Pids, Bins, Sync, Sz, S, get(log)) after 0 -> loop(log_end(S, Pids, Bins, Sync)) end; -log_loop(S, Pids, Bins, Sync) -> - [M | Ms] = S#state.messages, +log_loop(#state{messages = [M | Ms]}=S, Pids, Bins, Sync, Sz) -> S1 = S#state{messages = Ms}, - log_loop(M, Pids, Bins, Sync, S1, get(log)). + log_loop(M, Pids, Bins, Sync, Sz, S1, get(log)). %% Items logged after the last sync request found are sync:ed as well. -log_loop({alog,B}, Pids, Bins, Sync, S, L) when L#log.format =:= internal -> +log_loop({alog,B}, Pids, Bins, Sync, Sz, S, #log{format = internal}) -> %% {alog, _} allowed for the internal format only. - log_loop(S, Pids, [B | Bins], Sync); -log_loop({balog, B}, Pids, Bins, Sync, S, _L) -> - log_loop(S, Pids, [B | Bins], Sync); -log_loop({From, {log, B}}, Pids, Bins, Sync, S, L) - when L#log.format =:= internal -> + log_loop(S, Pids, [B | Bins], Sync, Sz+iolist_size(B)); +log_loop({balog, B}, Pids, Bins, Sync, Sz, S, _L) -> + log_loop(S, Pids, [B | Bins], Sync, Sz+iolist_size(B)); +log_loop({From, {log, B}}, Pids, Bins, Sync, Sz, S, #log{format = internal}) -> %% {log, _} allowed for the internal format only. - log_loop(S, [From | Pids], [B | Bins], Sync); -log_loop({From, {blog, B}}, Pids, Bins, Sync, S, _L) -> - log_loop(S, [From | Pids], [B | Bins], Sync); -log_loop({From, sync}, Pids, Bins, Sync, S, _L) -> - log_loop(S, Pids, Bins, [From | Sync]); -log_loop(Message, Pids, Bins, Sync, S, _L) -> + log_loop(S, [From | Pids], [B | Bins], Sync, Sz+iolist_size(B)); +log_loop({From, {blog, B}}, Pids, Bins, Sync, Sz, S, _L) -> + log_loop(S, [From | Pids], [B | Bins], Sync, Sz+iolist_size(B)); +log_loop({From, sync}, Pids, Bins, Sync, Sz, S, _L) -> + log_loop(S, Pids, Bins, [From | Sync], Sz); +log_loop(Message, Pids, Bins, Sync, _Sz, S, _L) -> NS = log_end(S, Pids, Bins, Sync), handle(Message, NS). @@ -939,13 +1077,13 @@ log_end(S, [], [], Sync) -> log_end(S, Pids, Bins, Sync) -> case do_log(get(log), rflat(Bins)) of N when is_integer(N) -> - replies(Pids, ok), + ok = replies(Pids, ok), S1 = (state_ok(S))#state{cnt = S#state.cnt+N}, log_end_sync(S1, Sync); {error, {error, {full, _Name}}, N} when Pids =:= [] -> log_end_sync(state_ok(S#state{cnt = S#state.cnt + N}), Sync); {error, Error, N} -> - replies(Pids, Error), + ok = replies(Pids, Error), state_err(S#state{cnt = S#state.cnt + N}, Error) end. @@ -954,7 +1092,7 @@ log_end_sync(S, []) -> S; log_end_sync(S, Sync) -> Res = do_sync(get(log)), - replies(Sync, Res), + ok = replies(Sync, Res), state_err(S, Res). %% Inlined. @@ -1046,7 +1184,7 @@ do_exit(S, From, Message0, Reason) -> _ -> Message0 end, _ = disk_log_server:close(self()), - replies(From, Message), + ok = replies(From, Message), ?PROFILE(ep:done()), exit(Reason). @@ -1110,20 +1248,29 @@ is_owner(Pid, L) -> %% ok | throw(Error) rename_file(File, NewFile, halt) -> - file:rename(File, NewFile); + case file:rename(File, NewFile) of + ok -> + ok; + Else -> + file_error(NewFile, Else) + end; rename_file(File, NewFile, wrap) -> rename_file(wrap_file_extensions(File), File, NewFile, ok). -rename_file([Ext|Exts], File, NewFile, Res) -> - NRes = case file:rename(add_ext(File, Ext), add_ext(NewFile, Ext)) of +rename_file([Ext|Exts], File, NewFile0, Res) -> + NewFile = add_ext(NewFile0, Ext), + NRes = case file:rename(add_ext(File, Ext), NewFile) of ok -> Res; Else -> - Else + file_error(NewFile, Else) end, - rename_file(Exts, File, NewFile, NRes); + rename_file(Exts, File, NewFile0, NRes); rename_file([], _File, _NewFiles, Res) -> Res. +file_error(FileName, {error, Error}) -> + {error, {file_error, FileName, Error}}. + %% "Old" error messages have been kept, arg_mismatch has been added. %%-spec compare_arg(dlog_options(), #arg{}, compare_arg([], _A, none, _OrigHead) -> @@ -1163,13 +1310,20 @@ compare_arg(_Attr, _Val, _A) -> %% -> {ok, Res, log(), Cnt} | Error do_open(A) -> - L = #log{name = A#arg.name, - filename = A#arg.file, - size = A#arg.size, - head = mk_head(A#arg.head, A#arg.format), - mode = A#arg.mode, - version = A#arg.version}, - do_open2(L, A). + #arg{type = Type, format = Format, name = Name, head = Head0, + file = FName, repair = Repair, size = Size, mode = Mode, + version = V} = A, + Head = mk_head(Head0, Format), + case do_open2(Type, Format, Name, FName, Repair, Size, Mode, Head, V) of + {ok, Ret, Extra, FormatType, NoItems} -> + L = #log{name = Name, type = Type, format = Format, + filename = FName, size = Size, + format_type = FormatType, head = Head, mode = Mode, + version = V, extra = Extra}, + {ok, Ret, L, NoItems}; + Error -> + Error + end. mk_head({head, Term}, internal) -> {ok, term_to_binary(Term)}; mk_head({head, Bytes}, external) -> {ok, check_bytes(Bytes)}; @@ -1285,57 +1439,44 @@ do_inc_wrap_file(L) -> %%----------------------------------------------------------------- %% -> {ok, Reply, log(), Cnt} | Error %% Note: the header is always written, even if the log size is too small. -do_open2(L, #arg{type = halt, format = internal, name = Name, - file = FName, repair = Repair, size = Size, mode = Mode}) -> - case catch disk_log_1:int_open(FName, Repair, Mode, L#log.head) of +do_open2(halt, internal, Name, FName, Repair, Size, Mode, Head, _V) -> + case catch disk_log_1:int_open(FName, Repair, Mode, Head) of {ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, - {ok, {ok, Name}, L#log{format_type = halt_int, extra = Halt}, - NoItems}; + {ok, {ok, Name}, Halt, halt_int, NoItems}; {repaired, FdC, Rec, Bad, FileSize} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, {ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}}, - L#log{format_type = halt_int, extra = Halt}, - Rec}; + Halt, halt_int, Rec}; Error -> Error end; -do_open2(L, #arg{type = wrap, format = internal, size = {MaxB, MaxF}, - name = Name, repair = Repair, file = FName, mode = Mode, - version = V}) -> +do_open2(wrap, internal, Name, FName, Repair, Size, Mode, Head, V) -> + {MaxB, MaxF} = Size, case catch - disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of + disk_log_1:mf_int_open(FName, MaxB, MaxF, Repair, Mode, Head, V) of {ok, Handle, Cnt} -> - {ok, {ok, Name}, L#log{type = wrap, - format_type = wrap_int, - extra = Handle}, Cnt}; + {ok, {ok, Name}, Handle, wrap_int, Cnt}; {repaired, Handle, Rec, Bad, Cnt} -> {ok, {repaired, Name, {recovered, Rec}, {badbytes, Bad}}, - L#log{type = wrap, format_type = wrap_int, extra = Handle}, Cnt}; + Handle, wrap_int, Cnt}; Error -> Error end; -do_open2(L, #arg{type = halt, format = external, file = FName, name = Name, - size = Size, repair = Repair, mode = Mode}) -> - case catch disk_log_1:ext_open(FName, Repair, Mode, L#log.head) of +do_open2(halt, external, Name, FName, Repair, Size, Mode, Head, _V) -> + case catch disk_log_1:ext_open(FName, Repair, Mode, Head) of {ok, {_Alloc, FdC, {NoItems, _NoBytes}, FileSize}} -> Halt = #halt{fdc = FdC, curB = FileSize, size = Size}, - {ok, {ok, Name}, - L#log{format_type = halt_ext, format = external, extra = Halt}, - NoItems}; + {ok, {ok, Name}, Halt, halt_ext, NoItems}; Error -> Error end; -do_open2(L, #arg{type = wrap, format = external, size = {MaxB, MaxF}, - name = Name, file = FName, repair = Repair, mode = Mode, - version = V}) -> +do_open2(wrap, external, Name, FName, Repair, Size, Mode, Head, V) -> + {MaxB, MaxF} = Size, case catch - disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, L#log.head, V) of + disk_log_1:mf_ext_open(FName, MaxB, MaxF, Repair, Mode, Head, V) of {ok, Handle, Cnt} -> - {ok, {ok, Name}, L#log{type = wrap, - format_type = wrap_ext, - extra = Handle, - format = external}, Cnt}; + {ok, {ok, Name}, Handle, wrap_ext, Cnt}; Error -> Error end. @@ -1381,48 +1522,48 @@ do_format_error({size_mismatch, OldSize, ArgSize}) -> io_lib:format("The given size ~p does not match the size ~p found on " "the disk log size file~n", [ArgSize, OldSize]); do_format_error({read_only_mode, Log}) -> - io_lib:format("The disk log ~p has been opened read-only, but the " + io_lib:format("The disk log ~tp has been opened read-only, but the " "requested operation needs read-write access~n", [Log]); do_format_error({format_external, Log}) -> io_lib:format("The requested operation can only be applied on internally " - "formatted disk logs, but ~p is externally formatted~n", + "formatted disk logs, but ~tp is externally formatted~n", [Log]); do_format_error({blocked_log, Log}) -> - io_lib:format("The blocked disk log ~p does not queue requests, or " + io_lib:format("The blocked disk log ~tp does not queue requests, or " "the log has been blocked by the calling process~n", [Log]); do_format_error({full, Log}) -> - io_lib:format("The halt log ~p is full~n", [Log]); + io_lib:format("The halt log ~tp is full~n", [Log]); do_format_error({not_blocked, Log}) -> - io_lib:format("The disk log ~p is not blocked~n", [Log]); + io_lib:format("The disk log ~tp is not blocked~n", [Log]); do_format_error({not_owner, Pid}) -> - io_lib:format("The pid ~p is not an owner of the disk log~n", [Pid]); + io_lib:format("The pid ~tp is not an owner of the disk log~n", [Pid]); do_format_error({not_blocked_by_pid, Log}) -> - io_lib:format("The disk log ~p is blocked, but only the blocking pid " + io_lib:format("The disk log ~tp is blocked, but only the blocking pid " "can unblock a disk log~n", [Log]); do_format_error({new_size_too_small, Log, CurrentSize}) -> - io_lib:format("The current size ~p of the halt log ~p is greater than the " + io_lib:format("The current size ~p of the halt log ~tp is greater than the " "requested new size~n", [CurrentSize, Log]); do_format_error({halt_log, Log}) -> - io_lib:format("The halt log ~p cannot be wrapped~n", [Log]); + io_lib:format("The halt log ~tp cannot be wrapped~n", [Log]); do_format_error({same_file_name, Log}) -> - io_lib:format("Current and new file name of the disk log ~p " + io_lib:format("Current and new file name of the disk log ~tp " "are the same~n", [Log]); do_format_error({arg_mismatch, Option, FirstValue, ArgValue}) -> - io_lib:format("The value ~p of the disk log option ~p does not match " - "the current value ~p~n", [ArgValue, Option, FirstValue]); + io_lib:format("The value ~tp of the disk log option ~p does not match " + "the current value ~tp~n", [ArgValue, Option, FirstValue]); do_format_error({name_already_open, Log}) -> - io_lib:format("The disk log ~p has already opened another file~n", [Log]); + io_lib:format("The disk log ~tp has already opened another file~n", [Log]); do_format_error({node_already_open, Log}) -> - io_lib:format("The distribution option of the disk log ~p does not match " + io_lib:format("The distribution option of the disk log ~tp does not match " "already open log~n", [Log]); do_format_error({open_read_write, Log}) -> - io_lib:format("The disk log ~p has already been opened read-write~n", + io_lib:format("The disk log ~tp has already been opened read-write~n", [Log]); do_format_error({open_read_only, Log}) -> - io_lib:format("The disk log ~p has already been opened read-only~n", + io_lib:format("The disk log ~tp has already been opened read-only~n", [Log]); do_format_error({not_internal_wrap, Log}) -> - io_lib:format("The requested operation cannot be applied since ~p is not " + io_lib:format("The requested operation cannot be applied since ~tp is not " "an internally formatted disk log~n", [Log]); do_format_error(no_such_log) -> io_lib:format("There is no disk log with the given name~n", []); @@ -1433,13 +1574,13 @@ do_format_error(nodedown) -> io_lib:format("There seems to be no node up that can handle " "the request~n", []); do_format_error({corrupt_log_file, FileName}) -> - io_lib:format("The disk log file \"~s\" contains corrupt data~n", + io_lib:format("The disk log file \"~ts\" contains corrupt data~n", [FileName]); do_format_error({need_repair, FileName}) -> - io_lib:format("The disk log file \"~s\" has not been closed properly and " + io_lib:format("The disk log file \"~ts\" has not been closed properly and " "needs repair~n", [FileName]); do_format_error({not_a_log_file, FileName}) -> - io_lib:format("The file \"~s\" is not a wrap log file~n", [FileName]); + io_lib:format("The file \"~ts\" is not a wrap log file~n", [FileName]); do_format_error({invalid_header, InvalidHeader}) -> io_lib:format("The disk log header is not wellformed: ~p~n", [InvalidHeader]); @@ -1447,14 +1588,14 @@ do_format_error(end_of_log) -> io_lib:format("An attempt was made to step outside a not yet " "full wrap log~n", []); do_format_error({invalid_index_file, FileName}) -> - io_lib:format("The wrap log index file \"~s\" cannot be used~n", + io_lib:format("The wrap log index file \"~ts\" cannot be used~n", [FileName]); do_format_error({no_continuation, BadCont}) -> io_lib:format("The term ~p is not a chunk continuation~n", [BadCont]); do_format_error({file_error, FileName, Reason}) -> - io_lib:format("\"~s\": ~p~n", [FileName, file:format_error(Reason)]); + io_lib:format("\"~ts\": ~tp~n", [FileName, file:format_error(Reason)]); do_format_error(E) -> - io_lib:format("~p~n", [E]). + io_lib:format("~tp~n", [E]). do_info(L, Cnt) -> #log{name = Name, type = Type, mode = Mode, filename = File, @@ -1735,7 +1876,8 @@ replies(Pids, Reply) -> send_reply(Pids, M). send_reply(Pid, M) when is_pid(Pid) -> - Pid ! M; + Pid ! M, + ok; send_reply([Pid | Pids], M) -> Pid ! M, send_reply(Pids, M); @@ -1768,13 +1910,8 @@ multi_req(Msg, Pids) -> {'DOWN', Ref, process, Pid, _Info} -> Reply; {disk_log, Pid, _Reply} -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, process, Pid, _Reason} -> - ok - after 0 -> - ok - end + erlang:demonitor(Ref, [flush]), + ok end end, {error, nonode}, Refs). @@ -1817,14 +1954,10 @@ monitor_request(Pid, Req) -> receive {'DOWN', Ref, process, Pid, _Info} -> {error, no_such_log}; - {disk_log, Pid, Reply} -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, process, Pid, _Reason} -> - Reply - after 0 -> - Reply - end + {disk_log, Pid, Reply} when not is_tuple(Reply) orelse + element(2, Reply) =/= disk_log_stopped -> + erlang:demonitor(Ref, [flush]), + Reply end. req2(Pid, R) -> @@ -1885,7 +2018,7 @@ notify_owners(Note) -> cache_error(S, Pids) -> Error = S#state.cache_error, - replies(Pids, Error), + ok = replies(Pids, Error), state_err(S#state{cache_error = ok}, Error). state_ok(S) -> diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl index b0849145ca..3262d979ee 100644 --- a/lib/kernel/src/disk_log.hrl +++ b/lib/kernel/src/disk_log.hrl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% @@ -44,33 +45,43 @@ -define(OPENED, <<6,7,8,9>>). -define(CLOSED, <<99,88,77,11>>). -%% Needed for the definition of fd() +%% Needed for the definition of #file_info{} %% Must use include_lib() so that we always can be sure to find %% file.hrl. A relative path will not work in an installed system. -include_lib("kernel/include/file.hrl"). -%% Ugly workaround. If we are building the bootstrap compiler, -%% file.hrl does not define the fd() type. --ifndef(FILE_HRL_). --type fd() :: pid() | #file_descriptor{}. --endif. - %%------------------------------------------------------------------------ %% Types -- alphabetically %%------------------------------------------------------------------------ +-type dlog_byte() :: [dlog_byte()] | byte(). -type dlog_format() :: 'external' | 'internal'. -type dlog_format_type() :: 'halt_ext' | 'halt_int' | 'wrap_ext' | 'wrap_int'. -type dlog_head() :: 'none' | {'ok', binary()} | mfa(). +-type dlog_head_opt() :: none | term() | binary() | [dlog_byte()]. +-type log() :: term(). % XXX: refine -type dlog_mode() :: 'read_only' | 'read_write'. -type dlog_name() :: atom() | string(). -type dlog_optattr() :: 'name' | 'file' | 'linkto' | 'repair' | 'type' | 'format' | 'size' | 'distributed' | 'notify' | 'head' | 'head_func' | 'mode'. --type dlog_options() :: [{dlog_optattr(), any()}]. +-type dlog_option() :: {name, Log :: log()} + | {file, FileName :: file:filename()} + | {linkto, LinkTo :: none | pid()} + | {repair, Repair :: true | false | truncate} + | {type, Type :: dlog_type} + | {format, Format :: dlog_format()} + | {size, Size :: dlog_size()} + | {distributed, Nodes :: [node()]} + | {notify, boolean()} + | {head, Head :: dlog_head_opt()} + | {head_func, MFA :: {atom(), atom(), list()}} + | {mode, Mode :: dlog_mode()}. +-type dlog_options() :: [dlog_option()]. -type dlog_repair() :: 'truncate' | boolean(). -type dlog_size() :: 'infinity' | pos_integer() - | {pos_integer(), pos_integer()}. + | {MaxNoBytes :: pos_integer(), + MaxNoFiles :: pos_integer()}. -type dlog_status() :: 'ok' | {'blocked', 'false' | [_]}. %QueueLogRecords -type dlog_type() :: 'halt' | 'wrap'. @@ -81,7 +92,7 @@ %% record of args for open -record(arg, {name = 0, version = undefined, - file = none :: 'none' | string(), + file = none :: 'none' | file:filename(), repair = true :: dlog_repair(), size = infinity :: dlog_size(), type = halt :: dlog_type(), @@ -94,7 +105,7 @@ options = [] :: dlog_options()}). -record(cache, %% Cache for logged terms (per file descriptor). - {fd :: fd(), %% File descriptor. + {fd :: file:fd(), %% File descriptor. sz = 0 :: non_neg_integer(), %% Number of bytes in the cache. c = [] :: iodata()} %% The cache. ). @@ -141,8 +152,8 @@ users = 0 :: non_neg_integer(), %% non-linked users filename :: file:filename(), %% real name of the file owners = [] :: [{pid(), boolean()}],%% [{pid, notify}] - type = halt :: dlog_type(), - format = internal :: dlog_format(), + type :: dlog_type(), + format :: dlog_format(), format_type :: dlog_format_type(), head = none, %% none | {head, H} | {M,F,A} %% called when wraplog wraps diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index 7103417149..2e61363aa6 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(disk_log_1). @@ -78,6 +79,7 @@ log(FdC, FileName, X) -> logl(X) -> logl(X, [], 0). +-dialyzer({no_improper_lists, logl/3}). logl([X | T], Bs, Size) -> Sz = byte_size(X), BSz = <<Sz:?SIZESZ/unit:8>>, @@ -295,12 +297,18 @@ read_chunk_ro(FdC, FileName, Pos, MaxBytes) -> pread(FdC, FileName, Pos + ?HEADSZ, MaxBytes). %% -> ok | throw(Error) -close(#cache{fd = Fd, c = []}, _FileName, read_only) -> - file:close(Fd); +close(#cache{fd = Fd, c = []}, FileName, read_only) -> + case file:close(Fd) of + ok -> ok; + Error -> file_error(FileName, Error) + end; close(#cache{fd = Fd, c = C}, FileName, read_write) -> {Reply, _NewFdC} = write_cache(Fd, FileName, C), mark(Fd, FileName, ?CLOSED), - file:close(Fd), + case file:close(Fd) of + ok -> ok; + Error -> file_error(FileName, Error) + end, if Reply =:= ok -> ok; true -> throw(Reply) end. %% Open an internal file. Head is ignored if Mode is read_only. @@ -320,7 +328,10 @@ int_open(FName, Repair, read_write, Head) -> {ok, FileHead} -> case is_head(FileHead) of yes -> - file:close(Fd), + case file:close(Fd) of + ok -> ok; + Error2 -> file_error(FName, Error2) + end, case open_update(FName) of {ok, Fd2} -> mark(Fd2, FName, ?OPENED), @@ -333,14 +344,14 @@ int_open(FName, Repair, read_write, Head) -> yes_not_closed when Repair -> repair(Fd, FName); yes_not_closed when not Repair -> - file:close(Fd), + _ = file:close(Fd), throw({error, {need_repair, FName}}); no -> - file:close(Fd), + _ = file:close(Fd), throw({error, {not_a_log_file, FName}}) end; eof -> - file:close(Fd), + _= file:close(Fd), throw({error, {not_a_log_file, FName}}); Error -> file_error_close(Fd, FName, Error) @@ -363,11 +374,11 @@ int_open(FName, _Repair, read_only, _Head) -> FdC = #cache{fd = Fd}, {ok, {existed, FdC, {0, 0}, P}}; no -> - file:close(Fd), + _= file:close(Fd), throw({error, {not_a_log_file, FName}}) end; eof -> - file:close(Fd), + _ = file:close(Fd), throw({error, {not_a_log_file, FName}}); Error -> file_error_close(Fd, FName, Error) @@ -398,7 +409,7 @@ int_log_head(Fd, Head) -> none -> {#cache{fd = Fd}, 0, 0}; Error -> - file:close(Fd), + _= file:close(Fd), throw(Error) end. @@ -450,13 +461,13 @@ ext_log_head(Fd, Head) -> none -> {#cache{fd = Fd}, {0, 0}}; Error -> - file:close(Fd), + _= file:close(Fd), throw(Error) end. %% -> _Any | throw() mark(Fd, FileName, What) -> - position_close2(Fd, FileName, 4), + {ok, _} = position_close2(Fd, FileName, 4), fwrite_close2(Fd, FileName, What). %% -> {ok, Bin} | Error @@ -489,7 +500,7 @@ lh(H, _F) -> % cannot happen repair(In, File) -> FSz = file_size(File), - error_logger:info_msg("disk_log: repairing ~p ...\n", [File]), + error_logger:info_msg("disk_log: repairing ~tp ...\n", [File]), Tmp = add_ext(File, "TMP"), {ok, {_Alloc, Out, {0, _}, _FileSize}} = new_int_file(Tmp, none), scan_f_read(<<>>, In, Out, File, FSz, Tmp, ?MAX_CHUNK_SIZE, 0, 0). @@ -560,7 +571,7 @@ scan_f2(B, FSz, Ack, No, Bad, Size, Tail) -> end. done_scan(In, Out, OutName, FName, RecoveredTerms, BadChars) -> - file:close(In), + _ = file:close(In), case catch fclose(Out, OutName) of ok -> case file:rename(OutName, FName) of @@ -574,19 +585,21 @@ done_scan(In, Out, OutName, FName, RecoveredTerms, BadChars) -> file_error(FName, Error) end; Error -> - file:delete(OutName), + _ = file:delete(OutName), file_error(FName, Error) end; Error -> - file:delete(OutName), + _ = file:delete(OutName), throw(Error) end. - + +-spec repair_err(file:io_device(), #cache{}, file:filename(), + file:filename(), {'error', file:posix()}) -> no_return(). repair_err(In, Out, OutName, ErrFileName, Error) -> - file:close(In), + _= file:close(In), catch fclose(Out, OutName), - % OutName is often the culprit, try to remove it anyway... - file:delete(OutName), + %% OutName is often the culprit, try to remove it anyway... + _ = file:delete(OutName), file_error(ErrFileName, Error). %% Used by wrap_log_reader. @@ -756,16 +769,16 @@ mf_int_chunk(Handle, {FileNo, Pos}, Bin, N) -> NFileNo = inc(FileNo, Handle#handle.maxF), case catch int_open(FName, true, read_only, any) of {error, _Reason} -> - error_logger:info_msg("disk_log: chunk error. File ~p missing.\n\n", + error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", [FName]), mf_int_chunk(Handle, {NFileNo, 0}, [], N); {ok, {_Alloc, FdC, _HeadSize, _FileSize}} -> case chunk(FdC, FName, Pos, Bin, N) of {NewFdC, eof} -> - file:close(NewFdC#cache.fd), + _ = file:close(NewFdC#cache.fd), mf_int_chunk(Handle, {NFileNo, 0}, [], N); {NewFdC, Other} -> - file:close(NewFdC#cache.fd), + _ = file:close(NewFdC#cache.fd), {Handle, conv(Other, FileNo)} end end. @@ -784,16 +797,16 @@ mf_int_chunk_read_only(Handle, {FileNo, Pos}, Bin, N) -> NFileNo = inc(FileNo, Handle#handle.maxF), case catch int_open(FName, true, read_only, any) of {error, _Reason} -> - error_logger:info_msg("disk_log: chunk error. File ~p missing.\n\n", + error_logger:info_msg("disk_log: chunk error. File ~tp missing.\n\n", [FName]), mf_int_chunk_read_only(Handle, {NFileNo, 0}, [], N); {ok, {_Alloc, FdC, _HeadSize, _FileSize}} -> case do_chunk_read_only(FdC, FName, Pos, Bin, N) of {NewFdC, eof} -> - file:close(NewFdC#cache.fd), + _ = file:close(NewFdC#cache.fd), mf_int_chunk_read_only(Handle, {NFileNo,0}, [], N); {NewFdC, Other} -> - file:close(NewFdC#cache.fd), + _ = file:close(NewFdC#cache.fd), {Handle, conv(Other, FileNo)} end end. @@ -1015,7 +1028,7 @@ ext_file_open(FName, NewFile, OldFile, OldCnt, Head, Repair, Mode) -> read_index_file(truncate, FName, MaxF) -> remove_files(FName, 2, MaxF), - file:delete(?index_file_name(FName)), + _ = file:delete(?index_file_name(FName)), {1, 0, 0, 0}; read_index_file(_, FName, _MaxF) -> read_index_file(FName). @@ -1041,7 +1054,7 @@ read_index_file(FName) -> _ErrorOrEof -> {1, 0, 0, 0} end, - file:close(Fd), + _ = file:close(Fd), R; _Error -> {1, 0, 0, 0} @@ -1094,7 +1107,7 @@ write_index_file(read_write, FName, NewFile, OldFile, OldCnt) -> %% Very old format, convert to the latest format! case file:read_file(FileName) of {ok, <<_CurF, Tail/binary>>} -> - position_close2(Fd, FileName, bof), + {ok, _} = position_close2(Fd, FileName, bof), Bin = <<0, 0:32, ?VERSION, NewFile:32>>, NewTail = to_8_bytes(Tail, [], FileName, Fd), fwrite_close2(Fd, FileName, [Bin | NewTail]), @@ -1113,7 +1126,7 @@ write_index_file(read_write, FName, NewFile, OldFile, OldCnt) -> R = file:pread(Fd, NewPos, SzSz), OldPos = Offset + (OldFile - 1)*SzSz, pwrite_close2(Fd, FileName, OldPos, OldCntBin), - file:close(Fd), + _ = file:close(Fd), case R of {ok, <<Lost:SzSz/unit:8>>} -> Lost; {ok, _} -> @@ -1123,19 +1136,20 @@ write_index_file(read_write, FName, NewFile, OldFile, OldCnt) -> end; true -> pwrite_close2(Fd, FileName, NewPos, OldCntBin), - file:close(Fd), + _ = file:close(Fd), 0 end; E -> file_error(FileName, E) end. +-dialyzer({no_improper_lists, to_8_bytes/4}). to_8_bytes(<<N:32,T/binary>>, NT, FileName, Fd) -> to_8_bytes(T, [NT | <<N:64>>], FileName, Fd); to_8_bytes(B, NT, _FileName, _Fd) when byte_size(B) =:= 0 -> NT; to_8_bytes(_B, _NT, FileName, Fd) -> - file:close(Fd), + _ = file:close(Fd), throw({error, {invalid_index_file, FileName}}). %% -> ok | throw(FileError) @@ -1145,7 +1159,7 @@ index_file_trunc(FName, N) -> {ok, Fd} -> case file:read(Fd, 6) of eof -> - file:close(Fd), + _ = file:close(Fd), ok; {ok, <<0, 0:32, Version>>} when Version =:= ?VERSION -> truncate_index_file(Fd, FileName, 10, 8, N); @@ -1164,10 +1178,10 @@ truncate_index_file(Fd, FileName, Offset, N, SzSz) -> Pos = Offset + N*SzSz, case Pos > file_size(FileName) of true -> - file:close(Fd); + ok = file:close(Fd); false -> truncate_at_close2(Fd, FileName, {bof, Pos}), - file:close(Fd) + ok = file:close(Fd) end, ok. @@ -1264,6 +1278,7 @@ ext_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, ext_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, ext_split_bins/6}). ext_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> NBs = Bs + byte_size(X), if @@ -1284,6 +1299,7 @@ int_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, int_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, int_split_bins/6}). int_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> Sz = byte_size(X), NBs = Bs + Sz + ?HEADERSZ, @@ -1410,7 +1426,8 @@ fwrite(#cache{c = []} = FdC, _FN, B, Size) -> ok; _ -> put(write_cache_timer_is_running, true), - erlang:send_after(?TIMEOUT, self(), {self(), write_cache}) + erlang:send_after(?TIMEOUT, self(), {self(), write_cache}), + ok end, {ok, FdC#cache{sz = Size, c = B}}; fwrite(#cache{sz = Sz, c = C} = FdC, _FN, B, Size) when Sz < ?MAX -> @@ -1493,7 +1510,7 @@ fwrite_close2(Fd, FileName, B) -> pwrite_close2(Fd, FileName, Position, B) -> case file:pwrite(Fd, Position, B) of ok -> ok; - Error -> file_error(FileName, {error, Error}) + {error,Error} -> file_error(FileName, {error, Error}) end. position2(Fd, FileName, Pos) -> @@ -1509,7 +1526,7 @@ position_close2(Fd, FileName, Pos) -> end. truncate_at_close2(Fd, FileName, Pos) -> - position_close2(Fd, FileName, Pos), + {ok, _} = position_close2(Fd, FileName, Pos), case file:truncate(Fd) of ok -> ok; Error -> file_error_close(Fd, FileName, Error) @@ -1517,7 +1534,7 @@ truncate_at_close2(Fd, FileName, Pos) -> fclose(#cache{fd = Fd, c = C}, FileName) -> %% The cache is empty if the file was opened in read_only mode. - write_cache_close(Fd, FileName, C), + _ = write_cache_close(Fd, FileName, C), file:close(Fd). %% -> {Reply, #cache{}}; Reply = ok | Error @@ -1529,7 +1546,7 @@ write_cache(Fd, FileName, C) -> Error -> {catch file_error(FileName, Error), #cache{fd = Fd}} end. --spec write_cache_close(fd(), file:filename(), iodata()) -> #cache{}. % | throw(Error) +-spec write_cache_close(file:fd(), file:filename(), iodata()) -> #cache{}. % | throw(Error) write_cache_close(Fd, _FileName, []) -> #cache{fd = Fd}; @@ -1539,13 +1556,13 @@ write_cache_close(Fd, FileName, C) -> Error -> file_error_close(Fd, FileName, Error) end. --spec file_error(file:filename(), {'error', atom()}) -> no_return(). +-spec file_error(file:filename(), {'error', file:posix()}) -> no_return(). file_error(FileName, {error, Error}) -> throw({error, {file_error, FileName, Error}}). --spec file_error_close(fd(), file:filename(), {'error', atom()}) -> no_return(). +-spec file_error_close(file:fd(), file:filename(), {'error', file:posix()}) -> no_return(). file_error_close(Fd, FileName, {error, Error}) -> - file:close(Fd), + _ = file:close(Fd), throw({error, {file_error, FileName, Error}}). diff --git a/lib/kernel/src/disk_log_server.erl b/lib/kernel/src/disk_log_server.erl index 8894ed87e8..78c15d0ad8 100644 --- a/lib/kernel/src/disk_log_server.erl +++ b/lib/kernel/src/disk_log_server.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -83,8 +84,8 @@ accessible_logs() -> init([]) -> process_flag(trap_exit, true), - ets:new(?DISK_LOG_NAME_TABLE, [named_table, set]), - ets:new(?DISK_LOG_PID_TABLE, [named_table, set]), + _ = ets:new(?DISK_LOG_NAME_TABLE, [named_table, set]), + _= ets:new(?DISK_LOG_PID_TABLE, [named_table, set]), {ok, #state{}}. handle_call({open, W, A}, From, State) -> @@ -159,15 +160,25 @@ ensure_started() -> undefined -> LogSup = {disk_log_sup, {disk_log_sup, start_link, []}, permanent, 1000, supervisor, [disk_log_sup]}, - supervisor:start_child(kernel_safe_sup, LogSup), + {ok, _} = ensure_child_started(kernel_safe_sup, LogSup), LogServer = {disk_log_server, {disk_log_server, start_link, []}, permanent, 2000, worker, [disk_log_server]}, - supervisor:start_child(kernel_safe_sup, LogServer), + {ok, _} = ensure_child_started(kernel_safe_sup, LogServer), ok; _ -> ok end. +ensure_child_started(Sup,Child) -> + case supervisor:start_child(Sup, Child) of + {ok,Pid} -> + {ok,Pid}; + {error,{already_started,Pid}} -> + {ok,Pid}; + Error -> + Error + end. + open([{Req, From} | L], State) -> State2 = case do_open(Req, From, State) of {pending, State1} -> @@ -189,7 +200,7 @@ do_open({open, W, #arg{name = Name}=A}=Req, From, State) -> false when W =:= local -> case A#arg.distributed of {true, Nodes} -> - Fun = fun() -> open_distr_rpc(Nodes, A, From) end, + Fun = open_distr_rpc_fun(Nodes, A, From), _Pid = spawn(Fun), %% No pending reply is expected, but don't reply yet. {pending, State}; @@ -215,11 +226,15 @@ do_open({open, W, #arg{name = Name}=A}=Req, From, State) -> end end. +-spec open_distr_rpc_fun([node()], _, _) -> % XXX: underspecified + fun(() -> no_return()). + +open_distr_rpc_fun(Nodes, A, From) -> + fun() -> open_distr_rpc(Nodes, A, From) end. + %% Spawning a process is a means to avoid deadlock when %% disk_log_servers mutually open disk_logs. --spec open_distr_rpc([node()], _, _) -> no_return(). % XXX: underspecified - open_distr_rpc(Nodes, A, From) -> {AllReplies, BadNodes} = rpc:multicall(Nodes, ?MODULE, dist_open, [A]), {Ok, Bad} = cr(AllReplies, [], []), diff --git a/lib/kernel/src/disk_log_sup.erl b/lib/kernel/src/disk_log_sup.erl index 96e37b678c..db5e3ecb3a 100644 --- a/lib/kernel/src/disk_log_sup.erl +++ b/lib/kernel/src/disk_log_sup.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/kernel/src/dist.hrl b/lib/kernel/src/dist.hrl deleted file mode 100644 index aea1ab81ba..0000000000 --- a/lib/kernel/src/dist.hrl +++ /dev/null @@ -1,38 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% - -%% -%% Distribution capabilities flags (corresponds with dist.h). -%% - --define(DFLAG_PUBLISHED,1). --define(DFLAG_ATOM_CACHE,2). --define(DFLAG_EXTENDED_REFERENCES,4). --define(DFLAG_DIST_MONITOR,8). --define(DFLAG_FUN_TAGS,16#10). --define(DFLAG_DIST_MONITOR_NAME,16#20). --define(DFLAG_HIDDEN_ATOM_CACHE,16#40). --define(DFLAG_NEW_FUN_TAGS,16#80). --define(DFLAG_EXTENDED_PIDS_PORTS,16#100). --define(DFLAG_EXPORT_PTR_TAG,16#200). --define(DFLAG_BIT_BINARIES,16#400). --define(DFLAG_NEW_FLOATS,16#800). --define(DFLAG_UNICODE_IO,16#1000). --define(DFLAG_DIST_HDR_ATOM_CACHE,16#2000). --define(DFLAG_SMALL_ATOM_TAGS, 16#4000). diff --git a/lib/kernel/src/dist_ac.erl b/lib/kernel/src/dist_ac.erl index 5c62aa31e9..6c2fa0b6b1 100644 --- a/lib/kernel/src/dist_ac.erl +++ b/lib/kernel/src/dist_ac.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -283,7 +284,7 @@ handle_cast(init_sync, _S) -> KernelConfig ! dist_ac_took_control, %% we're really just interested in nodedowns. - net_kernel:monitor_nodes(true), + ok = net_kernel:monitor_nodes(true), {Known, NAppls, RStarted} = sync_dacs(Appls), @@ -321,7 +322,7 @@ handle_call({takeover_application, AppName, RestartType}, From, S) -> case keysearch(AppName, #appl.name, Appls) of {value, Appl} when element(1, Appl#appl.id) =:= distributed -> {distributed, Node} = Appl#appl.id, - ac_takeover(req, AppName, Node, RestartType), + _ = ac_takeover(req, AppName, Node, RestartType), NAppl = Appl#appl{id = takeover}, NAppls = keyreplace(AppName, #appl.name, Appls, NAppl), TR = S#state.t_reqs, @@ -341,10 +342,10 @@ handle_call({permit_application, AppName, Bool, LockId, StartInfo}, From, S) -> %% here, but we have to be backwards-compatible. case application_controller:get_loaded(AppName) of {true, _} when not Bool -> - ac_stop_it(AppName), + _ = ac_stop_it(AppName), {reply, ok, S}; {true, _} when Bool -> - ac_start_it(req, AppName), + _ = ac_start_it(req, AppName), {reply, ok, S}; false -> {reply, {error, {not_loaded, AppName}}, S} @@ -533,7 +534,7 @@ handle_info({dist_ac_app_started, Node, Name, Res}, S) -> %% Another node started appl. Update appl list. {distributed, Node} end, - ac_started(req, Name, Node), + _ = ac_started(req, Name, Node), NAppl = Appl#appl{id = NId}, NAppls = keyreplace(Name, #appl.name, Appls, NAppl), TmpWeights = keydelete_all(Name, 1, S#state.tmp_weights), @@ -622,7 +623,7 @@ handle_info({nodedown, Node}, S) -> true -> {true, Appl#appl{id = {failover, Node}}}; false -> - ac_not_running(Appl#appl.name), + _ = ac_not_running(Appl#appl.name), {true, Appl#appl{id = undefined}} end; (_) -> @@ -656,7 +657,8 @@ handle_info({dist_ac_app_loaded, Node, Name, HisNodes, Permission, HeKnowsMe}, %% he's a new node connecting to us. Msg = {dist_ac_app_loaded, node(), Name, Nodes, dist_is_runnable(Appls, Name), true}, - {?DIST_AC, Node} ! Msg; + {?DIST_AC, Node} ! Msg, + ok; true -> ok end, @@ -811,29 +813,29 @@ start_appl(AppName, S, Type) -> start_distributed(Appl, Name, Nodes, PermittedNodes, S, Type) -> case find_start_node(Nodes, PermittedNodes, Name, S) of {ok, Node} when Node =:= node() -> - case Appl#appl.id of - {failover, FoNode} when Type =:= req -> - ac_failover(Name, FoNode, undefined); - {distributed, Node2} when Type =:= req -> - ac_takeover(req, Name, Node2, undefined); - _ when Type =:= reply -> - case lists:keysearch(Name, 2, S#state.remote_started) of - {value, {Node3, _}} -> - ac_takeover(reply, Name, Node3, undefined); - _ -> - ac_start_it(Type, Name) - end; - _ -> - ac_start_it(Type, Name) - end, + _ = case Appl#appl.id of + {failover, FoNode} when Type =:= req -> + ac_failover(Name, FoNode, undefined); + {distributed, Node2} when Type =:= req -> + ac_takeover(req, Name, Node2, undefined); + _ when Type =:= reply -> + case lists:keysearch(Name, 2, S#state.remote_started) of + {value, {Node3, _}} -> + ac_takeover(reply, Name, Node3, undefined); + _ -> + ac_start_it(Type, Name) + end; + _ -> + ac_start_it(Type, Name) + end, {run_waiting, true}; {already_started, Node} -> - ac_started(Type, Name, Node), + _ = ac_started(Type, Name, Node), {{distributed, Node}, false}; {ok, Node} -> case keysearch(Name, #appl.name, S#state.appls) of {value, #appl{id = {distributed, Node}}} -> - ac_started(Type, Name, Node), + _ = ac_started(Type, Name, Node), {{distributed, Node}, false}; _ -> wait_dist_start(Node, Appl, Name, Nodes, @@ -842,7 +844,7 @@ start_distributed(Appl, Name, Nodes, PermittedNodes, S, Type) -> not_started -> wait_dist_start2(Appl, Name, Nodes, PermittedNodes, S, Type); no_permission -> - ac_not_started(Type, Name), + _ = ac_not_started(Type, Name), {undefined, false} end. @@ -850,11 +852,11 @@ wait_dist_start(Node, Appl, Name, Nodes, PermittedNodes, S, Type) -> monitor_node(Node, true), receive {dist_ac_app_started, Node, Name, ok} -> - ac_started(Type, Name, Node), + _ = ac_started(Type, Name, Node), monitor_node(Node, false), {{distributed, Node}, false}; {dist_ac_app_started, Node, Name, {error, R}} -> - ac_error(Type, Name, {Node, R}), + _ = ac_error(Type, Name, {Node, R}), monitor_node(Node, false), {Appl#appl.id, false}; {dist_ac_weight, Name, _Weigth, Node} -> @@ -883,10 +885,10 @@ wait_dist_start(Node, Appl, Name, Nodes, PermittedNodes, S, Type) -> wait_dist_start2(Appl, Name, Nodes, PermittedNodes, S, Type) -> receive {dist_ac_app_started, Node, Name, ok} -> - ac_started(Type, Name, Node), + _ = ac_started(Type, Name, Node), {{distributed, Node}, false}; {dist_ac_app_started, Node, Name, {error, R}} -> - ac_error(Type, Name, {Node, R}), + _ = ac_error(Type, Name, {Node, R}), {Appl#appl.id, false}; {nodedown, Node} -> %% A node went down, try to start the app again - there may not @@ -974,7 +976,7 @@ permit(false, {value, _}, AppName, From, S, _LockId) -> case dist_get_runnable_nodes(S#state.appls, AppName) of [] -> %% There is no runnable node; stop application - ac_stop_it(AppName), + _ = ac_stop_it(AppName), SReqs = [{AppName, From} | S#state.s_reqs], {noreply, S#state{s_reqs = SReqs}}; Nodes -> @@ -1155,7 +1157,8 @@ send_nodes(Nodes, Msg) -> end, FlatNodes). send_after(Time, Msg) when is_integer(Time), Time >= 0 -> - spawn_link(?MODULE, send_timeout, [self(), Time, Msg]); + _Pid = spawn_link(?MODULE, send_timeout, [self(), Time, Msg]), + ok; send_after(_,_) -> % infinity ok. @@ -1305,7 +1308,7 @@ check_waiting([{From, AppName, false, Nodes} | Reqs], S, Node, Appls, Res, SReqs) -> case lists:delete(Node, Nodes) of [] -> - ac_stop_it(AppName), + _ = ac_stop_it(AppName), NSReqs = [{AppName, From} | SReqs], check_waiting(Reqs, Node, S, Appls, Res, NSReqs); NNodes -> diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index a2937d60b8..8d2fc4d4b7 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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. -%% +%% +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% %%%---------------------------------------------------------------------- @@ -115,7 +116,10 @@ make_this_flags(RequestType, OtherNode) -> ?DFLAG_NEW_FLOATS bor ?DFLAG_UNICODE_IO bor ?DFLAG_DIST_HDR_ATOM_CACHE bor - ?DFLAG_SMALL_ATOM_TAGS). + ?DFLAG_SMALL_ATOM_TAGS bor + ?DFLAG_UTF8_ATOMS bor + ?DFLAG_MAP_TAG bor + ?DFLAG_BIG_CREATION). handshake_other_started(#hs_data{request_type=ReqType}=HSData0) -> {PreOtherFlags,Node,Version} = recv_name(HSData0), @@ -139,7 +143,11 @@ handshake_other_started(#hs_data{request_type=ReqType}=HSData0) -> ChallengeB = recv_challenge_reply(HSData, ChallengeA, MyCookie), send_challenge_ack(HSData, gen_digest(ChallengeB, HisCookie)), ?debug({dist_util, self(), accept_connection, Node}), - connection(HSData). + connection(HSData); + +handshake_other_started(OldHsData) when element(1,OldHsData) =:= hs_data -> + handshake_other_started(convert_old_hsdata(OldHsData)). + %% %% check if connecting node is allowed to connect @@ -152,7 +160,7 @@ is_allowed(#hs_data{other_node = Node, send_status(HSData, not_allowed), error_msg("** Connection attempt from " "disallowed node ~w ** ~n", [Node]), - ?shutdown(Node); + ?shutdown2(Node, {is_allowed, not_allowed}); _ -> true end. @@ -193,7 +201,7 @@ check_dflag_xnc(#hs_data{other_node = Node, error_msg("** ~w: Connection attempt ~s node ~w ~s " "since it cannot handle extended ~s. " "**~n", [node(), Dir, Node, How, What]), - ?shutdown(Node) + ?shutdown2(Node, {check_dflag_xnc_failed, What}) end. @@ -296,7 +304,7 @@ shutdown(_Module, _Line, _Data, Reason) -> exit(Reason). %% Use this line to debug connection. %% Set net_kernel verbose = 1 as well. -%% exit({Reason, ?MODULE, _Line, _Data, erlang:now()}). +%% exit({Reason, ?MODULE, _Line, _Data, erlang:timestamp()}). flush_down() -> @@ -326,7 +334,20 @@ handshake_we_started(#hs_data{request_type=ReqType, gen_digest(ChallengeA,HisCookie)), reset_timer(NewHSData#hs_data.timer), recv_challenge_ack(NewHSData, MyChallenge, MyCookie), - connection(NewHSData). + connection(NewHSData); + +handshake_we_started(OldHsData) when element(1,OldHsData) =:= hs_data -> + handshake_we_started(convert_old_hsdata(OldHsData)). + +convert_old_hsdata({hs_data, KP, ON, TN, S, T, TF, A, OV, OF, OS, FS, FR, + FS_PRE, FS_POST, FG, FA, MFT, MFG, RT}) -> + #hs_data{ + kernel_pid = KP, other_node = ON, this_node = TN, socket = S, timer = T, + this_flags = TF, allowed = A, other_version = OV, other_flags = OF, + other_started = OS, f_send = FS, f_recv = FR, f_setopts_pre_nodeup = FS_PRE, + f_setopts_post_nodeup = FS_POST, f_getll = FG, f_address = FA, + mf_tick = MFT, mf_getstat = MFG, request_type = RT}. + %% -------------------------------------------------------------- %% The connection has been established. @@ -346,15 +367,15 @@ connection(#hs_data{other_node = Node, mark_nodeup(HSData,Address), case FPostNodeup(Socket) of ok -> - con_loop(HSData#hs_data.kernel_pid, - Node, - Socket, - Address, - HSData#hs_data.this_node, - PType, - #tick{}, - HSData#hs_data.mf_tick, - HSData#hs_data.mf_getstat); + con_loop({HSData#hs_data.kernel_pid, + Node, + Socket, + PType, + HSData#hs_data.mf_tick, + HSData#hs_data.mf_getstat, + HSData#hs_data.mf_setopts, + HSData#hs_data.mf_getopts}, + #tick{}); _ -> ?shutdown2(Node, connection_setup_failed) end; @@ -371,7 +392,9 @@ gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) -> %% gen_challenge() returns a "random" number %% --------------------------------------------------------------- gen_challenge() -> - {A,B,C} = erlang:now(), + A = erlang:phash2([erlang:node()]), + B = erlang:monotonic_time(), + C = erlang:unique_integer(), {D,_} = erlang:statistics(reductions), {E,_} = erlang:statistics(runtime), {F,_} = erlang:statistics(wall_clock), @@ -448,8 +471,8 @@ mark_nodeup(#hs_data{kernel_pid = Kernel, ?shutdown(Node) end. -con_loop(Kernel, Node, Socket, TcpAddress, - MyNode, Type, Tick, MFTick, MFGetstat) -> +con_loop({Kernel, Node, Socket, Type, MFTick, MFGetstat, MFSetOpts, MFGetOpts}=ConData, + Tick) -> receive {tcp_closed, Socket} -> ?shutdown2(Node, connection_closed); @@ -462,15 +485,12 @@ con_loop(Kernel, Node, Socket, TcpAddress, _ -> ignore_it end, - con_loop(Kernel, Node, Socket, TcpAddress, MyNode, Type, - Tick, MFTick, MFGetstat); + con_loop(ConData, Tick); {Kernel, tick} -> case send_tick(Socket, Tick, Type, MFTick, MFGetstat) of {ok, NewTick} -> - con_loop(Kernel, Node, Socket, TcpAddress, - MyNode, Type, NewTick, MFTick, - MFGetstat); + con_loop(ConData, NewTick); {error, not_responding} -> error_msg("** Node ~p not responding **~n" "** Removing (timedout) connection **~n", @@ -483,13 +503,24 @@ con_loop(Kernel, Node, Socket, TcpAddress, case MFGetstat(Socket) of {ok, Read, Write, _} -> From ! {self(), get_status, {ok, Read, Write}}, - con_loop(Kernel, Node, Socket, TcpAddress, - MyNode, - Type, Tick, - MFTick, MFGetstat); + con_loop(ConData, Tick); _ -> ?shutdown2(Node, get_status_failed) - end + end; + {From, Ref, {setopts, Opts}} -> + Ret = case MFSetOpts of + undefined -> {error, enotsup}; + _ -> MFSetOpts(Socket, Opts) + end, + From ! {Ref, Ret}, + con_loop(ConData, Tick); + {From, Ref, {getopts, Opts}} -> + Ret = case MFGetOpts of + undefined -> {error, enotsup}; + _ -> MFGetOpts(Socket, Opts) + end, + From ! {Ref, Ret}, + con_loop(ConData, Tick) end. @@ -564,17 +595,20 @@ recv_challenge(#hs_data{socket=Socket,other_node=Node, case Recv(Socket, 0, infinity) of {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} -> Flags = ?u32(Fl1,Fl2,Fl3,Fl4), - case {list_to_existing_atom(Ns),?u16(V1,V0)} of + try {list_to_existing_atom(Ns),?u16(V1,V0)} of {Node,Version} -> Challenge = ?u32(CA3,CA2,CA1,CA0), ?trace("recv: node=~w, challenge=~w version=~w\n", [Node, Challenge,Version]), {Flags,Challenge}; _ -> - ?shutdown(no_node) + ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) + catch + error:badarg -> + ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) end; - _ -> - ?shutdown(no_node) + Other -> + ?shutdown2(no_node, {recv_challenge_failed, Other}) end. @@ -598,10 +632,10 @@ recv_challenge_reply(#hs_data{socket = Socket, _ -> error_msg("** Connection attempt from " "disallowed node ~w ** ~n", [NodeB]), - ?shutdown(NodeB) + ?shutdown2(NodeB, {recv_challenge_reply_failed, bad_cookie}) end; - _ -> - ?shutdown(no_node) + Other -> + ?shutdown2(no_node, {recv_challenge_reply_failed, Other}) end. recv_challenge_ack(#hs_data{socket = Socket, f_recv = FRecv, @@ -618,10 +652,10 @@ recv_challenge_ack(#hs_data{socket = Socket, f_recv = FRecv, _ -> error_msg("** Connection attempt to " "disallowed node ~w ** ~n", [NodeB]), - ?shutdown(NodeB) + ?shutdown2(NodeB, {recv_challenge_ack_failed, bad_cookie}) end; - _ -> - ?shutdown(NodeB) + Other -> + ?shutdown2(NodeB, {recv_challenge_ack_failed, Other}) end. recv_status(#hs_data{kernel_pid = Kernel, socket = Socket, @@ -631,7 +665,7 @@ recv_status(#hs_data{kernel_pid = Kernel, socket = Socket, Stat = list_to_atom(StrStat), ?debug({dist_util,self(),recv_status, Node, Stat}), case Stat of - not_allowed -> ?shutdown(Node); + not_allowed -> ?shutdown2(Node, {recv_status_failed, not_allowed}); nok -> %% wait to be killed by net_kernel receive @@ -648,10 +682,10 @@ recv_status(#hs_data{kernel_pid = Kernel, socket = Socket, end; _ -> Stat end; - _Error -> + Error -> ?debug({dist_util,self(),recv_status_error, - Node, _Error}), - ?shutdown(Node) + Node, Error}), + ?shutdown2(Node, {recv_status_failed, Error}) end. @@ -750,11 +784,12 @@ setup_timer(Pid, Timeout) -> setup_timer(Pid, Timeout) after Timeout -> ?trace("Timer expires ~p, ~p~n",[Pid, Timeout]), - ?shutdown(timer) + ?shutdown2(timer, setup_timer_timeout) end. reset_timer(Timer) -> - Timer ! {self(), reset}. + Timer ! {self(), reset}, + ok. cancel_timer(Timer) -> unlink(Timer), diff --git a/lib/kernel/src/dist_util.hrl b/lib/kernel/src/dist_util.hrl deleted file mode 100644 index f2b0598532..0000000000 --- a/lib/kernel/src/dist_util.hrl +++ /dev/null @@ -1,87 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-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% -%% -%% uncomment this if tracing of handshake etc is wanted -%%-define(dist_trace, true). -%%-define(dist_debug, true). - - --ifdef(dist_debug). --define(debug(Term), erlang:display(Term)). --else. --define(debug(Term), ok). --endif. - --ifdef(dist_trace). --define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). -% Use the one below for config-file (early boot) connection tracing -%-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). --define(trace_factor,8). --else. --define(trace(Fmt,Args), ok). --define(trace_factor,1). --endif. - --define(shutdown(Data), dist_util:shutdown(?MODULE, ?LINE, Data)). --define(shutdown2(Data, Reason), dist_util:shutdown(?MODULE, ?LINE, Data, Reason)). - -%% Handshake state structure --record(hs_data, { - kernel_pid, %% Pid of net_kernel - other_node, %% Name of peer - this_node, %% my nodename - socket, %% The connection "socket" - timer, %% The setup timer - %% (stream_dist_handshake:start_timer) - this_flags, %% Flags my node should use - allowed, %% Allowed nodes list - other_version, %% The other nodes distribution version - other_flags, %% The other nodes flags. - other_started, %% True if the other node initiated. - f_send, %% Fun that behaves like gen_tcp:send - f_recv, %% Fun that behaves like gen_tcp:recv - f_setopts_pre_nodeup, %% Sets "socket" options before - %% nodeup is delivered to net_kernel - f_setopts_post_nodeup, %% Sets "socket" options after - %% nodeup is delivered - f_getll, %% Get low level port or pid. - f_address, %% The address of the "socket", - %% generated from Socket,Node - %% These two are used in the tick loop, - %% so they are not fun's to avoid holding old code. - mf_tick, %% Takes the socket as parameters and - %% sends a tick, this is no fun, it - %% is a tuple {M,F}. - %% Is should place {tcp_closed, Socket} - %% in the message queue on failure. - mf_getstat, %% Returns - %% {ok, RecvCnt, SendCnt, SendPend} for - %% a given socket. This is a {M,F}, - %% returning {error, Reason on failure} - request_type = normal -}). - - -%% The following should be filled in upon enter of... -%% - handshake_we_started: -%% kernel_pid, other_node, this_node, socket, timer, -%% this_flags, other_version, All fun's/mf's. -%% - handshake_other_started: -%% kernel_pid, this_node, socket, timer, -%% this_flags, allowed, All fun's/mf's. - diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl index 702b2feac9..ac81cc9689 100644 --- a/lib/kernel/src/erl_boot_server.erl +++ b/lib/kernel/src/erl_boot_server.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% %% A simple boot_server at a CP. @@ -53,12 +54,17 @@ bootp :: pid(), %% boot process prim_state %% state for efile code loader }). +-type state() :: #state{}. -define(single_addr_mask, {255, 255, 255, 255}). -type ip4_address() :: {0..255,0..255,0..255,0..255}. --spec start(Slaves :: [atom()]) -> {'ok', pid()} | {'error', any()}. +-spec start(Slaves) -> {'ok', Pid} | {'error', What} when + Slaves :: [Host], + Host :: atom(), + Pid :: pid(), + What :: any(). start(Slaves) -> case check_arg(Slaves) of @@ -68,7 +74,11 @@ start(Slaves) -> {error, {badarg, Slaves}} end. --spec start_link(Slaves :: [atom()]) -> {'ok', pid()} | {'error', any()}. +-spec start_link(Slaves) -> {'ok', Pid} | {'error', What} when + Slaves :: [Host], + Host :: atom(), + Pid :: pid(), + What :: any(). start_link(Slaves) -> case check_arg(Slaves) of @@ -94,7 +104,10 @@ check_arg([], Result) -> check_arg(_, _Result) -> error. --spec add_slave(Slave :: atom()) -> 'ok' | {'error', any()}. +-spec add_slave(Slave) -> 'ok' | {'error', What} when + Slave :: Host, + Host :: atom(), + What :: any(). add_slave(Slave) -> case inet:getaddr(Slave, inet) of @@ -104,7 +117,10 @@ add_slave(Slave) -> {error, {badarg, Slave}} end. --spec delete_slave(Slave :: atom()) -> 'ok' | {'error', any()}. +-spec delete_slave(Slave) -> 'ok' | {'error', What} when + Slave :: Host, + Host :: atom(), + What :: any(). delete_slave(Slave) -> case inet:getaddr(Slave, inet) of @@ -130,7 +146,9 @@ add_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> delete_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> gen_server:call(boot_server, {delete, {Mask, Addr}}). --spec which_slaves() -> [atom()]. +-spec which_slaves() -> Slaves when + Slaves :: [Host], + Host :: atom(). which_slaves() -> gen_server:call(boot_server, which). @@ -165,6 +183,8 @@ member_address(_, []) -> %% call-back functions. %% ------------------------------------------------------------ +-spec init([atom()]) -> {'ok', state()}. + init(Slaves) -> {ok, U} = gen_udp:open(?EBOOT_PORT, []), {ok, L} = gen_tcp:listen(0, [binary,{packet,4}]), @@ -172,19 +192,22 @@ init(Slaves) -> {ok, UPort} = inet:port(U), Ref = make_ref(), Pid = proc_lib:spawn_link(?MODULE, boot_init, [Ref]), - gen_tcp:controlling_process(L, Pid), + ok = gen_tcp:controlling_process(L, Pid), Pid ! {Ref, L}, %% We trap exit inorder to restart boot_init and udp_port process_flag(trap_exit, true), - {ok, #state {priority = 0, - version = erlang:system_info(version), - udp_sock = U, - udp_port = UPort, - listen_sock = L, - listen_port = Port, - slaves = ordsets:from_list(Slaves), - bootp = Pid - }}. + {ok, #state{priority = 0, + version = erlang:system_info(version), + udp_sock = U, + udp_port = UPort, + listen_sock = L, + listen_port = Port, + slaves = ordsets:from_list(Slaves), + bootp = Pid + }}. + +-spec handle_call('which' | {'add',atom()} | {'delete',atom()}, _, state()) -> + {'reply', 'ok' | [atom()], state()}. handle_call({add,Address}, _, S0) -> Slaves = ordsets:add_element(Address, S0#state.slaves), @@ -197,9 +220,13 @@ handle_call({delete,Address}, _, S0) -> handle_call(which, _, S0) -> {reply, ordsets:to_list(S0#state.slaves), S0}. +-spec handle_cast(term(), [atom()]) -> {'noreply', [atom()]}. + handle_cast(_, Slaves) -> {noreply, Slaves}. +-spec handle_info(term(), state()) -> {'noreply', state()}. + handle_info({udp, U, IP, Port, Data}, S0) -> Token = ?EBOOT_REQUEST ++ S0#state.version, Valid = member_address(IP, ordsets:to_list(S0#state.slaves)), @@ -207,9 +234,19 @@ handle_info({udp, U, IP, Port, Data}, S0) -> %% erlang version as the boot server node case {Valid,Data,Token} of {true,Token,Token} -> - gen_udp:send(U,IP,Port,[?EBOOT_REPLY,S0#state.priority, - int16(S0#state.listen_port), - S0#state.version]), + case gen_udp:send(U,IP,Port,[?EBOOT_REPLY,S0#state.priority, + int16(S0#state.listen_port), + S0#state.version]) + of + ok -> ok; + {error, not_owner} -> + error_logger:error_msg("** Illegal boot server connection attempt: " + "not owner of ~w ** ~n", [U]); + {error, Reason} -> + Err = file:format_error(Reason), + error_logger:error_msg("** Illegal boot server connection attempt: " + "~w POSIX error ** ~n", [U, Err]) + end, {noreply,S0}; {false,_,_} -> error_logger:error_msg("** Illegal boot server connection attempt: " @@ -230,9 +267,13 @@ handle_info({udp, U, IP, Port, Data}, S0) -> handle_info(_Info, S0) -> {noreply,S0}. +-spec terminate(term(), state()) -> 'ok'. + terminate(_Reason, _S0) -> ok. +-spec code_change(term(), state(), term()) -> {'ok', state()}. + code_change(_Vsn, State, _Extra) -> {ok, State}. @@ -242,6 +283,8 @@ code_change(_Vsn, State, _Extra) -> %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec boot_init(reference()) -> no_return(). + boot_init(Tag) -> receive {Tag, Listen} -> @@ -299,9 +342,13 @@ handle_command(S, PS, Msg) -> send_file_result(S, list_dir, Res), PS2; {read_file_info,File} -> - {Res, PS2} = erl_prim_loader:prim_read_file_info(PS, File), + {Res, PS2} = erl_prim_loader:prim_read_file_info(PS, File, true), send_file_result(S, read_file_info, Res), PS2; + {read_link_info,File} -> + {Res, PS2} = erl_prim_loader:prim_read_file_info(PS, File, false), + send_file_result(S, read_link_info, Res), + PS2; get_cwd -> {Res, PS2} = erl_prim_loader:prim_get_cwd(PS, []), send_file_result(S, get_cwd, Res), @@ -319,7 +366,14 @@ handle_command(S, PS, Msg) -> end. send_file_result(S, Cmd, Result) -> - gen_tcp:send(S, term_to_binary({Cmd,Result})). - -send_result(S, Result) -> - gen_tcp:send(S, term_to_binary(Result)). + send_result(S, {Cmd,Result}). + +send_result(S, Term) -> + case gen_tcp:send(S, term_to_binary(Term)) of + ok -> + ok; + Error -> + error_logger:error_msg("** Boot server could not send result " + "to socket: ~w** ~n", [Error]), + ok + end. diff --git a/lib/kernel/src/erl_ddll.erl b/lib/kernel/src/erl_ddll.erl index 88f91de24f..89a02cc762 100644 --- a/lib/kernel/src/erl_ddll.erl +++ b/lib/kernel/src/erl_ddll.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% %% Dynamic Driver Loader and Linker @@ -29,6 +30,99 @@ %%---------------------------------------------------------------------------- +-type path() :: string() | atom(). +-type driver() :: iolist() | atom(). + +%%---------------------------------------------------------------------------- +%%% BIFs + +-export([demonitor/1, info/2, format_error_int/1, monitor/2, + try_load/3, try_unload/2, loaded_drivers/0]). + +-spec demonitor(MonitorRef) -> ok when + MonitorRef :: reference(). + +demonitor(_) -> + erlang:nif_error(undef). + +-spec info(Name, Tag) -> Value when + Name :: driver(), + Tag :: processes | driver_options | port_count | linked_in_driver + | permanent | awaiting_load | awaiting_unload, + Value :: term(). + +info(_, _) -> + erlang:nif_error(undef). + +-spec format_error_int(ErrSpec) -> string() when + ErrSpec :: term(). + +format_error_int(_) -> + erlang:nif_error(undef). + +-spec monitor(Tag, Item) -> MonitorRef when + Tag :: driver, + Item :: {Name, When}, + Name :: driver(), + When :: loaded | unloaded | unloaded_only, + MonitorRef :: reference(). + +monitor(_, _) -> + erlang:nif_error(undef). + +-spec try_load(Path, Name, OptionList) -> + {ok,Status} | + {ok, PendingStatus, Ref} | + {error, ErrorDesc} when + Path :: path(), + Name :: driver(), + OptionList :: [Option], + Option :: {driver_options, DriverOptionList} + | {monitor, MonitorOption} + | {reload, ReloadOption}, + DriverOptionList :: [DriverOption], + DriverOption :: kill_ports, + MonitorOption :: pending_driver | pending, + ReloadOption :: pending_driver | pending, + Status :: loaded | already_loaded | PendingStatus, + PendingStatus :: pending_driver | pending_process, + Ref :: reference(), + ErrorDesc :: ErrorAtom | OpaqueError, + ErrorAtom :: linked_in_driver | inconsistent | permanent + | not_loaded_by_this_process | not_loaded + | pending_reload | pending_process, + OpaqueError :: term(). + +try_load(_, _, _) -> + erlang:nif_error(undef). + +-spec try_unload(Name, OptionList) -> + {ok, Status} | + {ok, PendingStatus, Ref} | + {error, ErrorAtom} when + Name :: driver(), + OptionList :: [Option], + Option :: {monitor, MonitorOption} | kill_ports, + MonitorOption :: pending_driver | pending, + Status :: unloaded | PendingStatus, + PendingStatus :: pending_driver | pending_process, + Ref :: reference(), + ErrorAtom :: linked_in_driver | not_loaded | + not_loaded_by_this_process | permanent. + +try_unload(_, _) -> + erlang:nif_error(undef). + +-spec loaded_drivers() -> {ok, Drivers} when + Drivers :: [Driver], + Driver :: string(). + +loaded_drivers() -> + erlang:nif_error(undef). + +%%% End of BIFs + + -spec start() -> {'error', {'already_started', 'undefined'}}. start() -> @@ -39,14 +133,18 @@ start() -> stop() -> ok. --spec load_driver(Path :: string() | atom(), Driver :: string() | atom()) -> - 'ok' | {'error', any()}. +-spec load_driver(Path, Name) -> 'ok' | {'error', ErrorDesc} when + Path :: path(), + Name :: driver(), + ErrorDesc :: term(). load_driver(Path, Driver) -> do_load_driver(Path, Driver, [{driver_options,[kill_ports]}]). --spec load(Path :: string() | atom(), Driver :: string() | atom()) -> - 'ok' | {'error', any()}. +-spec load(Path, Name) -> 'ok' | {'error', ErrorDesc} when + Path :: path(), + Name :: driver(), + ErrorDesc ::term(). load(Path, Driver) -> do_load_driver(Path, Driver, []). @@ -95,42 +193,56 @@ do_unload_driver(Driver,Flags) -> end end. --spec unload_driver(Driver :: string() | atom()) -> 'ok' | {'error', any()}. +-spec unload_driver(Name) -> 'ok' | {'error', ErrorDesc} when + Name :: driver(), + ErrorDesc :: term(). unload_driver(Driver) -> do_unload_driver(Driver,[{monitor,pending_driver},kill_ports]). --spec unload(Driver :: string() | atom()) -> 'ok' | {'error', any()}. +-spec unload(Name) -> 'ok' | {'error', ErrorDesc} when + Name :: driver(), + ErrorDesc :: term(). unload(Driver) -> do_unload_driver(Driver,[]). --spec reload(Path :: string() | atom(), Driver :: string() | atom()) -> - 'ok' | {'error', any()}. +-spec reload(Path, Name) -> 'ok' | {'error', ErrorDesc} when + Path :: path(), + Name :: driver(), + ErrorDesc :: pending_process | OpaqueError, + OpaqueError :: term(). reload(Path,Driver) -> do_load_driver(Path, Driver, [{reload,pending_driver}]). --spec reload_driver(Path :: string() | atom(), Driver :: string() | atom()) -> - 'ok' | {'error', any()}. +-spec reload_driver(Path, Name) -> 'ok' | {'error', ErrorDesc} when + Path :: path(), + Name :: driver(), + ErrorDesc :: pending_process | OpaqueError, + OpaqueError :: term(). reload_driver(Path,Driver) -> do_load_driver(Path, Driver, [{reload,pending_driver}, {driver_options,[kill_ports]}]). --spec format_error(Code :: atom()) -> string(). +-spec format_error(ErrorDesc) -> string() when + ErrorDesc :: term(). format_error(Code) -> case Code of - % This is the only error code returned only from erlang code... - % 'permanent' has a translation in the emulator, even though the erlang code uses it to... + %% This is the only error code returned only from erlang code... + %% 'permanent' has a translation in the emulator, even though the erlang code uses it to... load_cancelled -> "Loading was cancelled from other process"; _ -> erl_ddll:format_error_int(Code) end. --spec info(Driver :: string() | atom()) -> [{atom(), any()}]. +-spec info(Name) -> InfoList when + Name :: driver(), + InfoList :: [InfoItem, ...], + InfoItem :: {Tag :: atom(), Value :: term()}. info(Driver) -> [{processes, erl_ddll:info(Driver,processes)}, @@ -141,7 +253,12 @@ info(Driver) -> {awaiting_load, erl_ddll:info(Driver,awaiting_load)}, {awaiting_unload, erl_ddll:info(Driver,awaiting_unload)}]. --spec info() -> [{string(), [{atom(), any()}]}]. +-spec info() -> AllInfoList when + AllInfoList :: [DriverInfo], + DriverInfo :: {DriverName, InfoList}, + DriverName :: string(), + InfoList :: [InfoItem], + InfoItem :: {Tag :: atom(), Value :: term()}. info() -> {ok,DriverList} = erl_ddll:loaded_drivers(), diff --git a/lib/kernel/src/erl_distribution.erl b/lib/kernel/src/erl_distribution.erl index 25ad34357a..0bec78e938 100644 --- a/lib/kernel/src/erl_distribution.erl +++ b/lib/kernel/src/erl_distribution.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,21 +21,47 @@ -behaviour(supervisor). --export([start_link/0,start_link/1,init/1,start/1,stop/0]). +-export([start_link/0,start_link/2,init/1,start/1,stop/0]). -%-define(DBG,io:format("~p:~p~n",[?MODULE,?LINE])). -define(DBG,erlang:display([?MODULE,?LINE])). +%% Called during system start-up. + start_link() -> - case catch start_p() of - {ok,Args} -> - start_link(Args); - _ -> - ignore + do_start_link([{sname,shortnames},{name,longnames}]). + +%% Called from net_kernel:start/1 to start distribution after the +%% system has already started. + +start(Args) -> + C = {net_sup_dynamic, {?MODULE,start_link,[Args,false]}, permanent, + 1000, supervisor, [erl_distribution]}, + supervisor:start_child(kernel_sup, C). + +%% Stop distribution. + +stop() -> + case supervisor:terminate_child(kernel_sup, net_sup_dynamic) of + ok -> + supervisor:delete_child(kernel_sup, net_sup_dynamic); + Error -> + case whereis(net_sup) of + Pid when is_pid(Pid) -> + %% Dist. started through -sname | -name flags + {error, not_allowed}; + _ -> + Error + end end. -start_link(Args) -> - supervisor:start_link({local,net_sup},erl_distribution,Args). +%%% +%%% Internal helper functions. +%%% + +%% Helper start function. + +start_link(Args, CleanHalt) -> + supervisor:start_link({local,net_sup}, ?MODULE, [Args,CleanHalt]). init(NetArgs) -> Epmd = @@ -47,31 +74,20 @@ init(NetArgs) -> permanent,2000,worker,[EpmdMod]}] end, Auth = {auth,{auth,start_link,[]},permanent,2000,worker,[auth]}, - Kernel = {net_kernel,{net_kernel,start_link,[NetArgs]}, + Kernel = {net_kernel,{net_kernel,start_link,NetArgs}, permanent,2000,worker,[net_kernel]}, EarlySpecs = net_kernel:protocol_childspecs(), {ok,{{one_for_all,0,1}, EarlySpecs ++ Epmd ++ [Auth,Kernel]}}. -start_p() -> - sname(), - lname(), - false. - -sname() -> - case init:get_argument(sname) of +do_start_link([{Arg,Flag}|T]) -> + case init:get_argument(Arg) of {ok,[[Name]]} -> - throw({ok,[list_to_atom(Name),shortnames|ticktime()]}); + start_link([list_to_atom(Name),Flag|ticktime()], true); _ -> - false - end. - -lname() -> - case init:get_argument(name) of - {ok,[[Name]]} -> - throw({ok,[list_to_atom(Name),longnames|ticktime()]}); - _ -> - false - end. + do_start_link(T) + end; +do_start_link([]) -> + ignore. ticktime() -> %% catch, in case the system was started with boot file start_old, @@ -84,23 +100,3 @@ ticktime() -> _ -> [] end. - -start(Args) -> - C = {net_sup_dynamic, {erl_distribution, start_link, [Args]}, permanent, - 1000, supervisor, [erl_distribution]}, - supervisor:start_child(kernel_sup, C). - -stop() -> - case supervisor:terminate_child(kernel_sup, net_sup_dynamic) of - ok -> - supervisor:delete_child(kernel_sup, net_sup_dynamic); - Error -> - case whereis(net_sup) of - Pid when is_pid(Pid) -> - %% Dist. started through -sname | -name flags - {error, not_allowed}; - _ -> - Error - end - end. - diff --git a/lib/kernel/src/erl_epmd.erl b/lib/kernel/src/erl_epmd.erl index e4b371836b..7bc9e2ede3 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(erl_epmd). @@ -31,7 +32,7 @@ %% External exports -export([start/0, start_link/0, stop/0, port_please/2, port_please/3, names/0, names/1, - register_node/2, open/0, open/1, open/2]). + register_node/2, register_node/3, open/0, open/1, open/2]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -40,6 +41,7 @@ -import(lists, [reverse/1]). -record(state, {socket, port_no = -1, name = ""}). +-type state() :: #state{}. -include("inet_int.hrl"). -include("erl_epmd.hrl"). @@ -84,42 +86,50 @@ port_please1(Node,HostName, Timeout) -> Else end. -names() -> +names() -> {ok, H} = inet:gethostname(), names(H). -names(HostName) when is_atom(HostName) -> - names1(atom_to_list(HostName)); -names(HostName) when is_list(HostName) -> - names1(HostName); -names(EpmdAddr) -> - get_names(EpmdAddr). - -names1(HostName) -> +names(HostName) when is_atom(HostName); is_list(HostName) -> case inet:gethostbyname(HostName) of {ok,{hostent, _Name, _ , _Af, _Size, [EpmdAddr | _]}} -> get_names(EpmdAddr); Else -> Else - end. + end; +names(EpmdAddr) -> + get_names(EpmdAddr). register_node(Name, PortNo) -> - gen_server:call(erl_epmd, {register, Name, PortNo}, infinity). + register_node(Name, PortNo, inet). +register_node(Name, PortNo, inet_tcp) -> + register_node(Name, PortNo, inet); +register_node(Name, PortNo, inet6_tcp) -> + register_node(Name, PortNo, inet6); +register_node(Name, PortNo, Family) -> + gen_server:call(erl_epmd, {register, Name, PortNo, Family}, infinity). %%%---------------------------------------------------------------------- %%% Callback functions from gen_server %%%---------------------------------------------------------------------- +-spec init(_) -> {'ok', state()}. + init(_) -> {ok, #state{socket = -1}}. %%---------------------------------------------------------------------- -handle_call({register, Name, PortNo}, _From, State) -> +-type calls() :: 'client_info_req' | 'stop' | {'register', term(), term()}. + +-spec handle_call(calls(), term(), state()) -> + {'reply', term(), state()} | {'stop', 'shutdown', 'ok', state()}. + +handle_call({register, Name, PortNo, Family}, _From, State) -> case State#state.socket of P when P < 0 -> - case do_register_node(Name, PortNo) of + case do_register_node(Name, PortNo, Family) of {alive, Socket, Creation} -> S = State#state{socket = Socket, port_no = PortNo, @@ -133,19 +143,23 @@ handle_call({register, Name, PortNo}, _From, State) -> end; handle_call(client_info_req, _From, State) -> - Reply = {ok,{r4,State#state.name,State#state.port_no}}, - {reply,Reply,State}; + Reply = {ok,{r4,State#state.name,State#state.port_no}}, + {reply, Reply, State}; handle_call(stop, _From, State) -> {stop, shutdown, ok, State}. %%---------------------------------------------------------------------- +-spec handle_cast(term(), state()) -> {'noreply', state()}. + handle_cast(_, State) -> {noreply, State}. %%---------------------------------------------------------------------- +-spec handle_info(term(), state()) -> {'noreply', state()}. + handle_info({tcp_closed, Socket}, State) when State#state.socket =:= Socket -> {noreply, State#state{socket = -1}}; handle_info(_, State) -> @@ -153,6 +167,8 @@ handle_info(_, State) -> %%---------------------------------------------------------------------- +-spec terminate(term(), state()) -> 'ok'. + terminate(_, #state{socket = Socket}) when Socket > 0 -> close(Socket), ok; @@ -161,6 +177,8 @@ terminate(_, _) -> %%---------------------------------------------------------------------- +-spec code_change(term(), state(), term()) -> {'ok', state()}. + code_change(_OldVsn, State, _Extra) -> {ok, State}. @@ -194,44 +212,34 @@ open({A,B,C,D,E,F,G,H}=EpmdAddr, Timeout) when ?ip6(A,B,C,D,E,F,G,H) -> close(Socket) -> gen_tcp:close(Socket). - -do_register_node_v0(NodeName, TcpPort) -> - case open() of - {ok, Socket} -> - Name = cstring(NodeName), - Len = 1+2+length(Name), - gen_tcp:send(Socket, [?int16(Len), ?EPMD_ALIVE, - ?int16(TcpPort), Name]), - wait_for_reg_reply_v0(Socket, []); - Error -> - Error - end. - -do_register_node(NodeName, TcpPort) -> - case open() of +do_register_node(NodeName, TcpPort, Family) -> + Localhost = case Family of + inet -> open({127,0,0,1}); + inet6 -> open({0,0,0,0,0,0,0,1}) + end, + case Localhost of {ok, Socket} -> Name = to_string(NodeName), Extra = "", Elen = length(Extra), Len = 1+2+1+1+2+2+2+length(Name)+2+Elen, - gen_tcp:send(Socket, [?int16(Len), ?EPMD_ALIVE2_REQ, - ?int16(TcpPort), - $M, - 0, - ?int16(epmd_dist_high()), - ?int16(epmd_dist_low()), - ?int16(length(Name)), - Name, - ?int16(Elen), - Extra]), - case wait_for_reg_reply(Socket, []) of - {error, epmd_close} -> - %% could be old epmd; try old protocol -% erlang:display('trying old'), - do_register_node_v0(NodeName, TcpPort); - Other -> - Other - end; + Packet = [?int16(Len), ?EPMD_ALIVE2_REQ, + ?int16(TcpPort), + $M, + 0, + ?int16(epmd_dist_high()), + ?int16(epmd_dist_low()), + ?int16(length(Name)), + Name, + ?int16(Elen), + Extra], + case gen_tcp:send(Socket, Packet) of + ok -> + wait_for_reg_reply(Socket, []); + Error -> + close(Socket), + Error + end; Error -> Error end. @@ -289,82 +297,28 @@ wait_for_reg_reply(Socket, SoFar) -> {error, no_reg_reply_from_epmd} end. -wait_for_reg_reply_v0(Socket, SoFar) -> - receive - {tcp, Socket, Data0} -> - case SoFar ++ Data0 of - [$Y, A, B] -> - {alive, Socket, ?u16(A, B)}; - Data when length(Data) < 3 -> - wait_for_reg_reply(Socket, Data); - Garbage -> - {error, {garbage_from_epmd, Garbage}} - end; - {tcp_closed, Socket} -> - {error, duplicate_name} % A guess -- the most likely reason. - after 10000 -> - gen_tcp:close(Socket), - {error, no_reg_reply_from_epmd} - end. %% %% Lookup a node "Name" at Host %% -get_port_v0(Node, EpmdAddress) -> - case open(EpmdAddress) of - {ok, Socket} -> - Name = cstring(Node), - Len = 1+length(Name), - gen_tcp:send(Socket, [?int16(Len),?EPMD_PORT_PLEASE, Name]), - wait_for_port_reply_v0(Socket, []); - _Error -> - ?port_please_failure(), - noport - end. - -%%% Not used anymore -%%% get_port(Node, EpmdAddress) -> -%%% get_port(Node, EpmdAddress, infinity). get_port(Node, EpmdAddress, Timeout) -> case open(EpmdAddress, Timeout) of {ok, Socket} -> Name = to_string(Node), Len = 1+length(Name), - gen_tcp:send(Socket, [?int16(Len),?EPMD_PORT_PLEASE2_REQ, Name]), - Reply = wait_for_port_reply(Socket, []), - case Reply of - closed -> - get_port_v0(Node, EpmdAddress); - Other -> - Other + Msg = [?int16(Len),?EPMD_PORT_PLEASE2_REQ,Name], + case gen_tcp:send(Socket, Msg) of + ok -> + wait_for_port_reply(Socket, []); + _Error -> + ?port_please_failure2(_Error), + noport end; _Error -> ?port_please_failure2(_Error), noport end. -wait_for_port_reply_v0(Socket, SoFar) -> - receive - {tcp, Socket, Data0} -> -% io:format("got ~p~n", [Data0]), - case SoFar ++ Data0 of - [A, B] -> - wait_for_close(Socket, {port, ?u16(A, B), 0}); -% wait_for_close(Socket, {port, ?u16(A, B)}); - Data when length(Data) < 2 -> - wait_for_port_reply_v0(Socket, Data); - Garbage -> - ?port_please_failure(), - {error, {garbage_from_epmd, Garbage}} - end; - {tcp_closed, Socket} -> - ?port_please_failure(), - noport - after 10000 -> - ?port_please_failure(), - gen_tcp:close(Socket), - noport - end. wait_for_port_reply(Socket, SoFar) -> receive @@ -438,7 +392,7 @@ wait_for_port_reply_name(Socket, Len, Sofar) -> % io:format("data = ~p~n", _Data), wait_for_port_reply_name(Socket, Len, Sofar); {tcp_closed, Socket} -> - "foobar" + ok end. @@ -453,8 +407,6 @@ select_best_version(L1, _H1, _L2, H2) when L1 > H2 -> 0; select_best_version(_L1, H1, L2, _H2) when L2 > H1 -> 0; -select_best_version(_L1, H1, L2, _H2) when L2 > H1 -> - 0; select_best_version(_L1, H1, _L2, H2) -> erlang:min(H1, H2). @@ -471,8 +423,6 @@ wait_for_close(Socket, Reply) -> %% %% Creates a (flat) null terminated string from atom or list. %% -cstring(S) when is_atom(S) -> cstring(atom_to_list(S)); -cstring(S) when is_list(S) -> S ++ [0]. to_string(S) when is_atom(S) -> atom_to_list(S); to_string(S) when is_list(S) -> S. @@ -490,19 +440,24 @@ get_names(EpmdAddress) -> end. do_get_names(Socket) -> - gen_tcp:send(Socket, [?int16(1),?EPMD_NAMES]), - receive - {tcp, Socket, [P0,P1,P2,P3|T]} -> - EpmdPort = ?u32(P0,P1,P2,P3), - case get_epmd_port() of - EpmdPort -> - names_loop(Socket, T, []); - _ -> - close(Socket), - {error, address} + case gen_tcp:send(Socket, [?int16(1),?EPMD_NAMES]) of + ok -> + receive + {tcp, Socket, [P0,P1,P2,P3|T]} -> + EpmdPort = ?u32(P0,P1,P2,P3), + case get_epmd_port() of + EpmdPort -> + names_loop(Socket, T, []); + _ -> + close(Socket), + {error, address} + end; + {tcp_closed, Socket} -> + {ok, []} end; - {tcp_closed, Socket} -> - {ok, []} + _ -> + close(Socket), + {error, address} end. names_loop(Socket, Acc, Ps) -> diff --git a/lib/kernel/src/erl_epmd.hrl b/lib/kernel/src/erl_epmd.hrl index 47ab6195d8..3efcc81b55 100644 --- a/lib/kernel/src/erl_epmd.hrl +++ b/lib/kernel/src/erl_epmd.hrl @@ -1,32 +1,30 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% --define(EPMD_ALIVE, $a). --define(EPMD_PORT_PLEASE, $p). --define(EPMD_NAMES, $n). --define(EPMD_DUMP, $d). --define(EPMD_KILL, $k). --define(EPMD_STOP, $s). - --define(EPMD_ALIVE_OK, $Y). - -define(EPMD_ALIVE2_REQ, $x). -define(EPMD_PORT_PLEASE2_REQ, $z). -define(EPMD_ALIVE2_RESP, $y). -define(EPMD_PORT2_RESP, $w). +-define(EPMD_NAMES, $n). + +%% Commands used only by interactive client +-define(EPMD_DUMP, $d). +-define(EPMD_KILL, $k). +-define(EPMD_STOP, $s). diff --git a/lib/kernel/src/erl_reply.erl b/lib/kernel/src/erl_reply.erl index 1a61e630bc..e1e046cbb4 100644 --- a/lib/kernel/src/erl_reply.erl +++ b/lib/kernel/src/erl_reply.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -32,7 +33,7 @@ reply([Addr,Port,Msg]) -> P = list_to_integer(atom_to_list(Port)), M = atom_to_list(Msg), {ok, S} = gen_tcp:connect(Ip,P,[]), - gen_tcp:send(S,M), + ok = gen_tcp:send(S,M), gen_tcp:close(S), reply_done; reply(_) -> diff --git a/lib/kernel/src/error_handler.erl b/lib/kernel/src/error_handler.erl index 5f2507fc08..59ca8e690d 100644 --- a/lib/kernel/src/error_handler.erl +++ b/lib/kernel/src/error_handler.erl @@ -1,30 +1,41 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(error_handler). +%% FIXME: remove no_native directive after HiPE has been changed to make +%% remote calls link to the target's Export* like BEAM does. +%% For a detailed explanation see the commit titled +%% "error_handler: add no_native compiler directive" +-compile(no_native). -%% A simple error handler. +%% Callbacks called from the run-time system. +-export([undefined_function/3,undefined_lambda/3,breakpoint/3]). --export([undefined_function/3, undefined_lambda/3, stub_function/3, - breakpoint/3]). +%% Exported utility functions. +-export([raise_undef_exception/3]). +-export([stub_function/3]). --spec undefined_function(Module :: atom(), Function :: atom(), Args :: [_]) -> - any(). +-spec undefined_function(Module, Function, Args) -> + any() when + Module :: atom(), + Function :: atom(), + Args :: list(). undefined_function(Module, Func, Args) -> case ensure_loaded(Module) of @@ -33,12 +44,7 @@ undefined_function(Module, Func, Args) -> true -> apply(Module, Func, Args); false -> - case check_inheritance(Module, Args) of - {value, Base, Args1} -> - apply(Base, Func, Args1); - none -> - crash(Module, Func, Args) - end + call_undefined_function_handler(Module, Func, Args) end; {module, _} -> crash(Module, Func, Args); @@ -46,8 +52,10 @@ undefined_function(Module, Func, Args) -> crash(Module, Func, Args) end. --spec undefined_lambda(Module :: atom(), Function :: fun(), Args :: [_]) -> - any(). +-spec undefined_lambda(Module, Fun, Args) -> term() when + Module :: atom(), + Fun :: fun(), + Args :: list(). undefined_lambda(Module, Fun, Args) -> case ensure_loaded(Module) of @@ -67,6 +75,14 @@ undefined_lambda(Module, Fun, Args) -> breakpoint(Module, Func, Args) -> (int()):eval(Module, Func, Args). +-spec raise_undef_exception(Module, Function, Args) -> no_return() when + Module :: atom(), + Function :: atom(), + Args :: list(). + +raise_undef_exception(Module, Func, Args) -> + crash({Module,Func,Args,[]}). + %% Used to make the call to the 'int' module a "weak" one, to avoid %% building strong components in xref or dialyzer. @@ -75,11 +91,15 @@ int() -> int. %% %% Crash providing a beautiful stack backtrace. %% +-spec crash(atom(), [term()]) -> no_return(). + crash(Fun, Args) -> - crash({Fun,Args}). + crash({Fun,Args,[]}). + +-spec crash(atom(), atom(), arity() | [term()]) -> no_return(). crash(M, F, A) -> - crash({M,F,A}). + crash({M,F,A,[]}). -spec crash(tuple()) -> no_return(). @@ -87,7 +107,8 @@ crash(Tuple) -> try erlang:error(undef) catch error:undef -> - erlang:raise(error, undef, [Tuple|tl(erlang:get_stacktrace())]) + Stk = [Tuple|tl(erlang:get_stacktrace())], + erlang:raise(error, undef, Stk) end. %% If the code_server has not been started yet dynamic code loading @@ -113,29 +134,13 @@ ensure_loaded(Module) -> -spec stub_function(atom(), atom(), [_]) -> no_return(). stub_function(Mod, Func, Args) -> - exit({undef,[{Mod,Func,Args}]}). - -check_inheritance(Module, Args) -> - Attrs = erlang:get_module_info(Module, attributes), - case lists:keysearch(extends, 1, Attrs) of - {value,{extends,[Base]}} when is_atom(Base), Base =/= Module -> - %% This is just a heuristic for detecting abstract modules - %% with inheritance so they can be handled; it would be - %% much better to do it in the emulator runtime - case lists:keysearch(abstract, 1, Attrs) of - {value,{abstract,[true]}} -> - case lists:reverse(Args) of - [M|Rs] when tuple_size(M) > 1, - element(1,M) =:= Module, - tuple_size(element(2,M)) > 0, - is_atom(element(1,element(2,M))) -> - {value, Base, lists:reverse(Rs, [element(2,M)])}; - _ -> - {value, Base, Args} - end; - _ -> - {value, Base, Args} - end; - _ -> - none + exit({undef,[{Mod,Func,Args,[]}]}). + +call_undefined_function_handler(Module, Func, Args) -> + Handler = '$handle_undefined_function', + case erlang:function_exported(Module, Handler, 2) of + false -> + crash(Module, Func, Args); + true -> + Module:Handler(Func, Args) end. diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index cafdc52e84..3ee8e2c6e6 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -42,6 +43,18 @@ -type state() :: {non_neg_integer(), non_neg_integer(), [term()]}. +%%% BIF + +-export([warning_map/0]). + +-spec warning_map() -> Tag when + Tag :: error | warning | info. + +warning_map() -> + erlang:nif_error(undef). + +%%% End of BIF + %%----------------------------------------------------------------- -spec start() -> {'ok', pid()} | {'error', any()}. @@ -69,17 +82,22 @@ start_link() -> %% Used for simple messages; error or information. %%----------------------------------------------------------------- --spec error_msg(Format :: string()) -> 'ok'. +-spec error_msg(Format) -> 'ok' when + Format :: string(). error_msg(Format) -> error_msg(Format,[]). --spec error_msg(Format :: string(), Args :: list()) -> 'ok'. +-spec error_msg(Format, Data) -> 'ok' when + Format :: string(), + Data :: list(). error_msg(Format, Args) -> notify({error, group_leader(), {self(), Format, Args}}). --spec format(Format :: string(), Args :: list()) -> 'ok'. +-spec format(Format, Data) -> 'ok' when + Format :: string(), + Data :: list(). format(Format, Args) -> notify({error, group_leader(), {self(), Format, Args}}). @@ -90,12 +108,18 @@ format(Format, Args) -> %% The 'std_error' error_report type can always be used. %%----------------------------------------------------------------- --spec error_report(Report :: any()) -> 'ok'. +-type report() :: + [{Tag :: term(), Data :: term()} | term()] | string() | term(). + +-spec error_report(Report) -> 'ok' when + Report :: report(). error_report(Report) -> error_report(std_error, Report). --spec error_report(Type :: any(), Report :: any()) -> 'ok'. +-spec error_report(Type, Report) -> 'ok' when + Type :: term(), + Report :: report(). error_report(Type, Report) -> notify({error_report, group_leader(), {self(), Type, Report}}). @@ -109,12 +133,15 @@ error_report(Type, Report) -> %% mapped to std_info or std_error accordingly. %%----------------------------------------------------------------- --spec warning_report(Report :: any()) -> 'ok'. +-spec warning_report(Report) -> 'ok' when + Report :: report(). warning_report(Report) -> warning_report(std_warning, Report). --spec warning_report(Type :: any(), Report :: any()) -> 'ok'. +-spec warning_report(Type, Report) -> 'ok' when + Type :: any(), + Report :: report(). warning_report(Type, Report) -> {Tag, NType} = case error_logger:warning_map() of @@ -143,12 +170,15 @@ warning_report(Type, Report) -> %% other types of reports. %%----------------------------------------------------------------- --spec warning_msg(Format :: string()) -> 'ok'. +-spec warning_msg(Format) -> 'ok' when + Format :: string(). warning_msg(Format) -> warning_msg(Format,[]). --spec warning_msg(Format :: string(), Args :: list()) -> 'ok'. +-spec warning_msg(Format, Data) -> 'ok' when + Format :: string(), + Data :: list(). warning_msg(Format, Args) -> Tag = case error_logger:warning_map() of @@ -167,12 +197,15 @@ warning_msg(Format, Args) -> %% The 'std_info' info_report type can always be used. %%----------------------------------------------------------------- --spec info_report(Report :: any()) -> 'ok'. +-spec info_report(Report) -> 'ok' when + Report :: report(). info_report(Report) -> info_report(std_info, Report). --spec info_report(Type :: any(), Report :: any()) -> 'ok'. +-spec info_report(Type, Report) -> 'ok' when + Type :: any(), + Report :: report(). info_report(Type, Report) -> notify({info_report, group_leader(), {self(), Type, Report}}). @@ -182,12 +215,15 @@ info_report(Type, Report) -> %% information messages. %%----------------------------------------------------------------- --spec info_msg(Format :: string()) -> 'ok'. +-spec info_msg(Format) -> 'ok' when + Format :: string(). info_msg(Format) -> info_msg(Format,[]). --spec info_msg(Format :: string(), Args :: list()) -> 'ok'. +-spec info_msg(Format, Data) -> 'ok' when + Format :: string(), + Data :: list(). info_msg(Format, Args) -> notify({info_msg, group_leader(), {self(), Format, Args}}). @@ -210,30 +246,38 @@ notify(Msg) -> -spec swap_handler(Type :: swap_handler_type()) -> any(). swap_handler(tty) -> - gen_event:swap_handler(error_logger, {error_logger, swap}, - {error_logger_tty_h, []}), - simple_logger(); + R = gen_event:swap_handler(error_logger, {error_logger, swap}, + {error_logger_tty_h, []}), + ok = simple_logger(), + R; swap_handler({logfile, File}) -> - gen_event:swap_handler(error_logger, {error_logger, swap}, - {error_logger_file_h, File}), - simple_logger(); + R = gen_event:swap_handler(error_logger, {error_logger, swap}, + {error_logger_file_h, File}), + ok = simple_logger(), + R; swap_handler(silent) -> - gen_event:delete_handler(error_logger, error_logger, delete), - simple_logger(); + _ = gen_event:delete_handler(error_logger, error_logger, delete), + ok = simple_logger(); swap_handler(false) -> ok. % keep primitive event handler as-is --spec add_report_handler(Module :: atom()) -> any(). +-spec add_report_handler(Handler) -> any() when + Handler :: module(). add_report_handler(Module) when is_atom(Module) -> gen_event:add_handler(error_logger, Module, []). --spec add_report_handler(atom(), any()) -> any(). +-spec add_report_handler(Handler, Args) -> Result when + Handler :: module(), + Args :: gen_event:handler_args(), + Result :: gen_event:add_handler_ret(). add_report_handler(Module, Args) when is_atom(Module) -> gen_event:add_handler(error_logger, Module, Args). --spec delete_report_handler(Module :: atom()) -> any(). +-spec delete_report_handler(Handler) -> Result when + Handler :: module(), + Result :: gen_event:del_handler_ret(). delete_report_handler(Module) when is_atom(Module) -> gen_event:delete_handler(error_logger, Module, []). @@ -250,9 +294,16 @@ simple_logger() -> %% Log all errors to File for all eternity --spec logfile(Request :: {'open', string()}) -> 'ok' | {'error',any()} - ; (Request :: 'close') -> 'ok' | {'error', any()} - ; (Request :: 'filename') -> atom() | string() | {'error', any()}. +-type open_error() :: file:posix() | badarg | system_limit. + +-spec logfile(Request :: {open, Filename}) -> ok | {error, OpenReason} when + Filename ::file:name(), + OpenReason :: allready_have_logfile | open_error() + ; (Request :: close) -> ok | {error, CloseReason} when + CloseReason :: module_not_found + ; (Request :: filename) -> Filename | {error, FilenameReason} when + Filename :: file:name(), + FilenameReason :: no_log_file. logfile({open, File}) -> case lists:member(error_logger_file_h, @@ -280,7 +331,8 @@ logfile(filename) -> %% Possibly turn off all tty printouts, maybe we only want the errors %% to go to a file --spec tty(Flag :: boolean()) -> 'ok'. +-spec tty(Flag) -> 'ok' when + Flag :: boolean(). tty(true) -> Hs = gen_event:which_handlers(error_logger), @@ -308,8 +360,12 @@ init(Max) when is_integer(Max) -> %% go back. init({go_back, _PostState}) -> {ok, {?buffer_size, 0, []}}; -init(_) -> %% Start and just relay to other - {ok, []}. %% node if node(GLeader) =/= node(). +init(_) -> + %% The error logger process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + process_flag(message_queue_data, off_heap), + {ok, []}. -spec handle_event(term(), state()) -> {'ok', state()}. @@ -383,5 +439,82 @@ add_node(X, Pid) -> %% Can't do io_lib:format -display2(Tag,F,A) -> - erlang:display({error_logger,Tag,F,A}). +display2({{_Y,_Mo,_D},{_H,_Mi,_S}} = Date, F, A) -> + display_date(Date), + display3(string_p(F), F, A). + +display_date({{Y,Mo,D},{H,Mi,S}}) -> + erlang:display_string( + integer_to_list(Y) ++ "-" ++ + two_digits(Mo) ++ "-" ++ + two_digits(D) ++ " " ++ + two_digits(H) ++ ":" ++ + two_digits(Mi) ++ ":" ++ + two_digits(S) ++ " "). + +two_digits(N) when 0 =< N, N =< 9 -> + [$0, $0 + N]; +two_digits(N) -> + integer_to_list(N). + +display3(true, F, A) -> + %% Format string with arguments + erlang:display_string(F ++ "\n"), + [begin + erlang:display_string("\t"), + erlang:display(Arg) + end || Arg <- A], + ok; +display3(false, Atom, A) when is_atom(Atom) -> + %% The widest atom seems to be 'supervisor_report' at 17. + ColumnWidth = 20, + AtomString = atom_to_list(Atom), + AtomLength = length(AtomString), + Padding = lists:duplicate(ColumnWidth - AtomLength, $\s), + erlang:display_string(AtomString ++ Padding), + display4(A); +display3(_, F, A) -> + erlang:display({F, A}). + +display4([A, []]) -> + %% Not sure why crash reports look like this. + display4(A); +display4(A = [_|_]) -> + case lists:all(fun({Key,_Value}) -> is_atom(Key); (_) -> false end, A) of + true -> + erlang:display_string("\n"), + lists:foreach( + fun({Key, Value}) -> + erlang:display_string( + " " ++ + atom_to_list(Key) ++ + ": "), + erlang:display(Value) + end, A); + false -> + erlang:display(A) + end; +display4(A) -> + erlang:display(A). + +string_p([]) -> + false; +string_p(Term) -> + string_p1(Term). + +string_p1([H|T]) when is_integer(H), H >= $\s, H < 255 -> + string_p1(T); +string_p1([$\n|T]) -> string_p1(T); +string_p1([$\r|T]) -> string_p1(T); +string_p1([$\t|T]) -> string_p1(T); +string_p1([$\v|T]) -> string_p1(T); +string_p1([$\b|T]) -> string_p1(T); +string_p1([$\f|T]) -> string_p1(T); +string_p1([$\e|T]) -> string_p1(T); +string_p1([H|T]) when is_list(H) -> + case string_p1(H) of + true -> string_p1(T); + _ -> false + end; +string_p1([]) -> true; +string_p1(_) -> false. diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl index 7d6a5ade94..7b3f1e313a 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,7 +21,7 @@ %% Low-level debugging support. EXPERIMENTAL! --export([size/1,df/1,df/2,df/3]). +-export([size/1,df/1,df/2,df/3,ic/1]). %% This module contains the following *experimental* BIFs: %% disassemble/1 @@ -28,6 +29,161 @@ %% same/2 %% flat_size/1 +%%% BIFs + +-export([breakpoint/2, disassemble/1, display/1, dist_ext_to_term/2, + dump_monitors/1, dump_links/1, flat_size/1, + get_internal_state/1, instructions/0, lock_counters/1, + map_info/1, same/2, set_internal_state/2, + size_shared/1, copy_shared/1]). + +-spec breakpoint(MFA, Flag) -> non_neg_integer() when + MFA :: {Module :: module(), + Function :: atom(), + Arity :: arity() | '_'}, + Flag :: boolean(). + +breakpoint(_, _) -> + erlang:nif_error(undef). + +-spec disassemble(What) -> false | undef | Result when + What :: MFA | Address, + Result :: {Address, Code, MFA}, + MFA :: mfa(), + Address :: non_neg_integer(), + Code :: binary(). + +disassemble(_) -> + erlang:nif_error(undef). + +-spec display(Term) -> string() when + Term :: term(). + +display(_) -> + erlang:nif_error(undef). + +-spec dist_ext_to_term(Tuple, Binary) -> term() when + Tuple :: tuple(), + Binary :: binary(). + +dist_ext_to_term(_, _) -> + erlang:nif_error(undef). + +-spec dump_monitors(Id) -> true when + Id :: pid() | atom(). + +dump_monitors(_) -> + erlang:nif_error(undef). + +-spec dump_links(Id) -> true when + Id :: pid() | port() | atom(). + +dump_links(_) -> + erlang:nif_error(undef). + +-spec flat_size(Term) -> non_neg_integer() when + Term :: term(). + +flat_size(_) -> + erlang:nif_error(undef). + +-spec size_shared(Term) -> non_neg_integer() when + Term :: term(). + +size_shared(_) -> + erlang:nif_error(undef). + +-spec copy_shared(Term) -> term() when + Term :: term(). + +copy_shared(_) -> + erlang:nif_error(undef). + +-spec get_internal_state(W) -> term() when + W :: reds_left | node_and_dist_references | monitoring_nodes + | next_pid | 'DbTable_words' | check_io_debug + | process_info_args | processes | processes_bif_info + | max_atom_out_cache_index | nbalance | available_internal_state + | force_heap_frags | memory + | {process_status, pid()} + | {link_list, pid() | port() | node()} + | {monitor_list, pid() | node()} + | {channel_number, non_neg_integer()} + | {have_pending_exit, pid() | port() | atom()} + | {binary_info, binary()} + | {term_to_binary_no_funs, term()} + | {dist_port, port()} + | {atom_out_cache_index, atom()} + | {fake_scheduler_bindings, + default_bind | spread | processor_spread | thread_spread + | thread_no_node_processor_spread | no_node_processor_spread + | no_node_thread_spread | no_spread | unbound} + | {reader_groups_map, non_neg_integer()}. + +get_internal_state(_) -> + erlang:nif_error(undef). + +-spec instructions() -> [string()]. + +instructions() -> + erlang:nif_error(undef). + +-spec ic(F) -> Result when + F :: function(), + Result :: term(). + +ic(F) when is_function(F) -> + Is0 = erlang:system_info(instruction_counts), + R = F(), + Is1 = erlang:system_info(instruction_counts), + Is = lists:keysort(2,[{I,C1 - C0}||{{I,C1},{I,C0}} <- lists:zip(Is1,Is0)]), + _ = [io:format("~12w ~w~n", [C,I])||{I,C}<-Is], + io:format("Total: ~w~n",[lists:sum([C||{_I,C}<-Is])]), + R. + +-spec lock_counters(info) -> term(); + (clear) -> ok; + ({copy_save, boolean()}) -> boolean(); + ({process_locks, boolean()}) -> boolean(). + +lock_counters(_) -> + erlang:nif_error(undef). + +-spec same(Term1, Term2) -> boolean() when + Term1 :: term(), + Term2 :: term(). + +same(_, _) -> + erlang:nif_error(undef). + +-spec set_internal_state(available_internal_state, boolean()) -> boolean(); + (reds_left, non_neg_integer()) -> true; + (block, non_neg_integer()) -> true; + (sleep, non_neg_integer()) -> true; + (block_scheduler, non_neg_integer()) -> true; + (next_pid, non_neg_integer()) -> false | integer(); + (force_gc, pid() | atom()) -> boolean(); + (send_fake_exit_signal, {pid() | port(), pid(), term()}) -> dead | message | unaffected | exit; + (colliding_names, {atom(), non_neg_integer()}) -> + [atom()]; + (binary_loop_limit, default) -> -1; + (binary_loop_limit, non_neg_integer()) -> non_neg_integer(); + (re_loop_limit, default) -> -1; + (re_loop_limit, non_neg_integer()) -> non_neg_integer(); + (unicode_loop_limit, default) -> -1; + (unicode_loop_limit, non_neg_integer()) -> non_neg_integer(); + (hipe_test_reschedule_suspend, term()) -> nil(); + (hipe_test_reschedule_resume, pid() | port()) -> boolean(); + (test_long_gc_sleep, non_neg_integer()) -> true; + (kill_dist_connection, port()) -> boolean(); + (not_running_optimization, boolean()) -> boolean(); + (wait, deallocations) -> ok. + +set_internal_state(_, _) -> + erlang:nif_error(undef). + +%%% End of BIFs + %% size(Term) %% Returns the size of Term in actual heap words. Shared subterms are %% counted once. Example: If A = [a,b], B =[A,A] then size(B) returns 8, @@ -35,8 +191,10 @@ -spec size(term()) -> non_neg_integer(). +-record(s, {seen, maps}). + size(Term) -> - {Sum,_} = size(Term, gb_trees:empty(), 0), + {Sum,_} = size(Term, #s{seen=gb_trees:empty(),maps=[]}, 0), Sum. size([H|T]=Term, Seen0, Sum0) -> @@ -53,6 +211,16 @@ size(Tuple, Seen0, Sum0) when is_tuple(Tuple) -> Sum = Sum0 + 1 + tuple_size(Tuple), tuple_size(1, tuple_size(Tuple), Tuple, Seen, Sum) end; +size(Map, Seen0, Sum) when is_map(Map) -> + case remember_term(Map, Seen0) of + seen -> {Sum,Seen0}; + Seen -> map_size(Map, Seen, Sum) + end; +size(Fun, Seen0, Sum) when is_function(Fun) -> + case remember_term(Fun, Seen0) of + seen -> {Sum,Seen0}; + Seen -> fun_size(Fun, Seen, Sum) + end; size(Term, Seen0, Sum) -> case erts_debug:flat_size(Term) of 0 -> {Sum,Seen0}; @@ -68,14 +236,54 @@ tuple_size(I, Sz, _, Seen, Sum) when I > Sz -> tuple_size(I, Sz, Tuple, Seen0, Sum0) -> {Sum,Seen} = size(element(I, Tuple), Seen0, Sum0), tuple_size(I+1, Sz, Tuple, Seen, Sum). - -remember_term(Term, Seen) -> - case gb_trees:lookup(Term, Seen) of - none -> gb_trees:insert(Term, [Term], Seen); + +map_size(Map,Seen0,Sum0) -> + %% Danger: + %% The internal nodes from erts_internal:map_hashmap_children/1 + %% is not allowed to leak anywhere. They are only allowed in + %% containers (cons cells and tuples, not maps), in gc and + %% in erts_debug:same/2 + case erts_internal:term_type(Map) of + flatmap -> + Kt = erts_internal:map_to_tuple_keys(Map), + Vs = maps:values(Map), + {Sum1,Seen1} = size(Kt,Seen0,Sum0), + fold_size(Vs,Seen1,Sum1+length(Vs)+3); + hashmap -> + Cs = erts_internal:map_hashmap_children(Map), + fold_size(Cs,Seen0,Sum0+length(Cs)+2); + hashmap_node -> + Cs = erts_internal:map_hashmap_children(Map), + fold_size(Cs,Seen0,Sum0+length(Cs)+1) + end. + +fun_size(Fun, Seen, Sum) -> + case erlang:fun_info(Fun, type) of + {type,external} -> + {Sum + erts_debug:flat_size(Fun),Seen}; + {type,local} -> + Sz = erts_debug:flat_size(fun() -> ok end), + {env,Env} = erlang:fun_info(Fun, env), + fold_size(Env, Seen, Sum+Sz+length(Env)) + end. + +fold_size([H|T], Seen0, Sum0) -> + {Sum,Seen} = size(H, Seen0, Sum0), + fold_size(T, Seen, Sum); +fold_size([], Seen, Sum) -> {Sum,Seen}. + +remember_term(Term, #s{maps=Ms}=S) when is_map(Term) -> + case is_term_seen(Term, Ms) of + false -> S#s{maps=[Term|Ms]}; + true -> seen + end; +remember_term(Term, #s{seen=T}=S) -> + case gb_trees:lookup(Term,T) of + none -> S#s{seen=gb_trees:insert(Term,[Term],T)}; {value,Terms} -> case is_term_seen(Term, Terms) of - false -> gb_trees:update(Term, [Term|Terms], Seen); - true -> seen + false -> S#s{seen=gb_trees:update(Term,[Term|Terms],T)}; + true -> seen end end. @@ -139,7 +347,7 @@ dff(Name, Fs) when is_list(Name) -> try dff(F, Fs) after - file:close(F) + _ = file:close(F) end; {error,Reason} -> {error,{badopen,Reason}} @@ -153,3 +361,9 @@ cont_dis(File, {Addr,Str,MFA}, MFA) -> io:put_chars(File, binary_to_list(Str)), cont_dis(File, erts_debug:disassemble(Addr), MFA); cont_dis(_, {_,_,_}, _) -> ok. + +-spec map_info(Map) -> list() when + Map :: map(). + +map_info(_) -> + erlang:nif_error(undef). diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index a42771dfb6..6d94f7770f 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,20 +28,22 @@ -export([format_error/1]). %% File system and metadata. -export([get_cwd/0, get_cwd/1, set_cwd/1, delete/1, rename/2, - make_dir/1, del_dir/1, list_dir/1, - read_file_info/1, write_file_info/2, + make_dir/1, del_dir/1, list_dir/1, list_dir_all/1, + read_file_info/1, read_file_info/2, + write_file_info/2, write_file_info/3, altname/1, - read_link_info/1, read_link/1, + read_link_info/1, read_link_info/2, + read_link/1, read_link_all/1, make_link/2, make_symlink/2, read_file/1, write_file/2, write_file/3]). %% Specialized -export([ipread_s32bu_p32bu/3]). %% Generic file contents. --export([open/2, close/1, +-export([open/2, close/1, advise/4, allocate/3, read/2, write/2, pread/2, pread/3, pwrite/2, pwrite/3, read_line/1, - position/2, truncate/1, sync/1, + position/2, truncate/1, datasync/1, sync/1, copy/2, copy/3]). %% High level operations -export([consult/1, path_consult/2]). @@ -51,6 +54,9 @@ -export([pid2name/1]). +%% Sendfile functions +-export([sendfile/2,sendfile/5]). + %%% Obsolete exported functions -export([raw_read_file_info/1, raw_write_file_info/2]). @@ -61,6 +67,9 @@ -export([ipread_s32bu_p32bu_int/3]). +%% Types that can be used from other modules -- alphabetically ordered. +-export_type([date_time/0, fd/0, file_info/0, filename/0, filename_all/0, + io_device/0, name/0, name_all/0, posix/0]). %%% Includes and defines -include("file.hrl"). @@ -73,21 +82,59 @@ %% data types -type filename() :: string(). +-type filename_all() :: string() | binary(). -type file_info() :: #file_info{}. --type io_device() :: pid() | #file_descriptor{}. --type location() :: integer() | {'bof', integer()} | {'cur', integer()} - | {'eof', integer()} | 'bof' | 'cur' | 'eof'. --type mode() :: 'read' | 'write' | 'append' | 'raw' | 'binary' | - {'delayed_write', non_neg_integer(), non_neg_integer()} | - 'delayed_write' | {'read_ahead', pos_integer()} | - 'read_ahead' | 'compressed'. --type bindings() :: any(). +-type fd() :: #file_descriptor{}. +-type io_device() :: pid() | fd(). +-type location() :: integer() | {'bof', Offset :: integer()} + | {'cur', Offset :: integer()} + | {'eof', Offset :: integer()} | 'bof' | 'cur' | 'eof'. +-type mode() :: 'read' | 'write' | 'append' + | 'exclusive' | 'raw' | 'binary' + | {'delayed_write', + Size :: non_neg_integer(), + Delay :: non_neg_integer()} + | 'delayed_write' | {'read_ahead', Size :: pos_integer()} + | 'read_ahead' | 'compressed' + | {'encoding', unicode:encoding()} + | sync. +-type deep_list() :: [char() | atom() | deep_list()]. +-type name() :: string() | atom() | deep_list(). +-type name_all() :: string() | atom() | deep_list() | (RawFilename :: binary()). +-type posix() :: 'eacces' | 'eagain' | 'ebadf' | 'ebusy' | 'edquot' + | 'eexist' | 'efault' | 'efbig' | 'eintr' | 'einval' + | 'eio' | 'eisdir' | 'eloop' | 'emfile' | 'emlink' + | 'enametoolong' + | 'enfile' | 'enodev' | 'enoent' | 'enomem' | 'enospc' + | 'enotblk' | 'enotdir' | 'enotsup' | 'enxio' | 'eperm' + | 'epipe' | 'erofs' | 'espipe' | 'esrch' | 'estale' + | 'exdev'. +-type date_time() :: calendar:datetime(). +-type posix_file_advise() :: 'normal' | 'sequential' | 'random' + | 'no_reuse' | 'will_need' | 'dont_need'. +-type sendfile_option() :: {chunk_size, non_neg_integer()} + | {use_threads, boolean()}. +-type file_info_option() :: {'time', 'local'} | {'time', 'universal'} + | {'time', 'posix'} | raw. +%%% BIFs + +-export([native_name_encoding/0]). + +-spec native_name_encoding() -> latin1 | utf8. + +native_name_encoding() -> + erlang:nif_error(undef). + +%%% End of BIFs + %%%----------------------------------------------------------------- %%% General functions --spec format_error(Reason :: posix() | {integer(), atom(), any()}) -> - string(). +-spec format_error(Reason) -> Chars when + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}, + Chars :: string(). format_error({_Line, ?MODULE, undefined_script}) -> "no value returned from script"; @@ -98,7 +145,7 @@ format_error({Line, ?MODULE, {Reason, Stacktrace}}) -> io_lib:format("~w: evaluation failed with reason ~w and stacktrace ~w", [Line, Reason, Stacktrace]); format_error({Line, Mod, Reason}) -> - io_lib:format("~w: ~s", [Line, Mod:format_error(Reason)]); + io_lib:format("~w: ~ts", [Line, Mod:format_error(Reason)]); format_error(badarg) -> "bad argument"; format_error(system_limit) -> @@ -108,7 +155,9 @@ format_error(terminated) -> format_error(ErrorId) -> erl_posix_msg:message(ErrorId). --spec pid2name(Pid :: pid()) -> {'ok', filename()} | 'undefined'. +-spec pid2name(Pid) -> {ok, Filename} | undefined when + Filename :: filename_all(), + Pid :: pid(). pid2name(Pid) when is_pid(Pid) -> case whereis(?FILE_SERVER) of @@ -127,99 +176,226 @@ pid2name(Pid) when is_pid(Pid) -> %%% File server functions. %%% Functions that do not operate on a single open file. %%% Stateless. --spec get_cwd() -> {'ok', filename()} | {'error', posix()}. +-spec get_cwd() -> {ok, Dir} | {error, Reason} when + Dir :: filename(), + Reason :: posix(). get_cwd() -> call(get_cwd, []). --spec get_cwd(Drive :: string()) -> {'ok', filename()} | {'error', posix()}. +-spec get_cwd(Drive) -> {ok, Dir} | {error, Reason} when + Drive :: string(), + Dir :: filename(), + Reason :: posix() | badarg. get_cwd(Drive) -> check_and_call(get_cwd, [file_name(Drive)]). --spec set_cwd(Dirname :: name()) -> 'ok' | {'error', posix()}. +-spec set_cwd(Dir) -> ok | {error, Reason} when + Dir :: name() | EncodedBinary, + EncodedBinary :: binary(), + Reason :: posix() | badarg | no_translation. set_cwd(Dirname) -> check_and_call(set_cwd, [file_name(Dirname)]). --spec delete(Name :: name()) -> 'ok' | {'error', posix()}. +-spec delete(Filename) -> ok | {error, Reason} when + Filename :: name_all(), + Reason :: posix() | badarg. delete(Name) -> check_and_call(delete, [file_name(Name)]). --spec rename(From :: name(), To :: name()) -> 'ok' | {'error', posix()}. +-spec rename(Source, Destination) -> ok | {error, Reason} when + Source :: name_all(), + Destination :: name_all(), + Reason :: posix() | badarg. rename(From, To) -> check_and_call(rename, [file_name(From), file_name(To)]). --spec make_dir(Name :: name()) -> 'ok' | {'error', posix()}. +-spec make_dir(Dir) -> ok | {error, Reason} when + Dir :: name_all(), + Reason :: posix() | badarg. make_dir(Name) -> check_and_call(make_dir, [file_name(Name)]). --spec del_dir(Name :: name()) -> 'ok' | {'error', posix()}. +-spec del_dir(Dir) -> ok | {error, Reason} when + Dir :: name_all(), + Reason :: posix() | badarg. del_dir(Name) -> check_and_call(del_dir, [file_name(Name)]). --spec read_file_info(Name :: name()) -> {'ok', #file_info{}} | {'error', posix()}. +-spec read_file_info(Filename) -> {ok, FileInfo} | {error, Reason} when + Filename :: name_all(), + FileInfo :: file_info(), + Reason :: posix() | badarg. read_file_info(Name) -> check_and_call(read_file_info, [file_name(Name)]). --spec altname(Name :: name()) -> any(). +-spec read_file_info(Filename, Opts) -> {ok, FileInfo} | {error, Reason} when + Filename :: name_all(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +read_file_info(Name, Opts) when is_list(Opts) -> + Args = [file_name(Name), Opts], + case check_args(Args) of + ok -> + case lists:member(raw, Opts) of + true -> + [FileName|_] = Args, + ?PRIM_FILE:read_file_info(FileName, Opts); + false -> + call(read_file_info, Args) + end; + Error -> + Error + end. + +-spec altname(Name :: name_all()) -> any(). altname(Name) -> check_and_call(altname, [file_name(Name)]). --spec read_link_info(Name :: name()) -> {'ok', #file_info{}} | {'error', posix()}. +-spec read_link_info(Name) -> {ok, FileInfo} | {error, Reason} when + Name :: name_all(), + FileInfo :: file_info(), + Reason :: posix() | badarg. read_link_info(Name) -> check_and_call(read_link_info, [file_name(Name)]). --spec read_link(Name :: name()) -> {'ok', filename()} | {'error', posix()}. +-spec read_link_info(Name, Opts) -> {ok, FileInfo} | {error, Reason} when + Name :: name_all(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +read_link_info(Name, Opts) when is_list(Opts) -> + Args = [file_name(Name), Opts], + case check_args(Args) of + ok -> + case lists:member(raw, Opts) of + true -> + [FileName|_] = Args, + ?PRIM_FILE:read_link_info(FileName, Opts); + false -> + call(read_link_info, Args) + end; + Error -> + Error + end. + + +-spec read_link(Name) -> {ok, Filename} | {error, Reason} when + Name :: name_all(), + Filename :: filename(), + Reason :: posix() | badarg. read_link(Name) -> check_and_call(read_link, [file_name(Name)]). --spec write_file_info(Name :: name(), Info :: #file_info{}) -> - 'ok' | {'error', posix()}. +-spec read_link_all(Name) -> {ok, Filename} | {error, Reason} when + Name :: name_all(), + Filename :: filename_all(), + Reason :: posix() | badarg. + +read_link_all(Name) -> + check_and_call(read_link_all, [file_name(Name)]). + +-spec write_file_info(Filename, FileInfo) -> ok | {error, Reason} when + Filename :: name_all(), + FileInfo :: file_info(), + Reason :: posix() | badarg. write_file_info(Name, Info = #file_info{}) -> check_and_call(write_file_info, [file_name(Name), Info]). --spec list_dir(Name :: name()) -> {'ok', [filename()]} | {'error', posix()}. +-spec write_file_info(Filename, FileInfo, Opts) -> ok | {error, Reason} when + Filename :: name_all(), + Opts :: [file_info_option()], + FileInfo :: file_info(), + Reason :: posix() | badarg. + +write_file_info(Name, Info = #file_info{}, Opts) when is_list(Opts) -> + Args = [file_name(Name), Info, Opts], + case check_args(Args) of + ok -> + case lists:member(raw, Opts) of + true -> + [FileName|_] = Args, + ?PRIM_FILE:write_file_info(FileName, Info, Opts); + false -> + call(write_file_info, Args) + end; + Error -> + Error + end. + +-spec list_dir(Dir) -> {ok, Filenames} | {error, Reason} when + Dir :: name_all(), + Filenames :: [filename()], + Reason :: posix() + | badarg + | {no_translation, Filename :: unicode:latin1_binary()}. list_dir(Name) -> check_and_call(list_dir, [file_name(Name)]). --spec read_file(Name :: name()) -> {'ok', binary()} | {'error', posix()}. +-spec list_dir_all(Dir) -> {ok, Filenames} | {error, Reason} when + Dir :: name_all(), + Filenames :: [filename_all()], + Reason :: posix() | badarg. + +list_dir_all(Name) -> + check_and_call(list_dir_all, [file_name(Name)]). + +-spec read_file(Filename) -> {ok, Binary} | {error, Reason} when + Filename :: name_all(), + Binary :: binary(), + Reason :: posix() | badarg | terminated | system_limit. read_file(Name) -> check_and_call(read_file, [file_name(Name)]). --spec make_link(Old :: name(), New :: name()) -> 'ok' | {'error', posix()}. +-spec make_link(Existing, New) -> ok | {error, Reason} when + Existing :: name_all(), + New :: name_all(), + Reason :: posix() | badarg. make_link(Old, New) -> check_and_call(make_link, [file_name(Old), file_name(New)]). --spec make_symlink(Old :: name(), New :: name()) -> 'ok' | {'error', posix()}. +-spec make_symlink(Existing, New) -> ok | {error, Reason} when + Existing :: name_all(), + New :: name_all(), + Reason :: posix() | badarg. make_symlink(Old, New) -> check_and_call(make_symlink, [file_name(Old), file_name(New)]). --spec write_file(Name :: name(), Bin :: binary()) -> 'ok' | {'error', posix()}. +-spec write_file(Filename, Bytes) -> ok | {error, Reason} when + Filename :: name_all(), + Bytes :: iodata(), + Reason :: posix() | badarg | terminated | system_limit. write_file(Name, Bin) -> check_and_call(write_file, [file_name(Name), make_binary(Bin)]). %% This whole operation should be moved to the file_server and prim_file %% when it is time to change file server protocol again. -%% Meanwhile, it is implemented here, slihtly less efficient. -%% +%% Meanwhile, it is implemented here, slightly less efficient. --spec write_file(Name :: name(), Bin :: binary(), Modes :: [mode()]) -> - 'ok' | {'error', posix()}. +-spec write_file(Filename, Bytes, Modes) -> ok | {error, Reason} when + Filename :: name_all(), + Bytes :: iodata(), + Modes :: [mode()], + Reason :: posix() | badarg | terminated | system_limit. write_file(Name, Bin, ModeList) when is_list(ModeList) -> case make_binary(Bin) of @@ -232,7 +408,7 @@ write_file(Name, Bin, ModeList) when is_list(ModeList) -> ok -> close(Handle); E1 -> - close(Handle), + _ = close(Handle), E1 end; E2 -> @@ -245,26 +421,12 @@ write_file(Name, Bin, ModeList) when is_list(ModeList) -> %% Obsolete, undocumented, local node only, don't use!. %% XXX to be removed. raw_read_file_info(Name) -> - Args = [file_name(Name)], - case check_args(Args) of - ok -> - [FileName] = Args, - ?PRIM_FILE:read_file_info(FileName); - Error -> - Error - end. + read_file_info(Name, [raw]). %% Obsolete, undocumented, local node only, don't use!. %% XXX to be removed. raw_write_file_info(Name, #file_info{} = Info) -> - Args = [file_name(Name)], - case check_args(Args) of - ok -> - [FileName] = Args, - ?PRIM_FILE:write_file_info(FileName, Info); - Error -> - Error - end. + write_file_info(Name, Info, [raw]). %%%----------------------------------------------------------------- %%% File io server functions. @@ -273,28 +435,26 @@ raw_write_file_info(Name, #file_info{} = Info) -> %% Contemporary mode specification - list of options --spec open(Name :: name(), Modes :: [mode()]) -> - {'ok', io_device()} | {'error', posix()}. +-spec open(File, Modes) -> {ok, IoDevice} | {error, Reason} when + File :: Filename | iodata(), + Filename :: name_all(), + Modes :: [mode() | ram], + IoDevice :: io_device(), + Reason :: posix() | badarg | system_limit. open(Item, ModeList) when is_list(ModeList) -> case lists:member(raw, ModeList) of %% Raw file, use ?PRIM_FILE to handle this file true -> - %% check if raw file mode is disabled - case catch application:get_env(kernel, raw_files) of - {ok,false} -> - open(Item, lists:delete(raw, ModeList)); - _ -> % undefined | {ok,true} - Args = [file_name(Item) | ModeList], - case check_args(Args) of - ok -> - [FileName | _] = Args, - %% We rely on the returned Handle (in {ok, Handle}) - %% being a pid() or a #file_descriptor{} - ?PRIM_FILE:open(FileName, ModeList); - Error -> - Error - end + Args = [file_name(Item) | ModeList], + case check_args(Args) of + ok -> + [FileName | _] = Args, + %% We rely on the returned Handle (in {ok, Handle}) + %% being a pid() or a #file_descriptor{} + ?PRIM_FILE:open(FileName, ModeList); + Error -> + Error end; false -> case lists:member(ram, ModeList) of @@ -327,11 +487,12 @@ open(Item, Mode) -> %%% The File argument must be either a Pid or a handle %%% returned from ?PRIM_FILE:open. --spec close(File :: io_device()) -> 'ok' | {'error', posix()}. +-spec close(IoDevice) -> ok | {error, Reason} when + IoDevice :: io_device(), + Reason :: posix() | badarg | terminated. close(File) when is_pid(File) -> - R = file_request(File, close), - case wait_file_reply(File, R) of + case file_request(File, close) of {error, terminated} -> ok; Other -> @@ -345,10 +506,41 @@ close(#file_descriptor{module = Module} = Handle) -> close(_) -> {error, badarg}. --spec read(File :: io_device(), Size :: non_neg_integer()) -> - 'eof' | {'ok', [char()] | binary()} | {'error', posix()}. +-spec advise(IoDevice, Offset, Length, Advise) -> ok | {error, Reason} when + IoDevice :: io_device(), + Offset :: integer(), + Length :: integer(), + Advise :: posix_file_advise(), + Reason :: posix() | badarg. + +advise(File, Offset, Length, Advise) when is_pid(File) -> + file_request(File, {advise, Offset, Length, Advise}); +advise(#file_descriptor{module = Module} = Handle, Offset, Length, Advise) -> + Module:advise(Handle, Offset, Length, Advise); +advise(_, _, _, _) -> + {error, badarg}. -read(File, Sz) when is_pid(File), is_integer(Sz), Sz >= 0 -> +-spec allocate(File, Offset, Length) -> + 'ok' | {'error', posix()} when + File :: io_device(), + Offset :: non_neg_integer(), + Length :: non_neg_integer(). + +allocate(File, Offset, Length) when is_pid(File) -> + file_request(File, {allocate, Offset, Length}); +allocate(#file_descriptor{module = Module} = Handle, Offset, Length) -> + Module:allocate(Handle, Offset, Length). + +-spec read(IoDevice, Number) -> {ok, Data} | eof | {error, Reason} when + IoDevice :: io_device() | atom(), + Number :: non_neg_integer(), + Data :: string() | binary(), + Reason :: posix() + | badarg + | terminated + | {no_translation, unicode, latin1}. + +read(File, Sz) when (is_pid(File) orelse is_atom(File)), is_integer(Sz), Sz >= 0 -> case io:request(File, {get_chars, '', Sz}) of Data when is_list(Data); is_binary(Data) -> {ok, Data}; @@ -361,10 +553,15 @@ read(#file_descriptor{module = Module} = Handle, Sz) read(_, _) -> {error, badarg}. --spec read_line(File :: io_device()) -> - 'eof' | {'ok', [char()] | binary()} | {'error', posix()}. +-spec read_line(IoDevice) -> {ok, Data} | eof | {error, Reason} when + IoDevice :: io_device() | atom(), + Data :: string() | binary(), + Reason :: posix() + | badarg + | terminated + | {no_translation, unicode, latin1}. -read_line(File) when is_pid(File) -> +read_line(File) when (is_pid(File) orelse is_atom(File)) -> case io:request(File, {get_line, ''}) of Data when is_list(Data); is_binary(Data) -> {ok, Data}; @@ -376,9 +573,12 @@ read_line(#file_descriptor{module = Module} = Handle) -> read_line(_) -> {error, badarg}. --spec pread(File :: io_device(), - LocationNumbers :: [{location(), non_neg_integer()}]) -> - {'ok', [string() | binary() | 'eof']} | {'error', posix()}. +-spec pread(IoDevice, LocNums) -> {ok, DataL} | eof | {error, Reason} when + IoDevice :: io_device(), + LocNums :: [{Location :: location(), Number :: non_neg_integer()}], + DataL :: [Data], + Data :: string() | binary() | eof, + Reason :: posix() | badarg | terminated. pread(File, L) when is_pid(File), is_list(L) -> pread_int(File, L, []); @@ -401,27 +601,31 @@ pread_int(File, [{At, Sz} | T], R) when is_integer(Sz), Sz >= 0 -> pread_int(_, _, _) -> {error, badarg}. --spec pread(File :: io_device(), - Location :: location(), - Size :: non_neg_integer()) -> - 'eof' | {'ok', string() | binary()} | {'error', posix()}. +-spec pread(IoDevice, Location, Number) -> + {ok, Data} | eof | {error, Reason} when + IoDevice :: io_device(), + Location :: location(), + Number :: non_neg_integer(), + Data :: string() | binary(), + Reason :: posix() | badarg | terminated. pread(File, At, Sz) when is_pid(File), is_integer(Sz), Sz >= 0 -> - R = file_request(File, {pread, At, Sz}), - wait_file_reply(File, R); + file_request(File, {pread, At, Sz}); pread(#file_descriptor{module = Module} = Handle, Offs, Sz) when is_integer(Sz), Sz >= 0 -> Module:pread(Handle, Offs, Sz); pread(_, _, _) -> {error, badarg}. --spec write(File :: io_device(), Byte :: iodata()) -> - 'ok' | {'error', posix()}. +-spec write(IoDevice, Bytes) -> ok | {error, Reason} when + IoDevice :: io_device() | atom(), + Bytes :: iodata(), + Reason :: posix() | badarg | terminated. -write(File, Bytes) when is_pid(File) -> +write(File, Bytes) when (is_pid(File) orelse is_atom(File)) -> case make_binary(Bytes) of Bin when is_binary(Bin) -> - io:request(File, {put_chars,Bin}); + io:request(File, {put_chars,latin1,Bin}); Error -> Error end; @@ -430,8 +634,11 @@ write(#file_descriptor{module = Module} = Handle, Bytes) -> write(_, _) -> {error, badarg}. --spec pwrite(File :: io_device(), L :: [{location(), iodata()}]) -> - 'ok' | {'error', {non_neg_integer(), posix()}}. +-spec pwrite(IoDevice, LocBytes) -> ok | {error, {N, Reason}} when + IoDevice :: io_device(), + LocBytes :: [{Location :: location(), Bytes :: iodata()}], + N :: non_neg_integer(), + Reason :: posix() | badarg | terminated. pwrite(File, L) when is_pid(File), is_list(L) -> pwrite_int(File, L, 0); @@ -452,61 +659,85 @@ pwrite_int(File, [{At, Bytes} | T], R) -> pwrite_int(_, _, _) -> {error, badarg}. --spec pwrite(File :: io_device(), - Location :: location(), - Bytes :: iodata()) -> - 'ok' | {'error', posix()}. +-spec pwrite(IoDevice, Location, Bytes) -> ok | {error, Reason} when + IoDevice :: io_device(), + Location :: location(), + Bytes :: iodata(), + Reason :: posix() | badarg | terminated. pwrite(File, At, Bytes) when is_pid(File) -> - R = file_request(File, {pwrite, At, Bytes}), - wait_file_reply(File, R); + file_request(File, {pwrite, At, Bytes}); pwrite(#file_descriptor{module = Module} = Handle, Offs, Bytes) -> Module:pwrite(Handle, Offs, Bytes); pwrite(_, _, _) -> {error, badarg}. --spec sync(File :: io_device()) -> 'ok' | {'error', posix()}. +-spec datasync(IoDevice) -> ok | {error, Reason} when + IoDevice :: io_device(), + Reason :: posix() | badarg | terminated. + +datasync(File) when is_pid(File) -> + file_request(File, datasync); +datasync(#file_descriptor{module = Module} = Handle) -> + Module:datasync(Handle); +datasync(_) -> + {error, badarg}. + +-spec sync(IoDevice) -> ok | {error, Reason} when + IoDevice :: io_device(), + Reason :: posix() | badarg | terminated. sync(File) when is_pid(File) -> - R = file_request(File, sync), - wait_file_reply(File, R); + file_request(File, sync); sync(#file_descriptor{module = Module} = Handle) -> Module:sync(Handle); sync(_) -> {error, badarg}. --spec position(File :: io_device(), Location :: location()) -> - {'ok',integer()} | {'error', posix()}. +-spec position(IoDevice, Location) -> {ok, NewPosition} | {error, Reason} when + IoDevice :: io_device(), + Location :: location(), + NewPosition :: integer(), + Reason :: posix() | badarg | terminated. position(File, At) when is_pid(File) -> - R = file_request(File, {position,At}), - wait_file_reply(File, R); + file_request(File, {position,At}); position(#file_descriptor{module = Module} = Handle, At) -> Module:position(Handle, At); position(_, _) -> {error, badarg}. --spec truncate(File :: io_device()) -> 'ok' | {'error', posix()}. +-spec truncate(IoDevice) -> ok | {error, Reason} when + IoDevice :: io_device(), + Reason :: posix() | badarg | terminated. truncate(File) when is_pid(File) -> - R = file_request(File, truncate), - wait_file_reply(File, R); + file_request(File, truncate); truncate(#file_descriptor{module = Module} = Handle) -> Module:truncate(Handle); truncate(_) -> {error, badarg}. --spec copy(Source :: io_device() | name() | {name(), [mode()]}, - Destination :: io_device() | name() | {name(), [mode()]}) -> - {'ok', non_neg_integer()} | {'error', posix()}. +-spec copy(Source, Destination) -> {ok, BytesCopied} | {error, Reason} when + Source :: io_device() | Filename | {Filename, Modes}, + Destination :: io_device() | Filename | {Filename, Modes}, + Filename :: name_all(), + Modes :: [mode()], + BytesCopied :: non_neg_integer(), + Reason :: posix() | badarg | terminated. copy(Source, Dest) -> copy_int(Source, Dest, infinity). --spec copy(Source :: io_device() | name() | {name(), [mode()]}, - Destination :: io_device() | name() | {name(), [mode()]}, - Length :: non_neg_integer() | 'infinity') -> - {'ok', non_neg_integer()} | {'error', posix()}. +-spec copy(Source, Destination, ByteCount) -> + {ok, BytesCopied} | {error, Reason} when + Source :: io_device() | Filename | {Filename, Modes}, + Destination :: io_device() | Filename | {Filename, Modes}, + Filename :: name_all(), + Modes :: [mode()], + ByteCount :: non_neg_integer() | infinity, + BytesCopied :: non_neg_integer(), + Reason :: posix() | badarg | terminated. copy(Source, Dest, Length) when is_integer(Length), Length >= 0; @@ -551,7 +782,7 @@ copy_int({SourceName, SourceOpts}, Dest, Length) case open(Source, [read | SourceOpts]) of {ok, Handle} -> Result = copy_opened_int(Handle, Dest, Length, 0), - close(Handle), + _ = close(Handle), Result; {error, _} = Error -> Error @@ -567,9 +798,16 @@ copy_int(Source, {DestName, DestOpts}, Length) Dest -> case open(Dest, [write | DestOpts]) of {ok, Handle} -> - Result = copy_opened_int(Source, Handle, Length, 0), - close(Handle), - Result; + case copy_opened_int(Source, Handle, Length, 0) of + {ok, _} = OK -> + case close(Handle) of + ok -> OK; + Error -> Error + end; + Error -> + _ = close(Handle), + Error + end; {error, _} = Error -> Error end @@ -728,118 +966,161 @@ ipread_s32bu_p32bu_2(File, %%% The following functions, built upon the other interface functions, %%% provide a higher-lever interface to files. --spec consult(File :: name()) -> - {'ok', list()} | {'error', posix() | {integer(), atom(), any()}}. +-spec consult(Filename) -> {ok, Terms} | {error, Reason} when + Filename :: name_all(), + Terms :: [term()], + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. consult(File) -> case open(File, [read]) of {ok, Fd} -> R = consult_stream(Fd), - close(Fd), + _ = close(Fd), R; Error -> Error end. --spec path_consult(Paths :: [name()], File :: name()) -> - {'ok', list(), filename()} | {'error', posix() | {integer(), atom(), any()}}. +-spec path_consult(Path, Filename) -> {ok, Terms, FullName} | {error, Reason} when + Path :: [Dir], + Dir :: name_all(), + Filename :: name_all(), + Terms :: [term()], + FullName :: filename_all(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. path_consult(Path, File) -> case path_open(Path, File, [read]) of {ok, Fd, Full} -> case consult_stream(Fd) of {ok, List} -> - close(Fd), + _ = close(Fd), {ok, List, Full}; E1 -> - close(Fd), + _ = close(Fd), E1 end; E2 -> E2 end. --spec eval(File :: name()) -> 'ok' | {'error', posix()}. +-spec eval(Filename) -> ok | {error, Reason} when + Filename :: name_all(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. eval(File) -> eval(File, erl_eval:new_bindings()). --spec eval(File :: name(), Bindings :: bindings()) -> - 'ok' | {'error', posix()}. +-spec eval(Filename, Bindings) -> ok | {error, Reason} when + Filename :: name_all(), + Bindings :: erl_eval:binding_struct(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. eval(File, Bs) -> case open(File, [read]) of {ok, Fd} -> R = eval_stream(Fd, ignore, Bs), - close(Fd), + _ = close(Fd), R; Error -> Error end. --spec path_eval(Paths :: [name()], File :: name()) -> - {'ok', filename()} | {'error', posix() | {integer(), atom(), any()}}. +-spec path_eval(Path, Filename) -> {ok, FullName} | {error, Reason} when + Path :: [Dir :: name_all()], + Filename :: name_all(), + FullName :: filename_all(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. path_eval(Path, File) -> path_eval(Path, File, erl_eval:new_bindings()). --spec path_eval(Paths :: [name()], File :: name(), Bindings :: bindings()) -> - {'ok', filename()} | {'error', posix() | {integer(), atom(), any()}}. +-spec path_eval(Path, Filename, Bindings) -> + {ok, FullName} | {error, Reason} when + Path :: [Dir :: name_all()], + Filename :: name_all(), + Bindings :: erl_eval:binding_struct(), + FullName :: filename_all(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. path_eval(Path, File, Bs) -> case path_open(Path, File, [read]) of {ok, Fd, Full} -> case eval_stream(Fd, ignore, Bs) of ok -> - close(Fd), + _ = close(Fd), {ok, Full}; E1 -> - close(Fd), + _ = close(Fd), E1 end; E2 -> E2 end. --spec script(File :: name()) -> - {'ok', any()} | {'error', posix() | {integer(), atom(), any()}}. +-spec script(Filename) -> {ok, Value} | {error, Reason} when + Filename :: name_all(), + Value :: term(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. script(File) -> script(File, erl_eval:new_bindings()). --spec script(File :: name(), Bindings :: bindings()) -> - {'ok', any()} | {'error', posix() | {integer(), atom(), any()}}. +-spec script(Filename, Bindings) -> {ok, Value} | {error, Reason} when + Filename :: name_all(), + Bindings :: erl_eval:binding_struct(), + Value :: term(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. script(File, Bs) -> case open(File, [read]) of {ok, Fd} -> R = eval_stream(Fd, return, Bs), - close(Fd), + _ = close(Fd), R; Error -> Error end. --spec path_script/2 :: (Paths :: [name()], File :: name()) -> - {'ok', term(), filename()} | {'error', posix() | {integer(), atom(), _}}. +-spec path_script(Path, Filename) -> + {ok, Value, FullName} | {error, Reason} when + Path :: [Dir :: name_all()], + Filename :: name_all(), + Value :: term(), + FullName :: filename_all(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. path_script(Path, File) -> path_script(Path, File, erl_eval:new_bindings()). --spec path_script(Paths :: [name()], - File :: name(), - Bindings :: bindings()) -> - {'ok', term(), filename()} | {'error', posix() | {integer(), atom(), _}}. +-spec path_script(Path, Filename, Bindings) -> + {ok, Value, FullName} | {error, Reason} when + Path :: [Dir :: name_all()], + Filename :: name_all(), + Bindings :: erl_eval:binding_struct(), + Value :: term(), + FullName :: filename_all(), + Reason :: posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. path_script(Path, File, Bs) -> case path_open(Path, File, [read]) of {ok,Fd,Full} -> case eval_stream(Fd, return, Bs) of {ok,R} -> - close(Fd), + _ = close(Fd), {ok, R, Full}; E1 -> - close(Fd), + _ = close(Fd), E1 end; E2 -> @@ -854,8 +1135,14 @@ path_script(Path, File, Bs) -> %% Searches the Paths for file Filename which can be opened with Mode. %% The path list is ignored if Filename contains an absolute path. --spec path_open(Paths :: [name()], Name :: name(), Modes :: [mode()]) -> - {'ok', io_device(), filename()} | {'error', posix()}. +-spec path_open(Path, Filename, Modes) -> + {ok, IoDevice, FullName} | {error, Reason} when + Path :: [Dir :: name_all()], + Filename :: name_all(), + Modes :: [mode()], + IoDevice :: io_device(), + FullName :: filename_all(), + Reason :: posix() | badarg | system_limit. path_open(PathList, Name, Mode) -> case file_name(Name) of @@ -875,56 +1162,207 @@ path_open(PathList, Name, Mode) -> end end. --spec change_mode(Name :: name(), Mode :: integer()) -> - 'ok' | {'error', posix()}. +-spec change_mode(Filename, Mode) -> ok | {error, Reason} when + Filename :: name_all(), + Mode :: integer(), + Reason :: posix() | badarg. change_mode(Name, Mode) when is_integer(Mode) -> write_file_info(Name, #file_info{mode=Mode}). --spec change_owner(Name :: name(), OwnerId :: integer()) -> - 'ok' | {'error', posix()}. +-spec change_owner(Filename, Uid) -> ok | {error, Reason} when + Filename :: name_all(), + Uid :: integer(), + Reason :: posix() | badarg. change_owner(Name, OwnerId) when is_integer(OwnerId) -> write_file_info(Name, #file_info{uid=OwnerId}). --spec change_owner(Name :: name(), - OwnerId :: integer(), - GroupId :: integer()) -> - 'ok' | {'error', posix()}. +-spec change_owner(Filename, Uid, Gid) -> ok | {error, Reason} when + Filename :: name_all(), + Uid :: integer(), + Gid :: integer(), + Reason :: posix() | badarg. change_owner(Name, OwnerId, GroupId) when is_integer(OwnerId), is_integer(GroupId) -> write_file_info(Name, #file_info{uid=OwnerId, gid=GroupId}). --spec change_group(Name :: name(), GroupId :: integer()) -> - 'ok' | {'error', posix()}. +-spec change_group(Filename, Gid) -> ok | {error, Reason} when + Filename :: name_all(), + Gid :: integer(), + Reason :: posix() | badarg. change_group(Name, GroupId) when is_integer(GroupId) -> write_file_info(Name, #file_info{gid=GroupId}). --spec change_time(Name :: name(), Time :: date_time()) -> - 'ok' | {'error', posix()}. +-spec change_time(Filename, Mtime) -> ok | {error, Reason} when + Filename :: name_all(), + Mtime :: date_time(), + Reason :: posix() | badarg. -change_time(Name, Time) - when is_tuple(Time) -> +change_time(Name, {{Y, M, D}, {H, Min, Sec}}=Time) + when is_integer(Y), is_integer(M), is_integer(D), + is_integer(H), is_integer(Min), is_integer(Sec)-> write_file_info(Name, #file_info{mtime=Time}). --spec change_time(Name :: name(), - ATime :: date_time(), - MTime :: date_time()) -> - 'ok' | {'error', posix()}. - -change_time(Name, Atime, Mtime) - when is_tuple(Atime), is_tuple(Mtime) -> +-spec change_time(Filename, Atime, Mtime) -> ok | {error, Reason} when + Filename :: name_all(), + Atime :: date_time(), + Mtime :: date_time(), + Reason :: posix() | badarg. + +change_time(Name, {{AY, AM, AD}, {AH, AMin, ASec}}=Atime, + {{MY, MM, MD}, {MH, MMin, MSec}}=Mtime) + when is_integer(AY), is_integer(AM), is_integer(AD), + is_integer(AH), is_integer(AMin), is_integer(ASec), + is_integer(MY), is_integer(MM), is_integer(MD), + is_integer(MH), is_integer(MMin), is_integer(MSec)-> write_file_info(Name, #file_info{atime=Atime, mtime=Mtime}). +%% +%% Send data using sendfile +%% + +%% 1 MB, Windows seems to behave badly if it is much larger then this +-define(MAX_CHUNK_SIZE, (1 bsl 20)). + +-spec sendfile(RawFile, Socket, Offset, Bytes, Opts) -> + {'ok', non_neg_integer()} | {'error', inet:posix() | + closed | badarg | not_owner} when + RawFile :: fd(), + Socket :: inet:socket(), + Offset :: non_neg_integer(), + Bytes :: non_neg_integer(), + Opts :: [sendfile_option()]. +sendfile(File, _Sock, _Offet, _Bytes, _Opts) when is_pid(File) -> + {error, badarg}; +sendfile(File, Sock, Offset, Bytes, []) -> + sendfile(File, Sock, Offset, Bytes, ?MAX_CHUNK_SIZE, [], [], []); +sendfile(File, Sock, Offset, Bytes, Opts) -> + ChunkSize0 = proplists:get_value(chunk_size, Opts, ?MAX_CHUNK_SIZE), + ChunkSize = if ChunkSize0 > ?MAX_CHUNK_SIZE -> + ?MAX_CHUNK_SIZE; + true -> ChunkSize0 + end, + %% Support for headers, trailers and options has been removed because the + %% Darwin and BSD API for using it does not play nice with + %% non-blocking sockets. See unix_efile.c for more info. + sendfile(File, Sock, Offset, Bytes, ChunkSize, [], [], Opts). + +%% sendfile/2 +-spec sendfile(Filename, Socket) -> + {'ok', non_neg_integer()} | {'error', inet:posix() | + closed | badarg | not_owner} + when Filename :: name_all(), + Socket :: inet:socket(). +sendfile(Filename, Sock) -> + case file:open(Filename, [read, raw, binary]) of + {error, Reason} -> + {error, Reason}; + {ok, Fd} -> + Res = sendfile(Fd, Sock, 0, 0, []), + _ = file:close(Fd), + Res + end. + +%% Internal sendfile functions +sendfile(#file_descriptor{ module = Mod } = Fd, Sock, Offset, Bytes, + ChunkSize, Headers, Trailers, Opts) + when is_port(Sock) -> + case Mod:sendfile(Fd, Sock, Offset, Bytes, ChunkSize, Headers, Trailers, + Opts) of + {error, enotsup} -> + sendfile_fallback(Fd, Sock, Offset, Bytes, ChunkSize, + Headers, Trailers); + Else -> + Else + end; +sendfile(_,_,_,_,_,_,_,_) -> + {error, badarg}. + +%%% +%% Sendfile Fallback +%%% +sendfile_fallback(File, Sock, Offset, Bytes, ChunkSize, + Headers, Trailers) + when Headers == []; is_integer(Headers) -> + case sendfile_fallback(File, Sock, Offset, Bytes, ChunkSize) of + {ok, BytesSent} when is_list(Trailers), + Trailers =/= [], + is_integer(Headers) -> + sendfile_send(Sock, Trailers, BytesSent+Headers); + {ok, BytesSent} when is_list(Trailers), Trailers =/= [] -> + sendfile_send(Sock, Trailers, BytesSent); + {ok, BytesSent} when is_integer(Headers) -> + {ok, BytesSent + Headers}; + Else -> + Else + end; +sendfile_fallback(File, Sock, Offset, Bytes, ChunkSize, Headers, Trailers) -> + case sendfile_send(Sock, Headers, 0) of + {ok, BytesSent} -> + sendfile_fallback(File, Sock, Offset, Bytes, ChunkSize, BytesSent, + Trailers); + Else -> + Else + end. + + +sendfile_fallback(File, Sock, Offset, Bytes, ChunkSize) -> + {ok, CurrPos} = file:position(File, {cur, 0}), + {ok, _NewPos} = file:position(File, {bof, Offset}), + Res = sendfile_fallback_int(File, Sock, Bytes, ChunkSize, 0), + _ = file:position(File, {bof, CurrPos}), + Res. + + +sendfile_fallback_int(File, Sock, Bytes, ChunkSize, BytesSent) + when Bytes > BytesSent; Bytes == 0 -> + Size = if Bytes == 0 -> + ChunkSize; + (Bytes - BytesSent) < ChunkSize -> + Bytes - BytesSent; + true -> + ChunkSize + end, + case file:read(File, Size) of + {ok, Data} -> + case sendfile_send(Sock, Data, BytesSent) of + {ok,NewBytesSent} -> + sendfile_fallback_int( + File, Sock, Bytes, ChunkSize, + NewBytesSent); + Error -> + Error + end; + eof -> + {ok, BytesSent}; + Error -> + Error + end; +sendfile_fallback_int(_File, _Sock, BytesSent, _ChunkSize, BytesSent) -> + {ok, BytesSent}. + +sendfile_send(Sock, Data, Old) -> + Len = iolist_size(Data), + case gen_tcp:send(Sock, Data) of + ok -> + {ok, Len+Old}; + Else -> + Else + end. + + + %%%----------------------------------------------------------------- %%% Helpers consult_stream(Fd) -> + _ = epp:set_encoding(Fd), consult_stream(Fd, 1, []). consult_stream(Fd, Line, Acc) -> @@ -938,6 +1376,7 @@ consult_stream(Fd, Line, Acc) -> end. eval_stream(Fd, Handling, Bs) -> + _ = epp:set_encoding(Fd), eval_stream(Fd, Handling, 1, undefined, [], Bs). eval_stream(Fd, H, Line, Last, E, Bs) -> @@ -970,11 +1409,11 @@ path_open_first([Path|Rest], Name, Mode, LastError) -> {error, _} = Error -> Error; FilePath -> - FileName = filename:join(FilePath, Name), + FileName = fname_join(FilePath, Name), case open(FileName, Mode) of {ok, Fd} -> {ok, Fd, FileName}; - {error, enoent} -> + {error, Reason} when Reason =:= enoent; Reason =:= enotdir -> path_open_first(Rest, Name, Mode, LastError); Error -> Error @@ -983,6 +1422,11 @@ path_open_first([Path|Rest], Name, Mode, LastError) -> path_open_first([], _Name, _Mode, LastError) -> {error, LastError}. +fname_join(".", Name) -> + Name; +fname_join(Dir, Name) -> + filename:join(Dir, Name). + %%%----------------------------------------------------------------- %%% Utility functions. @@ -990,22 +1434,26 @@ path_open_first([], _Name, _Mode, LastError) -> %% Generates a flat file name from a deep list of atoms and %% characters (integers). +file_name(N) when is_binary(N) -> + N; file_name(N) -> try - file_name_1(N) + file_name_1(N,file:native_name_encoding()) catch Reason -> {error, Reason} end. -file_name_1([C|T]) when is_integer(C), C > 0, C =< 255 -> - [C|file_name_1(T)]; -file_name_1([H|T]) -> - file_name_1(H) ++ file_name_1(T); -file_name_1([]) -> +file_name_1([C|T],latin1) when is_integer(C), C < 256-> + [C|file_name_1(T,latin1)]; +file_name_1([C|T],utf8) when is_integer(C) -> + [C|file_name_1(T,utf8)]; +file_name_1([H|T],E) -> + file_name_1(H,E) ++ file_name_1(T,E); +file_name_1([],_) -> []; -file_name_1(N) when is_atom(N) -> +file_name_1(N,_) when is_atom(N) -> atom_to_list(N); -file_name_1(_) -> +file_name_1(_,_) -> throw(badarg). make_binary(Bin) when is_binary(Bin) -> @@ -1036,7 +1484,11 @@ mode_list(_) -> %% Functions for communicating with the file server call(Command, Args) when is_list(Args) -> - gen_server:call(?FILE_SERVER, list_to_tuple([Command | Args]), infinity). + X = erlang:dt_spread_tag(true), + Y = gen_server:call(?FILE_SERVER, list_to_tuple([Command | Args]), + infinity), + erlang:dt_restore_tag(X), + Y. check_and_call(Command, Args) when is_list(Args) -> case check_args(Args) of @@ -1054,25 +1506,19 @@ check_args([]) -> ok. %%----------------------------------------------------------------- -%% Functions for communicating with a file io server. +%% Function for communicating with a file io server. %% The messages sent have the following formats: %% %% {file_request,From,ReplyAs,Request} %% {file_reply,ReplyAs,Reply} file_request(Io, Request) -> - R = erlang:monitor(process, Io), - Io ! {file_request,self(),Io,Request}, - R. - -wait_file_reply(From, Ref) -> + Ref = erlang:monitor(process, Io), + Io ! {file_request,self(),Ref,Request}, receive - {file_reply,From,Reply} -> - erlang:demonitor(Ref), - receive {'DOWN', Ref, _, _, _} -> ok after 0 -> ok end, - %% receive {'EXIT', From, _} -> ok after 0 -> ok end, + {file_reply,Ref,Reply} -> + erlang:demonitor(Ref, [flush]), Reply; {'DOWN', Ref, _, _, _} -> - %% receive {'EXIT', From, _} -> ok after 0 -> ok end, {error, terminated} end. diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index 37e803c493..deb7b315b1 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-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. -%% +%% +%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(file_io_server). @@ -40,15 +41,17 @@ format_error({_Line, ?MODULE, Reason}) -> io_lib:format("~w", [Reason]); format_error({_Line, Mod, Reason}) -> Mod:format_error(Reason); +format_error(invalid_unicode) -> + io_lib:format("cannot translate from UTF-8", []); format_error(ErrorId) -> erl_posix_msg:message(ErrorId). start(Owner, FileName, ModeList) - when is_pid(Owner), is_list(FileName), is_list(ModeList) -> + when is_pid(Owner), (is_list(FileName) orelse is_binary(FileName)), is_list(ModeList) -> do_start(spawn, Owner, FileName, ModeList). start_link(Owner, FileName, ModeList) - when is_pid(Owner), is_list(FileName), is_list(ModeList) -> + when is_pid(Owner), (is_list(FileName) orelse is_binary(FileName)), is_list(ModeList) -> do_start(spawn_link, Owner, FileName, ModeList). %%%----------------------------------------------------------------- @@ -57,9 +60,11 @@ start_link(Owner, FileName, ModeList) do_start(Spawn, Owner, FileName, ModeList) -> Self = self(), Ref = make_ref(), + Utag = erlang:dt_spread_tag(true), Pid = erlang:Spawn( fun() -> + erlang:dt_restore_tag(Utag), %% process_flag(trap_exit, true), case parse_options(ModeList) of {ReadMode, UnicodeMode, Opts} -> @@ -84,11 +89,11 @@ do_start(Spawn, Owner, FileName, ModeList) -> exit(Reason1) end end), + erlang:dt_restore_tag(Utag), Mref = erlang:monitor(process, Pid), receive {Ref, {error, _Reason} = Error} -> - erlang:demonitor(Mref), - receive {'DOWN', Mref, _, _, _} -> ok after 0 -> ok end, + erlang:demonitor(Mref, [flush]), Error; {Ref, ok} -> erlang:demonitor(Mref), @@ -106,21 +111,21 @@ do_start(Spawn, Owner, FileName, ModeList) -> parse_options(List) -> parse_options(expand_encoding(List), list, latin1, []). -parse_options([],list,Uni,Acc) -> +parse_options([], list, Uni, Acc) -> {list,Uni,[binary|lists:reverse(Acc)]}; -parse_options([],binary,Uni,Acc) -> +parse_options([], binary, Uni, Acc) -> {binary,Uni,lists:reverse(Acc)}; -parse_options([{encoding, Encoding}|T],RMode,_,Acc) -> +parse_options([{encoding, Encoding}|T], RMode, _, Acc) -> case valid_enc(Encoding) of {ok, ExpandedEnc} -> - parse_options(T,RMode,ExpandedEnc,Acc); - {error,Reason} -> - {error,Reason} + parse_options(T, RMode, ExpandedEnc, Acc); + {error,_Reason} = Error -> + Error end; -parse_options([binary|T],_,Uni,Acc) -> - parse_options(T,binary,Uni,[binary|Acc]); -parse_options([H|T],R,U,Acc) -> - parse_options(T,R,U,[H|Acc]). +parse_options([binary|T], _, Uni, Acc) -> + parse_options(T, binary, Uni, [binary|Acc]); +parse_options([H|T], R, U, Acc) -> + parse_options(T, R, U, [H|Acc]). expand_encoding([]) -> []; @@ -153,35 +158,34 @@ valid_enc(_Other) -> {error,badarg}. - server_loop(#state{mref = Mref} = State) -> receive {file_request, From, ReplyAs, Request} when is_pid(From) -> case file_request(Request, State) of {reply, Reply, NewState} -> - file_reply(From, ReplyAs, Reply), + _ = file_reply(From, ReplyAs, Reply), server_loop(NewState); {error, Reply, NewState} -> %% error is the same as reply, except that %% it breaks the io_request_loop further down - file_reply(From, ReplyAs, Reply), + _ = file_reply(From, ReplyAs, Reply), server_loop(NewState); {stop, Reason, Reply, _NewState} -> - file_reply(From, ReplyAs, Reply), + _ = file_reply(From, ReplyAs, Reply), exit(Reason) end; {io_request, From, ReplyAs, Request} when is_pid(From) -> case io_request(Request, State) of {reply, Reply, NewState} -> - io_reply(From, ReplyAs, Reply), + _ = io_reply(From, ReplyAs, Reply), server_loop(NewState); {error, Reply, NewState} -> %% error is the same as reply, except that %% it breaks the io_request_loop further down - io_reply(From, ReplyAs, Reply), + _ = io_reply(From, ReplyAs, Reply), server_loop(NewState); {stop, Reason, Reply, _NewState} -> - io_reply(From, ReplyAs, Reply), + _ = io_reply(From, ReplyAs, Reply), exit(Reason) end; {'DOWN', Mref, _, _, Reason} -> @@ -199,54 +203,103 @@ io_reply(From, ReplyAs, Reply) -> %%%----------------------------------------------------------------- %%% file requests +file_request({advise,Offset,Length,Advise}, + #state{handle=Handle}=State) -> + case ?PRIM_FILE:advise(Handle, Offset, Length, Advise) of + {error,Reason}=Reply -> + {stop,Reason,Reply,State}; + Reply -> + {reply,Reply,State} + end; +file_request({allocate, Offset, Length}, + #state{handle = Handle} = State) -> + Reply = ?PRIM_FILE:allocate(Handle, Offset, Length), + {reply, Reply, State}; +file_request({pread,At,Sz}, State) + when At =:= cur; + At =:= {cur,0} -> + case get_chars(Sz, latin1, State) of + {reply,Reply,NewState} + when is_list(Reply); + is_binary(Reply) -> + {reply,{ok,Reply},NewState}; + Other -> + Other + end; file_request({pread,At,Sz}, - #state{handle=Handle,buf=Buf,read_mode=ReadMode}=State) -> + #state{handle=Handle,buf=Buf}=State) -> case position(Handle, At, Buf) of - {ok,_Offs} -> - case ?PRIM_FILE:read(Handle, Sz) of - {ok,Bin} when ReadMode =:= list -> - std_reply({ok,binary_to_list(Bin)}, State); - Reply -> - std_reply(Reply, State) - end; - Reply -> - std_reply(Reply, State) + {error,_} = Reply -> + {error,Reply,State}; + _ -> + case get_chars(Sz, latin1, State#state{buf= <<>>}) of + {reply,Reply,NewState} + when is_list(Reply); + is_binary(Reply) -> + {reply,{ok,Reply},NewState}; + Other -> + Other + end end; +file_request({pwrite,At,Data}, + #state{buf= <<>>}=State) + when At =:= cur; + At =:= {cur,0} -> + put_chars(Data, latin1, State); file_request({pwrite,At,Data}, #state{handle=Handle,buf=Buf}=State) -> case position(Handle, At, Buf) of - {ok,_Offs} -> - std_reply(?PRIM_FILE:write(Handle, Data), State); + {error,_} = Reply -> + {error,Reply,State}; + _ -> + put_chars(Data, latin1, State) + end; +file_request(datasync, + #state{handle=Handle}=State) -> + case ?PRIM_FILE:datasync(Handle) of + {error,Reason}=Reply -> + {stop,Reason,Reply,State}; Reply -> - std_reply(Reply, State) + {reply,Reply,State} end; file_request(sync, #state{handle=Handle}=State) -> case ?PRIM_FILE:sync(Handle) of - {error,_}=Reply -> - {stop,normal,Reply,State}; + {error,Reason}=Reply -> + {stop,Reason,Reply,State}; Reply -> {reply,Reply,State} end; file_request(close, #state{handle=Handle}=State) -> - {stop,normal,?PRIM_FILE:close(Handle),State#state{buf= <<>>}}; + case ?PRIM_FILE:close(Handle) of + {error,Reason}=Reply -> + {stop,Reason,Reply,State#state{buf= <<>>}}; + Reply -> + {stop,normal,Reply,State#state{buf= <<>>}} + end; file_request({position,At}, #state{handle=Handle,buf=Buf}=State) -> - std_reply(position(Handle, At, Buf), State); + case position(Handle, At, Buf) of + {error,_} = Reply -> + {error,Reply,State}; + Reply -> + std_reply(Reply, State) + end; file_request(truncate, #state{handle=Handle}=State) -> case ?PRIM_FILE:truncate(Handle) of - {error,_Reason}=Reply -> - {stop,normal,Reply,State#state{buf= <<>>}}; + {error,Reason}=Reply -> + {stop,Reason,Reply,State#state{buf= <<>>}}; Reply -> - {reply,Reply,State} + std_reply(Reply, State) end; file_request(Unknown, #state{}=State) -> Reason = {request, Unknown}, {error,{error,Reason},State}. +%% Standard reply and clear buffer std_reply({error,_}=Reply, State) -> {error,Reply,State#state{buf= <<>>}}; std_reply(Reply, State) -> @@ -262,8 +315,8 @@ io_request({put_chars, Enc, Chars}, io_request({put_chars, Enc, Chars}, #state{handle=Handle,buf=Buf}=State) -> case position(Handle, cur, Buf) of - {error,_}=Reply -> - {stop,normal,Reply,State#state{buf= <<>>}}; + {error,Reason}=Reply -> + {stop,Reason,Reply,State}; _ -> put_chars(Chars, Enc, State#state{buf= <<>>}) end; @@ -284,18 +337,18 @@ io_request({get_chars,Enc,_Prompt,N}, #state{}=State) -> get_chars(N, Enc, State); -%% -%% This optimization gives almost nothing - needs more working... -%% Disabled for now. /PaN -%% -%% io_request({get_line,Enc,_Prompt}, -%% #state{unic=latin1}=State) -> -%% get_line(Enc,State); - -io_request({get_line,Enc,_Prompt}, - #state{}=State) -> - get_chars(io_lib, collect_line, [], Enc, State); - +io_request({get_line,OutEnc,_Prompt}, #state{buf=Buf, read_mode=Mode, unic=InEnc} = State0) -> + try + %% Minimize the encoding conversions + WorkEnc = case InEnc of + {_,_} -> OutEnc; %% utf16 or utf32 + _ -> InEnc %% Byte oriented utf8 or latin1 + end, + {Res, State} = get_line(start, convert_enc(Buf, InEnc, WorkEnc), WorkEnc, State0), + {reply, cast(Res, Mode, WorkEnc, OutEnc), State} + catch exit:ExError -> + {stop,ExError,{error,ExError},State0#state{buf= <<>>}} + end; io_request({setopts, Opts}, #state{}=State) when is_list(Opts) -> @@ -326,7 +379,6 @@ io_request(Unknown, {error,{error,Reason},State}. - %% Process a list of requests as long as the results are ok. io_request_loop([], Result) -> @@ -342,79 +394,66 @@ io_request_loop([Request|Tail], io_request_loop(Tail, io_request(Request, State)). - %% I/O request put_chars %% put_chars(Chars, latin1, #state{handle=Handle, unic=latin1}=State) -> + NewState = State#state{buf = <<>>}, case ?PRIM_FILE:write(Handle, Chars) of - {error,_}=Reply -> - {stop,normal,Reply,State}; + {error,Reason}=Reply -> + {stop,Reason,Reply,NewState}; Reply -> - {reply,Reply,State} + {reply,Reply,NewState} end; put_chars(Chars, InEncoding, #state{handle=Handle, unic=OutEncoding}=State) -> + NewState = State#state{buf = <<>>}, case unicode:characters_to_binary(Chars,InEncoding,OutEncoding) of Bin when is_binary(Bin) -> case ?PRIM_FILE:write(Handle, Bin) of - {error,_}=Reply -> - {stop,normal,Reply,State}; + {error,Reason}=Reply -> + {stop,Reason,Reply,NewState}; Reply -> - {reply,Reply,State} + {reply,Reply,NewState} end; {error,_,_} -> - {stop,normal,{error,{no_translation, InEncoding, OutEncoding}},State} + {stop,no_translation, + {error,{no_translation, InEncoding, OutEncoding}}, + NewState} + end. + +get_line(S, {<<>>, Cont}, OutEnc, + #state{handle=Handle, read_mode=Mode, unic=InEnc}=State) -> + case ?PRIM_FILE:read(Handle, read_size(Mode)) of + {ok,Bin} -> + get_line(S, convert_enc([Cont, Bin], InEnc, OutEnc), OutEnc, State); + eof -> + get_line(S, {eof, Cont}, OutEnc, State); + {error,Reason}=Error -> + {stop,Reason,Error,State} + end; +get_line(S0, {Buf, BCont}, OutEnc, #state{unic=InEnc}=State) -> + case io_lib:collect_line(S0, Buf, OutEnc, []) of + {stop, Result, Cont0} -> + %% Convert both buffers back to file InEnc encoding + {Cont, <<>>} = convert_enc(Cont0, OutEnc, InEnc), + {Result, State#state{buf=cast_binary([Cont, BCont])}}; + S -> + get_line(S, {<<>>, BCont}, OutEnc, State) + end. + +convert_enc(Bins, Enc, Enc) -> + {cast_binary(Bins), <<>>}; +convert_enc(eof, _, _) -> + {<<>>, <<>>}; +convert_enc(Bin, InEnc, OutEnc) -> + case unicode:characters_to_binary(Bin, InEnc, OutEnc) of + Res when is_binary(Res) -> + {Res, <<>>}; + {incomplete, Res, Cont} -> + {Res, Cont}; + {error, _, _} -> + exit({no_translation, InEnc, OutEnc}) end. -%% -%% Process the I/O request get_line for latin1 encoding of file specially -%% Unfortunately this function gives almost nothing, it needs more work -%% I disable it for now /PaN -%% -%% srch(<<>>,_,_) -> -%% nomatch; -%% srch(<<X:8,_/binary>>,X,N) -> -%% {match,N}; -%% srch(<<_:8,T/binary>>,X,N) -> -%% srch(T,X,N+1). -%% get_line(OutEnc, #state{handle=Handle,buf = <<>>,unic=latin1}=State) -> -%% case ?PRIM_FILE:read(Handle,?READ_SIZE_BINARY) of -%% {ok, B} -> -%% get_line(OutEnc, State#state{buf = B}); -%% eof -> -%% {reply,eof,State}; -%% {error,Reason}=Error -> -%% {stop,Reason,Error,State} -%% end; -%% get_line(OutEnc, #state{handle=Handle,buf=Buf,read_mode=ReadMode,unic=latin1}=State) -> -%% case srch(Buf,$\n,0) of -%% nomatch -> -%% case ?PRIM_FILE:read(Handle,?READ_SIZE_BINARY) of -%% {ok, B} -> -%% get_line(OutEnc,State#state{buf = <<Buf/binary,B/binary>>}); -%% eof -> -%% std_reply(cast(Buf, ReadMode,latin1,OutEnc), State); -%% {error,Reason}=Error -> -%% {stop,Reason,Error,State#state{buf= <<>>}} -%% end; -%% {match,Pos} when Pos >= 1-> -%% PosP1 = Pos + 1, -%% <<Res0:PosP1/binary,NewBuf/binary>> = Buf, -%% PosM1 = Pos - 1, -%% Res = case Res0 of -%% <<Chomped:PosM1/binary,$\r:8,$\n:8>> -> -%% cat(Chomped, <<"\n">>, ReadMode,latin1,OutEnc); -%% _Other -> -%% cast(Res0, ReadMode,latin1,OutEnc) -%% end, -%% {reply,Res,State#state{buf=NewBuf}}; -%% {match,Pos} -> -%% PosP1 = Pos + 1, -%% <<Res:PosP1/binary,NewBuf/binary>> = Buf, -%% {reply,Res,State#state{buf=NewBuf}} -%% end; -%% get_line(_, #state{}=State) -> -%% {error,{error,get_line},State}. - %% %% Process the I/O request get_chars %% @@ -533,7 +572,7 @@ get_chars_notempty(Mod, Func, XtraArg, S, OutEnc, <<>> -> get_chars_apply(Mod, Func, XtraArg, S, OutEnc, State, eof); _ -> - {stop,invalid_unicode,{error,invalid_unicode},State} + {stop,invalid_unicode,invalid_unicode_error(Mod, Func, XtraArg, S),State} end; {error,Reason}=Error -> {stop,Reason,Error,State} @@ -600,17 +639,25 @@ get_chars_apply(Mod, Func, XtraArg, S0, OutEnc, end catch exit:ExReason -> - {stop,ExReason,{error,err_func(Mod, Func, XtraArg)},State}; + {stop,ExReason,invalid_unicode_error(Mod, Func, XtraArg, S0),State}; error:ErrReason -> {stop,ErrReason,{error,err_func(Mod, Func, XtraArg)},State} end. - +%% A hack that tries to inform the caller about the position where the +%% error occured. +invalid_unicode_error(Mod, Func, XtraArg, S) -> + try + {erl_scan,tokens,_Args} = XtraArg, + Location = erl_scan:continuation_location(S), + {error,{Location, ?MODULE, invalid_unicode},Location} + catch + _:_ -> + {error,err_func(Mod, Func, XtraArg)} + end. %% Convert error code to make it look as before err_func(io_lib, get_until, {_,F,_}) -> - F; -err_func(_, F, _) -> F. @@ -653,20 +700,14 @@ do_setopts(Opts, State) -> end. getopts(#state{read_mode=RM, unic=Unic} = State) -> - Bin = {binary, case RM of - binary -> - true; - _ -> - false - end}, + Bin = {binary, RM =:= binary}, Uni = {encoding, Unic}, {reply,[Bin,Uni],State}. - %% Concatenate two binaries and convert the result to list or binary -cat(B1, B2, binary,latin1,latin1) -> +cat(B1, B2, binary, latin1, latin1) -> list_to_binary([B1,B2]); -cat(B1, B2, binary,InEncoding,OutEncoding) -> +cat(B1, B2, binary, InEncoding, OutEncoding) -> case unicode:characters_to_binary([B1,B2],InEncoding,OutEncoding) of Good when is_binary(Good) -> Good; @@ -688,6 +729,8 @@ cat(B1, B2, list, latin1,_) -> binary_to_list(B1)++binary_to_list(B2). %% Cast binary to list or binary +cast(eof, _, _, _) -> + eof; cast(B, binary, latin1, latin1) -> B; cast(B, binary, InEncoding, OutEncoding) -> @@ -711,6 +754,8 @@ cast(B, list, InEncoding, OutEncoding) -> %% Convert buffer to binary cast_binary(Binary) when is_binary(Binary) -> Binary; +cast_binary([<<>>|List]) -> + cast_binary(List); cast_binary(List) when is_list(List) -> list_to_binary(List); cast_binary(_EOF) -> @@ -872,11 +917,14 @@ cbv({utf32,little},_) -> %% Compensates ?PRIM_FILE:position/2 for the number of bytes %% we have buffered - -position(Handle, cur, Buf) -> - position(Handle, {cur, 0}, Buf); -position(Handle, {cur, Offs}, Buf) when is_binary(Buf) -> - ?PRIM_FILE:position(Handle, {cur, Offs-byte_size(Buf)}); -position(Handle, At, _Buf) -> - ?PRIM_FILE:position(Handle, At). - +position(Handle, At, Buf) -> + ?PRIM_FILE:position( + Handle, + case At of + cur -> + {cur, -byte_size(Buf)}; + {cur, Offs} -> + {cur, Offs-byte_size(Buf)}; + _ -> + At + end). diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 74f2fb94a9..6504174cbc 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2000-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. -%% +%% +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% @@ -62,6 +63,8 @@ stop() -> %%% Callback functions from gen_server %%%---------------------------------------------------------------------- +-type state() :: port(). % Internal type + %%---------------------------------------------------------------------- %% Func: init/1 %% Returns: {ok, State} | @@ -69,11 +72,15 @@ stop() -> %% ignore | %% {stop, Reason} %%---------------------------------------------------------------------- + +-spec init([]) -> {'ok', state()} | {'stop', term()}. + init([]) -> process_flag(trap_exit, true), case ?PRIM_FILE:start() of {ok, Handle} -> - ets:new(?FILE_IO_SERVER_TABLE, [named_table]), + ?FILE_IO_SERVER_TABLE = + ets:new(?FILE_IO_SERVER_TABLE, [named_table]), {ok, Handle}; {error, Reason} -> {stop, Reason} @@ -88,6 +95,12 @@ init([]) -> %% {stop, Reason, Reply, State} | (terminate/2 is called) %% {stop, Reason, State} (terminate/2 is called) %%---------------------------------------------------------------------- + +-spec handle_call(term(), term(), state()) -> + {'noreply', state()} | + {'reply', 'eof' | 'ok' | {'error', term()} | {'ok', term()}, state()} | + {'stop', 'normal', 'stopped', state()}. + handle_call({open, Name, ModeList}, {Pid, _Tag} = _From, Handle) when is_list(ModeList) -> Child = ?FILE_IO_SERVER:start_link(Pid, Name, ModeList), @@ -125,6 +138,8 @@ handle_call({del_dir, Name}, _From, Handle) -> handle_call({list_dir, Name}, _From, Handle) -> {reply, ?PRIM_FILE:list_dir(Handle, Name), Handle}; +handle_call({list_dir_all, Name}, _From, Handle) -> + {reply, ?PRIM_FILE:list_dir_all(Handle, Name), Handle}; handle_call(get_cwd, _From, Handle) -> {reply, ?PRIM_FILE:get_cwd(Handle), Handle}; @@ -136,17 +151,28 @@ handle_call({get_cwd, Name}, _From, Handle) -> handle_call({read_file_info, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_file_info(Handle, Name), Handle}; +handle_call({read_file_info, Name, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:read_file_info(Handle, Name, Opts), Handle}; + handle_call({altname, Name}, _From, Handle) -> {reply, ?PRIM_FILE:altname(Handle, Name), Handle}; handle_call({write_file_info, Name, Info}, _From, Handle) -> {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info), Handle}; +handle_call({write_file_info, Name, Info, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:write_file_info(Handle, Name, Info, Opts), Handle}; + handle_call({read_link_info, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link_info(Handle, Name), Handle}; +handle_call({read_link_info, Name, Opts}, _From, Handle) -> + {reply, ?PRIM_FILE:read_link_info(Handle, Name, Opts), Handle}; + handle_call({read_link, Name}, _From, Handle) -> {reply, ?PRIM_FILE:read_link(Handle, Name), Handle}; +handle_call({read_link_all, Name}, _From, Handle) -> + {reply, ?PRIM_FILE:read_link_all(Handle, Name), Handle}; handle_call({make_link, Old, New}, _From, Handle) -> {reply, ?PRIM_FILE:make_link(Handle, Old, New), Handle}; @@ -190,6 +216,9 @@ handle_call(Request, From, Handle) -> %% {noreply, State, Timeout} | %% {stop, Reason, State} (terminate/2 is called) %%---------------------------------------------------------------------- + +-spec handle_cast(term(), state()) -> {'noreply', state()}. + handle_cast(Msg, State) -> error_logger:error_msg("handle_cast(~p, _)", [Msg]), {noreply, State}. @@ -201,6 +230,9 @@ handle_cast(Msg, State) -> %% {stop, Reason, State} (terminate/2 is called) %%---------------------------------------------------------------------- +-spec handle_info(term(), state()) -> + {'noreply', state()} | {'stop', 'normal', state()}. + handle_info({'EXIT', Pid, _Reason}, Handle) when is_pid(Pid) -> ets:delete(?FILE_IO_SERVER_TABLE, Pid), {noreply, Handle}; @@ -219,6 +251,9 @@ handle_info(Info, State) -> %% Purpose: Shutdown the server %% Returns: any (ignored by gen_server) %%---------------------------------------------------------------------- + +-spec terminate(term(), state()) -> 'ok'. + terminate(_Reason, Handle) -> ?PRIM_FILE:stop(Handle). @@ -227,6 +262,9 @@ terminate(_Reason, Handle) -> %% Purpose: Convert process state when code is changed %% Returns: {ok, NewState} %%---------------------------------------------------------------------- + +-spec code_change(term(), state(), term()) -> {'ok', state()}. + code_change(_OldVsn, State, _Extra) -> {ok, State}. @@ -281,8 +319,7 @@ do_start_slave(start, Filer, Name) -> SlaveMonitor = erlang:monitor(process, Slave), receive {started, Token} -> - erlang:demonitor(SlaveMonitor), - receive {'DOWN', SlaveMonitor, _, _, _} -> ok after 0 -> ok end, + erlang:demonitor(SlaveMonitor, [flush]), {ok, Slave}; {'DOWN', SlaveMonitor, _, _, Reason} -> exit(Reason) diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index 5a31e3976f..a6aa0edd15 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,19 +28,104 @@ -include("inet_sctp.hrl"). -export([open/0,open/1,open/2,close/1]). --export([listen/2,connect/4,connect/5,connect_init/4,connect_init/5]). +-export([listen/2,peeloff/2]). +-export([connect/4,connect/5,connect_init/4,connect_init/5]). -export([eof/2,abort/2]). -export([send/3,send/4,recv/1,recv/2]). -export([error_string/1]). -export([controlling_process/2]). - +-type assoc_id() :: term(). +-type option() :: + {active, true | false | once | -32768..32767} | + {buffer, non_neg_integer()} | + {dontroute, boolean()} | + {high_msgq_watermark, pos_integer()} | + {linger, {boolean(), non_neg_integer()}} | + {low_msgq_watermark, pos_integer()} | + {mode, list | binary} | list | binary | + {priority, non_neg_integer()} | + {recbuf, non_neg_integer()} | + {reuseaddr, boolean()} | + {ipv6_v6only, boolean()} | + {sctp_adaptation_layer, #sctp_setadaptation{}} | + {sctp_associnfo, #sctp_assocparams{}} | + {sctp_autoclose, non_neg_integer()} | + {sctp_default_send_param, #sctp_sndrcvinfo{}} | + {sctp_delayed_ack_time, #sctp_assoc_value{}} | + {sctp_disable_fragments, boolean()} | + {sctp_events, #sctp_event_subscribe{}} | + {sctp_get_peer_addr_info, #sctp_paddrinfo{}} | + {sctp_i_want_mapped_v4_addr, boolean()} | + {sctp_initmsg, #sctp_initmsg{}} | + {sctp_maxseg, non_neg_integer()} | + {sctp_nodelay, boolean()} | + {sctp_peer_addr_params, #sctp_paddrparams{}} | + {sctp_primary_addr, #sctp_prim{}} | + {sctp_rtoinfo, #sctp_rtoinfo{}} | + {sctp_set_peer_primary_addr, #sctp_setpeerprim{}} | + {sctp_status, #sctp_status{}} | + {sndbuf, non_neg_integer()} | + {tos, non_neg_integer()}. +-type option_name() :: + active | + buffer | + dontroute | + high_msgq_watermark | + linger | + low_msgq_watermark | + mode | + priority | + recbuf | + reuseaddr | + ipv6_v6only | + sctp_adaptation_layer | + sctp_associnfo | + sctp_autoclose | + sctp_default_send_param | + sctp_delayed_ack_time | + sctp_disable_fragments | + sctp_events | + sctp_get_peer_addr_info | + sctp_i_want_mapped_v4_addr | + sctp_initmsg | + sctp_maxseg | + sctp_nodelay | + sctp_peer_addr_params | + sctp_primary_addr | + sctp_rtoinfo | + sctp_set_peer_primary_addr | + sctp_status | + sndbuf | + tos. +-type sctp_socket() :: port(). + +-export_type([assoc_id/0, option/0, option_name/0, sctp_socket/0]). + +-spec open() -> {ok, Socket} | {error, inet:posix()} when + Socket :: sctp_socket(). open() -> open([]). -open(Opts) when is_list(Opts) -> - Mod = mod(Opts), +-spec open(Port) -> {ok, Socket} | {error, inet:posix()} when + Port :: inet:port_number(), + Socket :: sctp_socket(); + (Opts) -> {ok, Socket} | {error, inet:posix()} when + Opts :: [Opt], + Opt :: {ip,IP} + | {ifaddr,IP} + | inet:address_family() + | {port,Port} + | {type,SockType} + | option(), + IP :: inet:ip_address() | any | loopback, + Port :: inet:port_number(), + SockType :: seqpacket | stream, + Socket :: sctp_socket(). + +open(Opts0) when is_list(Opts0) -> + {Mod, Opts} = inet:sctp_module(Opts0), case Mod:open(Opts) of {error,badarg} -> erlang:error(badarg, [Opts]); @@ -52,11 +138,27 @@ open(Port) when is_integer(Port) -> open(X) -> erlang:error(badarg, [X]). +-spec open(Port, Opts) -> {ok, Socket} | {error, inet:posix()} when + Opts :: [Opt], + Opt :: {ip,IP} + | {ifaddr,IP} + | inet:address_family() + | {port,Port} + | {type,SockType} + | option(), + IP :: inet:ip_address() | any | loopback, + Port :: inet:port_number(), + SockType :: seqpacket | stream, + Socket :: sctp_socket(). + open(Port, Opts) when is_integer(Port), is_list(Opts) -> open([{port,Port}|Opts]); open(Port, Opts) -> erlang:error(badarg, [Port,Opts]). +-spec close(Socket) -> ok | {error, inet:posix()} when + Socket :: sctp_socket(). + close(S) when is_port(S) -> case inet_db:lookup_socket(S) of {ok,Mod} -> @@ -68,18 +170,60 @@ close(S) -> -listen(S, Flag) when is_port(S), is_boolean(Flag) -> +-spec listen(Socket, IsServer) -> ok | {error, Reason} when + Socket :: sctp_socket(), + IsServer :: boolean(), + Reason :: term(); + (Socket, Backlog) -> ok | {error, Reason} when + Socket :: sctp_socket(), + Backlog :: integer(), + Reason :: term(). + +listen(S, Backlog) + when is_port(S), is_boolean(Backlog); + is_port(S), is_integer(Backlog) -> case inet_db:lookup_socket(S) of {ok,Mod} -> - Mod:listen(S, Flag); + Mod:listen(S, Backlog); Error -> Error end; listen(S, Flag) -> erlang:error(badarg, [S,Flag]). +-spec peeloff(Socket, Assoc) -> {ok, NewSocket} | {error, Reason} when + Socket :: sctp_socket(), + Assoc :: #sctp_assoc_change{} | assoc_id(), + NewSocket :: sctp_socket(), + Reason :: term(). + +peeloff(S, #sctp_assoc_change{assoc_id=AssocId}) when is_port(S) -> + peeloff(S, AssocId); +peeloff(S, AssocId) when is_port(S), is_integer(AssocId) -> + case inet_db:lookup_socket(S) of + {ok,Mod} -> + Mod:peeloff(S, AssocId); + Error -> Error + end. + +-spec connect(Socket, Addr, Port, Opts) -> {ok, Assoc} | {error, inet:posix()} when + Socket :: sctp_socket(), + Addr :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Opts :: [Opt :: option()], + Assoc :: #sctp_assoc_change{}. + connect(S, Addr, Port, Opts) -> connect(S, Addr, Port, Opts, infinity). +-spec connect(Socket, Addr, Port, Opts, Timeout) -> + {ok, Assoc} | {error, inet:posix()} when + Socket :: sctp_socket(), + Addr :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Opts :: [Opt :: option()], + Timeout :: timeout(), + Assoc :: #sctp_assoc_change{}. + connect(S, Addr, Port, Opts, Timeout) -> case do_connect(S, Addr, Port, Opts, Timeout, true) of badarg -> @@ -88,9 +232,24 @@ connect(S, Addr, Port, Opts, Timeout) -> Result end. +-spec connect_init(Socket, Addr, Port, Opts) -> + ok | {error, inet:posix()} when + Socket :: sctp_socket(), + Addr :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Opts :: [option()]. + connect_init(S, Addr, Port, Opts) -> connect_init(S, Addr, Port, Opts, infinity). +-spec connect_init(Socket, Addr, Port, Opts, Timeout) -> + ok | {error, inet:posix()} when + Socket :: sctp_socket(), + Addr :: inet:ip_address() | inet:hostname(), + Port :: inet:port_number(), + Opts :: [option()], + Timeout :: timeout(). + connect_init(S, Addr, Port, Opts, Timeout) -> case do_connect(S, Addr, Port, Opts, Timeout, false) of badarg -> @@ -116,7 +275,7 @@ do_connect(S, Addr, Port, Opts, Timeout, ConnWait) when is_port(S), is_list(Opts Mod:connect(S, IP, Port, Opts, ConnectTimer); Error -> Error after - inet:stop_timer(Timer) + _ = inet:stop_timer(Timer) end catch error:badarg -> @@ -130,12 +289,20 @@ do_connect(_S, _Addr, _Port, _Opts, _Timeout, _ConnWait) -> badarg. +-spec eof(Socket, Assoc) -> ok | {error, Reason} when + Socket :: sctp_socket(), + Assoc :: #sctp_assoc_change{}, + Reason :: term(). eof(S, #sctp_assoc_change{assoc_id=AssocId}) when is_port(S) -> eof_or_abort(S, AssocId, eof); eof(S, Assoc) -> erlang:error(badarg, [S,Assoc]). +-spec abort(Socket, Assoc) -> ok | {error, inet:posix()} when + Socket :: sctp_socket(), + Assoc :: #sctp_assoc_change{}. + abort(S, #sctp_assoc_change{assoc_id=AssocId}) when is_port(S) -> eof_or_abort(S, AssocId, abort); abort(S, Assoc) -> @@ -151,6 +318,11 @@ eof_or_abort(S, AssocId, Action) -> end. +-spec send(Socket, SndRcvInfo, Data) -> ok | {error, Reason} when + Socket :: sctp_socket(), + SndRcvInfo :: #sctp_sndrcvinfo{}, + Data :: binary() | iolist(), + Reason :: term(). %% Full-featured send. Rarely needed. send(S, #sctp_sndrcvinfo{}=SRI, Data) when is_port(S) -> @@ -162,30 +334,60 @@ send(S, #sctp_sndrcvinfo{}=SRI, Data) when is_port(S) -> send(S, SRI, Data) -> erlang:error(badarg, [S,SRI,Data]). +-spec send(Socket, Assoc, Stream, Data) -> ok | {error, Reason} when + Socket :: sctp_socket(), + Assoc :: #sctp_assoc_change{} | assoc_id(), + Stream :: integer(), + Data :: binary() | iolist(), + Reason :: term(). + send(S, #sctp_assoc_change{assoc_id=AssocId}, Stream, Data) when is_port(S), is_integer(Stream) -> case inet_db:lookup_socket(S) of {ok,Mod} -> - Mod:sendmsg(S, #sctp_sndrcvinfo{ - stream = Stream, - assoc_id = AssocId}, Data); + Mod:send(S, AssocId, Stream, Data); Error -> Error end; send(S, AssocId, Stream, Data) when is_port(S), is_integer(AssocId), is_integer(Stream) -> case inet_db:lookup_socket(S) of {ok,Mod} -> - Mod:sendmsg(S, #sctp_sndrcvinfo{ - stream = Stream, - assoc_id = AssocId}, Data); + Mod:send(S, AssocId, Stream, Data); Error -> Error end; send(S, AssocChange, Stream, Data) -> erlang:error(badarg, [S,AssocChange,Stream,Data]). +-spec recv(Socket) -> {ok, {FromIP, FromPort, AncData, Data}} + | {error, Reason} when + Socket :: sctp_socket(), + FromIP :: inet:ip_address(), + FromPort :: inet:port_number(), + AncData :: [#sctp_sndrcvinfo{}], + Data :: binary() | string() | #sctp_sndrcvinfo{} + | #sctp_assoc_change{} | #sctp_paddr_change{} + | #sctp_adaptation_event{}, + Reason :: inet:posix() | #sctp_send_failed{} | #sctp_paddr_change{} + | #sctp_pdapi_event{} | #sctp_remote_error{} + | #sctp_shutdown_event{}. + recv(S) -> recv(S, infinity). +-spec recv(Socket, Timeout) -> {ok, {FromIP, FromPort, AncData, Data}} + | {error, Reason} when + Socket :: sctp_socket(), + Timeout :: timeout(), + FromIP :: inet:ip_address(), + FromPort :: inet:port_number(), + AncData :: [#sctp_sndrcvinfo{}], + Data :: binary() | string() | #sctp_sndrcvinfo{} + | #sctp_assoc_change{} | #sctp_paddr_change{} + | #sctp_adaptation_event{}, + Reason :: inet:posix() | #sctp_send_failed{} | #sctp_paddr_change{} + | #sctp_pdapi_event{} | #sctp_remote_error{} + | #sctp_shutdown_event{}. + recv(S, Timeout) when is_port(S) -> case inet_db:lookup_socket(S) of {ok,Mod} -> @@ -196,6 +398,8 @@ recv(S, Timeout) -> erlang:error(badarg, [S,Timeout]). +-spec error_string(ErrorNumber) -> ok | string() | unknown_error when + ErrorNumber :: integer(). error_string(0) -> ok; @@ -220,7 +424,11 @@ error_string(9) -> error_string(10) -> "Cookie Received While Shutting Down"; error_string(11) -> + "Restart of an Association with New Addresses"; +error_string(12) -> "User Initiated Abort"; +error_string(13) -> + "Protocol Violation"; %% For more info on principal SCTP error codes: phone +44 7981131933 error_string(N) when is_integer(N) -> unknown_error; @@ -228,27 +436,12 @@ error_string(X) -> erlang:error(badarg, [X]). +-spec controlling_process(Socket, Pid) -> ok | {error, Reason} when + Socket :: sctp_socket(), + Pid :: pid(), + Reason :: closed | not_owner | badarg | inet:posix(). controlling_process(S, Pid) when is_port(S), is_pid(Pid) -> inet:udp_controlling_process(S, Pid); controlling_process(S, Pid) -> erlang:error(badarg, [S,Pid]). - -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Utilites -%% - -%% Get the SCTP moudule -mod() -> inet_db:sctp_module(). - -%% Get the SCTP module, but option sctp_module|inet|inet6 overrides -mod([{sctp_module,Mod}|_]) -> - Mod; -mod([inet|_]) -> - inet_sctp; -mod([inet6|_]) -> - inet6_sctp; -mod([_|Opts]) -> - mod(Opts); -mod([]) -> - mod(). diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 7401b06a64..ac61dbc792 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -27,17 +28,122 @@ -export([fdopen/2]). -include("inet_int.hrl"). +-include("file.hrl"). + +-type option() :: + {active, true | false | once | -32768..32767} | + {buffer, non_neg_integer()} | + {delay_send, boolean()} | + {deliver, port | term} | + {dontroute, boolean()} | + {exit_on_close, boolean()} | + {header, non_neg_integer()} | + {high_msgq_watermark, pos_integer()} | + {high_watermark, non_neg_integer()} | + {keepalive, boolean()} | + {linger, {boolean(), non_neg_integer()}} | + {low_msgq_watermark, pos_integer()} | + {low_watermark, non_neg_integer()} | + {mode, list | binary} | list | binary | + {nodelay, boolean()} | + {packet, + 0 | 1 | 2 | 4 | raw | sunrm | asn1 | + cdr | fcgi | line | tpkt | http | httph | http_bin | httph_bin } | + {packet_size, non_neg_integer()} | + {priority, non_neg_integer()} | + {raw, + Protocol :: non_neg_integer(), + OptionNum :: non_neg_integer(), + ValueBin :: binary()} | + {recbuf, non_neg_integer()} | + {reuseaddr, boolean()} | + {send_timeout, non_neg_integer() | infinity} | + {send_timeout_close, boolean()} | + {show_econnreset, boolean()} | + {sndbuf, non_neg_integer()} | + {tos, non_neg_integer()} | + {ipv6_v6only, boolean()}. +-type option_name() :: + active | + buffer | + delay_send | + deliver | + dontroute | + exit_on_close | + header | + high_msgq_watermark | + high_watermark | + keepalive | + linger | + low_msgq_watermark | + low_watermark | + mode | + nodelay | + packet | + packet_size | + priority | + {raw, + Protocol :: non_neg_integer(), + OptionNum :: non_neg_integer(), + ValueSpec :: (ValueSize :: non_neg_integer()) | + (ValueBin :: binary())} | + recbuf | + reuseaddr | + send_timeout | + send_timeout_close | + show_econnreset | + sndbuf | + tos | + ipv6_v6only. +-type connect_option() :: + {ip, inet:socket_address()} | + {fd, Fd :: non_neg_integer()} | + {ifaddr, inet:socket_address()} | + inet:address_family() | + {port, inet:port_number()} | + {tcp_module, module()} | + option(). +-type listen_option() :: + {ip, inet:socket_address()} | + {fd, Fd :: non_neg_integer()} | + {ifaddr, inet:socket_address()} | + inet:address_family() | + {port, inet:port_number()} | + {backlog, B :: non_neg_integer()} | + {tcp_module, module()} | + option(). +-type socket() :: port(). + +-export_type([option/0, option_name/0, connect_option/0, listen_option/0, + socket/0]). %% %% Connect a socket %% + +-spec connect(Address, Port, Options) -> {ok, Socket} | {error, Reason} when + Address :: inet:socket_address() | inet:hostname(), + Port :: inet:port_number(), + Options :: [connect_option()], + Socket :: socket(), + Reason :: inet:posix(). + connect(Address, Port, Opts) -> connect(Address,Port,Opts,infinity). +-spec connect(Address, Port, Options, Timeout) -> + {ok, Socket} | {error, Reason} when + Address :: inet:socket_address() | inet:hostname(), + Port :: inet:port_number(), + Options :: [connect_option()], + Timeout :: timeout(), + Socket :: socket(), + Reason :: inet:posix(). + connect(Address, Port, Opts, Time) -> Timer = inet:start_timer(Time), Res = (catch connect1(Address,Port,Opts,Timer)), - inet:stop_timer(Timer), + _ = inet:stop_timer(Timer), case Res of {ok,S} -> {ok,S}; {error, einval} -> exit(badarg); @@ -45,8 +151,8 @@ connect(Address, Port, Opts, Time) -> Error -> Error end. -connect1(Address,Port,Opts,Timer) -> - Mod = mod(Opts), +connect1(Address, Port, Opts0, Timer) -> + {Mod, Opts} = inet:tcp_module(Opts0, Address), case Mod:getaddrs(Address,Timer) of {ok,IPs} -> case Mod:getserv(Port) of @@ -72,8 +178,15 @@ try_connect([], _Port, _Opts, _Timer, _Mod, Err) -> %% %% Listen on a tcp port %% -listen(Port, Opts) -> - Mod = mod(Opts), + +-spec listen(Port, Options) -> {ok, ListenSocket} | {error, Reason} when + Port :: inet:port_number(), + Options :: [listen_option()], + ListenSocket :: socket(), + Reason :: system_limit | inet:posix(). + +listen(Port, Opts0) -> + {Mod, Opts} = inet:tcp_module(Opts0), case Mod:getserv(Port) of {ok,TP} -> Mod:listen(TP, Opts); @@ -85,6 +198,12 @@ listen(Port, Opts) -> %% %% Generic tcp accept %% + +-spec accept(ListenSocket) -> {ok, Socket} | {error, Reason} when + ListenSocket :: socket(), + Socket :: socket(), + Reason :: closed | timeout | system_limit | inet:posix(). + accept(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -93,6 +212,12 @@ accept(S) -> Error end. +-spec accept(ListenSocket, Timeout) -> {ok, Socket} | {error, Reason} when + ListenSocket :: socket(), + Timeout :: timeout(), + Socket :: socket(), + Reason :: closed | timeout | system_limit | inet:posix(). + accept(S, Time) when is_port(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -104,6 +229,12 @@ accept(S, Time) when is_port(S) -> %% %% Generic tcp shutdown %% + +-spec shutdown(Socket, How) -> ok | {error, Reason} when + Socket :: socket(), + How :: read | write | read_write, + Reason :: inet:posix(). + shutdown(S, How) when is_port(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -115,12 +246,22 @@ shutdown(S, How) when is_port(S) -> %% %% Close %% + +-spec close(Socket) -> ok when + Socket :: socket(). + close(S) -> inet:tcp_close(S). %% %% Send %% + +-spec send(Socket, Packet) -> ok | {error, Reason} when + Socket :: socket(), + Packet :: iodata(), + Reason :: closed | inet:posix(). + send(S, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -132,6 +273,14 @@ send(S, Packet) when is_port(S) -> %% %% Receive data from a socket (passive mode) %% + +-spec recv(Socket, Length) -> {ok, Packet} | {error, Reason} when + Socket :: socket(), + Length :: non_neg_integer(), + Packet :: string() | binary() | HttpPacket, + Reason :: closed | inet:posix(), + HttpPacket :: term(). + recv(S, Length) when is_port(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -140,6 +289,14 @@ recv(S, Length) when is_port(S) -> Error end. +-spec recv(Socket, Length, Timeout) -> {ok, Packet} | {error, Reason} when + Socket :: socket(), + Length :: non_neg_integer(), + Timeout :: timeout(), + Packet :: string() | binary() | HttpPacket, + Reason :: closed | inet:posix(), + HttpPacket :: term(). + recv(S, Length, Time) when is_port(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -154,11 +311,17 @@ unrecv(S, Data) when is_port(S) -> Mod:unrecv(S, Data); Error -> Error - end. + end. %% %% Set controlling process %% + +-spec controlling_process(Socket, Pid) -> ok | {error, Reason} when + Socket :: socket(), + Pid :: pid(), + Reason :: closed | not_owner | badarg | inet:posix(). + controlling_process(S, NewOwner) -> case inet_db:lookup_socket(S) of {ok, _Mod} -> % Just check that this is an open socket @@ -172,21 +335,6 @@ controlling_process(S, NewOwner) -> %% %% Create a port/socket from a file descriptor %% -fdopen(Fd, Opts) -> - Mod = mod(Opts), +fdopen(Fd, Opts0) -> + {Mod, Opts} = inet:tcp_module(Opts0), Mod:fdopen(Fd, Opts). - -%% Get the tcp_module -mod() -> inet_db:tcp_module(). - -%% Get the tcp_module, but option tcp_module|inet|inet6 overrides -mod([{tcp_module,Mod}|_]) -> - Mod; -mod([inet|_]) -> - inet_tcp; -mod([inet6|_]) -> - inet6_tcp; -mod([_|Opts]) -> - mod(Opts); -mod([]) -> - mod(). diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 6bded4bda6..3121544719 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -25,17 +26,99 @@ -include("inet_int.hrl"). +-type option() :: + {active, true | false | once | -32768..32767} | + {add_membership, {inet:ip_address(), inet:ip_address()}} | + {broadcast, boolean()} | + {buffer, non_neg_integer()} | + {deliver, port | term} | + {dontroute, boolean()} | + {drop_membership, {inet:ip_address(), inet:ip_address()}} | + {header, non_neg_integer()} | + {high_msgq_watermark, pos_integer()} | + {low_msgq_watermark, pos_integer()} | + {mode, list | binary} | list | binary | + {multicast_if, inet:ip_address()} | + {multicast_loop, boolean()} | + {multicast_ttl, non_neg_integer()} | + {priority, non_neg_integer()} | + {raw, + Protocol :: non_neg_integer(), + OptionNum :: non_neg_integer(), + ValueBin :: binary()} | + {read_packets, non_neg_integer()} | + {recbuf, non_neg_integer()} | + {reuseaddr, boolean()} | + {sndbuf, non_neg_integer()} | + {tos, non_neg_integer()} | + {ipv6_v6only, boolean()}. +-type option_name() :: + active | + broadcast | + buffer | + deliver | + dontroute | + header | + high_msgq_watermark | + low_msgq_watermark | + mode | + multicast_if | + multicast_loop | + multicast_ttl | + priority | + {raw, + Protocol :: non_neg_integer(), + OptionNum :: non_neg_integer(), + ValueSpec :: (ValueSize :: non_neg_integer()) | + (ValueBin :: binary())} | + read_packets | + recbuf | + reuseaddr | + sndbuf | + tos | + ipv6_v6only. +-type socket() :: port(). + +-export_type([option/0, option_name/0, socket/0]). + +-spec open(Port) -> {ok, Socket} | {error, Reason} when + Port :: inet:port_number(), + Socket :: socket(), + Reason :: inet:posix(). + open(Port) -> open(Port, []). -open(Port, Opts) -> - Mod = mod(Opts), - {ok,UP} = Mod:getserv(Port), +-spec open(Port, Opts) -> {ok, Socket} | {error, Reason} when + Port :: inet:port_number(), + Opts :: [Option], + Option :: {ip, inet:socket_address()} + | {fd, non_neg_integer()} + | {ifaddr, inet:socket_address()} + | inet:address_family() + | {port, inet:port_number()} + | option(), + Socket :: socket(), + Reason :: inet:posix(). + +open(Port, Opts0) -> + {Mod, Opts} = inet:udp_module(Opts0), + {ok, UP} = Mod:getserv(Port), Mod:open(UP, Opts). +-spec close(Socket) -> ok when + Socket :: socket(). + close(S) -> inet:udp_close(S). +-spec send(Socket, Address, Port, Packet) -> ok | {error, Reason} when + Socket :: socket(), + Address :: inet:socket_address() | inet:hostname(), + Port :: inet:port_number(), + Packet :: iodata(), + Reason :: not_owner | inet:posix(). + send(S, Address, Port, Packet) when is_port(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -61,6 +144,15 @@ send(S, Packet) when is_port(S) -> Error end. +-spec recv(Socket, Length) -> + {ok, {Address, Port, Packet}} | {error, Reason} when + Socket :: socket(), + Length :: non_neg_integer(), + Address :: inet:ip_address() | inet:returned_non_ip_address(), + Port :: inet:port_number(), + Packet :: string() | binary(), + Reason :: not_owner | inet:posix(). + recv(S,Len) when is_port(S), is_integer(Len) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -69,6 +161,16 @@ recv(S,Len) when is_port(S), is_integer(Len) -> Error end. +-spec recv(Socket, Length, Timeout) -> + {ok, {Address, Port, Packet}} | {error, Reason} when + Socket :: socket(), + Length :: non_neg_integer(), + Timeout :: timeout(), + Address :: inet:ip_address() | inet:returned_non_ip_address(), + Port :: inet:port_number(), + Packet :: string() | binary(), + Reason :: not_owner | inet:posix(). + recv(S,Len,Time) when is_port(S) -> case inet_db:lookup_socket(S) of {ok, Mod} -> @@ -90,28 +192,17 @@ connect(S, Address, Port) when is_port(S) -> Error end. +-spec controlling_process(Socket, Pid) -> ok | {error, Reason} when + Socket :: socket(), + Pid :: pid(), + Reason :: closed | not_owner | badarg | inet:posix(). + controlling_process(S, NewOwner) -> inet:udp_controlling_process(S, NewOwner). %% %% Create a port/socket from a file descriptor %% -fdopen(Fd, Opts) -> - Mod = mod(), +fdopen(Fd, Opts0) -> + {Mod,Opts} = inet:udp_module(Opts0), Mod:fdopen(Fd, Opts). - - -%% Get the udp_module -mod() -> inet_db:udp_module(). - -%% Get the udp_module, but option udp_module|inet|inet6 overrides -mod([{udp_module,Mod}|_]) -> - Mod; -mod([inet|_]) -> - inet_udp; -mod([inet6|_]) -> - inet6_udp; -mod([_|Opts]) -> - mod(Opts); -mod([]) -> - mod(). diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index cc0402da73..0c73ead7c5 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(global). @@ -28,7 +29,7 @@ %% External exports -export([start/0, start_link/0, stop/0, sync/0, sync/1, - safe_whereis_name/1, whereis_name/1, register_name/2, + whereis_name/1, register_name/2, register_name/3, register_name_external/2, register_name_external/3, unregister_name_external/1,re_register_name/2, re_register_name/3, unregister_name/1, registered_names/0, send/2, node_disconnected/1, @@ -112,9 +113,10 @@ resolvers = [], syncers = [] :: [pid()], node_name = node() :: node(), - the_locker, the_deleter, the_registrar, trace, - global_lock_down = false + the_locker, the_registrar, trace, + global_lock_down = false :: boolean() }). +-type state() :: #state{}. %%% There are also ETS tables used for bookkeeping of locks and names %%% (the first position is the key): @@ -153,6 +155,8 @@ %%% It can be removed later as can the deleter process. %%% An extra process calling erlang:monitor() is sometimes created. %%% The new_nodes messages has been augmented with the global lock id. +%%% +%%% R14A (OTP-8527): The deleter process has been removed. start() -> gen_server:start({local, global_name_server}, ?MODULE, [], []). @@ -163,7 +167,7 @@ start_link() -> stop() -> gen_server:call(global_name_server, stop, infinity). --spec sync() -> 'ok' | {'error', term()}. +-spec sync() -> 'ok' | {'error', Reason :: term()}. sync() -> case check_sync_nodes() of {error, _} = Error -> @@ -172,7 +176,7 @@ sync() -> gen_server:call(global_name_server, {sync, SyncNodes}, infinity) end. --spec sync([node()]) -> 'ok' | {'error', term()}. +-spec sync([node()]) -> 'ok' | {'error', Reason :: term()}. sync(Nodes) -> case check_sync_nodes(Nodes) of {error, _} = Error -> @@ -181,7 +185,10 @@ sync(Nodes) -> gen_server:call(global_name_server, {sync, SyncNodes}, infinity) end. --spec send(term(), term()) -> pid(). +-spec send(Name, Msg) -> Pid when + Name :: term(), + Msg :: term(), + Pid :: pid(). send(Name, Msg) -> case whereis_name(Name) of Pid when is_pid(Pid) -> @@ -192,14 +199,11 @@ send(Name, Msg) -> end. %% See OTP-3737. --spec whereis_name(term()) -> pid() | 'undefined'. +-spec whereis_name(Name) -> pid() | 'undefined' when + Name :: term(). whereis_name(Name) -> where(Name). --spec safe_whereis_name(term()) -> pid() | 'undefined'. -safe_whereis_name(Name) -> - gen_server:call(global_name_server, {whereis, Name}, infinity). - node_disconnected(Node) -> global_name_server ! {nodedown, Node}. @@ -216,14 +220,21 @@ node_disconnected(Node) -> %% undefined which one of them is used. %% Method blocks the name registration, but does not affect global locking. %%----------------------------------------------------------------- --spec register_name(term(), pid()) -> 'yes' | 'no'. +-spec register_name(Name, Pid) -> 'yes' | 'no' when + Name :: term(), + Pid :: pid(). register_name(Name, Pid) when is_pid(Pid) -> register_name(Name, Pid, fun random_exit_name/3). --type method() :: fun((term(), pid(), pid()) -> pid() | 'none'). +-type method() :: fun((Name :: term(), Pid :: pid(), Pid2 :: pid()) -> + pid() | 'none'). --spec register_name(term(), pid(), method()) -> 'yes' | 'no'. -register_name(Name, Pid, Method) when is_pid(Pid) -> +-spec register_name(Name, Pid, Resolve) -> 'yes' | 'no' when + Name :: term(), + Pid :: pid(), + Resolve :: method(). +register_name(Name, Pid, Method0) when is_pid(Pid) -> + Method = allow_tuple_fun(Method0), Fun = fun(Nodes) -> case (where(Name) =:= undefined) andalso check_dupname(Name, Pid) of true -> @@ -254,7 +265,8 @@ check_dupname(Name, Pid) -> end end. --spec unregister_name(term()) -> _. +-spec unregister_name(Name) -> _ when + Name :: term(). unregister_name(Name) -> case where(Name) of undefined -> @@ -270,12 +282,18 @@ unregister_name(Name) -> gen_server:call(global_name_server, {registrar, Fun}, infinity) end. --spec re_register_name(term(), pid()) -> _. +-spec re_register_name(Name, Pid) -> 'yes' when + Name :: term(), + Pid :: pid(). re_register_name(Name, Pid) when is_pid(Pid) -> re_register_name(Name, Pid, fun random_exit_name/3). --spec re_register_name(term(), pid(), method()) -> _. -re_register_name(Name, Pid, Method) when is_pid(Pid) -> +-spec re_register_name(Name, Pid, Resolve) -> 'yes' when + Name :: term(), + Pid :: pid(), + Resolve :: method(). +re_register_name(Name, Pid, Method0) when is_pid(Pid) -> + Method = allow_tuple_fun(Method0), Fun = fun(Nodes) -> gen_server:multi_call(Nodes, global_name_server, @@ -285,7 +303,8 @@ re_register_name(Name, Pid, Method) when is_pid(Pid) -> ?trace({re_register_name, self(), Name, Pid, Method}), gen_server:call(global_name_server, {registrar, Fun}, infinity). --spec registered_names() -> [term()]. +-spec registered_names() -> [Name] when + Name :: term(). registered_names() -> MS = ets:fun2ms(fun({Name,_Pid,_M,_RP,_R}) -> Name end), ets:select(global_names, MS). @@ -326,19 +345,25 @@ register_name_external(Name, Pid, Method) when is_pid(Pid) -> unregister_name_external(Name) -> unregister_name(Name). --type id() :: {term(), term()}. +-type id() :: {ResourceId :: term(), LockRequesterId :: term()}. --spec set_lock(id()) -> boolean(). +-spec set_lock(Id) -> boolean() when + Id :: id(). set_lock(Id) -> set_lock(Id, [node() | nodes()], infinity, 1). -type retries() :: non_neg_integer() | 'infinity'. --spec set_lock(id(), [node()]) -> boolean(). +-spec set_lock(Id, Nodes) -> boolean() when + Id :: id(), + Nodes :: [node()]. set_lock(Id, Nodes) -> set_lock(Id, Nodes, infinity, 1). --spec set_lock(id(), [node()], retries()) -> boolean(). +-spec set_lock(Id, Nodes, Retries) -> boolean() when + Id :: id(), + Nodes :: [node()], + Retries :: retries(). set_lock(Id, Nodes, Retries) when is_integer(Retries), Retries >= 0 -> set_lock(Id, Nodes, Retries, 1); set_lock(Id, Nodes, infinity) -> @@ -360,11 +385,14 @@ set_lock({_ResourceId, _LockRequesterId} = Id, Nodes, Retries, Times) -> set_lock(Id, Nodes, dec(Retries), Times+1) end. --spec del_lock(id()) -> 'true'. +-spec del_lock(Id) -> 'true' when + Id :: id(). del_lock(Id) -> del_lock(Id, [node() | nodes()]). --spec del_lock(id(), [node()]) -> 'true'. +-spec del_lock(Id, Nodes) -> 'true' when + Id :: id(), + Nodes :: [node()]. del_lock({_ResourceId, _LockRequesterId} = Id, Nodes) -> ?trace({del_lock, {me,self()}, Id, {nodes,Nodes}}), gen_server:multi_call(Nodes, global_name_server, {del_lock, Id}), @@ -372,13 +400,25 @@ del_lock({_ResourceId, _LockRequesterId} = Id, Nodes) -> -type trans_fun() :: function() | {module(), atom()}. --spec trans(id(), trans_fun()) -> term(). +-spec trans(Id, Fun) -> Res | aborted when + Id :: id(), + Fun :: trans_fun(), + Res :: term(). trans(Id, Fun) -> trans(Id, Fun, [node() | nodes()], infinity). --spec trans(id(), trans_fun(), [node()]) -> term(). +-spec trans(Id, Fun, Nodes) -> Res | aborted when + Id :: id(), + Fun :: trans_fun(), + Nodes :: [node()], + Res :: term(). trans(Id, Fun, Nodes) -> trans(Id, Fun, Nodes, infinity). --spec trans(id(), trans_fun(), [node()], retries()) -> term(). +-spec trans(Id, Fun, Nodes, Retries) -> Res | aborted when + Id :: id(), + Fun :: trans_fun(), + Nodes :: [node()], + Retries :: retries(), + Res :: term(). trans(Id, Fun, Nodes, Retries) -> case set_lock(Id, Nodes, Retries) of true -> @@ -397,6 +437,9 @@ info() -> %%%----------------------------------------------------------------- %%% Call-back functions from gen_server %%%----------------------------------------------------------------- + +-spec init([]) -> {'ok', state()}. + init([]) -> process_flag(trap_exit, true), _ = ets:new(global_locks, [set, named_table, protected]), @@ -416,18 +459,17 @@ init([]) -> no_trace end, + Ca = case init:get_argument(connect_all) of + {ok, [["false"]]} -> + false; + _ -> + true + end, S = #state{the_locker = start_the_locker(DoTrace), trace = T0, - the_deleter = start_the_deleter(self()), - the_registrar = start_the_registrar()}, - S1 = trace_message(S, {init, node()}, []), - - case init:get_argument(connect_all) of - {ok, [["false"]]} -> - {ok, S1#state{connect_all = false}}; - _ -> - {ok, S1#state{connect_all = true}} - end. + the_registrar = start_the_registrar(), + connect_all = Ca}, + {ok, trace_message(S, {init, node()}, [])}. %%----------------------------------------------------------------- %% Connection algorithm @@ -467,8 +509,7 @@ init([]) -> %% delay can sometimes be quite substantial. Global guarantees that %% the name will eventually be removed, but there is no %% synchronization between nodes; the name can be removed from some -%% node(s) long before it is removed from other nodes. Using -%% safe_whereis_name is no cure. +%% node(s) long before it is removed from other nodes. %% %% - Global cannot handle problems with the distribution very well. %% Depending on the value of the kernel variable 'net_ticktime' long @@ -541,9 +582,10 @@ init([]) -> %% sent by each node to all new nodes (Node becomes known to them) %%----------------------------------------------------------------- -handle_call({whereis, Name}, From, S) -> - do_whereis(Name, From), - {noreply, S}; +-spec handle_call(term(), {pid(), term()}, state()) -> + {'noreply', state()} | + {'reply', term(), state()} | + {'stop', 'normal', 'stopped', state()}. handle_call({registrar, Fun}, From, S) -> S#state.the_registrar ! {trans_all_known, Fun, From}, @@ -620,6 +662,9 @@ handle_call(Request, From, S) -> %% init_connect %% %%======================================================================== + +-spec handle_cast(term(), state()) -> {'noreply', state()}. + handle_cast({init_connect, Vsn, Node, InitMsg}, S) -> %% Sent from global_name_server at Node. ?trace({'####', init_connect, {vsn, Vsn}, {node,Node},{initmsg,InitMsg}}), @@ -763,13 +808,16 @@ handle_cast({in_sync, Node, _IsKnown}, S) -> %% Called when Pid on other node crashed handle_cast({async_del_name, _Name, _Pid}, S) -> - %% Sent from the_deleter at some node in the partition but node(). + %% Sent from the_deleter at some node in the partition but node() (-R13B) %% The DOWN message deletes the name. + %% R14A nodes and later do not send async_del_name messages. {noreply, S}; handle_cast({async_del_lock, _ResourceId, _Pid}, S) -> - %% Sent from global_name_server at some node in the partition but node(). + %% Sent from global_name_server at some node in the partition but + %% node(). (-R13B) %% The DOWN message deletes the lock. + %% R14A nodes and later do not send async_del_lock messages. {noreply, S}; handle_cast(Request, S) -> @@ -778,8 +826,11 @@ handle_cast(Request, S) -> "handle_cast(~p, _)\n", [Request]), {noreply, S}. -handle_info({'EXIT', Deleter, _Reason}=Exit, #state{the_deleter=Deleter}=S) -> - {stop, {deleter_died,Exit}, S#state{the_deleter=undefined}}; +%%======================================================================== + +-spec handle_info(term(), state()) -> + {'noreply', state()} | {'stop', term(), state()}. + handle_info({'EXIT', Locker, _Reason}=Exit, #state{the_locker=Locker}=S) -> {stop, {locker_died,Exit}, S#state{the_locker=undefined}}; handle_info({'EXIT', Registrar, _}=Exit, #state{the_registrar=Registrar}=S) -> @@ -831,11 +882,12 @@ handle_info({nodeup, Node}, S0) when S0#state.connect_all -> false -> resend_pre_connect(Node), - %% now() is used as a tag to separate different synch sessions + %% erlang:unique_integer([monotonic]) is used as a tag to + %% separate different synch sessions %% from each others. Global could be confused at bursty nodeups %% because it couldn't separate the messages between the different %% synch sessions started by a nodeup. - MyTag = now(), + MyTag = erlang:unique_integer([monotonic]), put({sync_tag_my, Node}, MyTag), ?trace({sending_nodeup_to_locker, {node,Node},{mytag,MyTag}}), S1#state.the_locker ! {nodeup, Node, MyTag}, @@ -1120,12 +1172,17 @@ do_whereis(Name, From) -> send_again({whereis, Name, From}) end. +-spec terminate(term(), state()) -> 'ok'. + terminate(_Reason, _S) -> true = ets:delete(global_names), true = ets:delete(global_names_ext), true = ets:delete(global_locks), true = ets:delete(global_pid_names), - true = ets:delete(global_pid_ids). + true = ets:delete(global_pid_ids), + ok. + +-spec code_change(term(), state(), term()) -> {'ok', state()}. code_change(_OldVsn, S, _Extra) -> {ok, S}. @@ -1173,7 +1230,15 @@ ins_name_ext(Name, Pid, Method, RegNode, FromPidOrNode, ExtraInfo, S0) -> where(Name) -> case ets:lookup(global_names, Name) of - [{_Name, Pid, _Method, _RPid, _Ref}] -> Pid; + [{_Name, Pid, _Method, _RPid, _Ref}] -> + if node(Pid) == node() -> + case is_process_alive(Pid) of + true -> Pid; + false -> undefined + end; + true -> + Pid + end; [] -> undefined end. @@ -1348,30 +1413,13 @@ lock_still_set(PidOrNode, ExtraInfo, S) -> [{?GLOBAL_RID, _LockReqId, PidRefs}] when is_pid(PidOrNode) -> %% Name registration. lists:keymember(PidOrNode, 1, PidRefs); - [{?GLOBAL_RID, LockReqId, PidRefs}] when is_atom(PidOrNode) -> - case extra_info(lock, ExtraInfo) of - {?GLOBAL_RID, LockId} -> % R11B-4 or later - LockReqId =:= LockId; - undefined -> - lock_still_set_old(PidOrNode, LockReqId, PidRefs) - end; + [{?GLOBAL_RID, LockReqId, _PidRefs}] when is_atom(PidOrNode) -> + {?GLOBAL_RID, LockId} = extra_info(lock, ExtraInfo), + LockReqId =:= LockId; [] -> - %% If the global lock was not removed by a DOWN message - %% then we have a node that do not monitor locking pids - %% (pre R11B-3), or an R11B-3 node (which does not ensure - %% that {new_nodes, ...} arrives before {del_lock, ...}). not S#state.global_lock_down end. -%%% The following is probably overkill. It is possible that this node -%%% has been locked again, but it is a rare occasion. -lock_still_set_old(_Node, ReqId, _PidRefs) when is_pid(ReqId) -> - %% Cannot do better than return true. - true; -lock_still_set_old(Node, ReqId, PidRefs) when is_list(ReqId) -> - %% Connection, version > 4, but before R11B-4. - [P || {P, _RPid, _Ref} <- PidRefs, node(P) =:= Node] =/= []. - extra_info(Tag, ExtraInfo) -> %% ExtraInfo used to be a list of nodes (vsn 2). case catch lists:keyfind(Tag, 1, ExtraInfo) of @@ -1382,36 +1430,18 @@ extra_info(Tag, ExtraInfo) -> end. del_name(Ref, S) -> - NameL = [{Name, Pid} || + NameL = [Name || {_, Name} <- ets:lookup(global_pid_names, Ref), - {_, Pid, _Method, _RPid, Ref1} <- + {_, _Pid, _Method, _RPid, Ref1} <- ets:lookup(global_names, Name), Ref1 =:= Ref], - ?trace({async_del_name, self(), NameL, Ref}), case NameL of - [{Name, Pid}] -> - _ = del_names(Name, Pid, S), + [Name] -> delete_global_name2(Name, S); [] -> S end. -%% Send {async_del_name, ...} to old nodes (pre R11B-3). -del_names(Name, Pid, S) -> - Send = case ets:lookup(global_names_ext, Name) of - [{Name, Pid, RegNode}] -> - RegNode =:= node(); - [] -> - node(Pid) =:= node() - end, - if - Send -> - ?trace({del_names, {pid,Pid}, {name,Name}}), - S#state.the_deleter ! {delete_name, self(), Name, Pid}; - true -> - ok - end. - %% Keeps the entry in global_names for whereis_name/1. delete_global_name_keep_pid(Name, S) -> case ets:lookup(global_names, Name) of @@ -1485,14 +1515,18 @@ delete_global_name(_Name, _Pid) -> -record(him, {node, locker, vsn, my_tag}). start_the_locker(DoTrace) -> - spawn_link(fun() -> init_the_locker(DoTrace) end). + spawn_link(init_the_locker_fun(DoTrace)). -init_the_locker(DoTrace) -> - process_flag(trap_exit, true), % needed? - S0 = #multi{do_trace = DoTrace}, - S1 = update_locker_known({add, get_known()}, S0), - loop_the_locker(S1), - erlang:error(locker_exited). +-spec init_the_locker_fun(boolean()) -> fun(() -> no_return()). + +init_the_locker_fun(DoTrace) -> + fun() -> + process_flag(trap_exit, true), % needed? + S0 = #multi{do_trace = DoTrace}, + S1 = update_locker_known({add, get_known()}, S0), + loop_the_locker(S1), + erlang:error(locker_exited) + end. loop_the_locker(S) -> ?trace({loop_the_locker,S}), @@ -1740,8 +1774,8 @@ update_locker_known(Upd, S) -> S#multi{known = Known, the_boss = TheBoss}. random_element(L) -> - {A,B,C} = now(), - E = (A+B+C) rem length(L), + E = abs(erlang:monotonic_time() + bxor erlang:unique_integer()) rem length(L), lists:nth(E+1, L). exclude_known(Others, Known) -> @@ -1939,7 +1973,10 @@ resolve_it(Method, Name, Pid1, Pid2) -> minmax(P1,P2) -> if node(P1) < node(P2) -> {P1, P2}; true -> {P2, P1} end. --spec random_exit_name(term(), pid(), pid()) -> pid(). +-spec random_exit_name(Name, Pid1, Pid2) -> pid() when + Name :: term(), + Pid1 :: pid(), + Pid2 :: pid(). random_exit_name(Name, Pid, Pid2) -> {Min, Max} = minmax(Pid, Pid2), error_logger:info_msg("global: Name conflict terminating ~w\n", @@ -1947,12 +1984,19 @@ random_exit_name(Name, Pid, Pid2) -> exit(Max, kill), Min. +-spec random_notify_name(Name, Pid1, Pid2) -> pid() when + Name :: term(), + Pid1 :: pid(), + Pid2 :: pid(). random_notify_name(Name, Pid, Pid2) -> {Min, Max} = minmax(Pid, Pid2), Max ! {global_name_conflict, Name}, Min. --spec notify_all_name(term(), pid(), pid()) -> 'none'. +-spec notify_all_name(Name, Pid1, Pid2) -> 'none' when + Name :: term(), + Pid1 :: pid(), + Pid2 :: pid(). notify_all_name(Name, Pid, Pid2) -> Pid ! {global_name_conflict, Name, Pid2}, Pid2 ! {global_name_conflict, Name, Pid}, @@ -1986,10 +2030,9 @@ pid_is_locking(Pid, PidRefs) -> delete_lock(Ref, S0) -> Locks = pid_locks(Ref), - del_locks(Locks, Ref, S0#state.known), F = fun({ResourceId, LockRequesterId, PidRefs}, S) -> {Pid, _RPid, Ref} = lists:keyfind(Ref, 3, PidRefs), - remove_lock(ResourceId, LockRequesterId, Pid, PidRefs, true,S) + remove_lock(ResourceId, LockRequesterId, Pid, PidRefs, true, S) end, lists:foldl(F, S0, Locks). @@ -2003,20 +2046,6 @@ pid_locks(Ref) -> rpid_is_locking(Ref, PidRefs) -> lists:keyfind(Ref, 3, PidRefs) =/= false. -%% Send {async_del_lock, ...} to old nodes (pre R11B-3). -del_locks([{ResourceId, _LockReqId, PidRefs} | Tail], Ref, KnownNodes) -> - {Pid, _RPid, Ref} = lists:keyfind(Ref, 3, PidRefs), - case node(Pid) =:= node() of - true -> - gen_server:abcast(KnownNodes, global_name_server, - {async_del_lock, ResourceId, Pid}); - false -> - ok - end, - del_locks(Tail, Ref, KnownNodes); -del_locks([], _Ref, _KnownNodes) -> - ok. - handle_nodedown(Node, S) -> %% DOWN signals from monitors have removed locks and registered names. #state{known = Known, synced = Syncs} = S, @@ -2039,21 +2068,17 @@ get_known() -> gen_server:call(global_name_server, get_known, infinity). random_sleep(Times) -> - case (Times rem 10) of - 0 -> erase(random_seed); - _ -> ok - end, - case get(random_seed) of - undefined -> - {A1, A2, A3} = now(), - random:seed(A1, A2, A3 + erlang:phash(node(), 100000)); - _ -> ok - end, + _ = case Times rem 10 of + 0 -> + _ = rand:seed(exsplus); + _ -> + ok + end, %% First time 1/4 seconds, then doubling each time up to 8 seconds max. Tmax = if Times > 5 -> 8000; true -> ((1 bsl Times) * 1000) div 8 end, - T = random:uniform(Tmax), + T = rand:uniform(Tmax), ?trace({random_sleep, {me,self()}, {times,Times}, {t,T}, {tmax,Tmax}}), receive after T -> ok end. @@ -2078,7 +2103,7 @@ trace_message(S, M, X) -> S#state{trace = [trace_message(M, X) | S#state.trace]}. trace_message(M, X) -> - {node(), now(), M, nodes(), X}. + {node(), erlang:timestamp(), M, nodes(), X}. %%----------------------------------------------------------------- %% Each sync process corresponds to one call to sync. Each such @@ -2147,51 +2172,6 @@ get_own_nodes() -> OkTup end. -%%----------------------------------------------------------------- -%% The deleter process is a satellite process to global_name_server -%% that does background batch deleting of names when a process -%% that had globally registered names dies. It is started by and -%% linked to global_name_server. -%%----------------------------------------------------------------- - -start_the_deleter(Global) -> - spawn_link(fun() -> loop_the_deleter(Global) end). - -loop_the_deleter(Global) -> - Deletions = collect_deletions(Global, []), - ?trace({loop_the_deleter, self(), {deletions,Deletions}, - {names,get_names()}}), - %% trans_all_known is called rather than trans/3 with nodes() as - %% third argument. The reason is that known gets updated by - %% new_nodes when the lock is still set. nodes() on the other hand - %% could be updated later (if in_sync is received after the lock - %% is gone). It is not likely that in_sync would be received after - %% the lock has been taken here, but using trans_all_known makes it - %% even less likely. - trans_all_known( - fun(Known) -> - lists:map( - fun({Name,Pid}) -> - gen_server:abcast(Known, global_name_server, - {async_del_name, Name, Pid}) - end, Deletions) - end), - loop_the_deleter(Global). - -collect_deletions(Global, Deletions) -> - receive - {delete_name, Global, Name, Pid} -> - collect_deletions(Global, [{Name,Pid} | Deletions]); - Other -> - unexpected_message(Other, deleter), - collect_deletions(Global, Deletions) - after case Deletions of - [] -> infinity; - _ -> 0 - end -> - lists:reverse(Deletions) - end. - %% The registrar is a helper process that registers and unregisters %% names. Since it never dies it assures that names are registered and %% unregistered on all known nodes. It is started by and linked to @@ -2199,7 +2179,7 @@ collect_deletions(Global, Deletions) -> start_the_registrar() -> spawn_link(fun() -> loop_the_registrar() end). - + loop_the_registrar() -> receive {trans_all_known, Fun, From} -> @@ -2242,3 +2222,9 @@ intersection(_, []) -> []; intersection(L1, L2) -> L1 -- (L1 -- L2). + +%% Support legacy tuple funs as resolve functions. +allow_tuple_fun({M, F}) when is_atom(M), is_atom(F) -> + fun M:F/3; +allow_tuple_fun(Fun) when is_function(Fun, 3) -> + Fun. diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl index 7e141ac5c7..f5ead2a4c5 100644 --- a/lib/kernel/src/global_group.erl +++ b/lib/kernel/src/global_group.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -62,9 +63,10 @@ -type sync_state() :: 'no_conf' | 'synced'. -type group_name() :: atom(). --type group_tuple() :: {group_name(), [node()]} - | {group_name(), publish_type(), [node()]}. - +-type group_tuple() :: {GroupName :: group_name(), [node()]} + | {GroupName :: group_name(), + PublishType :: publish_type(), + [node()]}. %%%==================================================================================== %%% The state of the global_group process @@ -97,11 +99,14 @@ %%% External exported %%%==================================================================================== --spec global_groups() -> {group_name(), [group_name()]} | 'undefined'. +-spec global_groups() -> {GroupName, GroupNames} | undefined when + GroupName :: group_name(), + GroupNames :: [GroupName]. global_groups() -> request(global_groups). --spec monitor_nodes(boolean()) -> 'ok'. +-spec monitor_nodes(Flag) -> 'ok' when + Flag :: boolean(). monitor_nodes(Flag) -> case Flag of true -> request({monitor_nodes, Flag}); @@ -109,30 +114,41 @@ monitor_nodes(Flag) -> _ -> {error, not_boolean} end. --spec own_nodes() -> [node()]. +-spec own_nodes() -> Nodes when + Nodes :: [Node :: node()]. own_nodes() -> request(own_nodes). -type name() :: atom(). -type where() :: {'node', node()} | {'group', group_name()}. --spec registered_names(where()) -> [name()]. +-spec registered_names(Where) -> Names when + Where :: where(), + Names :: [Name :: name()]. registered_names(Arg) -> request({registered_names, Arg}). --spec send(name(), term()) -> pid() | {'badarg', {name(), term()}}. +-spec send(Name, Msg) -> pid() | {'badarg', {Name, Msg}} when + Name :: name(), + Msg :: term(). send(Name, Msg) -> request({send, Name, Msg}). --spec send(where(), name(), term()) -> pid() | {'badarg', {name(), term()}}. +-spec send(Where, Name, Msg) -> pid() | {'badarg', {Name, Msg}} when + Where :: where(), + Name :: name(), + Msg :: term(). send(Group, Name, Msg) -> request({send, Group, Name, Msg}). --spec whereis_name(name()) -> pid() | 'undefined'. +-spec whereis_name(Name) -> pid() | 'undefined' when + Name :: name(). whereis_name(Name) -> request({whereis_name, Name}). --spec whereis_name(where(), name()) -> pid() | 'undefined'. +-spec whereis_name(Where, Name) -> pid() | 'undefined' when + Where :: where(), + Name :: name(). whereis_name(Group, Name) -> request({whereis_name, Group, Name}). @@ -155,14 +171,14 @@ ng_add_check(Node, OthersNG) -> ng_add_check(Node, PubType, OthersNG) -> request({ng_add_check, Node, PubType, OthersNG}). --type info_item() :: {'state', sync_state()} - | {'own_group_name', group_name()} - | {'own_group_nodes', [node()]} - | {'synched_nodes', [node()]} - | {'sync_error', [node()]} - | {'no_contact', [node()]} - | {'other_groups', [group_tuple()]} - | {'monitoring', [pid()]}. +-type info_item() :: {'state', State :: sync_state()} + | {'own_group_name', GroupName :: group_name()} + | {'own_group_nodes', Nodes :: [node()]} + | {'synched_nodes', Nodes :: [node()]} + | {'sync_error', Nodes :: [node()]} + | {'no_contact', Nodes :: [node()]} + | {'other_groups', Groups :: [group_tuple()]} + | {'monitoring', Pids :: [pid()]}. -spec info() -> [info_item()]. info() -> @@ -257,7 +273,7 @@ init([]) -> {ok, #state{publish_type = PT, group_publish_type = PubTpGrp, sync_state = synced, group_name = DefGroupName, no_contact = lists:sort(DefNodes), - other_grps = DefOther}} + other_grps = DefOther, connect_all = Ca}} end. @@ -676,7 +692,7 @@ handle_cast({registered_names, User}, S) -> handle_cast({registered_names_res, Result, Pid, From}, S) -> % io:format(">>>>> registered_names_res Result ~p~n",[Result]), unlink(Pid), - exit(Pid, normal), + Pid ! kill, Wait = get(registered_names), NewWait = lists:delete({Pid, From},Wait), put(registered_names, NewWait), @@ -702,7 +718,7 @@ handle_cast({send_res, Result, Name, Msg, Pid, From}, S) -> ToPid ! Msg end, unlink(Pid), - exit(Pid, normal), + Pid ! kill, Wait = get(send), NewWait = lists:delete({Pid, From, Name, Msg},Wait), put(send, NewWait), @@ -732,7 +748,7 @@ handle_cast({find_name_res, Result, Pid, From}, S) -> % io:format(">>>>> find_name_res Result ~p~n",[Result]), % io:format(">>>>> find_name_res get() ~p~n",[get()]), unlink(Pid), - exit(Pid, normal), + Pid ! kill, Wait = get(whereis_name), NewWait = lists:delete({Pid, From},Wait), put(whereis_name, NewWait), @@ -1012,6 +1028,7 @@ grp_tuple({Name, normal, Nodes}) -> %%% The special process which checks that all nodes in the own global group %%% agrees on the configuration. %%%==================================================================================== +-spec sync_init(_, _, _, _) -> no_return(). sync_init(Type, Cname, PubType, Nodes) -> {Up, Down} = sync_check_node(lists:delete(node(), Nodes), [], []), sync_check_init(Type, Up, Cname, Nodes, Down, PubType). @@ -1032,9 +1049,11 @@ sync_check_node([Node|Nodes], Up, Down) -> %%% Check that all nodes are in agreement of the global %%% group configuration. %%%------------------------------------------------------------- +-spec sync_check_init(_, _, _, _, _, _) -> no_return(). sync_check_init(Type, Up, Cname, Nodes, Down, PubType) -> sync_check_init(Type, Up, Cname, Nodes, 3, [], Down, PubType). +-spec sync_check_init(_, _, _, _, _, _, _, _) -> no_return(). sync_check_init(_Type, NoContact, _Cname, _Nodes, 0, ErrorNodes, Down, _PubType) -> case ErrorNodes of [] -> @@ -1131,9 +1150,14 @@ do_unlink(Pid, State) -> %%%==================================================================================== %%% Send a nodeup/down messages to monitoring Pids in the own global group. %%%==================================================================================== -send_monitor([P|T], M, no_conf) -> safesend_nc(P, M), send_monitor(T, M, no_conf); -send_monitor([P|T], M, SyncState) -> safesend(P, M), send_monitor(T, M, SyncState); -send_monitor([], _, _) -> ok. +send_monitor([P|T], M, no_conf) -> + _ = safesend_nc(P, M), + send_monitor(T, M, no_conf); +send_monitor([P|T], M, SyncState) -> + _ = safesend(P, M), + send_monitor(T, M, SyncState); +send_monitor([], _, _) -> + ok. safesend(Name, {Msg, Node}) when is_atom(Name) -> case lists:member(Node, get_own_nodes()) of diff --git a/lib/kernel/src/global_search.erl b/lib/kernel/src/global_search.erl index b723e18a1b..11b70113e2 100644 --- a/lib/kernel/src/global_search.erl +++ b/lib/kernel/src/global_search.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -69,6 +70,7 @@ start(Flag, Arg) -> %%%==================================================================================== %%%==================================================================================== +-spec init_send(_) -> no_return(). init_send({any, NodesList, Name, Msg, From}) -> case whereis_any_loop(NodesList, Name) of undefined -> @@ -115,6 +117,7 @@ init_send({node, Node, Name, Msg, From}) -> %%%==================================================================================== %%%==================================================================================== +-spec init_whereis(_) -> no_return(). init_whereis({any, NodesList, Name, From}) -> R = whereis_any_loop(NodesList, Name), gen_server:cast(global_group, {find_name_res, R, self(), From}), @@ -146,6 +149,7 @@ init_whereis({node, Node, Name, From}) -> %%%==================================================================================== %%%==================================================================================== %%%==================================================================================== +-spec init_names(_) -> no_return(). init_names({group, Nodes, From}) -> case names_group_loop(Nodes) of group_down -> diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index a45ba34eae..b5e73117dd 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(group). @@ -111,8 +112,13 @@ start_shell1(Fun) -> server_loop(Drv, Shell, Buf0) -> receive {io_request,From,ReplyAs,Req} when is_pid(From) -> - Buf = io_request(Req, From, ReplyAs, Drv, Buf0), - server_loop(Drv, Shell, Buf); + %% This io_request may cause a transition to a couple of + %% selective receive loops elsewhere in this module. + Buf = io_request(Req, From, ReplyAs, Drv, Buf0), + server_loop(Drv, Shell, Buf); + {reply,{{From,ReplyAs},Reply}} -> + io_reply(From, ReplyAs, Reply), + server_loop(Drv, Shell, Buf0); {driver_id,ReplyTo} -> ReplyTo ! {self(),driver_id,Drv}, server_loop(Drv, Shell, Buf0); @@ -172,10 +178,13 @@ set_unicode_state(Drv,Bool) -> io_request(Req, From, ReplyAs, Drv, Buf0) -> - case io_request(Req, Drv, Buf0) of + case io_request(Req, Drv, {From,ReplyAs}, Buf0) of {ok,Reply,Buf} -> io_reply(From, ReplyAs, Reply), Buf; + {noreply,Buf} -> + %% We expect a {reply,_} message from the Drv when request is done + Buf; {error,Reply,Buf} -> io_reply(From, ReplyAs, Reply), Buf; @@ -196,78 +205,85 @@ io_request(Req, From, ReplyAs, Drv, Buf0) -> %% io_request({put_chars,unicode,Binary}, Drv, Buf) when is_binary(Binary) -> %% send_drv(Drv, {put_chars,Binary}), %% {ok,ok,Buf}; -io_request({put_chars,unicode,Chars}, Drv, Buf) -> +%% +%% These put requests have to be synchronous to the driver as otherwise +%% there is no guarantee that the data has actually been printed. +io_request({put_chars,unicode,Chars}, Drv, From, Buf) -> case catch unicode:characters_to_binary(Chars,utf8) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode, Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,{put_chars, unicode,Chars}},Buf} end; -io_request({put_chars,unicode,M,F,As}, Drv, Buf) -> +io_request({put_chars,unicode,M,F,As}, Drv, From, Buf) -> case catch apply(M, F, As) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; Chars -> case catch unicode:characters_to_binary(Chars,utf8) of B when is_binary(B) -> - send_drv(Drv, {put_chars, unicode,B}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,F},Buf} end end; -io_request({put_chars,latin1,Binary}, Drv, Buf) when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}), - {ok,ok,Buf}; -io_request({put_chars,latin1,Chars}, Drv, Buf) -> +io_request({put_chars,latin1,Binary}, Drv, From, Buf) when is_binary(Binary) -> + send_drv(Drv, {put_chars_sync, unicode, + unicode:characters_to_binary(Binary,latin1), + {From,ok}}), + {noreply,Buf}; +io_request({put_chars,latin1,Chars}, Drv, From, Buf) -> case catch unicode:characters_to_binary(Chars,latin1) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,Binary}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, Binary, {From,ok}}), + {noreply,Buf}; _ -> - {error,{error,{put_chars,Chars}},Buf} + {error,{error,{put_chars,latin1,Chars}},Buf} end; -io_request({put_chars,latin1,M,F,As}, Drv, Buf) -> +io_request({put_chars,latin1,M,F,As}, Drv, From, Buf) -> case catch apply(M, F, As) of Binary when is_binary(Binary) -> - send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, + unicode:characters_to_binary(Binary,latin1), + {From,ok}}), + {noreply,Buf}; Chars -> case catch unicode:characters_to_binary(Chars,latin1) of B when is_binary(B) -> - send_drv(Drv, {put_chars, unicode,B}), - {ok,ok,Buf}; + send_drv(Drv, {put_chars_sync, unicode, B, {From,ok}}), + {noreply,Buf}; _ -> {error,{error,F},Buf} end end; -io_request({get_chars,Encoding,Prompt,N}, Drv, Buf) -> +io_request({get_chars,Encoding,Prompt,N}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding); -io_request({get_line,Encoding,Prompt}, Drv, Buf) -> +io_request({get_line,Encoding,Prompt}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding); -io_request({get_until,Encoding, Prompt,M,F,As}, Drv, Buf) -> +io_request({get_until,Encoding, Prompt,M,F,As}, Drv, _From, Buf) -> get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding); -io_request({get_password,_Encoding},Drv,Buf) -> +io_request({get_password,_Encoding},Drv,_From,Buf) -> get_password_chars(Drv, Buf); -io_request({setopts,Opts}, Drv, Buf) when is_list(Opts) -> +io_request({setopts,Opts}, Drv, _From, Buf) when is_list(Opts) -> setopts(Opts, Drv, Buf); -io_request(getopts, Drv, Buf) -> +io_request(getopts, Drv, _From, Buf) -> getopts(Drv, Buf); -io_request({requests,Reqs}, Drv, Buf) -> - io_requests(Reqs, {ok,ok,Buf}, Drv); +io_request({requests,Reqs}, Drv, From, Buf) -> + io_requests(Reqs, {ok,ok,Buf}, From, Drv); %% New in R12 -io_request({get_geometry,columns},Drv,Buf) -> +io_request({get_geometry,columns},Drv,_From,Buf) -> case get_tty_geometry(Drv) of {W,_H} -> {ok,W,Buf}; _ -> {error,{error,enotsup},Buf} end; -io_request({get_geometry,rows},Drv,Buf) -> +io_request({get_geometry,rows},Drv,_From,Buf) -> case get_tty_geometry(Drv) of {_W,H} -> {ok,H,Buf}; @@ -276,48 +292,61 @@ io_request({get_geometry,rows},Drv,Buf) -> end; %% BC with pre-R13 -io_request({put_chars,Chars}, Drv, Buf) -> - io_request({put_chars,latin1,Chars}, Drv, Buf); -io_request({put_chars,M,F,As}, Drv, Buf) -> - io_request({put_chars,latin1,M,F,As}, Drv, Buf); -io_request({get_chars,Prompt,N}, Drv, Buf) -> - io_request({get_chars,latin1,Prompt,N}, Drv, Buf); -io_request({get_line,Prompt}, Drv, Buf) -> - io_request({get_line,latin1,Prompt}, Drv, Buf); -io_request({get_until, Prompt,M,F,As}, Drv, Buf) -> - io_request({get_until,latin1, Prompt,M,F,As}, Drv, Buf); -io_request(get_password,Drv,Buf) -> - io_request({get_password,latin1},Drv,Buf); - - - -io_request(_, _Drv, Buf) -> +io_request({put_chars,Chars}, Drv, From, Buf) -> + io_request({put_chars,latin1,Chars}, Drv, From, Buf); +io_request({put_chars,M,F,As}, Drv, From, Buf) -> + io_request({put_chars,latin1,M,F,As}, Drv, From, Buf); +io_request({get_chars,Prompt,N}, Drv, From, Buf) -> + io_request({get_chars,latin1,Prompt,N}, Drv, From, Buf); +io_request({get_line,Prompt}, Drv, From, Buf) -> + io_request({get_line,latin1,Prompt}, Drv, From, Buf); +io_request({get_until, Prompt,M,F,As}, Drv, From, Buf) -> + io_request({get_until,latin1, Prompt,M,F,As}, Drv, From, Buf); +io_request(get_password,Drv,From,Buf) -> + io_request({get_password,latin1},Drv,From,Buf); + + + +io_request(_, _Drv, _From, Buf) -> {error,{error,request},Buf}. -%% Status = io_requests(RequestList, PrevStat, Drv) -%% Process a list of output requests as long as the previous status is 'ok'. - -io_requests([R|Rs], {ok,ok,Buf}, Drv) -> - io_requests(Rs, io_request(R, Drv, Buf), Drv); -io_requests([_|_], Error, _Drv) -> +%% Status = io_requests(RequestList, PrevStat, From, Drv) +%% Process a list of output requests as long as +%% the previous status is 'ok' or noreply. +%% +%% We use undefined as the From for all but the last request +%% in order to discards acknowledgements from those requests. +%% +io_requests([R|Rs], {noreply,Buf}, From, Drv) -> + ReqFrom = if Rs =:= [] -> From; true -> undefined end, + io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv); +io_requests([R|Rs], {ok,ok,Buf}, From, Drv) -> + ReqFrom = if Rs =:= [] -> From; true -> undefined end, + io_requests(Rs, io_request(R, Drv, ReqFrom, Buf), From, Drv); +io_requests([_|_], Error, _From, _Drv) -> Error; -io_requests([], Stat, _) -> +io_requests([], Stat, _From, _) -> Stat. %% io_reply(From, ReplyAs, Reply) %% The function for sending i/o command acknowledgement. %% The ACK contains the return value. +io_reply(undefined, _ReplyAs, _Reply) -> + %% Ignore these replies as they are generated from io_requests/4. + ok; io_reply(From, ReplyAs, Reply) -> - From ! {io_reply,ReplyAs,Reply}. + From ! {io_reply,ReplyAs,Reply}, + ok. %% send_drv(Drv, Message) %% send_drv_reqs(Drv, Requests) send_drv(Drv, Msg) -> - Drv ! {self(),Msg}. + Drv ! {self(),Msg}, + ok. -send_drv_reqs(_Drv, []) -> []; +send_drv_reqs(_Drv, []) -> ok; send_drv_reqs(Drv, Rs) -> send_drv(Drv, {requests,Rs}). @@ -424,7 +453,7 @@ get_password_chars(Drv,Buf) -> end. get_chars(Prompt, M, F, Xa, Drv, Buf, Encoding) -> - Pbs = prompt_bytes(Prompt), + Pbs = prompt_bytes(Prompt, Encoding), get_chars_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding). get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) -> @@ -446,7 +475,6 @@ get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) -> end. get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State0, Line, Encoding) -> - id(M,F), case catch M:F(State0, cast(Line,get(read_mode), Encoding), Encoding, Xa) of {stop,Result,Rest} -> {ok,Result,append(Rest, Buf, Encoding)}; @@ -456,8 +484,6 @@ get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State0, Line, Encoding) -> get_chars_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding) end. -id(M,F) -> - {M,F}. %% Convert error code to make it look as before err_func(io_lib, get_until, {_,F,_}) -> F; @@ -477,15 +503,15 @@ get_line(Chars, Pbs, Drv, Encoding) -> get_line1(edlin:edit_line(Chars, Cont), Drv, new_stack(get(line_buffer)), Encoding). -get_line1({done,Line,Rest,Rs}, Drv, _Ls, _Encoding) -> +get_line1({done,Line,Rest,Rs}, Drv, Ls, _Encoding) -> send_drv_reqs(Drv, Rs), - put(line_buffer, [Line|lists:delete(Line, get(line_buffer))]), + save_line_buffer(Line, get_lines(Ls)), {done,Line,Rest}; get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) when ((Mode =:= none) and (Char =:= $\^P)) or ((Mode =:= meta_left_sq_bracket) and (Char =:= $A)) -> send_drv_reqs(Drv, Rs), - case up_stack(Ls0) of + case up_stack(save_line(Ls0, edlin:current_line(Cont))) of {none,_Ls} -> send_drv(Drv, beep), get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding); @@ -498,14 +524,14 @@ get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) Drv, Ls, Encoding) end; -get_line1({undefined,{_A,Mode,Char},_Cs,Cont,Rs}, Drv, Ls0, Encoding) +get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) when ((Mode =:= none) and (Char =:= $\^N)) or ((Mode =:= meta_left_sq_bracket) and (Char =:= $B)) -> send_drv_reqs(Drv, Rs), - case down_stack(Ls0) of - {none,Ls} -> - send_drv_reqs(Drv, edlin:erase_line(Cont)), - get_line1(edlin:start(edlin:prompt(Cont)), Drv, Ls, Encoding); + case down_stack(save_line(Ls0, edlin:current_line(Cont))) of + {none,_Ls} -> + send_drv(Drv, beep), + get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding); {Lcs,Ls} -> send_drv_reqs(Drv, edlin:erase_line(Cont)), {more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)), @@ -515,6 +541,27 @@ get_line1({undefined,{_A,Mode,Char},_Cs,Cont,Rs}, Drv, Ls0, Encoding) Drv, Ls, Encoding) end; +%% ^R = backward search, ^S = forward search. +%% Search is tricky to implement and does a lot of back-and-forth +%% work with edlin.erl (from stdlib). Edlin takes care of writing +%% and handling lines and escape characters to get out of search, +%% whereas this module does the actual searching and appending to lines. +%% Erlang's shell wasn't exactly meant to traverse the wall between +%% line and line stack, so we at least restrict it by introducing +%% new modes: search, search_quit, search_found. These are added to +%% the regular ones (none, meta_left_sq_bracket) and handle special +%% cases of history search. +get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls, Encoding) + when ((Mode =:= none) and (Char =:= $\^R)) -> + send_drv_reqs(Drv, Rs), + %% drop current line, move to search mode. We store the current + %% prompt ('N>') and substitute it with the search prompt. + send_drv_reqs(Drv, edlin:erase_line(Cont)), + put(search_quit_prompt, edlin:prompt(Cont)), + Pbs = prompt_bytes("(search)`': ", Encoding), + {more_chars,Ncont,Nrs} = edlin:start(Pbs, search), + send_drv_reqs(Drv, Nrs), + get_line1(edlin:edit_line1(Cs, Ncont), Drv, Ls, Encoding); get_line1({expand, Before, Cs0, Cont,Rs}, Drv, Ls0, Encoding) -> send_drv_reqs(Drv, Rs), ExpandFun = get(expand_fun), @@ -535,8 +582,59 @@ get_line1({undefined,_Char,Cs,Cont,Rs}, Drv, Ls, Encoding) -> send_drv_reqs(Drv, Rs), send_drv(Drv, beep), get_line1(edlin:edit_line(Cs, Cont), Drv, Ls, Encoding); +%% The search item was found and accepted (new line entered on the exact +%% result found) +get_line1({_What,Cont={line,_Prompt,_Chars,search_found},Rs}, Drv, Ls0, Encoding) -> + Line = edlin:current_line(Cont), + %% this may create duplicate entries. + Ls = save_line(new_stack(get_lines(Ls0)), Line), + get_line1({done, Line, "", Rs}, Drv, Ls, Encoding); +%% The search mode has been exited, but the user wants to remain in line +%% editing mode wherever that was, but editing the search result. +get_line1({What,Cont={line,_Prompt,_Chars,search_quit},Rs}, Drv, Ls, Encoding) -> + Line = edlin:current_chars(Cont), + %% Load back the old prompt with the correct line number. + case get(search_quit_prompt) of + undefined -> % should not happen. Fallback. + LsFallback = save_line(new_stack(get_lines(Ls)), Line), + get_line1({done, "\n", Line, Rs}, Drv, LsFallback, Encoding); + Prompt -> % redraw the line and keep going with the same stack position + NCont = {line,Prompt,{lists:reverse(Line),[]},none}, + send_drv_reqs(Drv, Rs), + send_drv_reqs(Drv, edlin:erase_line(Cont)), + send_drv_reqs(Drv, edlin:redraw_line(NCont)), + get_line1({What, NCont ,[]}, Drv, pad_stack(Ls), Encoding) + end; +%% Search mode is entered. +get_line1({What,{line,Prompt,{RevCmd0,_Aft},search},Rs}, + Drv, Ls0, Encoding) -> + send_drv_reqs(Drv, Rs), + %% Figure out search direction. ^S and ^R are returned through edlin + %% whenever we received a search while being already in search mode. + {Search, Ls1, RevCmd} = case RevCmd0 of + [$\^S|RevCmd1] -> + {fun search_down_stack/2, Ls0, RevCmd1}; + [$\^R|RevCmd1] -> + {fun search_up_stack/2, Ls0, RevCmd1}; + _ -> % new search, rewind stack for a proper search. + {fun search_up_stack/2, new_stack(get_lines(Ls0)), RevCmd0} + end, + Cmd = lists:reverse(RevCmd), + {Ls, NewStack} = case Search(Ls1, Cmd) of + {none, Ls2} -> + send_drv(Drv, beep), + {Ls2, {RevCmd, "': "}}; + {Line, Ls2} -> % found. Complete the output edlin couldn't have done. + send_drv_reqs(Drv, [{put_chars, Encoding, Line}]), + {Ls2, {RevCmd, "': "++Line}} + end, + Cont = {line,Prompt,NewStack,search}, + more_data(What, Cont, Drv, Ls, Encoding); get_line1({What,Cont0,Rs}, Drv, Ls, Encoding) -> send_drv_reqs(Drv, Rs), + more_data(What, Cont0, Drv, Ls, Encoding). + +more_data(What, Cont0, Drv, Ls, Encoding) -> receive {Drv,{data,Cs}} -> get_line1(edlin:edit_line(Cs, Cont0), Drv, Ls, Encoding); @@ -548,6 +646,10 @@ get_line1({What,Cont0,Rs}, Drv, Ls, Encoding) -> io_request(Req, From, ReplyAs, Drv, []), %WRONG!!! send_drv_reqs(Drv, edlin:redraw_line(Cont)), get_line1({more_chars,Cont,[]}, Drv, Ls, Encoding); + {reply,{{From,ReplyAs},Reply}} -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + more_data(What, Cont0, Drv, Ls, Encoding); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> @@ -557,7 +659,6 @@ get_line1({What,Cont0,Rs}, Drv, Ls, Encoding) -> get_line1(edlin:edit_line([], Cont0), Drv, Ls, Encoding) end. - get_line_echo_off(Chars, Pbs, Drv) -> send_drv_reqs(Drv, [{put_chars, unicode,Pbs}]), get_line_echo_off1(edit_line(Chars,[]), Drv). @@ -571,6 +672,10 @@ get_line_echo_off1({Chars,[]}, Drv) -> {io_request,From,ReplyAs,Req} when is_pid(From) -> io_request(Req, From, ReplyAs, Drv, []), get_line_echo_off1({Chars,[]}, Drv); + {reply,{{From,ReplyAs},Reply}} when From =/= undefined -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + get_line_echo_off1({Chars,[]},Drv); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> @@ -627,6 +732,83 @@ down_stack({stack,U,{},[]}) -> down_stack({stack,U,C,D}) -> down_stack({stack,[C|U],{},D}). +save_line({stack, U, {}, []}, Line) -> + {stack, U, {}, [Line]}; +save_line({stack, U, _L, D}, Line) -> + {stack, U, Line, D}. + +get_lines(Ls) -> get_all_lines(Ls). +%get_lines({stack, U, {}, []}) -> +% U; +%get_lines({stack, U, {}, D}) -> +% tl(lists:reverse(D, U)); +%get_lines({stack, U, L, D}) -> +% get_lines({stack, U, {}, [L|D]}). + +%% There's a funny behaviour whenever the line stack doesn't have a "\n" +%% at its end -- get_lines() seemed to work on the assumption it *will* be +%% there, but the manipulations done with search history do not require it. +%% +%% It is an assumption because the function was built with either the full +%% stack being on the 'Up' side (we're on the new line) where it isn't +%% stripped. The only other case when it isn't on the 'Up' side is when +%% someone has used the up/down arrows (or ^P and ^N) to navigate lines, +%% in which case, a line with only a \n is stored at the end of the stack +%% (the \n is returned by edlin:current_line/1). +%% +%% get_all_lines works the same as get_lines, but only strips the trailing +%% character if it's a linebreak. Otherwise it's kept the same. This is +%% because traversing the stack due to search history will *not* insert +%% said empty line in the stack at the same time as other commands do, +%% and thus it should not always be stripped unless we know a new line +%% is the last entry. +get_all_lines({stack, U, {}, []}) -> + U; +get_all_lines({stack, U, {}, D}) -> + case lists:reverse(D, U) of + ["\n"|Lines] -> Lines; + Lines -> Lines + end; +get_all_lines({stack, U, L, D}) -> + get_all_lines({stack, U, {}, [L|D]}). + +%% For the same reason as above, though, we need to expand the stack +%% in some cases to make sure we play nice with up/down arrows. We need +%% to insert newlines, but not always. +pad_stack({stack, U, L, D}) -> + {stack, U, L, D++["\n"]}. + +save_line_buffer("\n", Lines) -> + save_line_buffer(Lines); +save_line_buffer(Line, [Line|_Lines]=Lines) -> + save_line_buffer(Lines); +save_line_buffer(Line, Lines) -> + save_line_buffer([Line|Lines]). + +save_line_buffer(Lines) -> + put(line_buffer, Lines). + +search_up_stack(Stack, Substr) -> + case up_stack(Stack) of + {none,NewStack} -> {none,NewStack}; + {L, NewStack} -> + case string:str(L, Substr) of + 0 -> search_up_stack(NewStack, Substr); + _ -> {string:strip(L,right,$\n), NewStack} + end + end. + +search_down_stack(Stack, Substr) -> + case down_stack(Stack) of + {none,NewStack} -> {none,NewStack}; + {L, NewStack} -> + case string:str(L, Substr) of + 0 -> search_down_stack(NewStack, Substr); + _ -> {string:strip(L,right,$\n), NewStack} + end + end. + + %% This is get_line without line editing (except for backspace) and %% without echo. get_password_line(Chars, Drv) -> @@ -643,6 +825,10 @@ get_password1({Chars,[]}, Drv) -> %% set to []. But do we expect anything but plain output? get_password1({Chars, []}, Drv); + {reply,{{From,ReplyAs},Reply}} -> + %% We take care of replies from puts here as well + io_reply(From, ReplyAs, Reply), + get_password1({Chars, []},Drv); {'EXIT',Drv,interrupt} -> interrupted; {'EXIT',Drv,_} -> @@ -665,10 +851,10 @@ edit_password([$\177|Cs],[_|Chars]) ->%% is backspace enough? edit_password([Char|Cs],Chars) -> edit_password(Cs,[Char|Chars]). -%% prompt_bytes(Prompt) -%% Return a flat list of bytes for the Prompt. -prompt_bytes(Prompt) -> - lists:flatten(io_lib:format_prompt(Prompt)). +%% prompt_bytes(Prompt, Encoding) +%% Return a flat list of characters for the Prompt. +prompt_bytes(Prompt, Encoding) -> + lists:flatten(io_lib:format_prompt(Prompt, Encoding)). cast(L, binary,latin1) when is_list(L) -> list_to_binary(L); diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index bad0950fca..8fa48d56fb 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -1,27 +1,32 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(heart). +-compile(no_native). +% 'no_native' as part of a crude fix to make init:restart/0 work by clearing +% all hipe inter-module information (hipe_mfa_info's in hipe_bif0.c). + %%%-------------------------------------------------------------------- %%% This is a rewrite of pre_heart from BS.3. %%% -%%% The purpose of this process-module is to act as an supervisor +%%% The purpose of this process-module is to act as a supervisor %%% of the entire erlang-system. This 'heart' beats with a frequence %%% satisfying an external port program *not* reboot the entire %%% system. If however the erlang-emulator would hang, a reboot is @@ -29,7 +34,11 @@ %%% %%% It recognizes the flag '-heart' %%%-------------------------------------------------------------------- --export([start/0, init/2, set_cmd/1, clear_cmd/0, get_cmd/0, cycle/0]). +-export([start/0, init/2, + set_cmd/1, clear_cmd/0, get_cmd/0, + set_callback/2, clear_callback/0, get_callback/0, + set_options/1, get_options/0, + cycle/0]). -define(START_ACK, 1). -define(HEART_BEAT, 2). @@ -38,9 +47,21 @@ -define(CLEAR_CMD, 5). -define(GET_CMD, 6). -define(HEART_CMD, 7). +-define(PREPARING_CRASH, 8). % Used in beam vm -define(TIMEOUT, 5000). -define(CYCLE_TIMEOUT, 10000). +-define(HEART_PORT_NAME, heart_port). + +%% valid heart options +-define(SCHEDULER_CHECK_OPT, check_schedulers). + +-type heart_option() :: ?SCHEDULER_CHECK_OPT. + +-record(state,{port :: port(), + cmd :: [] | binary(), + options :: [heart_option()], + callback :: 'undefined' | {atom(), atom()}}). %%--------------------------------------------------------------------- @@ -61,8 +82,8 @@ start() -> wait_for_init_ack(From) -> receive - {ok, From} -> - {ok, From}; + {ok, From} = Ok -> + Ok; {no_heart, From} -> ignore; {Error, From} -> @@ -74,57 +95,95 @@ wait_for_init_ack(From) -> init(Starter, Parent) -> process_flag(trap_exit, true), process_flag(priority, max), - register(heart, self()), + register(?MODULE, self()), case catch start_portprogram() of {ok, Port} -> Starter ! {ok, self()}, - loop(Parent, Port, ""); + loop(Parent, #state{port=Port, cmd=[], options=[]}); no_heart -> Starter ! {no_heart, self()}; error -> Starter ! {start_error, self()} end. --spec set_cmd(string()) -> 'ok' | {'error', {'bad_cmd', string()}}. +-spec set_cmd(Cmd) -> 'ok' | {'error', {'bad_cmd', Cmd}} when + Cmd :: string(). set_cmd(Cmd) -> - heart ! {self(), set_cmd, Cmd}, + ?MODULE ! {self(), set_cmd, Cmd}, wait(). --spec get_cmd() -> 'ok'. +-spec get_cmd() -> {ok, Cmd} when + Cmd :: string(). get_cmd() -> - heart ! {self(), get_cmd}, + ?MODULE ! {self(), get_cmd}, wait(). --spec clear_cmd() -> {'ok', string()}. +-spec clear_cmd() -> ok. clear_cmd() -> - heart ! {self(), clear_cmd}, + ?MODULE ! {self(), clear_cmd}, + wait(). + +-spec set_callback(Module,Function) -> 'ok' | {'error', {'bad_callback', {Module, Function}}} when + Module :: atom(), + Function :: atom(). + +set_callback(Module, Function) -> + ?MODULE ! {self(), set_callback, {Module,Function}}, + wait(). + +-spec get_callback() -> {'ok', {Module, Function}} | 'none' when + Module :: atom(), + Function :: atom(). + +get_callback() -> + ?MODULE ! {self(), get_callback}, + wait(). + +-spec clear_callback() -> ok. + +clear_callback() -> + ?MODULE ! {self(), clear_callback}, + wait(). + +-spec set_options(Options) -> 'ok' | {'error', {'bad_options', Options}} when + Options :: [heart_option()]. + +set_options(Options) -> + ?MODULE ! {self(), set_options, Options}, wait(). +-spec get_options() -> {'ok', Options} | 'none' when + Options :: [atom()]. + +get_options() -> + ?MODULE ! {self(), get_options}, + wait(). %%% Should be used solely by the release handler!!!!!!! -spec cycle() -> 'ok' | {'error', term()}. cycle() -> - heart ! {self(), cycle}, + ?MODULE ! {self(), cycle}, wait(). wait() -> receive - {heart, Res} -> + {?MODULE, Res} -> Res end. start_portprogram() -> check_start_heart(), - HeartCmd = "heart -pid " ++ os:getpid() ++ " " ++ - get_heart_timeouts(), + HeartCmd = "heart -pid " ++ os:getpid() ++ " " ++ get_heart_timeouts(), try open_port({spawn, HeartCmd}, [{packet, 2}]) of Port when is_port(Port) -> case wait_ack(Port) of ok -> + %% register port so the vm can find it if need be + register(?HEART_PORT_NAME, Port), {ok, Port}; {error, Reason} -> report_problem({{port_problem, Reason}, @@ -139,16 +198,11 @@ start_portprogram() -> end. get_heart_timeouts() -> - HeartOpts = case os:getenv("HEART_BEAT_TIMEOUT") of - false -> ""; - H when is_list(H) -> - "-ht " ++ H - end, - HeartOpts ++ case os:getenv("HEART_BEAT_BOOT_DELAY") of - false -> ""; - W when is_list(W) -> - " -wt " ++ W - end. + case os:getenv("HEART_BEAT_TIMEOUT") of + false -> ""; + H when is_list(H) -> + "-ht " ++ H + end. check_start_heart() -> case init:get_argument(heart) of @@ -172,84 +226,133 @@ wait_ack(Port) -> {error, Reason} end. -loop(Parent, Port, Cmd) -> - send_heart_beat(Port), +loop(Parent, #state{port=Port}=S) -> + _ = send_heart_beat(S), receive - {From, set_cmd, NewCmd} when is_list(NewCmd), length(NewCmd) < 2047 -> - send_heart_cmd(Port, NewCmd), - wait_ack(Port), - From ! {heart, ok}, - loop(Parent, Port, NewCmd); - {From, set_cmd, NewCmd} -> - From ! {heart, {error, {bad_cmd, NewCmd}}}, - loop(Parent, Port, Cmd); + {From, set_cmd, NewCmd0} -> + Enc = file:native_name_encoding(), + case catch unicode:characters_to_binary(NewCmd0,Enc,Enc) of + NewCmd when is_binary(NewCmd), byte_size(NewCmd) < 2047 -> + _ = send_heart_cmd(Port, NewCmd), + _ = wait_ack(Port), + From ! {?MODULE, ok}, + loop(Parent, S#state{cmd=NewCmd}); + _ -> + From ! {?MODULE, {error, {bad_cmd, NewCmd0}}}, + loop(Parent, S) + end; {From, clear_cmd} -> - From ! {heart, ok}, - send_heart_cmd(Port, ""), - wait_ack(Port), - loop(Parent, Port, ""); + From ! {?MODULE, ok}, + _ = send_heart_cmd(Port, []), + _ = wait_ack(Port), + loop(Parent, S#state{cmd = []}); {From, get_cmd} -> - From ! {heart, get_heart_cmd(Port)}, - loop(Parent, Port, Cmd); + From ! {?MODULE, get_heart_cmd(Port)}, + loop(Parent, S); + {From, set_callback, Callback} -> + case Callback of + {M,F} when is_atom(M), is_atom(F) -> + From ! {?MODULE, ok}, + loop(Parent, S#state{callback=Callback}); + _ -> + From ! {?MODULE, {error, {bad_callback, Callback}}}, + loop(Parent, S) + end; + {From, get_callback} -> + Res = case S#state.callback of + undefined -> none; + Cb -> {ok, Cb} + end, + From ! {?MODULE, Res}, + loop(Parent, S); + {From, clear_callback} -> + From ! {?MODULE, ok}, + loop(Parent, S#state{callback=undefined}); + {From, set_options, Options} -> + case validate_options(Options) of + Validated when is_list(Validated) -> + From ! {?MODULE, ok}, + loop(Parent, S#state{options=Validated}); + _ -> + From ! {?MODULE, {error, {bad_options, Options}}}, + loop(Parent, S) + end; + {From, get_options} -> + Res = case S#state.options of + [] -> none; + Cb -> {ok, Cb} + end, + From ! {?MODULE, Res}, + loop(Parent, S); {From, cycle} -> %% Calls back to loop - do_cycle_port_program(From, Parent, Port, Cmd); + do_cycle_port_program(From, Parent, S); {'EXIT', Parent, shutdown} -> no_reboot_shutdown(Port); {'EXIT', Parent, Reason} -> exit(Port, Reason), exit(Reason); {'EXIT', Port, badsig} -> % we can ignore badsig-messages! - loop(Parent, Port, Cmd); + loop(Parent, S); {'EXIT', Port, _Reason} -> - exit({port_terminated, {heart, loop, [Parent, Port, Cmd]}}); + exit({port_terminated, {?MODULE, loop, [Parent, S]}}); _ -> - loop(Parent, Port, Cmd) + loop(Parent, S) after ?TIMEOUT -> - loop(Parent, Port, Cmd) + loop(Parent, S) end. -spec no_reboot_shutdown(port()) -> no_return(). no_reboot_shutdown(Port) -> - send_shutdown(Port), + _ = send_shutdown(Port), receive {'EXIT', Port, Reason} when Reason =/= badsig -> exit(normal) end. -do_cycle_port_program(Caller, Parent, Port, Cmd) -> +validate_options(Opts) -> validate_options(Opts,[]). +validate_options([],Res) -> Res; +validate_options([?SCHEDULER_CHECK_OPT=Opt|Opts],Res) -> validate_options(Opts,[Opt|Res]); +validate_options(_,_) -> error. + +do_cycle_port_program(Caller, Parent, #state{port=Port} = S) -> + unregister(?HEART_PORT_NAME), case catch start_portprogram() of {ok, NewPort} -> - send_shutdown(Port), + _ = send_shutdown(Port), receive {'EXIT', Port, _Reason} -> - send_heart_cmd(NewPort, Cmd), - Caller ! {heart, ok}, - loop(Parent, NewPort, Cmd) + _ = send_heart_cmd(NewPort, S#state.cmd), + Caller ! {?MODULE, ok}, + loop(Parent, S#state{port=NewPort}) after ?CYCLE_TIMEOUT -> %% Huh! Two heart port programs running... %% well, the old one has to be sick not to respond %% so we'll settle for the new one... - send_heart_cmd(NewPort, Cmd), - Caller ! {heart, {error, stop_error}}, - loop(Parent, NewPort, Cmd) + _ = send_heart_cmd(NewPort, S#state.cmd), + Caller ! {?MODULE, {error, stop_error}}, + loop(Parent, S#state{port=NewPort}) end; no_heart -> - Caller ! {heart, {error, no_heart}}, - loop(Parent, Port, Cmd); + Caller ! {?MODULE, {error, no_heart}}, + loop(Parent, S); error -> - Caller ! {heart, {error, start_error}}, - loop(Parent, Port, Cmd) + Caller ! {?MODULE, {error, start_error}}, + loop(Parent, S) end. %% "Beates" the heart once. -send_heart_beat(Port) -> Port ! {self(), {command, [?HEART_BEAT]}}. +send_heart_beat(#state{port=Port, callback=Cb, options=Opts}) -> + ok = check_system(Opts), + ok = check_callback(Cb), + Port ! {self(), {command, [?HEART_BEAT]}}. %% Set a new HEART_COMMAND. +-dialyzer({no_improper_lists, send_heart_cmd/2}). send_heart_cmd(Port, []) -> Port ! {self(), {command, [?CLEAR_CMD]}}; send_heart_cmd(Port, Cmd) -> @@ -262,6 +365,24 @@ get_heart_cmd(Port) -> {ok, Cmd} end. +check_system([]) -> ok; +check_system([?SCHEDULER_CHECK_OPT|Opts]) -> + ok = erts_internal:system_check(schedulers), + check_system(Opts). + +%% validate system by performing a check before the heartbeat +%% return 'ok' if everything is alright. +%% Terminate if with reason if something is a miss. +%% It is fine to timeout in the callback, in fact that is the intention +%% if something goes wront -> no heartbeat. + +check_callback(Callback) -> + case Callback of + undefined -> ok; + {M,F} -> + erlang:apply(M,F,[]) + end. + %% Sends shutdown command to the port. send_shutdown(Port) -> Port ! {self(), {command, [?SHUT_DOWN]}}. diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index f289b8110d..087cceb5d8 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -34,13 +34,19 @@ -module(hipe_unified_loader). +-compile(no_native). +% 'no_native' is a workaround to avoid "The code server called unloaded module" +% caused by Mod:module_info(exports) in patch_to_emu_step1() called by post_beam_load. +% Reproducable with hipelibs and asn1_SUITE. +% I think the real solution would be to let BIF erlang:load_module/2 redirect all +% hipe calls to the module and thereby remove post_beam_load. + -export([chunk_name/1, %% Only the code and code_server modules may call the entries below! - load_hipe_modules/0, - load_native_code/2, + load_native_code/3, post_beam_load/1, - load_module/3, - load/2]). + load_module/4, + load/3]). %%-define(DEBUG,true). -define(DO_ASSERT,true). @@ -76,68 +82,57 @@ chunk_name(Architecture) -> %% HW32 %% HiPE, x86, Win32 end. -%%======================================================================== - --spec load_hipe_modules() -> 'ok'. -%% @doc -%% Ensures HiPE's loader modules are loaded. -%% Called from code.erl at start-up. - -load_hipe_modules() -> - ok. +word_size(Architecture) -> + case Architecture of + amd64 -> 8; + ppc64 -> 8; + _ -> 4 + end. %%======================================================================== --spec load_native_code(Mod, binary()) -> 'no_native' | {'module', Mod} - when is_subtype(Mod, atom()). +-spec load_native_code(Mod, binary(), hipe_architecture()) -> + 'no_native' | {'module', Mod} when Mod :: atom(). %% @doc %% Loads the native code of a module Mod. %% Returns {module,Mod} on success (for compatibility with %% code:load_file/1) and the atom `no_native' on failure. -load_native_code(Mod, Bin) when is_atom(Mod), is_binary(Bin) -> - Architecture = erlang:system_info(hipe_architecture), - try chunk_name(Architecture) of - ChunkTag -> - %% patch_to_emu(Mod), - case code:get_chunk(Bin, ChunkTag) of - undefined -> no_native; - NativeCode when is_binary(NativeCode) -> - erlang:system_flag(multi_scheduling, block), - try - OldReferencesToPatch = patch_to_emu_step1(Mod), - case load_module(Mod, NativeCode, Bin, OldReferencesToPatch) of - bad_crc -> no_native; - Result -> Result - end - after - erlang:system_flag(multi_scheduling, unblock) - end +load_native_code(_Mod, _Bin, undefined) -> + no_native; +load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) -> + %% patch_to_emu(Mod), + case code:get_chunk(Bin, chunk_name(Architecture)) of + undefined -> no_native; + NativeCode when is_binary(NativeCode) -> + erlang:system_flag(multi_scheduling, block_normal), + try + OldReferencesToPatch = patch_to_emu_step1(Mod), + case load_module(Mod, NativeCode, Bin, OldReferencesToPatch, + Architecture) of + bad_crc -> no_native; + Result -> Result + end + after + erlang:system_flag(multi_scheduling, unblock_normal) end - catch - _:_ -> - %% Unknown HiPE architecture. Can't happen (in principle). - no_native end. %%======================================================================== --spec post_beam_load(atom()) -> 'ok'. +-spec post_beam_load([module()]) -> 'ok'. -post_beam_load(Mod) when is_atom(Mod) -> - Architecture = erlang:system_info(hipe_architecture), - try chunk_name(Architecture) of - _ChunkTag -> - erlang:system_flag(multi_scheduling, block), - try - patch_to_emu(Mod) - after - erlang:system_flag(multi_scheduling, unblock) - end - catch - _:_ -> - ok - end. +post_beam_load([])-> + ok; +post_beam_load([_|_]=Mods) -> + erlang:system_flag(multi_scheduling, block_normal), + try + _ = [patch_to_emu(Mod) || Mod <- Mods], + ok + after + erlang:system_flag(multi_scheduling, unblock_normal) + end, + ok. %%======================================================================== @@ -152,52 +147,62 @@ version_check(Version, Mod) when is_atom(Mod) -> %%======================================================================== --spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module',Mod} - when is_subtype(Mod,atom()). -load_module(Mod, Bin, Beam) -> - erlang:system_flag(multi_scheduling, block), +-spec load_module(Mod, binary(), _, hipe_architecture()) -> + 'bad_crc' | {'module', Mod} when Mod :: atom(). + +load_module(Mod, Bin, Beam, Architecture) -> + erlang:system_flag(multi_scheduling, block_normal), try - load_module_nosmp(Mod, Bin, Beam) + load_module_nosmp(Mod, Bin, Beam, Architecture) after - erlang:system_flag(multi_scheduling, unblock) + erlang:system_flag(multi_scheduling, unblock_normal) end. -load_module_nosmp(Mod, Bin, Beam) -> - load_module(Mod, Bin, Beam, []). +load_module_nosmp(Mod, Bin, Beam, Architecture) -> + load_module(Mod, Bin, Beam, [], Architecture). -load_module(Mod, Bin, Beam, OldReferencesToPatch) -> +load_module(Mod, Bin, Beam, OldReferencesToPatch, Architecture) -> ?debug_msg("************ Loading Module ~w ************\n",[Mod]), %% Loading a whole module, let the BEAM loader patch closures. put(hipe_patch_closures, false), - load_common(Mod, Bin, Beam, OldReferencesToPatch). + load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture). %%======================================================================== --spec load(Mod, binary()) -> 'bad_crc' | {'module',Mod} - when is_subtype(Mod,atom()). -load(Mod, Bin) -> - erlang:system_flag(multi_scheduling, block), +-spec load(Mod, binary(), hipe_architecture()) -> + 'bad_crc' | {'module', Mod} when Mod :: atom(). + +load(Mod, Bin, Architecture) -> + erlang:system_flag(multi_scheduling, block_normal), try - load_nosmp(Mod, Bin) + load_nosmp(Mod, Bin, Architecture) after - erlang:system_flag(multi_scheduling, unblock) + erlang:system_flag(multi_scheduling, unblock_normal) end. -load_nosmp(Mod, Bin) -> +load_nosmp(Mod, Bin, Architecture) -> ?debug_msg("********* Loading funs in module ~w *********\n",[Mod]), %% Loading just some functions in a module; patch closures separately. put(hipe_patch_closures, true), - load_common(Mod, Bin, [], []). + load_common(Mod, Bin, [], [], Architecture). %%------------------------------------------------------------------------ -load_common(Mod, Bin, Beam, OldReferencesToPatch) -> +load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture) -> %% Unpack the binary. [{Version, CheckSum}, ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap, CodeSize, CodeBinary, Refs, 0,[] % ColdSize, CRrefs ] = binary_to_term(Bin), + MD5 = erlang:md5(Bin), % use md5 of actual running code for module_info + ?debug_msg("***** ErLLVM *****~nVersion: ~s~nCheckSum: ~w~nConstAlign: ~w~n" ++ + "ConstSize: ~w~nConstMap: ~w~nLabelMap: ~w~nExportMap ~w~nRefs ~w~n", + [Version, CheckSum, ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap, + Refs]), + %% Write HiPE binary code to a file in the current directory in order to + %% debug by disassembling. + %% file:write_file("erl.o", CodeBinary, [binary]), %% Check that we are loading up-to-date code. version_check(Version, Mod), case hipe_bifs:check_crc(CheckSum) of @@ -207,37 +212,55 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> "please regenerate native code for this runtime system\n", [Mod]), bad_crc; true -> + put(closures_to_patch, []), + WordSize = word_size(Architecture), + WriteWord = write_word_fun(WordSize), %% Create data segment - {ConstAddr,ConstMap2} = create_data_segment(ConstAlign, ConstSize, ConstMap), + {ConstAddr,ConstMap2} = + create_data_segment(ConstAlign, ConstSize, ConstMap, WriteWord), %% Find callees for which we may need trampolines. - CalleeMFAs = find_callee_mfas(Refs), + CalleeMFAs = find_callee_mfas(Refs, Architecture), %% Write the code to memory. - {CodeAddress,Trampolines} = enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam), + {CodeAddress,Trampolines} = + enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam), %% Construct CalleeMFA-to-trampoline mapping. - TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines), + TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines, + Architecture), %% Patch references to code labels in data seg. - patch_consts(LabelMap, ConstAddr, CodeAddress), + ok = patch_consts(LabelMap, ConstAddr, CodeAddress, WriteWord), %% Find out which functions are being loaded (and where). %% Note: Addresses are sorted descending. {MFAs,Addresses} = exports(ExportMap, CodeAddress), %% Remove references to old versions of the module. ReferencesToPatch = get_refs_from(MFAs, []), - remove_refs_from(MFAs), + %% io:format("References to patch: ~w~n", [ReferencesToPatch]), + ok = remove_refs_from(MFAs), %% Patch all dynamic references in the code. %% Function calls, Atoms, Constants, System calls - patch(Refs, CodeAddress, ConstMap2, Addresses, TrampolineMap), + ok = patch(Refs, CodeAddress, ConstMap2, Addresses, TrampolineMap), + %% Tell the system where the loaded funs are. %% (patches the BEAM code to redirect to native.) case Beam of [] -> - export_funs(Addresses); + %% This module was previously loaded as BEAM code during system + %% start-up before the code server has started (-enable-native-libs + %% is active), so we must now patch the pre-existing entries in the + %% fun table with the native code addresses for all closures. + lists:foreach(fun({FE, DestAddress}) -> + hipe_bifs:set_native_address_in_fe(FE, DestAddress) + end, erase(closures_to_patch)), + export_funs(Addresses), + ok; BeamBinary when is_binary(BeamBinary) -> %% Find all closures in the code. + [] = erase(closures_to_patch), %Clean up, assertion. ClosurePatches = find_closure_patches(Refs), AddressesOfClosuresToPatch = calculate_addresses(ClosurePatches, CodeAddress, Addresses), export_funs(Addresses), - export_funs(Mod, BeamBinary, Addresses, AddressesOfClosuresToPatch) + export_funs(Mod, MD5, BeamBinary, + Addresses, AddressesOfClosuresToPatch) end, %% Redirect references to the old module to the new module's BEAM stub. patch_to_emu_step2(OldReferencesToPatch), @@ -245,6 +268,9 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> %% The call to export_funs/1 above updated the native addresses %% for the targets, so passing 'Addresses' is not needed. redirect(ReferencesToPatch), + %% Final clean up. + _ = erase(hipe_patch_closures), + _ = erase(hipe_assert_code_area), ?debug_msg("****************Loader Finished****************\n", []), {module,Mod} % for compatibility with code:load_file/1 end. @@ -253,14 +279,26 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) -> %% Scan the list of patches and build a set (returned as a tuple) %% of the callees for which we may need trampolines. %% -find_callee_mfas(Patches) when is_list(Patches) -> - case erlang:system_info(hipe_architecture) of - amd64 -> []; - arm -> find_callee_mfas(Patches, gb_sets:empty(), false); - powerpc -> find_callee_mfas(Patches, gb_sets:empty(), true); - %% ppc64 -> find_callee_mfas(Patches, gb_sets:empty(), true); - ultrasparc -> []; - x86 -> [] +find_callee_mfas(Patches, Architecture) when is_list(Patches) -> + case needs_trampolines(Architecture) of + true -> find_callee_mfas(Patches, gb_sets:empty(), + no_erts_trampolines(Architecture)); + _ -> [] + end. + +needs_trampolines(Architecture) -> + case Architecture of + arm -> true; + powerpc -> true; + ppc64 -> true; + _ -> false + end. + +no_erts_trampolines(Architecture) -> + case Architecture of + powerpc -> true; + ppc64 -> true; + _ -> false end. find_callee_mfas([{Type,Data}|Patches], MFAs, SkipErtsSyms) -> @@ -296,13 +334,9 @@ add_callee_mfas([], MFAs, _SkipErtsSyms) -> MFAs. %%---------------------------------------------------------------- %% -mk_trampoline_map([], []) -> []; % archs not using trampolines -mk_trampoline_map(CalleeMFAs, Trampolines) -> - SizeofLong = - case erlang:system_info(hipe_architecture) of - amd64 -> 8; - _ -> 4 - end, +mk_trampoline_map([], [], _) -> []; % archs not using trampolines +mk_trampoline_map(CalleeMFAs, Trampolines, Architecture) -> + SizeofLong = word_size(Architecture), mk_trampoline_map(tuple_size(CalleeMFAs), CalleeMFAs, Trampolines, SizeofLong, gb_trees:empty()). @@ -325,7 +359,7 @@ trampoline_map_get(MFA, Map) -> gb_trees:get(MFA, Map). trampoline_map_lookup(_, []) -> []; % archs not using trampolines trampoline_map_lookup(Primop, Map) -> case gb_trees:lookup(Primop, Map) of - {value,X} -> X; + {value, X} -> X; _ -> [] end. @@ -340,11 +374,16 @@ exports(ExportMap, BaseAddress) -> exports(ExportMap, BaseAddress, [], []). exports([Offset,M,F,A,IsClosure,IsExported|Rest], BaseAddress, MFAs, Addresses) -> - MFA = {M,F,A}, - Address = BaseAddress + Offset, - FunDef = #fundef{address=Address, mfa=MFA, is_closure=IsClosure, - is_exported=IsExported}, - exports(Rest, BaseAddress, [MFA|MFAs], [FunDef|Addresses]); + case IsExported andalso erlang:is_builtin(M, F, A) of + true -> + exports(Rest, BaseAddress, MFAs, Addresses); + _false -> + MFA = {M,F,A}, + Address = BaseAddress + Offset, + FunDef = #fundef{address=Address, mfa=MFA, is_closure=IsClosure, + is_exported=IsExported}, + exports(Rest, BaseAddress, [MFA|MFAs], [FunDef|Addresses]) + end; exports([], _, MFAs, Addresses) -> {MFAs, Addresses}. @@ -367,7 +406,7 @@ offsets_to_addresses(Os, Base) -> find_closure_patches([{Type,Refs} | Rest]) -> case ?EXT2PATCH_TYPE(Type) of load_address -> - find_closure_refs(Refs,Rest); + find_closure_refs(Refs, Rest); _ -> find_closure_patches(Rest) end; @@ -402,16 +441,17 @@ export_funs([FunDef | Addresses]) -> hipe_bifs:set_native_address(MFA, Address, IsClosure), export_funs(Addresses); export_funs([]) -> - true. + ok. -export_funs(Mod, Beam, Addresses, ClosuresToPatch) -> - Fs = [{F,A,Address} || #fundef{address=Address, mfa={_M,F,A}} <- Addresses], - code:make_stub_module(Mod, Beam, {Fs,ClosuresToPatch}). +export_funs(Mod, MD5, Beam, Addresses, ClosuresToPatch) -> + Fs = [{F,A,Address} || #fundef{address=Address, mfa={_M,F,A}} <- Addresses], + Mod = code:make_stub_module(Mod, Beam, {Fs,ClosuresToPatch,MD5}), + ok. %%======================================================================== %% Patching %% @spec patch(refs(), BaseAddress::integer(), ConstAndZone::term(), -%% Addresses::term(), TrampolineMap::term()) -> term() +%% Addresses::term(), TrampolineMap::term()) -> 'ok'. %% @type refs()=[{RefType::integer(), Reflist::reflist()} | refs()] %% %% @type reflist()= [{Data::term(), Offsets::offests()}|reflist()] @@ -424,7 +464,7 @@ export_funs(Mod, Beam, Addresses, ClosuresToPatch) -> %% patch([{Type,SortedRefs}|Rest], CodeAddress, ConstMap2, Addresses, TrampolineMap) -> - ?debug_msg("Patching ~w at [~w+offset] with ~w\n", + ?debug_msg("Patching ~w at [~w+offset] with ~w\n", [Type,CodeAddress,SortedRefs]), case ?EXT2PATCH_TYPE(Type) of call_local -> @@ -435,7 +475,7 @@ patch([{Type,SortedRefs}|Rest], CodeAddress, ConstMap2, Addresses, TrampolineMap patch_all(Other, SortedRefs, CodeAddress, {ConstMap2,CodeAddress}, Addresses) end, patch(Rest, CodeAddress, ConstMap2, Addresses, TrampolineMap); -patch([], _, _, _, _) -> true. +patch([], _, _, _, _) -> ok. %%---------------------------------------------------------------- %% Handle a 'call_local' or 'call_remote' patch. @@ -457,14 +497,14 @@ patch_call([{DestMFA,Offsets}|SortedRefs], BaseAddress, Addresses, RemoteOrLocal end, patch_call(SortedRefs, BaseAddress, Addresses, RemoteOrLocal, TrampolineMap); patch_call([], _, _, _, _) -> - true. + ok. patch_bif_call_list([Offset|Offsets], BaseAddress, BifAddress, Trampoline) -> CallAddress = BaseAddress+Offset, ?ASSERT(assert_local_patch(CallAddress)), patch_call_insn(CallAddress, BifAddress, Trampoline), patch_bif_call_list(Offsets, BaseAddress, BifAddress, Trampoline); -patch_bif_call_list([], _, _, _) -> []. +patch_bif_call_list([], _, _, _) -> ok. patch_mfa_call_list([Offset|Offsets], BaseAddress, DestMFA, DestAddress, Addresses, RemoteOrLocal, Trampoline) -> CallAddress = BaseAddress+Offset, @@ -472,7 +512,7 @@ patch_mfa_call_list([Offset|Offsets], BaseAddress, DestMFA, DestAddress, Address ?ASSERT(assert_local_patch(CallAddress)), patch_call_insn(CallAddress, DestAddress, Trampoline), patch_mfa_call_list(Offsets, BaseAddress, DestMFA, DestAddress, Addresses, RemoteOrLocal, Trampoline); -patch_mfa_call_list([], _, _, _, _, _, _) -> []. +patch_mfa_call_list([], _, _, _, _, _, _) -> ok. patch_call_insn(CallAddress, DestAddress, Trampoline) -> %% This assertion is false when we're called from redirect/2. @@ -485,7 +525,7 @@ patch_call_insn(CallAddress, DestAddress, Trampoline) -> patch_all(Type, [{Dest,Offsets}|Rest], BaseAddress, ConstAndZone, Addresses)-> patch_all_offsets(Type, Dest, Offsets, BaseAddress, ConstAndZone, Addresses), patch_all(Type, Rest, BaseAddress, ConstAndZone, Addresses); -patch_all(_, [], _, _, _) -> true. +patch_all(_, [], _, _, _) -> ok. patch_all_offsets(Type, Data, [Offset|Offsets], BaseAddress, ConstAndZone, Addresses) -> @@ -495,7 +535,7 @@ patch_all_offsets(Type, Data, [Offset|Offsets], BaseAddress, patch_offset(Type, Data, Address, ConstAndZone, Addresses), ?debug_msg("Patching done\n",[]), patch_all_offsets(Type, Data, Offsets, BaseAddress, ConstAndZone, Addresses); -patch_all_offsets(_, _, [], _, _, _) -> true. +patch_all_offsets(_, _, [], _, _, _) -> ok. %%---------------------------------------------------------------- %% Handle any patch type except 'call_local' or 'call_remote'. @@ -508,7 +548,7 @@ patch_offset(Type, Data, Address, ConstAndZone, Addresses) -> Atom = Data, patch_atom(Address, Atom); sdesc -> - patch_sdesc(Data, Address, ConstAndZone); + patch_sdesc(Data, Address, ConstAndZone, Addresses); x86_abs_pcrel -> patch_instr(Address, Data, x86_abs_pcrel) %% _ -> @@ -521,14 +561,16 @@ patch_atom(Address, Atom) -> patch_instr(Address, hipe_bifs:atom_to_word(Atom), atom). patch_sdesc(?STACK_DESC(SymExnRA, FSize, Arity, Live), - Address, {_ConstMap2,CodeAddress}) -> + Address, {_ConstMap2,CodeAddress}, _Addresses) -> ExnRA = case SymExnRA of [] -> 0; % No catch LabelOffset -> CodeAddress + LabelOffset end, ?ASSERT(assert_local_patch(Address)), - hipe_bifs:enter_sdesc({Address, ExnRA, FSize, Arity, Live}). + DBG_MFA = ?IF_DEBUG(address_to_mfa_lth(Address, _Addresses), {undefined,undefined,0}), + hipe_bifs:enter_sdesc({Address, ExnRA, FSize, Arity, Live, DBG_MFA}). + %%---------------------------------------------------------------- %% Handle a 'load_address'-type patch. @@ -553,12 +595,17 @@ patch_closure(DestMFA, Uniq, Index, Address, Addresses) -> case get(hipe_patch_closures) of false -> []; % This is taken care of when registering the module. - true -> % We are not loading a module patch these closures + true -> + %% We are replacing a previosly loaded BEAM module with native code, + %% so we must reference the pre-existing entries in the fun table + %% from the native code. We must delay actually patching the native + %% address into the fun entry to ensure that the native code cannot + %% be called until it has been completely fixed up. RemoteOrLocal = local, % closure code refs are local DestAddress = get_native_address(DestMFA, Addresses, RemoteOrLocal), BEAMAddress = hipe_bifs:fun_to_address(DestMFA), - FE = hipe_bifs:make_fe(DestAddress, mod(DestMFA), - {Uniq, Index, BEAMAddress}), + FE = hipe_bifs:get_fe(mod(DestMFA), {Uniq, Index, BEAMAddress}), + put(closures_to_patch, [{FE,DestAddress}|get(closures_to_patch)]), ?debug_msg("Patch FE(~w) to 0x~.16b->0x~.16b (emu:0x~.16b)\n", [DestMFA, FE, DestAddress, BEAMAddress]), ?ASSERT(assert_local_patch(Address)), @@ -585,22 +632,24 @@ patch_load_mfa(CodeAddress, DestMFA, Addresses, RemoteOrLocal) -> %%---------------------------------------------------------------- %% Patch references to code labels in the data segment. %% -patch_consts(Labels, DataAddress, CodeAddress) -> +patch_consts(Labels, DataAddress, CodeAddress, WriteWord) -> lists:foreach(fun (L) -> - patch_label_or_labels(L, DataAddress, CodeAddress) + patch_label_or_labels(L, DataAddress, CodeAddress, + WriteWord) end, Labels). -patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress) -> +patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress, WriteWord) -> ?ASSERT(assert_local_patch(CodeAddress+Offset)), - write_word(DataAddress+Pos, CodeAddress+Offset); -patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress) -> - sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress). + WriteWord(DataAddress+Pos, CodeAddress+Offset); +patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress, + WriteWord) -> + sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord). -sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress) -> +sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord) -> WriteAndInc = fun ({_, Offset}, DataPos) -> ?ASSERT(assert_local_patch(CodeAddress+Offset)), - write_word(DataPos, CodeAddress+Offset) + WriteWord(DataPos, CodeAddress+Offset) end, lists:foldl(WriteAndInc, DataAddress+Base, sort_on_representation(UnOrderdList)). @@ -625,18 +674,19 @@ patch_instr(Address, Value, Type) -> %% %% XXX: It appears this is used for inserting both code addresses %% and other data. In HiPE, code addresses are still 32-bit on -%% 64-bit machines. -write_word(DataAddress, DataWord) -> - case erlang:system_info(hipe_architecture) of - amd64 -> - hipe_bifs:write_u64(DataAddress, DataWord), - DataAddress+8; - %% ppc64 -> - %% hipe_bifs:write_u64(DataAddress, DataWord), - %% DataAddress+8; - _ -> - hipe_bifs:write_u32(DataAddress, DataWord), - DataAddress+4 +%% some 64-bit machines. +write_word_fun(WordSize) -> + case WordSize of + 8 -> + fun (DataAddress, DataWord) -> + hipe_bifs:write_u64(DataAddress, DataWord), + DataAddress+8 + end; + 4 -> + fun (DataAddress, DataWord) -> + hipe_bifs:write_u32(DataAddress, DataWord), + DataAddress+4 + end end. %%-------------------------------------------------------------------- @@ -652,30 +702,31 @@ bif_address(Name) when is_atom(Name) -> %% memory, and produces a ConstMap2 mapping each constant's ConstNo to %% its runtime address, tagged if the constant is a term. %% -create_data_segment(DataAlign, DataSize, DataList) -> +create_data_segment(DataAlign, DataSize, DataList, WriteWord) -> %%io:format("create_data_segment: \nDataAlign: ~p\nDataSize: ~p\nDataList: ~p\n",[DataAlign,DataSize,DataList]), DataAddress = hipe_bifs:alloc_data(DataAlign, DataSize), - enter_data(DataList, [], DataAddress, DataSize). + enter_data(DataList, [], DataAddress, DataSize, WriteWord). -enter_data(List, ConstMap2, DataAddress, DataSize) -> +enter_data(List, ConstMap2, DataAddress, DataSize, WriteWord) -> case List of [ConstNo,Offset,Type,Data|Rest] when is_integer(Offset) -> %%?msg("Const ~w\n",[[ConstNo,Offset,Type,Data]]), ?ASSERT((Offset >= 0) and (Offset =< DataSize)), - Res = enter_datum(Type, Data, DataAddress+Offset), - enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize); + Res = enter_datum(Type, Data, DataAddress+Offset, WriteWord), + enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize, + WriteWord); [] -> {DataAddress, ConstMap2} end. -enter_datum(Type, Data, Address) -> +enter_datum(Type, Data, Address, WriteWord) -> case ?EXT2CONST_TYPE(Type) of term -> %% Address is unused for terms hipe_bifs:term_to_word(hipe_bifs:merge_term(Data)); sorted_block -> L = lists:sort([hipe_bifs:term_to_word(Term) || Term <- Data]), - write_words(L, Address), + write_words(L, Address, WriteWord), Address; block -> case Data of @@ -683,7 +734,7 @@ enter_datum(Type, Data, Address) -> write_bytes(Lbls, Address); {Lbls, SortOrder} -> SortedLbls = [Lbl || {_,Lbl} <- lists:sort(group(Lbls, SortOrder))], - write_words(SortedLbls, Address); + write_words(SortedLbls, Address, WriteWord); Lbls -> write_bytes(Lbls, Address) end, @@ -698,9 +749,9 @@ group([B1,B2,B3,B4|Ls], [O|Os]) -> bytes_to_32(B4,B3,B2,B1) -> (B4 bsl 24) bor (B3 bsl 16) bor (B2 bsl 8) bor B1. -write_words([W|Rest], Addr) -> - write_words(Rest, write_word(Addr, W)); -write_words([], Addr) when is_integer(Addr) -> true. +write_words([W|Rest], Addr, WriteWord) -> + write_words(Rest, WriteWord(Addr, W), WriteWord); +write_words([], Addr, _) when is_integer(Addr) -> true. write_bytes([B|Rest], Addr) -> hipe_bifs:write_u8(Addr, B), @@ -735,7 +786,7 @@ find_const(ConstNo, []) -> %% add_ref(CalleeMFA, Address, Addresses, RefType, Trampoline, RemoteOrLocal) -> - CallerMFA = address_to_mfa(Address, Addresses), + CallerMFA = address_to_mfa_lth(Address, Addresses), %% just a sanity assertion below true = case RemoteOrLocal of local -> @@ -748,15 +799,35 @@ add_ref(CalleeMFA, Address, Addresses, RefType, Trampoline, RemoteOrLocal) -> %% io:format("Adding ref ~w\n",[{CallerMFA, CalleeMFA, Address, RefType}]), hipe_bifs:add_ref(CalleeMFA, {CallerMFA,Address,RefType,Trampoline,RemoteOrLocal}). -address_to_mfa(Address, [#fundef{address=Adr, mfa=MFA}|_Rest]) when Address >= Adr -> MFA; -address_to_mfa(Address, [_ | Rest]) -> address_to_mfa(Address, Rest); -address_to_mfa(Address, []) -> - ?error_msg("Local adddress not found ~w\n",[Address]), - exit({?MODULE, local_address_not_found}). +% For FunDefs sorted from low to high addresses +address_to_mfa_lth(Address, FunDefs) -> + case address_to_mfa_lth(Address, FunDefs, false) of + false -> + ?error_msg("Local adddress not found ~w\n",[Address]), + exit({?MODULE, local_address_not_found}); + MFA -> + MFA + end. + +address_to_mfa_lth(Address, [#fundef{address=Adr, mfa=MFA}|Rest], Prev) -> + if Address < Adr -> + Prev; + true -> + address_to_mfa_lth(Address, Rest, MFA) + end; +address_to_mfa_lth(_Address, [], Prev) -> + Prev. + +% For FunDefs sorted from high to low addresses +%% address_to_mfa_htl(Address, [#fundef{address=Adr, mfa=MFA}|_Rest]) when Address >= Adr -> MFA; +%% address_to_mfa_htl(Address, [_ | Rest]) -> address_to_mfa_htl(Address, Rest); +%% address_to_mfa_htl(Address, []) -> +%% ?error_msg("Local adddress not found ~w\n",[Address]), +%% exit({?MODULE, local_address_not_found}). %%---------------------------------------------------------------- %% Change callers of the given module to instead trap to BEAM. -%% load_native_code/2 calls this just before loading native code. +%% load_native_code/3 calls this just before loading native code. %% patch_to_emu(Mod) -> patch_to_emu_step2(patch_to_emu_step1(Mod)). @@ -773,12 +844,11 @@ patch_to_emu_step1(Mod) -> %% were added as the result of dynamic apply calls. We must %% purge them too, but we have no explicit record of them. %% Therefore invalidate all native addresses for the module. - %% emu_make_stubs/1 will repair the ones for compiled static calls. hipe_bifs:invalidate_funinfo_native_addresses(MFAs), %% Find all call sites that call these MFAs. As a side-effect, %% create native stubs for any MFAs that are referred. ReferencesToPatch = get_refs_from(MFAs, []), - remove_refs_from(MFAs), + ok = remove_refs_from(MFAs), ReferencesToPatch; false -> %% The first time we load the module, no redirection needs to be done. @@ -787,7 +857,6 @@ patch_to_emu_step1(Mod) -> %% Step 2 must occur after the new BEAM stub module is created. patch_to_emu_step2(ReferencesToPatch) -> - emu_make_stubs(ReferencesToPatch), redirect(ReferencesToPatch). -spec is_loaded(Module::atom()) -> boolean(). @@ -798,21 +867,6 @@ is_loaded(M) when is_atom(M) -> catch _:_ -> false end. --ifdef(notdef). -emu_make_stubs([{MFA,_Refs}|Rest]) -> - make_stub(MFA), - emu_make_stubs(Rest); -emu_make_stubs([]) -> - []. - -make_stub({_,_,A} = MFA) -> - EmuAddress = hipe_bifs:get_emu_address(MFA), - StubAddress = hipe_bifs:make_native_stub(EmuAddress, A), - hipe_bifs:set_funinfo_native_address(MFA, StubAddress). --else. -emu_make_stubs(_) -> []. --endif. - %%-------------------------------------------------------------------- %% Given a list of MFAs, tag them with their referred_from references. %% The resulting {MFA,Refs} list is later passed to redirect/1, once @@ -822,11 +876,8 @@ get_refs_from(MFAs, []) -> mark_referred_from(MFAs), MFAs. -mark_referred_from([MFA|MFAs]) -> - hipe_bifs:mark_referred_from(MFA), - mark_referred_from(MFAs); -mark_referred_from([]) -> - []. +mark_referred_from(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:mark_referred_from(MFA) end, MFAs). %%-------------------------------------------------------------------- %% Given a list of MFAs with referred_from references, update their @@ -834,11 +885,8 @@ mark_referred_from([]) -> %% %% The {MFA,Refs} list must come from get_refs_from/2. %% -redirect([MFA|Rest]) -> - hipe_bifs:redirect_referred_from(MFA), - redirect(Rest); -redirect([]) -> - ok. +redirect(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:redirect_referred_from(MFA) end, MFAs). %%-------------------------------------------------------------------- %% Given a list of MFAs, remove all referred_from references having @@ -850,11 +898,8 @@ redirect([]) -> %% list. The refers_to list is used here to find the CalleeMFAs whose %% referred_from lists should be updated. %% -remove_refs_from([CallerMFA|CallerMFAs]) -> - hipe_bifs:remove_refs_from(CallerMFA), - remove_refs_from(CallerMFAs); -remove_refs_from([]) -> - []. +remove_refs_from(MFAs) -> + lists:foreach(fun(MFA) -> hipe_bifs:remove_refs_from(MFA) end, MFAs). %%-------------------------------------------------------------------- diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index eb503235d8..f5c13ecdd7 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -24,21 +25,30 @@ %% socket -export([peername/1, sockname/1, port/1, send/2, + peernames/1, peernames/2, socknames/1, socknames/2, setopts/2, getopts/2, + getifaddrs/0, getifaddrs/1, getif/1, getif/0, getiflist/0, getiflist/1, ifget/3, ifget/2, ifset/3, ifset/2, getstat/1, getstat/2, ip/1, stats/0, options/0, - pushf/3, popf/1, close/1, gethostname/0, gethostname/1]). + pushf/3, popf/1, close/1, gethostname/0, gethostname/1, + parse_ipv4_address/1, parse_ipv6_address/1, parse_ipv4strict_address/1, + parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1, ntoa/1]). -export([connect_options/2, listen_options/2, udp_options/2, sctp_options/2]). +-export([udp_module/1, tcp_module/1, tcp_module/2, sctp_module/1]). -export([i/0, i/1, i/2]). --export([getll/1, getfd/1, open/7, fdopen/5]). +-export([getll/1, getfd/1, open/8, fdopen/6]). -export([tcp_controlling_process/2, udp_controlling_process/2, tcp_close/1, udp_close/1]). + +%% used by sendfile +-export([lock_socket/2]). + %% used by socks5 -export([setsockname/2, setpeername/2]). @@ -62,6 +72,11 @@ %% timer interface -export([start_timer/1, timeout/1, timeout/2, stop_timer/1]). +-export_type([address_family/0, hostent/0, hostname/0, ip4_address/0, + ip6_address/0, ip_address/0, port_number/0, + local_address/0, socket_address/0, returned_non_ip_address/0, + socket_setopt/0, socket_getopt/0, + posix/0, socket/0, stat_option/0]). %% imports -import(lists, [append/1, duplicate/2, filter/2, foldl/3]). @@ -76,97 +91,27 @@ %%% --------------------------------- %%% Contract type definitions + +-type hostent() :: #hostent{}. +-type hostname() :: atom() | string(). +-type ip4_address() :: {0..255,0..255,0..255,0..255}. +-type ip6_address() :: {0..65535,0..65535,0..65535,0..65535, + 0..65535,0..65535,0..65535,0..65535}. +-type ip_address() :: ip4_address() | ip6_address(). +-type port_number() :: 0..65535. +-type local_address() :: {local, File :: binary() | string()}. +-type returned_non_ip_address() :: + {local, binary()} | + {unspec, <<>>} | + {undefined, any()}. +-type posix() :: exbadport | exbadseq | file:posix(). -type socket() :: port(). --type posix() :: atom(). -type socket_setopt() :: - {'raw', non_neg_integer(), non_neg_integer(), binary()} | - %% TCP/UDP options - {'reuseaddr', boolean()} | - {'keepalive', boolean()} | - {'dontroute', boolean()} | - {'linger', {boolean(), non_neg_integer()}} | - {'broadcast', boolean()} | - {'sndbuf', non_neg_integer()} | - {'recbuf', non_neg_integer()} | - {'priority', non_neg_integer()} | - {'tos', non_neg_integer()} | - {'nodelay', boolean()} | - {'multicast_ttl', non_neg_integer()} | - {'multicast_loop', boolean()} | - {'multicast_if', ip_address()} | - {'add_membership', {ip_address(), ip_address()}} | - {'drop_membership', {ip_address(), ip_address()}} | - {'header', non_neg_integer()} | - {'buffer', non_neg_integer()} | - {'active', boolean() | 'once'} | - {'packet', - 0 | 1 | 2 | 4 | 'raw' | 'sunrm' | 'asn1' | - 'cdr' | 'fcgi' | 'line' | 'tpkt' | 'http' | 'httph' | 'http_bin' | 'httph_bin' } | - {'mode', list() | binary()} | - {'port', 'port', 'term'} | - {'exit_on_close', boolean()} | - {'low_watermark', non_neg_integer()} | - {'high_watermark', non_neg_integer()} | - {'bit8', 'clear' | 'set' | 'on' | 'off'} | - {'send_timeout', non_neg_integer() | 'infinity'} | - {'send_timeout_close', boolean()} | - {'delay_send', boolean()} | - {'packet_size', non_neg_integer()} | - {'read_packets', non_neg_integer()} | - %% SCTP options - {'sctp_rtoinfo', #sctp_rtoinfo{}} | - {'sctp_associnfo', #sctp_assocparams{}} | - {'sctp_initmsg', #sctp_initmsg{}} | - {'sctp_nodelay', boolean()} | - {'sctp_autoclose', non_neg_integer()} | - {'sctp_disable_fragments', boolean()} | - {'sctp_i_want_mapped_v4_addr', boolean()} | - {'sctp_maxseg', non_neg_integer()} | - {'sctp_primary_addr', #sctp_prim{}} | - {'sctp_set_peer_primary_addr', #sctp_setpeerprim{}} | - {'sctp_adaptation_layer', #sctp_setadaptation{}} | - {'sctp_peer_addr_params', #sctp_paddrparams{}} | - {'sctp_default_send_param', #sctp_sndrcvinfo{}} | - {'sctp_events', #sctp_event_subscribe{}} | - {'sctp_delayed_ack_time', #sctp_assoc_value{}}. + gen_sctp:option() | gen_tcp:option() | gen_udp:option(). -type socket_getopt() :: - {'raw', - non_neg_integer(), non_neg_integer(), binary()|non_neg_integer()} | - %% TCP/UDP options - 'reuseaddr' | 'keepalive' | 'dontroute' | 'linger' | - 'broadcast' | 'sndbuf' | 'recbuf' | 'priority' | 'tos' | 'nodelay' | - 'multicast_ttl' | 'multicast_loop' | 'multicast_if' | - 'add_membership' | 'drop_membership' | - 'header' | 'buffer' | 'active' | 'packet' | 'mode' | 'port' | - 'exit_on_close' | 'low_watermark' | 'high_watermark' | 'bit8' | - 'send_timeout' | 'send_timeout_close' | - 'delay_send' | 'packet_size' | 'read_packets' | - %% SCTP options - {'sctp_status', #sctp_status{}} | - 'sctp_get_peer_addr_info' | - {'sctp_get_peer_addr_info', #sctp_status{}} | - 'sctp_rtoinfo' | - {'sctp_rtoinfo', #sctp_rtoinfo{}} | - 'sctp_associnfo' | - {'sctp_associnfo', #sctp_assocparams{}} | - 'sctp_initmsg' | - {'sctp_initmsg', #sctp_initmsg{}} | - 'sctp_nodelay' | 'sctp_autoclose' | 'sctp_disable_fragments' | - 'sctp_i_want_mapped_v4_addr' | 'sctp_maxseg' | - {'sctp_primary_addr', #sctp_prim{}} | - {'sctp_set_peer_primary_addr', #sctp_setpeerprim{}} | - 'sctp_adaptation_layer' | - {'sctp_adaptation_layer', #sctp_setadaptation{}} | - {'sctp_peer_addr_params', #sctp_paddrparams{}} | - 'sctp_default_send_param' | - {'sctp_default_send_param', #sctp_sndrcvinfo{}} | - 'sctp_events' | - {'sctp_events', #sctp_event_subscribe{}} | - 'sctp_delayed_ack_time' | - {'sctp_delayed_ack_time', #sctp_assoc_value{}}. - + gen_sctp:option_name() | gen_tcp:option_name() | gen_udp:option_name(). -type ether_address() :: [0..255]. -type if_setopt() :: @@ -184,20 +129,35 @@ 'addr' | 'broadaddr' | 'dstaddr' | 'mtu' | 'netmask' | 'flags' |'hwaddr'. --type family_option() :: 'inet' | 'inet6'. --type protocol_option() :: 'tcp' | 'udp' | 'sctp'. +-type if_getopt_result() :: + {'addr', ip_address()} | + {'broadaddr', ip_address()} | + {'dstaddr', ip_address()} | + {'mtu', non_neg_integer()} | + {'netmask', ip_address()} | + {'flags', ['up' | 'down' | 'broadcast' | 'no_broadcast' | + 'pointtopoint' | 'no_pointtopoint' | + 'running' | 'multicast' | 'loopback']} | + {'hwaddr', ether_address()}. + +-type address_family() :: 'inet' | 'inet6' | 'local'. +-type socket_protocol() :: 'tcp' | 'udp' | 'sctp'. +-type socket_type() :: 'stream' | 'dgram' | 'seqpacket'. +-type socket_address() :: + ip_address() | 'any' | 'loopback' | local_address(). -type stat_option() :: 'recv_cnt' | 'recv_max' | 'recv_avg' | 'recv_oct' | 'recv_dvi' | 'send_cnt' | 'send_max' | 'send_avg' | 'send_oct' | 'send_pend'. %%% --------------------------------- --spec get_rc() -> [{any(),any()}]. +-spec get_rc() -> [{Par :: any(), Val :: any()}]. get_rc() -> inet_db:get_rc(). --spec close(Socket :: socket()) -> 'ok'. +-spec close(Socket) -> 'ok' when + Socket :: socket(). close(Socket) -> prim_inet:close(Socket), @@ -208,28 +168,64 @@ close(Socket) -> ok end. --spec peername(Socket :: socket()) -> - {'ok', {ip_address(), non_neg_integer()}} | {'error', posix()}. + +-spec peername(Socket :: socket()) -> + {ok, + {ip_address(), port_number()} | + returned_non_ip_address()} | + {error, posix()}. peername(Socket) -> prim_inet:peername(Socket). --spec setpeername(Socket :: socket(), Address :: {ip_address(), ip_port()}) -> - 'ok' | {'error', any()}. +-spec setpeername( + Socket :: socket(), + Address :: + {ip_address() | 'any' | 'loopback', + port_number()} | + socket_address()) -> + 'ok' | {'error', any()}. setpeername(Socket, {IP,Port}) -> prim_inet:setpeername(Socket, {IP,Port}); setpeername(Socket, undefined) -> prim_inet:setpeername(Socket, undefined). +-spec peernames(Socket :: socket()) -> + {ok, + [{ip_address(), port_number()} | + returned_non_ip_address()]} | + {error, posix()}. + +peernames(Socket) -> + prim_inet:peernames(Socket). + +-spec peernames(Socket, Assoc) -> + {ok, [{Address, Port}]} | {error, posix()} when + Socket :: socket(), + Assoc :: #sctp_assoc_change{} | gen_sctp:assoc_id(), + Address :: ip_address(), + Port :: non_neg_integer(). + +peernames(Socket, Assoc) -> + prim_inet:peernames(Socket, Assoc). --spec sockname(Socket :: socket()) -> - {'ok', {ip_address(), non_neg_integer()}} | {'error', posix()}. + +-spec sockname(Socket :: socket()) -> + {ok, + {ip_address(), port_number()} | + returned_non_ip_address()} | + {error, posix()}. sockname(Socket) -> prim_inet:sockname(Socket). --spec setsockname(Socket :: socket(), Address :: {ip_address(), ip_port()}) -> +-spec setsockname( + Socket :: socket(), + Address :: + {ip_address() | 'any' | 'loopback', + port_number()} | + socket_address()) -> 'ok' | {'error', any()}. setsockname(Socket, {IP,Port}) -> @@ -237,7 +233,29 @@ setsockname(Socket, {IP,Port}) -> setsockname(Socket, undefined) -> prim_inet:setsockname(Socket, undefined). --spec port(Socket :: socket()) -> {'ok', ip_port()} | {'error', any()}. +-spec socknames(Socket :: socket()) -> + {ok, + [{ip_address(), port_number()} | + returned_non_ip_address()]} | + {error, posix()}. + +socknames(Socket) -> + prim_inet:socknames(Socket). + +-spec socknames(Socket, Assoc) -> + {ok, [{Address, Port}]} | {error, posix()} when + Socket :: socket(), + Assoc :: #sctp_assoc_change{} | gen_sctp:assoc_id(), + Address :: ip_address(), + Port :: non_neg_integer(). + +socknames(Socket, Assoc) -> + prim_inet:socknames(Socket, Assoc). + + +-spec port(Socket) -> {'ok', Port} | {'error', any()} when + Socket :: socket(), + Port :: port_number(). port(Socket) -> case prim_inet:sockname(Socket) of @@ -251,17 +269,62 @@ port(Socket) -> send(Socket, Packet) -> prim_inet:send(Socket, Packet). --spec setopts(Socket :: socket(), Opts :: [socket_setopt()]) -> - 'ok' | {'error', posix()}. +-spec setopts(Socket, Options) -> ok | {error, posix()} when + Socket :: socket(), + Options :: [socket_setopt()]. setopts(Socket, Opts) -> - prim_inet:setopts(Socket, Opts). - --spec getopts(Socket :: socket(), Opts :: [socket_getopt()]) -> - {'ok', [socket_setopt()]} | {'error', posix()}. + SocketOpts = + [case Opt of + {netns,NS} -> + {netns,filename2binary(NS)}; + _ -> + Opt + end || Opt <- Opts], + prim_inet:setopts(Socket, SocketOpts). + +-spec getopts(Socket, Options) -> + {'ok', OptionValues} | {'error', posix()} when + Socket :: socket(), + Options :: [socket_getopt()], + OptionValues :: [socket_setopt()]. getopts(Socket, Opts) -> - prim_inet:getopts(Socket, Opts). + case prim_inet:getopts(Socket, Opts) of + {ok,OptionValues} -> + {ok, + [case OptionValue of + {netns,Bin} -> + {netns,binary2filename(Bin)}; + _ -> + OptionValue + end || OptionValue <- OptionValues]}; + Other -> + Other + end. + +-spec getifaddrs(Socket :: socket()) -> + {'ok', [string()]} | {'error', posix()}. + +getifaddrs(Socket) -> + prim_inet:getifaddrs(Socket). + +-spec getifaddrs() -> {ok, Iflist} | {error, posix()} when + Iflist :: [{Ifname,[Ifopt]}], + Ifname :: string(), + Ifopt :: {flags,[Flag]} | {addr,Addr} | {netmask,Netmask} + | {broadaddr,Broadaddr} | {dstaddr,Dstaddr} + | {hwaddr,Hwaddr}, + Flag :: up | broadcast | loopback | pointtopoint + | running | multicast, + Addr :: ip_address(), + Netmask :: ip_address(), + Broadaddr :: ip_address(), + Dstaddr :: ip_address(), + Hwaddr :: [byte()]. + +getifaddrs() -> + withsocket(fun(S) -> prim_inet:getifaddrs(S) end). -spec getiflist(Socket :: socket()) -> {'ok', [string()]} | {'error', posix()}. @@ -277,13 +340,13 @@ getiflist() -> -spec ifget(Socket :: socket(), Name :: string() | atom(), Opts :: [if_getopt()]) -> - {'ok', [if_setopt()]} | {'error', posix()}. + {'ok', [if_getopt_result()]} | {'error', posix()}. ifget(Socket, Name, Opts) -> prim_inet:ifget(Socket, Name, Opts). -spec ifget(Name :: string() | atom(), Opts :: [if_getopt()]) -> - {'ok', [if_setopt()]} | {'error', posix()}. + {'ok', [if_getopt_result()]} | {'error', posix()}. ifget(Name, Opts) -> withsocket(fun(S) -> prim_inet:ifget(S, Name, Opts) end). @@ -357,7 +420,8 @@ popf(_Socket) -> % use of the DHCP-protocol % should never fail --spec gethostname() -> {'ok', string()}. +-spec gethostname() -> {'ok', Hostname} when + Hostname :: string(). gethostname() -> case inet_udp:open(0,[]) of @@ -376,39 +440,53 @@ gethostname() -> gethostname(Socket) -> prim_inet:gethostname(Socket). --spec getstat(Socket :: socket()) -> - {'ok', [{stat_option(), integer()}]} | {'error', posix()}. +-spec getstat(Socket) -> + {ok, OptionValues} | {error, posix()} when + Socket :: socket(), + OptionValues :: [{stat_option(), integer()}]. getstat(Socket) -> prim_inet:getstat(Socket, stats()). --spec getstat(Socket :: socket(), Statoptions :: [stat_option()]) -> - {'ok', [{stat_option(), integer()}]} | {'error', posix()}. +-spec getstat(Socket, Options) -> + {ok, OptionValues} | {error, posix()} when + Socket :: socket(), + Options :: [stat_option()], + OptionValues :: [{stat_option(), integer()}]. getstat(Socket,What) -> prim_inet:getstat(Socket, What). --spec gethostbyname(Name :: string() | atom()) -> - {'ok', #hostent{}} | {'error', posix()}. +-spec gethostbyname(Hostname) -> {ok, Hostent} | {error, posix()} when + Hostname :: hostname(), + Hostent :: hostent(). gethostbyname(Name) -> - gethostbyname_tm(Name, inet, false). + case inet_db:res_option(inet6) of + true -> + gethostbyname_tm(Name, inet6, false); + false -> + gethostbyname_tm(Name, inet, false) + end. --spec gethostbyname(Name :: string() | atom(), Family :: family_option()) -> - {'ok', #hostent{}} | {'error', posix()}. +-spec gethostbyname(Hostname, Family) -> + {ok, Hostent} | {error, posix()} when + Hostname :: hostname(), + Family :: address_family(), + Hostent :: hostent(). gethostbyname(Name,Family) -> gethostbyname_tm(Name, Family, false). --spec gethostbyname(Name :: string() | atom(), - Family :: family_option(), +-spec gethostbyname(Name :: hostname(), + Family :: address_family(), Timeout :: non_neg_integer() | 'infinity') -> {'ok', #hostent{}} | {'error', posix()}. gethostbyname(Name,Family,Timeout) -> Timer = start_timer(Timeout), Res = gethostbyname_tm(Name,Family,Timer), - stop_timer(Timer), + _ = stop_timer(Timer), Res. gethostbyname_tm(Name,Family,Timer) -> @@ -425,8 +503,9 @@ gethostbyname_tm(Name,Family,Timer) -> gethostbyname_tm(Name, Family, Timer, Opts). --spec gethostbyaddr(Address :: string() | ip_address()) -> - {'ok', #hostent{}} | {'error', posix()}. +-spec gethostbyaddr(Address) -> {ok, Hostent} | {error, posix()} when + Address :: string() | ip_address(), + Hostent :: hostent(). gethostbyaddr(Address) -> gethostbyaddr_tm(Address, false). @@ -438,7 +517,7 @@ gethostbyaddr(Address) -> gethostbyaddr(Address,Timeout) -> Timer = start_timer(Timeout), Res = gethostbyaddr_tm(Address, Timer), - stop_timer(Timer), + _ = stop_timer(Timer), Res. gethostbyaddr_tm(Address,Timer) -> @@ -477,22 +556,23 @@ getfd(Socket) -> %% Lookup an ip address %% --spec getaddr(Host :: ip_address() | string() | atom(), - Family :: family_option()) -> - {'ok', ip_address()} | {'error', posix()}. +-spec getaddr(Host, Family) -> {ok, Address} | {error, posix()} when + Host :: ip_address() | hostname(), + Family :: address_family(), + Address :: ip_address(). getaddr(Address, Family) -> getaddr(Address, Family, infinity). --spec getaddr(Host :: ip_address() | string() | atom(), - Family :: family_option(), +-spec getaddr(Host :: ip_address() | hostname(), + Family :: address_family(), Timeout :: non_neg_integer() | 'infinity') -> {'ok', ip_address()} | {'error', posix()}. getaddr(Address, Family, Timeout) -> Timer = start_timer(Timeout), Res = getaddr_tm(Address, Family, Timer), - stop_timer(Timer), + _ = stop_timer(Timer), Res. getaddr_tm(Address, Family, Timer) -> @@ -501,25 +581,27 @@ getaddr_tm(Address, Family, Timer) -> Error -> Error end. --spec getaddrs(Host :: ip_address() | string() | atom(), - Family :: family_option()) -> - {'ok', [ip_address()]} | {'error', posix()}. +-spec getaddrs(Host, Family) -> + {ok, Addresses} | {error, posix()} when + Host :: ip_address() | hostname(), + Family :: address_family(), + Addresses :: [ip_address()]. getaddrs(Address, Family) -> getaddrs(Address, Family, infinity). -spec getaddrs(Host :: ip_address() | string() | atom(), - Family :: family_option(), + Family :: address_family(), Timeout :: non_neg_integer() | 'infinity') -> {'ok', [ip_address()]} | {'error', posix()}. getaddrs(Address, Family, Timeout) -> Timer = start_timer(Timeout), Res = getaddrs_tm(Address, Family, Timer), - stop_timer(Timer), + _ = stop_timer(Timer), Res. --spec getservbyport(Port :: ip_port(), Protocol :: atom() | string()) -> +-spec getservbyport(Port :: port_number(), Protocol :: atom() | string()) -> {'ok', string()} | {'error', posix()}. getservbyport(Port, Proto) -> @@ -533,7 +615,7 @@ getservbyport(Port, Proto) -> -spec getservbyname(Name :: atom() | string(), Protocol :: atom() | string()) -> - {'ok', ip_port()} | {'error', posix()}. + {'ok', port_number()} | {'error', posix()}. getservbyname(Name, Protocol) when is_atom(Name) -> case inet_udp:open(0, []) of @@ -544,15 +626,64 @@ getservbyname(Name, Protocol) when is_atom(Name) -> Error -> Error end. +-spec ntoa(IpAddress) -> Address | {error, einval} when + Address :: string(), + IpAddress :: ip_address(). +ntoa(Addr) -> + inet_parse:ntoa(Addr). + +-spec parse_ipv4_address(Address) -> + {ok, IPv4Address} | {error, einval} when + Address :: string(), + IPv4Address :: ip_address(). +parse_ipv4_address(Addr) -> + inet_parse:ipv4_address(Addr). + +-spec parse_ipv6_address(Address) -> + {ok, IPv6Address} | {error, einval} when + Address :: string(), + IPv6Address :: ip_address(). +parse_ipv6_address(Addr) -> + inet_parse:ipv6_address(Addr). + +-spec parse_ipv4strict_address(Address) -> + {ok, IPv4Address} | {error, einval} when + Address :: string(), + IPv4Address :: ip_address(). +parse_ipv4strict_address(Addr) -> + inet_parse:ipv4strict_address(Addr). + +-spec parse_ipv6strict_address(Address) -> + {ok, IPv6Address} | {error, einval} when + Address :: string(), + IPv6Address :: ip_address(). +parse_ipv6strict_address(Addr) -> + inet_parse:ipv6strict_address(Addr). + +-spec parse_address(Address) -> + {ok, IPAddress} | {error, einval} when + Address :: string(), + IPAddress :: ip_address(). +parse_address(Addr) -> + inet_parse:address(Addr). + +-spec parse_strict_address(Address) -> + {ok, IPAddress} | {error, einval} when + Address :: string(), + IPAddress :: ip_address(). +parse_strict_address(Addr) -> + inet_parse:strict_address(Addr). + %% Return a list of available options options() -> [ - tos, priority, reuseaddr, keepalive, dontroute, linger, - broadcast, sndbuf, recbuf, nodelay, + tos, tclass, priority, reuseaddr, keepalive, dontroute, linger, + broadcast, sndbuf, recbuf, nodelay, ipv6_v6only, buffer, header, active, packet, deliver, mode, multicast_if, multicast_ttl, multicast_loop, exit_on_close, high_watermark, low_watermark, - bit8, send_timeout, send_timeout_close + high_msgq_watermark, low_msgq_watermark, + send_timeout, send_timeout_close, show_econnreset ]. %% Return a list of statistics options @@ -567,12 +698,13 @@ stats() -> %% Available options for tcp:connect %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% connect_options() -> - [tos, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay, - header, active, packet, packet_size, buffer, mode, deliver, - exit_on_close, high_watermark, low_watermark, bit8, send_timeout, - send_timeout_close, delay_send,raw]. + [tos, tclass, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay, + header, active, packet, packet_size, buffer, mode, deliver, line_delimiter, + exit_on_close, high_watermark, low_watermark, high_msgq_watermark, + low_msgq_watermark, send_timeout, send_timeout_close, delay_send, raw, + show_econnreset]. -connect_options(Opts, Family) -> +connect_options(Opts, Mod) -> BaseOpts = case application:get_env(kernel, inet_default_connect_options) of {ok,List} when is_list(List) -> @@ -588,14 +720,15 @@ connect_options(Opts, Family) -> case con_opt(Opts, BaseOpts, connect_options()) of {ok, R} -> {ok, R#connect_opts { - ifaddr = translate_ip(R#connect_opts.ifaddr, Family) + opts = lists:reverse(R#connect_opts.opts), + ifaddr = Mod:translate_ip(R#connect_opts.ifaddr) }}; Error -> Error end. -con_opt([{raw,A,B,C}|Opts],R,As) -> +con_opt([{raw,A,B,C}|Opts],#connect_opts{} = R,As) -> con_opt([{raw,{A,B,C}}|Opts],R,As); -con_opt([Opt | Opts], R, As) -> +con_opt([Opt | Opts], #connect_opts{} = R, As) -> case Opt of {ip,IP} -> con_opt(Opts, R#connect_opts { ifaddr = IP }, As); {ifaddr,IP} -> con_opt(Opts, R#connect_opts { ifaddr = IP }, As); @@ -603,16 +736,26 @@ con_opt([Opt | Opts], R, As) -> {fd,Fd} -> con_opt(Opts, R#connect_opts { fd = Fd }, As); binary -> con_add(mode, binary, R, Opts, As); list -> con_add(mode, list, R, Opts, As); - {tcp_module,_} -> con_opt(Opts, R, As); - inet -> con_opt(Opts, R, As); - inet6 -> con_opt(Opts, R, As); + {netns,NS} -> + BinNS = filename2binary(NS), + case prim_inet:is_sockopt_val(netns, BinNS) of + true -> + con_opt(Opts, R#connect_opts { fd = [{netns,BinNS}] }, As); + false -> + {error, badarg} + end; + {active,N} when is_integer(N), N < 32768, N >= -32768 -> + NOpts = lists:keydelete(active, 1, R#connect_opts.opts), + con_opt(Opts, R#connect_opts { opts = [{active,N}|NOpts] }, As); + {line_delimiter,C} when is_integer(C), C >= 0, C =< 255 -> + con_add(line_delimiter, C, R, Opts, As); {Name,Val} when is_atom(Name) -> con_add(Name, Val, R, Opts, As); _ -> {error, badarg} end; -con_opt([], R, _) -> +con_opt([], #connect_opts{} = R, _) -> {ok, R}. -con_add(Name, Val, R, Opts, AllOpts) -> +con_add(Name, Val, #connect_opts{} = R, Opts, AllOpts) -> case add_opt(Name, Val, R#connect_opts.opts, AllOpts) of {ok, SOpts} -> con_opt(Opts, R#connect_opts { opts = SOpts }, AllOpts); @@ -623,12 +766,13 @@ con_add(Name, Val, R, Opts, AllOpts) -> %% Available options for tcp:listen %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% listen_options() -> - [tos, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay, - header, active, packet, buffer, mode, deliver, backlog, - exit_on_close, high_watermark, low_watermark, bit8, send_timeout, - send_timeout_close, delay_send, packet_size,raw]. + [tos, tclass, priority, reuseaddr, keepalive, linger, sndbuf, recbuf, nodelay, + header, active, packet, buffer, mode, deliver, backlog, ipv6_v6only, + exit_on_close, high_watermark, low_watermark, high_msgq_watermark, + low_msgq_watermark, send_timeout, send_timeout_close, delay_send, + packet_size, raw, show_econnreset]. -listen_options(Opts, Family) -> +listen_options(Opts, Mod) -> BaseOpts = case application:get_env(kernel, inet_default_listen_options) of {ok,List} when is_list(List) -> @@ -644,14 +788,15 @@ listen_options(Opts, Family) -> case list_opt(Opts, BaseOpts, listen_options()) of {ok, R} -> {ok, R#listen_opts { - ifaddr = translate_ip(R#listen_opts.ifaddr, Family) + opts = lists:reverse(R#listen_opts.opts), + ifaddr = Mod:translate_ip(R#listen_opts.ifaddr) }}; Error -> Error end. -list_opt([{raw,A,B,C}|Opts], R, As) -> +list_opt([{raw,A,B,C}|Opts], #listen_opts{} = R, As) -> list_opt([{raw,{A,B,C}}|Opts], R, As); -list_opt([Opt | Opts], R, As) -> +list_opt([Opt | Opts], #listen_opts{} = R, As) -> case Opt of {ip,IP} -> list_opt(Opts, R#listen_opts { ifaddr = IP }, As); {ifaddr,IP} -> list_opt(Opts, R#listen_opts { ifaddr = IP }, As); @@ -660,44 +805,67 @@ list_opt([Opt | Opts], R, As) -> {backlog,BL} -> list_opt(Opts, R#listen_opts { backlog = BL }, As); binary -> list_add(mode, binary, R, Opts, As); list -> list_add(mode, list, R, Opts, As); - {tcp_module,_} -> list_opt(Opts, R, As); - inet -> list_opt(Opts, R, As); - inet6 -> list_opt(Opts, R, As); + {netns,NS} -> + BinNS = filename2binary(NS), + case prim_inet:is_sockopt_val(netns, BinNS) of + true -> + list_opt(Opts, R#listen_opts { fd = [{netns,BinNS}] }, As); + false -> + {error, badarg} + end; + {active,N} when is_integer(N), N < 32768, N >= -32768 -> + NOpts = lists:keydelete(active, 1, R#listen_opts.opts), + list_opt(Opts, R#listen_opts { opts = [{active,N}|NOpts] }, As); {Name,Val} when is_atom(Name) -> list_add(Name, Val, R, Opts, As); _ -> {error, badarg} end; -list_opt([], R, _SockOpts) -> +list_opt([], #listen_opts{} = R, _SockOpts) -> {ok, R}. -list_add(Name, Val, R, Opts, As) -> +list_add(Name, Val, #listen_opts{} = R, Opts, As) -> case add_opt(Name, Val, R#listen_opts.opts, As) of {ok, SOpts} -> list_opt(Opts, R#listen_opts { opts = SOpts }, As); Error -> Error end. +tcp_module(Opts) -> + tcp_module_1(Opts, undefined). + +tcp_module(Opts, Addr) -> + Address = {undefined,Addr}, + %% Address has to be a 2-tuple but the first element is ignored + tcp_module_1(Opts, Address). + +tcp_module_1(Opts, Address) -> + mod( + Opts, tcp_module, Address, + #{inet => inet_tcp, inet6 => inet6_tcp, local => local_tcp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Available options for udp:open %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% udp_options() -> - [tos, priority, reuseaddr, sndbuf, recbuf, header, active, buffer, mode, - deliver, + [tos, tclass, priority, reuseaddr, sndbuf, recbuf, header, active, buffer, mode, + deliver, ipv6_v6only, broadcast, dontroute, multicast_if, multicast_ttl, multicast_loop, - add_membership, drop_membership, read_packets,raw]. + add_membership, drop_membership, read_packets,raw, + high_msgq_watermark, low_msgq_watermark]. -udp_options(Opts, Family) -> +udp_options(Opts, Mod) -> case udp_opt(Opts, #udp_opts { }, udp_options()) of {ok, R} -> {ok, R#udp_opts { - ifaddr = translate_ip(R#udp_opts.ifaddr, Family) + opts = lists:reverse(R#udp_opts.opts), + ifaddr = Mod:translate_ip(R#udp_opts.ifaddr) }}; Error -> Error end. -udp_opt([{raw,A,B,C}|Opts], R, As) -> +udp_opt([{raw,A,B,C}|Opts], #udp_opts{} = R, As) -> udp_opt([{raw,{A,B,C}}|Opts], R, As); -udp_opt([Opt | Opts], R, As) -> +udp_opt([Opt | Opts], #udp_opts{} = R, As) -> case Opt of {ip,IP} -> udp_opt(Opts, R#udp_opts { ifaddr = IP }, As); {ifaddr,IP} -> udp_opt(Opts, R#udp_opts { ifaddr = IP }, As); @@ -705,28 +873,41 @@ udp_opt([Opt | Opts], R, As) -> {fd,Fd} -> udp_opt(Opts, R#udp_opts { fd = Fd }, As); binary -> udp_add(mode, binary, R, Opts, As); list -> udp_add(mode, list, R, Opts, As); - {udp_module,_} -> udp_opt(Opts, R, As); - inet -> udp_opt(Opts, R, As); - inet6 -> udp_opt(Opts, R, As); + {netns,NS} -> + BinNS = filename2binary(NS), + case prim_inet:is_sockopt_val(netns, BinNS) of + true -> + udp_opt(Opts, R#udp_opts { fd = [{netns,BinNS}] }, As); + false -> + {error, badarg} + end; + {active,N} when is_integer(N), N < 32768, N >= -32768 -> + NOpts = lists:keydelete(active, 1, R#udp_opts.opts), + udp_opt(Opts, R#udp_opts { opts = [{active,N}|NOpts] }, As); {Name,Val} when is_atom(Name) -> udp_add(Name, Val, R, Opts, As); _ -> {error, badarg} end; -udp_opt([], R, _SockOpts) -> +udp_opt([], #udp_opts{} = R, _SockOpts) -> {ok, R}. -udp_add(Name, Val, R, Opts, As) -> +udp_add(Name, Val, #udp_opts{} = R, Opts, As) -> case add_opt(Name, Val, R#udp_opts.opts, As) of {ok, SOpts} -> udp_opt(Opts, R#udp_opts { opts = SOpts }, As); Error -> Error end. +udp_module(Opts) -> + mod( + Opts, udp_module, undefined, + #{inet => inet_udp, inet6 => inet6_udp, local => local_udp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Available options for sctp:open %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Currently supported options include: % (*) {mode, list|binary} or just list|binary -% (*) {active, true|false|once} +% (*) {active, true|false|once|N} % (*) {sctp_module, inet_sctp|inet6_sctp} or just inet|inet6 % (*) options set via setsockopt. % The full list is below in sctp_options/0 . @@ -736,8 +917,8 @@ udp_add(Name, Val, R, Opts, As) -> % (*) passing of open FDs ("fdopen") is not supported. sctp_options() -> [ % The following are generic inet options supported for SCTP sockets: - mode, active, buffer, tos, priority, dontroute, reuseaddr, linger, sndbuf, - recbuf, + mode, active, buffer, tos, tclass, priority, dontroute, reuseaddr, linger, sndbuf, + recbuf, ipv6_v6only, high_msgq_watermark, low_msgq_watermark, % Other options are SCTP-specific (though they may be similar to their % TCP and UDP counter-parts): @@ -752,13 +933,16 @@ sctp_options() -> sctp_options(Opts, Mod) -> case sctp_opt(Opts, Mod, #sctp_opts{}, sctp_options()) of {ok,#sctp_opts{ifaddr=undefined}=SO} -> - {ok,SO#sctp_opts{ifaddr=Mod:translate_ip(?SCTP_DEF_IFADDR)}}; - {ok,_}=OK -> - OK; + {ok, + SO#sctp_opts{ + opts=lists:reverse(SO#sctp_opts.opts), + ifaddr=Mod:translate_ip(?SCTP_DEF_IFADDR)}}; + {ok,SO} -> + {ok,SO#sctp_opts{opts=lists:reverse(SO#sctp_opts.opts)}}; Error -> Error end. -sctp_opt([Opt|Opts], Mod, R, As) -> +sctp_opt([Opt|Opts], Mod, #sctp_opts{} = R, As) -> case Opt of {ip,IP} -> sctp_opt_ifaddr(Opts, Mod, R, As, IP); @@ -770,18 +954,35 @@ sctp_opt([Opt|Opts], Mod, R, As) -> sctp_opt(Opts, Mod, R#sctp_opts{port=P}, As); Error -> Error end; + {type,Type} when Type =:= seqpacket; Type =:= stream -> + sctp_opt(Opts, Mod, R#sctp_opts{type=Type}, As); binary -> sctp_opt (Opts, Mod, R, As, mode, binary); list -> sctp_opt (Opts, Mod, R, As, mode, list); - {sctp_module,_} -> sctp_opt (Opts, Mod, R, As); % Done with - inet -> sctp_opt (Opts, Mod, R, As); % Done with - inet6 -> sctp_opt (Opts, Mod, R, As); % Done with + {netns,NS} -> + BinNS = filename2binary(NS), + case prim_inet:is_sockopt_val(netns, BinNS) of + true -> + sctp_opt( + Opts, Mod, + R#sctp_opts { fd = [{netns,BinNS}] }, + As); + false -> + {error, badarg} + end; + {active,N} when is_integer(N), N < 32768, N >= -32768 -> + NOpts = lists:keydelete(active, 1, R#sctp_opts.opts), + sctp_opt(Opts, Mod, R#sctp_opts { opts = [{active,N}|NOpts] }, As); {Name,Val} -> sctp_opt (Opts, Mod, R, As, Name, Val); _ -> {error,badarg} end; -sctp_opt([], _Mod, R, _SockOpts) -> - {ok, R}. +sctp_opt([], _Mod, #sctp_opts{ifaddr=IfAddr}=R, _SockOpts) -> + if is_list(IfAddr) -> + {ok, R#sctp_opts{ifaddr=lists:reverse(IfAddr)}}; + true -> + {ok, R} + end. -sctp_opt(Opts, Mod, R, As, Name, Val) -> +sctp_opt(Opts, Mod, #sctp_opts{} = R, As, Name, Val) -> case add_opt(Name, Val, R#sctp_opts.opts, As) of {ok,SocketOpts} -> sctp_opt(Opts, Mod, R#sctp_opts{opts=SocketOpts}, As); @@ -798,6 +999,11 @@ sctp_opt_ifaddr(Opts, Mod, #sctp_opts{ifaddr=IfAddr}=R, As, Addr) -> _ -> [IP,IfAddr] end}, As). +sctp_module(Opts) -> + mod( + Opts, sctp_module, undefined, + #{inet => inet_sctp, inet6 => inet6_sctp}). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Util to check and insert option in option list %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -806,6 +1012,8 @@ add_opt(Name, Val, Opts, As) -> case lists:member(Name, As) of true -> case prim_inet:is_sockopt_val(Name, Val) of + true when Name =:= raw -> + {ok, [{Name,Val} | Opts]}; true -> Opts1 = lists:keydelete(Name, 1, Opts), {ok, [{Name,Val} | Opts1]}; @@ -815,12 +1023,92 @@ add_opt(Name, Val, Opts, As) -> end. +%% Passthrough all unknown - catch type errors later +filename2binary(List) when is_list(List) -> + OutEncoding = file:native_name_encoding(), + try unicode:characters_to_binary(List, unicode, OutEncoding) of + Bin when is_binary(Bin) -> + Bin; + _ -> + List + catch + error:badarg -> + List + end; +filename2binary(Bin) -> + Bin. + +binary2filename(Bin) -> + InEncoding = file:native_name_encoding(), + case unicode:characters_to_list(Bin, InEncoding) of + Filename when is_list(Filename) -> + Filename; + _ -> + %% For getopt/setopt of netns this should only happen if + %% a binary with wrong encoding was used when setting the + %% option, hence the user shall eat his/her own medicine. + %% + %% I.e passthrough here too for now. + %% Future usecases will most probably not want this, + %% rather Unicode error or warning + %% depending on emulator flag instead. + Bin + end. + + translate_ip(any, inet) -> {0,0,0,0}; translate_ip(loopback, inet) -> {127,0,0,1}; translate_ip(any, inet6) -> {0,0,0,0,0,0,0,0}; translate_ip(loopback, inet6) -> {0,0,0,0,0,0,0,1}; translate_ip(IP, _) -> IP. +mod(Opts, Tag, Address, Map) -> + mod(Opts, Tag, Address, Map, undefined, []). +%% +mod([{Tag, M}|Opts], Tag, Address, Map, Mod, Acc) -> + mod(Opts, Tag, Address, Map, Mod, Acc, M); +mod([{T, _} = Opt|Opts], Tag, _Address, Map, Mod, Acc) + when T =:= ip; T =:= ifaddr-> + mod(Opts, Tag, Opt, Map, Mod, [Opt|Acc]); +mod([Family|Opts], Tag, Address, Map, Mod, Acc) when is_atom(Family) -> + case Map of + #{Family := M} -> + mod(Opts, Tag, Address, Map, Mod, Acc, M); + #{} -> + mod(Opts, Tag, Address, Map, Mod, [Family|Acc]) + end; +mod([Opt|Opts], Tag, Address, Map, Mod, Acc) -> + mod(Opts, Tag, Address, Map, Mod, [Opt|Acc]); +mod([], Tag, Address, Map, undefined, Acc) -> + {case Address of + {_, {local, _}} -> + case Map of + #{local := Mod} -> + Mod; + #{} -> + inet_db:Tag() + end; + {_, IP} when tuple_size(IP) =:= 8 -> + #{inet := IPv4Mod} = Map, + %% Get the mod, but IPv6 address overrides default IPv4 + case inet_db:Tag() of + IPv4Mod -> + #{inet6 := IPv6Mod} = Map, + IPv6Mod; + Mod -> + Mod + end; + _ -> + inet_db:Tag() + end, lists:reverse(Acc)}; +mod([], _Tag, _Address, _Map, Mod, Acc) -> + {Mod, lists:reverse(Acc)}. +%% +mod(Opts, Tag, Address, Map, undefined, Acc, M) -> + mod(Opts, Tag, Address, Map, M, Acc); +mod(Opts, Tag, Address, Map, Mod, Acc, _M) -> + mod(Opts, Tag, Address, Map, Mod, Acc). + getaddrs_tm({A,B,C,D} = IP, Fam, _) -> %% Only "syntactic" validation and check of family. @@ -880,7 +1168,7 @@ gethostbyname_tm(Name, Type, Timer, [wins|_]=Opts) -> gethostbyname_tm_native(Name, Type, Timer, Opts); gethostbyname_tm(Name, Type, Timer, [native|_]=Opts) -> gethostbyname_tm_native(Name, Type, Timer, Opts); -gethostbyname_tm(Name, Type, Timer, [_|_]=Opts) -> +gethostbyname_tm(Name, Type, Timer, [_|Opts]) -> gethostbyname_tm(Name, Type, Timer, Opts); %% Make sure we always can look up our own hostname. gethostbyname_tm(Name, Type, Timer, []) -> @@ -911,21 +1199,34 @@ gethostbyname_self(Name, Type) when is_atom(Name) -> gethostbyname_self(Name, Type) when is_list(Name), Type =:= inet; is_list(Name), Type =:= inet6 -> - case inet_db:gethostname() of - Name -> - {ok,make_hostent(Name, - [translate_ip(loopback, Type)], - [], Type)}; - Self -> + N = inet_db:tolower(Name), + Self = inet_db:gethostname(), + %% + %% This is the final fallback that pretends /etc/hosts has got + %% a line for the hostname on the loopback address. + %% Lookups into /etc/hosts are case insensitive and return + %% what is in the file. Therefore the letter case may differ between + %% the returned hostent record and the hostname that was asked for. + %% + case inet_db:tolower(Self) of + N -> + {ok, + make_hostent( + Self, [translate_ip(loopback, Type)], [], Type)}; + _ -> case inet_db:res_option(domain) of - "" -> {error,nxdomain}; + "" -> + {error,nxdomain}; Domain -> - case lists:append([Self,".",Domain]) of - Name -> - {ok,make_hostent(Name, - [translate_ip(loopback, Type)], - [], Type)}; - _ -> {error,nxdomain} + FQDN = lists:append([Self,".",Domain]), + case inet_db:tolower(FQDN) of + N -> + {ok, + make_hostent( + FQDN, + [translate_ip(loopback, Type)], [], Type)}; + _ -> + {error,nxdomain} end end end; @@ -1014,30 +1315,42 @@ gethostbyaddr_tm_native(Addr, Timer, Opts) -> Result -> Result end. --spec open(Fd :: integer(), - Addr :: ip_address(), - Port :: ip_port(), +-spec open(Fd_or_OpenOpts :: integer() | list(), + Addr :: + socket_address() | + {ip_address() | 'any' | 'loopback', % Unofficial + port_number()} | + {inet, % Unofficial + {ip4_address() | 'any' | 'loopback', + port_number()}} | + {inet6, % Unofficial + {ip6_address() | 'any' | 'loopback', + port_number()}} | + undefined, % Internal - no bind() + Port :: port_number(), Opts :: [socket_setopt()], - Protocol :: protocol_option(), - Family :: 'inet' | 'inet6', + Protocol :: socket_protocol(), + Family :: address_family(), + Type :: socket_type(), Module :: atom()) -> {'ok', socket()} | {'error', posix()}. -open(Fd, Addr, Port, Opts, Protocol, Family, Module) when Fd < 0 -> - case prim_inet:open(Protocol, Family) of +open(FdO, Addr, Port, Opts, Protocol, Family, Type, Module) + when is_integer(FdO), FdO < 0; + is_list(FdO) -> + OpenOpts = + if is_list(FdO) -> FdO; + true -> [] + end, + case prim_inet:open(Protocol, Family, Type, OpenOpts) of {ok,S} -> case prim_inet:setopts(S, Opts) of + ok when Addr =:= undefined -> + inet_db:register_socket(S, Module), + {ok,S}; ok -> - case if is_list(Addr) -> - prim_inet:bind(S, add, - [case A of - {_,_} -> A; - _ -> {A,Port} - end || A <- Addr]); - true -> - prim_inet:bind(S, Addr, Port) - end of - {ok, _} -> + case bind(S, Addr, Port) of + {ok, _} -> inet_db:register_socket(S, Module), {ok,S}; Error -> @@ -1051,25 +1364,85 @@ open(Fd, Addr, Port, Opts, Protocol, Family, Module) when Fd < 0 -> Error -> Error end; -open(Fd, _Addr, _Port, Opts, Protocol, Family, Module) -> - fdopen(Fd, Opts, Protocol, Family, Module). +open(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) + when is_integer(Fd) -> + fdopen(Fd, Addr, Port, Opts, Protocol, Family, Type, Module). + +bind(S, Addr, Port) when is_list(Addr) -> + bindx(S, Addr, Port); +bind(S, Addr, Port) -> + prim_inet:bind(S, Addr, Port). + +bindx(S, [Addr], Port0) -> + {IP, Port} = set_bindx_port(Addr, Port0), + prim_inet:bind(S, IP, Port); +bindx(S, Addrs, Port0) -> + [{IP, Port} | Rest] = [set_bindx_port(Addr, Port0) || Addr <- Addrs], + case prim_inet:bind(S, IP, Port) of + {ok, AssignedPort} when Port =:= 0 -> + %% On newer Linux kernels, Solaris and FreeBSD, calling + %% bindx with port 0 is ok, but on SuSE 10, it results in einval + Rest2 = [change_bindx_0_port(Addr, AssignedPort) || Addr <- Rest], + prim_inet:bind(S, add, Rest2); + {ok, _} -> + prim_inet:bind(S, add, Rest); + Error -> + Error + end. + +set_bindx_port({_IP, _Port}=Addr, _OtherPort) -> + Addr; +set_bindx_port(IP, Port) -> + {IP, Port}. + +change_bindx_0_port({IP, 0}, AssignedPort) -> + {IP, AssignedPort}; +change_bindx_0_port({_IP, _Port}=Addr, _AssignedPort) -> + Addr. + -spec fdopen(Fd :: non_neg_integer(), Opts :: [socket_setopt()], - Protocol :: protocol_option(), - Family :: family_option(), + Protocol :: socket_protocol(), + Family :: address_family(), + Type :: socket_type(), Module :: atom()) -> {'ok', socket()} | {'error', posix()}. -fdopen(Fd, Opts, Protocol, Family, Module) -> - case prim_inet:fdopen(Protocol, Fd, Family) of +fdopen(Fd, Opts, Protocol, Family, Type, Module) -> + fdopen(Fd, any, 0, Opts, Protocol, Family, Type, Module). + +fdopen(Fd, Addr, Port, Opts, Protocol, Family, Type, Module) -> + Bound = + %% We do not do any binding if default port+addr options + %% were given, in order to keep backwards compatability + %% with pre Erlang/OTP 17 + case Addr of + {0,0,0,0} when Port =:= 0 -> true; + {0,0,0,0,0,0,0,0} when Port =:= 0 -> true; + any when Port =:= 0 -> true; + _ -> false + end, + case prim_inet:fdopen(Protocol, Family, Type, Fd, Bound) of {ok, S} -> case prim_inet:setopts(S, Opts) of - ok -> + ok + when Addr =:= undefined; + Bound -> inet_db:register_socket(S, Module), {ok, S}; + ok -> + case bind(S, Addr, Port) of + {ok, _} -> + inet_db:register_socket(S, Module), + {ok, S}; + Error -> + prim_inet:close(S), + Error + end; Error -> - prim_inet:close(S), Error + prim_inet:close(S), + Error end; Error -> Error end. @@ -1078,18 +1451,24 @@ fdopen(Fd, Opts, Protocol, Family, Module) -> %% socket stat %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -i() -> i(tcp), i(udp). +i() -> i(tcp), i(udp), i(sctp). i(Proto) -> i(Proto, [port, module, recv, sent, owner, - local_address, foreign_address, state]). + local_address, foreign_address, state, type]). i(tcp, Fs) -> ii(tcp_sockets(), Fs, tcp); i(udp, Fs) -> - ii(udp_sockets(), Fs, udp). + ii(udp_sockets(), Fs, udp); +i(sctp, Fs) -> + ii(sctp_sockets(), Fs, sctp). ii(Ss, Fs, Proto) -> - LLs = [h_line(Fs) | info_lines(Ss, Fs, Proto)], + LLs = + case info_lines(Ss, Fs, Proto) of + [] -> []; + InfoLines -> [h_line(Fs) | InfoLines] + end, Maxs = foldl( fun(Line,Max0) -> smax(Max0,Line) end, duplicate(length(Fs),0),LLs), @@ -1157,6 +1536,7 @@ info(S, F, Proto) -> case prim_inet:gettype(S) of {ok,{_,stream}} -> "STREAM"; {ok,{_,dgram}} -> "DGRAM"; + {ok,{_,seqpacket}} -> "SEQPACKET"; _ -> " " end; fd -> @@ -1208,6 +1588,7 @@ fmt_port(N, Proto) -> %% Return a list of all tcp sockets tcp_sockets() -> port_list("tcp_inet"). udp_sockets() -> port_list("udp_inet"). +sctp_sockets() -> port_list("sctp_inet"). %% Return all ports having the name 'Name' port_list(Name) -> @@ -1223,10 +1604,13 @@ port_list(Name) -> %% utils %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec format_error(posix()) -> string(). +-spec format_error(Reason) -> string() when + Reason :: posix() | system_limit. format_error(exbadport) -> "invalid port state"; format_error(exbadseq) -> "bad command sequence"; +format_error(system_limit) -> + "a system limit was hit, probably not enough ports"; format_error(Tag) -> erl_posix_msg:message(Tag). @@ -1248,6 +1632,8 @@ udp_close(S) when is_port(S) -> %% Set controlling process for TCP socket. tcp_controlling_process(S, NewOwner) when is_port(S), is_pid(NewOwner) -> case erlang:port_info(S, connected) of + {connected, NewOwner} -> + ok; {connected, Pid} when Pid =/= self() -> {error, not_owner}; undefined -> @@ -1255,20 +1641,28 @@ tcp_controlling_process(S, NewOwner) when is_port(S), is_pid(NewOwner) -> _ -> case prim_inet:getopt(S, active) of {ok, A0} -> - prim_inet:setopt(S, active, false), - case tcp_sync_input(S, NewOwner, false) of - true -> %% socket already closed, + SetOptRes = + case A0 of + false -> ok; + _ -> prim_inet:setopt(S, active, false) + end, + case {tcp_sync_input(S, NewOwner, false), SetOptRes} of + {true, _} -> %% socket already closed ok; - false -> + {false, ok} -> try erlang:port_connect(S, NewOwner) of true -> unlink(S), %% unlink from port - prim_inet:setopt(S, active, A0), - ok + case A0 of + false -> ok; + _ -> prim_inet:setopt(S, active, A0) + end catch error:Reason -> {error, Reason} - end + end; + {false, Error} -> + Error end; Error -> Error @@ -1299,17 +1693,18 @@ tcp_sync_input(S, Owner, Flag) -> %% Set controlling process for UDP or SCTP socket. udp_controlling_process(S, NewOwner) when is_port(S), is_pid(NewOwner) -> case erlang:port_info(S, connected) of + {connected, NewOwner} -> + ok; {connected, Pid} when Pid =/= self() -> {error, not_owner}; _ -> {ok, A0} = prim_inet:getopt(S, active), - prim_inet:setopt(S, active, false), + ok = prim_inet:setopt(S, active, false), udp_sync_input(S, NewOwner), try erlang:port_connect(S, NewOwner) of true -> unlink(S), - prim_inet:setopt(S, active, A0), - ok + ok = prim_inet:setopt(S, active, A0) catch error:Reason -> {error, Reason} @@ -1361,3 +1756,14 @@ stop_timer(Timer) -> end; T -> T end. + + +lock_socket(S,Val) -> + case erlang:port_info(S, connected) of + {connected, Pid} when Pid =/= self() -> + {error, not_owner}; + undefined -> + {error, einval}; + _ -> + prim_inet:ignorefd(S,Val) + end. diff --git a/lib/kernel/src/inet6_sctp.erl b/lib/kernel/src/inet6_sctp.erl index 5c49c4fec3..a5503f6f54 100644 --- a/lib/kernel/src/inet6_sctp.erl +++ b/lib/kernel/src/inet6_sctp.erl @@ -1,25 +1,25 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-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. -%% +%% +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% %% SCTP protocol contribution by Leonid Timochouk and Serge Aleynikov. %% See also: $ERL_TOP/lib/kernel/AUTHORS %% -%% -module(inet6_sctp). %% This module provides functions for communicating with @@ -30,32 +30,28 @@ -include("inet_sctp.hrl"). -include("inet_int.hrl"). +-define(PROTO, sctp). -define(FAMILY, inet6). -export([getserv/1,getaddr/1,getaddr/2,translate_ip/1]). --export([open/1,close/1,listen/2,connect/5,sendmsg/3,recv/2]). +-export([open/1,close/1,listen/2,peeloff/2,connect/5]). +-export([sendmsg/3,send/4,recv/2]). getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> - inet:getservbyname(Name, sctp); -getserv(_) -> - {error,einval}. +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO); +getserv(_) -> {error,einval}. -getaddr(Address) -> - inet:getaddr(Address, ?FAMILY). -getaddr(Address, Timer) -> - inet:getaddr_tm(Address, ?FAMILY, Timer). - -translate_ip(IP) -> - inet:translate_ip(IP, ?FAMILY). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). open(Opts) -> case inet:sctp_options(Opts, ?MODULE) of - {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,opts=SOs}} -> - inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, ?MODULE); + {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,type=Type,opts=SOs}} -> + inet:open(Fd, Addr, Port, SOs, ?PROTO, ?FAMILY, Type, ?MODULE); Error -> Error end. @@ -65,11 +61,38 @@ close(S) -> listen(S, Flag) -> prim_inet:listen(S, Flag). +peeloff(S, AssocId) -> + case prim_inet:peeloff(S, AssocId) of + {ok, NewS}=Result -> + inet_db:register_socket(NewS, ?MODULE), + Result; + Error -> Error + end. + connect(S, Addr, Port, Opts, Timer) -> inet_sctp:connect(S, Addr, Port, Opts, Timer). sendmsg(S, SRI, Data) -> prim_inet:sendmsg(S, SRI, Data). +send(S, AssocId, Stream, Data) -> + case prim_inet:getopts( + S, + [{sctp_default_send_param,#sctp_sndrcvinfo{assoc_id=AssocId}}]) of + {ok, + [{sctp_default_send_param, + #sctp_sndrcvinfo{ + flags=Flags, context=Context, ppid=PPID, timetolive=TTL}}]} -> + prim_inet:sendmsg( + S, + #sctp_sndrcvinfo{ + flags=Flags, context=Context, ppid=PPID, timetolive=TTL, + assoc_id=AssocId, stream=Stream}, + Data); + _ -> + prim_inet:sendmsg( + S, #sctp_sndrcvinfo{assoc_id=AssocId, stream=Stream}, Data) + end. + recv(S, Timeout) -> prim_inet:recvfrom(S, 0, Timeout). diff --git a/lib/kernel/src/inet6_tcp.erl b/lib/kernel/src/inet6_tcp.erl index cc45f6c7f6..a0d5d3df70 100644 --- a/lib/kernel/src/inet6_tcp.erl +++ b/lib/kernel/src/inet6_tcp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -24,21 +25,48 @@ -export([controlling_process/2]). -export([fdopen/2]). +-export([family/0, mask/2, parse_address/1]). % inet_tcp_dist -export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). +-export([translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet6). +-define(PROTO, tcp). +-define(TYPE, stream). + +%% my address family +family() -> ?FAMILY. + +%% Apply netmask on address +mask({M1,M2,M3,M4,M5,M6,M7,M8}, {IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4, + M5 band IP5, + M6 band IP6, + M7 band IP7, + M8 band IP8 }. + +%% Parse address string +parse_address(Host) -> + inet_parse:ipv6strict_address(Host). + %% inet_tcp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,tcp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_tcp address lookup -getaddr(Address) -> inet:getaddr(Address, inet6). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet6, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). %% inet_tcp address lookup -getaddrs(Address) -> inet:getaddrs(Address, inet6). -getaddrs(Address,Timer) -> inet:getaddrs_tm(Address,inet6,Timer). +getaddrs(Address) -> inet:getaddrs(Address, ?FAMILY). +getaddrs(Address, Timer) -> inet:getaddrs_tm(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). %% %% Send data on a socket @@ -53,11 +81,6 @@ recv(Socket, Length) -> prim_inet:recv(Socket, Length). recv(Socket, Length, Timeout) -> prim_inet:recv(Socket, Length, Timeout). unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). -%% -%% Close a socket (async) -%% -close(Socket) -> - inet:tcp_close(Socket). %% %% Shutdown one end of a socket @@ -66,6 +89,12 @@ shutdown(Socket, How) -> prim_inet:shutdown(Socket, How). %% +%% Close a socket (async) +%% +close(Socket) -> + inet:tcp_close(Socket). + +%% %% Set controlling process %% FIXME: move messages to new owner!!! %% @@ -80,24 +109,28 @@ connect(Address, Port, Opts) -> connect(Address, Port, Opts, infinity) -> do_connect(Address, Port, Opts, infinity); -connect(Address, Port, Opts, Timeout) when is_integer(Timeout), - Timeout >= 0 -> +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> do_connect(Address, Port, Opts, Timeout). -do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) when - ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - case inet:connect_options(Opts, inet6) of +do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) + when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> + case inet:connect_options(Opts, ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #connect_opts{fd=Fd, - ifaddr=BAddr={Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb}, - port=BPort, - opts=SockOpts}} + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr = {Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb}, + port = BPort, + opts = SockOpts}} when ?ip6(Ab,Bb,Cb,Db,Eb,Fb,Gb,Hb), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet6,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:connect(S, Addr, Port, Time) of - ok -> {ok,S}; - Error -> prim_inet:close(S), Error + ok -> {ok,S}; + Error -> prim_inet:close(S), Error end; Error -> Error end; @@ -108,14 +141,18 @@ do_connect(Addr = {A,B,C,D,E,F,G,H}, Port, Opts, Time) when %% Listen %% listen(Port, Opts) -> - case inet:listen_options([{port,Port} | Opts], inet6) of + case inet:listen_options([{port,Port} | Opts], ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #listen_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D,E,F,G,H}, - port=BPort, - opts=SockOpts}=R} + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D,E,F,G,H}, + port = BPort, + opts = SockOpts} = R} when ?ip6(A,B,C,D,E,F,G,H), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet6,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:listen(S, R#listen_opts.backlog) of ok -> {ok, S}; @@ -136,18 +173,17 @@ accept(L) -> {ok,S}; Error -> Error end. - -accept(L,Timeout) -> - case prim_inet:accept(L,Timeout) of + +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. - + %% %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, tcp, inet6, ?MODULE). - + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet6_tcp_dist.erl b/lib/kernel/src/inet6_tcp_dist.erl index 34cf582af7..9b6c2745d5 100644 --- a/lib/kernel/src/inet6_tcp_dist.erl +++ b/lib/kernel/src/inet6_tcp_dist.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(inet6_tcp_dist). @@ -23,28 +24,7 @@ -export([listen/1, accept/1, accept_connection/5, setup/5, close/1, select/1, is_node_name/1]). -%% internal exports - --export([accept_loop/2,do_accept/6,do_setup/6, getstat/1,tick/1]). - --import(error_logger,[error_msg/2]). - --include("net_address.hrl"). - - - --define(to_port(Socket, Data, Opts), - case inet6_tcp:send(Socket, Data, Opts) of - {error, closed} -> - self() ! {tcp_closed, Socket}, - {error, closed}; - R -> - R - end). - - --include("dist.hrl"). --include("dist_util.hrl"). +-export([setopts/2, getopts/2]). %% ------------------------------------------------------------ %% Select this protocol based on node name @@ -52,14 +32,7 @@ %% ------------------------------------------------------------ select(Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_, Host] -> - case inet:getaddr(Host,inet6) of - {ok,_} -> true; - _ -> false - end; - _ -> false - end. + inet_tcp_dist:gen_select(inet6_tcp, Node). %% ------------------------------------------------------------ %% Create the listen socket, i.e. the port that this erlang @@ -67,55 +40,14 @@ select(Node) -> %% ------------------------------------------------------------ listen(Name) -> - case inet6_tcp:listen(0, [{active, false}, {packet,2}]) of - {ok, Socket} -> - TcpAddress = get_tcp_address(Socket), - {_,Port} = TcpAddress#net_address.address, - {ok, Creation} = erl_epmd:register_node(Name, Port), - {ok, {Socket, TcpAddress, Creation}}; - Error -> - Error - end. + inet_tcp_dist:gen_listen(inet6_tcp, Name). %% ------------------------------------------------------------ %% Accepts new connection attempts from other Erlang nodes. %% ------------------------------------------------------------ accept(Listen) -> - spawn_opt(?MODULE, accept_loop, [self(), Listen], [link, {priority, max}]). - -accept_loop(Kernel, Listen) -> - case inet6_tcp:accept(Listen) of - {ok, Socket} -> - Kernel ! {accept,self(),Socket,inet,tcp}, - controller(Kernel, Socket), - accept_loop(Kernel, Listen); - Error -> - exit(Error) - end. - -controller(Kernel, Socket) -> - receive - {Kernel, controller, Pid} -> - flush_controller(Pid, Socket), - inet6_tcp:controlling_process(Socket, Pid), - flush_controller(Pid, Socket), - Pid ! {self(), controller}; - {Kernel, unsupported_protocol} -> - exit(unsupported_protocol) - end. - -flush_controller(Pid, Socket) -> - receive - {tcp, Socket, Data} -> - Pid ! {tcp, Socket, Data}, - flush_controller(Pid, Socket); - {tcp_closed, Socket} -> - Pid ! {tcp_closed, Socket}, - flush_controller(Pid, Socket) - after 0 -> - ok - end. + inet_tcp_dist:gen_accept(inet6_tcp, Listen). %% ------------------------------------------------------------ %% Accepts a new connection attempt from another Erlang node. @@ -123,85 +55,7 @@ flush_controller(Pid, Socket) -> %% ------------------------------------------------------------ accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - spawn_opt(?MODULE, do_accept, - [self(), AcceptPid, Socket, MyNode, Allowed, SetupTime], - [link, {priority, max}]). - -do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> - receive - {AcceptPid, controller} -> - Timer = dist_util:start_timer(SetupTime), - case check_ip(Socket) of - true -> - HSData = #hs_data{ - kernel_pid = Kernel, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - allowed = Allowed, - f_send = fun(S,D) -> inet6_tcp:send(S,D) end, - f_recv = fun(S,N,T) -> inet6_tcp:recv(S,N,T) - end, - f_setopts_pre_nodeup = - fun(S) -> - inet:setopts(S, - [{active, false}, - {packet, 4}, - nodelay()]) - end, - f_setopts_post_nodeup = - fun(S) -> - inet:setopts(S, - [{active, true}, - {deliver, port}, - {packet, 4}, - nodelay()]) - end, - f_getll = fun(S) -> - inet:getll(S) - end, - f_address = fun get_remote_id/2, - mf_tick = {?MODULE, tick}, - mf_getstat = {?MODULE,getstat} - }, - dist_util:handshake_other_started(HSData); - {false,IP} -> - error_msg("** Connection attempt from " - "disallowed IP ~w ** ~n", [IP]), - ?shutdown(no_node) - end - end. - - -%% we may not always want the nodelay behaviour -%% for performance reasons - -nodelay() -> - case application:get_env(kernel, dist_nodelay) of - undefined -> - {nodelay, true}; - {ok, true} -> - {nodelay, true}; - {ok, false} -> - {nodelay, false}; - _ -> - {nodelay, true} - end. - - -%% ------------------------------------------------------------ -%% Get remote information about a Socket. -%% ------------------------------------------------------------ - -get_remote_id(Socket, Node) -> - {ok, Address} = inet:peername(Socket), - [_, Host] = split_node(atom_to_list(Node), $@, []), - #net_address { - address = Address, - host = Host, - protocol = tcp, - family = inet6 }. + inet_tcp_dist:gen_accept_connection(inet6_tcp, AcceptPid, Socket, MyNode, Allowed, SetupTime). %% ------------------------------------------------------------ %% Setup a new connection to another Erlang node. @@ -209,209 +63,19 @@ get_remote_id(Socket, Node) -> %% ------------------------------------------------------------ setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> - spawn_opt(?MODULE, do_setup, - [self(), Node, Type, MyNode, LongOrShortNames, SetupTime], - [link, {priority, max}]). - -do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> - ?trace("~p~n",[{?MODULE,self(),setup,Node}]), - [Name, Address] = splitnode(Node, LongOrShortNames), - case inet:getaddr(Address, inet6) of - {ok, Ip} -> - Timer = dist_util:start_timer(SetupTime), - case erl_epmd:port_please(Name, Ip) of - {port, TcpPort, Version} -> - ?trace("port_please(~p) -> version ~p~n", - [Node,Version]), - dist_util:reset_timer(Timer), - case inet6_tcp:connect(Ip, TcpPort, - [{active, false}, - {packet,2}]) of - {ok, Socket} -> - HSData = #hs_data{ - kernel_pid = Kernel, - other_node = Node, - this_node = MyNode, - socket = Socket, - timer = Timer, - this_flags = 0, - other_version = Version, - f_send = fun inet_tcp:send/2, - f_recv = fun inet_tcp:recv/3, - f_setopts_pre_nodeup = - fun(S) -> - inet:setopts - (S, - [{active, false}, - {packet, 4}, - nodelay()]) - end, - f_setopts_post_nodeup = - fun(S) -> - inet:setopts - (S, - [{active, true}, - {deliver, port}, - {packet, 4}, - nodelay()]) - end, - f_getll = fun inet:getll/1, - f_address = - fun(_,_) -> - #net_address { - address = {Ip,TcpPort}, - host = Address, - protocol = tcp, - family = inet} - end, - mf_tick = fun ?MODULE:tick/1, - mf_getstat = fun ?MODULE:getstat/1, - request_type = Type - }, - dist_util:handshake_we_started(HSData); - _ -> - %% Other Node may have closed since - %% port_please ! - ?trace("other node (~p) " - "closed since port_please.~n", - [Node]), - ?shutdown(Node) - end; - _ -> - ?trace("port_please (~p) " - "failed.~n", [Node]), - ?shutdown(Node) - end; - __Other -> - ?trace("inet_getaddr(~p) " - "failed (~p).~n", [Node,__Other]), - ?shutdown(Node) - end. + inet_tcp_dist:gen_setup(inet6_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime). %% %% Close a socket. %% close(Socket) -> inet6_tcp:close(Socket). - - -%% If Node is illegal terminate the connection setup!! -splitnode(Node, LongOrShortNames) -> - case split_node(atom_to_list(Node), $@, []) of - [Name|Tail] when Tail =/= [] -> - Host = lists:append(Tail), - case split_node(Host, $., []) of - [_] when LongOrShortNames =:= longnames -> - error_msg("** System running to use " - "fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); - L when length(L) > 1, LongOrShortNames =:= shortnames -> - error_msg("** System NOT running to use fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); - _ -> - [Name, Host] - end; - [_] -> - error_msg("** Nodename ~p illegal, no '@' character **~n", - [Node]), - ?shutdown(Node); - _ -> - error_msg("** Nodename ~p illegal **~n", [Node]), - ?shutdown(Node) - end. - -split_node([Chr|T], Chr, Ack) -> [lists:reverse(Ack)|split_node(T, Chr, [])]; -split_node([H|T], Chr, Ack) -> split_node(T, Chr, [H|Ack]); -split_node([], _, Ack) -> [lists:reverse(Ack)]. - -%% ------------------------------------------------------------ -%% Fetch local information about a Socket. -%% ------------------------------------------------------------ -get_tcp_address(Socket) -> - {ok, Address} = inet:sockname(Socket), - {ok, Host} = inet:gethostname(), - #net_address { - address = Address, - host = Host, - protocol = tcp, - family = inet6 - }. - -%% ------------------------------------------------------------ -%% Do only accept new connection attempts from nodes at our -%% own LAN, if the check_ip environment parameter is true. -%% ------------------------------------------------------------ -check_ip(Socket) -> - case application:get_env(check_ip) of - {ok, true} -> - case get_ifs(Socket) of - {ok, IFs, IP} -> - check_ip(IFs, IP); - _ -> - ?shutdown(no_node) - end; - _ -> - true - end. - -get_ifs(Socket) -> - case inet:peername(Socket) of - {ok, {IP, _}} -> - case inet:getif(Socket) of - {ok, IFs} -> {ok, IFs, IP}; - Error -> Error - end; - Error -> - Error - end. - -check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> - case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of - {M, M} -> true; - _ -> check_ip(IFs, PeerIP) - end; -check_ip([], PeerIP) -> - {false, PeerIP}. -mask({M1,M2,M3,M4,M5,M6,M7,M8}, {IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8}) -> - {M1 band IP1, - M2 band IP2, - M3 band IP3, - M4 band IP4, - M5 band IP5, - M6 band IP6, - M7 band IP7, - M8 band IP8 }. - is_node_name(Node) when is_atom(Node) -> - case split_node(atom_to_list(Node), $@, []) of - [_,_Host] -> true; - _ -> false - end; -is_node_name(_Node) -> - false. -tick(Sock) -> - ?to_port(Sock,[],[force]). -getstat(Socket) -> - case inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of - {ok, Stat} -> - split_stat(Stat,0,0,0); - Error -> - Error - end. + inet_tcp_dist:is_node_name(Node). -split_stat([{recv_cnt, R}|Stat], _, W, P) -> - split_stat(Stat, R, W, P); -split_stat([{send_cnt, W}|Stat], R, _, P) -> - split_stat(Stat, R, W, P); -split_stat([{send_pend, P}|Stat], R, W, _) -> - split_stat(Stat, R, W, P); -split_stat([], R, W, P) -> - {ok, R, W, P}. +setopts(S, Opts) -> + inet_tcp_dist:setopts(S, Opts). +getopts(S, Opts) -> + inet_tcp_dist:getopts(S, Opts). diff --git a/lib/kernel/src/inet6_udp.erl b/lib/kernel/src/inet6_udp.erl index e81d417151..71db0357cd 100644 --- a/lib/kernel/src/inet6_udp.erl +++ b/lib/kernel/src/inet6_udp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,29 +24,44 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([getserv/1, getaddr/1, getaddr/2]). +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet6). +-define(PROTO, udp). +-define(TYPE, dgram). + + %% inet_udp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,udp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_udp address lookup -getaddr(Address) -> inet:getaddr(Address, inet6). -getaddr(Address,Timer) -> inet:getaddr(Address, inet6, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). +-spec open(_) -> {ok, inet:socket()} | {error, atom()}. open(Port) -> open(Port, []). +-spec open(_, _) -> {ok, inet:socket()} | {error, atom()}. open(Port, Opts) -> - case inet:udp_options([{port,Port} | Opts], inet6) of + case inet:udp_options( + [{port,Port} | Opts], + ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #udp_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D,E,F,G,H}, - port=BPort, - opts=SockOpts}} + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D,E,F,G,H}, + port = BPort, + opts = SockOpts}} when ?ip6(A,B,C,D,E,F,G,H), ?port(BPort) -> - inet:open(Fd,BAddr,BPort,SockOpts,udp,inet6,?MODULE); + inet:open( + Fd, BAddr, BPort, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); {ok, _} -> exit(badarg) end. @@ -60,12 +76,13 @@ connect(S, Addr = {A,B,C,D,E,F,G,H}, P) when ?ip6(A,B,C,D,E,F,G,H), ?port(P) -> prim_inet:connect(S, Addr, P). -recv(S,Len) -> +recv(S, Len) -> prim_inet:recvfrom(S, Len). -recv(S,Len,Time) -> +recv(S, Len, Time) -> prim_inet:recvfrom(S, Len, Time). +-spec close(inet:socket()) -> ok. close(S) -> inet:udp_close(S). @@ -84,4 +101,4 @@ controlling_process(Socket, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, udp, inet6, ?MODULE). + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet_boot.hrl b/lib/kernel/src/inet_boot.hrl index 35501a0f9c..adeda604e6 100644 --- a/lib/kernel/src/inet_boot.hrl +++ b/lib/kernel/src/inet_boot.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl index 311e6bc9f9..4bbc520449 100644 --- a/lib/kernel/src/inet_config.erl +++ b/lib/kernel/src/inet_config.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,6 +24,8 @@ -import(lists, [foreach/2, member/2, reverse/1]). +%% Avoid warning for local function error/2 clashing with autoimported BIF. +-compile({no_auto_import,[error/2]}). -export([init/0]). -export([do_load_resolv/2]). @@ -42,26 +45,6 @@ %% -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 @@ -69,6 +52,7 @@ init() -> %% the user to provide it (by means of inetrc), so we need to look %% for it ourselves. + OsType = os:type(), do_load_resolv(OsType, erl_dist_mode()), case OsType of @@ -121,7 +105,7 @@ init() -> %% Add inetrc config entries case inet_db:add_rc_list(CfgList) of ok -> ok; - _ -> error("syntax error in ~s~n", [RcFile]) + _ -> error("syntax error in ~ts~n", [RcFile]) end, %% Set up a resolver configuration file for inet_res, @@ -130,13 +114,7 @@ init() -> {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, + Etc = os:getenv("ERL_INET_ETC_DIR", ?DEFAULT_ETC), case inet_db:res_option(resolv_conf) of undefined -> inet_db:res_option( @@ -169,11 +147,7 @@ erl_dist_mode() -> 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, + Etc = os:getenv("ERL_INET_ETC_DIR", ?DEFAULT_ETC), load_resolv(filename:join(Etc, ?DEFAULT_RESOLV), resolv), case Type of freebsd -> %% we may have to check version (2.2.2) @@ -214,45 +188,6 @@ 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]). @@ -322,10 +257,10 @@ load_resolv(File, Func) -> {ok, Ls} -> inet_db:add_rc_list(Ls); {error, Reason} -> - error("parse error in file ~s: ~p", [File, Reason]) + error("parse error in file ~ts: ~p", [File, Reason]) end; Error -> - warning("file not found ~s: ~p~n", [File, Error]) + warning("file not found ~ts: ~p~n", [File, Error]) end. %% @@ -341,12 +276,12 @@ load_hosts(File,Os) -> inet_db:add_host(IP, [Name|Aliases]) end, Ls); {error, Reason} -> - error("parse error in file ~s: ~p", [File, Reason]) + error("parse error in file ~ts: ~p", [File, Reason]) end; Error -> case Os of unix -> - error("file not found ~s: ~p~n", [File, Error]); + error("file not found ~ts: ~p~n", [File, Error]); _ -> %% for windows or nt the hosts file is not always there %% and we don't require it @@ -360,10 +295,7 @@ load_hosts(File,Os) -> 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, + TcpReg = os:getenv("ERL_INET_ETC_DIR", ""), {ok, Reg} = win32reg:open([read]), {TcpIp,HFileKey} = case Type of @@ -454,55 +386,6 @@ win32_get_strings(Reg, [Name|Rest], Result) -> 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 @@ -567,11 +450,11 @@ get_rc(File) -> {ok,Ls} -> Ls; _Error -> - error("parse error in ~s~n", [File]), + error("parse error in ~ts~n", [File]), error end; _Error -> - error("file ~s not found~n", [File]), + error("file ~ts not found~n", [File]), error end. @@ -600,8 +483,12 @@ warning(Fmt, Args) -> %% 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, []). + case file_binary_to_list(Bin) of + {ok, String} -> + parse_inetrc(String ++ "\n", 1, []); + error -> + {error, 'bad_encoding'} + end. parse_inetrc_skip_line([], _Line, Ack) -> {ok, reverse(Ack)}; @@ -640,3 +527,16 @@ parse_inetrc(Str, Line, Ack) -> {more, _} -> %% Bug in erl_scan !! {error, {'scan_inetrc', {eof, Line}}} end. + +file_binary_to_list(Bin) -> + Enc = case epp:read_encoding_from_binary(Bin) of + none -> epp:default_encoding(); + Encoding -> Encoding + end, + case catch unicode:characters_to_list(Bin, Enc) of + String when is_list(String) -> + {ok, String}; + _ -> + error + end. + diff --git a/lib/kernel/src/inet_config.hrl b/lib/kernel/src/inet_config.hrl index e9bb79f05d..b22ee0f598 100644 --- a/lib/kernel/src/inet_config.hrl +++ b/lib/kernel/src/inet_config.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index a05b380855..465cec1b45 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -88,6 +89,7 @@ hosts_file_byaddr, %% hosts table from system file cache_timer %% timer reference for refresh }). +-type state() :: #state{}. -include("inet.hrl"). -include("inet_int.hrl"). @@ -101,14 +103,14 @@ start() -> case gen_server:start({local, inet_db}, inet_db, [], []) of - {ok,Pid} -> inet_config:init(), {ok,Pid}; + {ok, _Pid}=Ok -> inet_config:init(), Ok; Error -> Error end. start_link() -> case gen_server:start_link({local, inet_db}, inet_db, [], []) of - {ok,Pid} -> inet_config:init(), {ok,Pid}; + {ok, _Pid}=Ok -> inet_config:init(), Ok; Error -> Error end. @@ -139,7 +141,6 @@ add_hosts(File) -> Error -> Error end. - add_host(IP, Names) -> call({add_host, IP, Names}). del_host(IP) -> call({del_host, IP}). @@ -481,10 +482,7 @@ res_check_option_absfile(F) -> res_check_list([], _Fun) -> true; res_check_list([H|T], Fun) -> - case Fun(H) of - true -> res_check_list(T, Fun); - false -> false - end; + Fun(H) andalso res_check_list(T, Fun); res_check_list(_, _Fun) -> false. res_check_ns({{A,B,C,D,E,F,G,H}, Port}) @@ -496,12 +494,12 @@ res_check_ns(_) -> false. res_check_search("") -> true; res_check_search(Dom) -> inet_parse:visible_string(Dom). -socks_option(server) -> db_get(socks5_server); -socks_option(port) -> db_get(socks5_port); -socks_option(methods) -> db_get(socks5_methods); -socks_option(noproxy) -> db_get(socks5_noproxy). +socks_option(server) -> db_get(socks5_server); +socks_option(port) -> db_get(socks5_port); +socks_option(methods) -> db_get(socks5_methods); +socks_option(noproxy) -> db_get(socks5_noproxy). -gethostname() -> db_get(hostname). +gethostname() -> db_get(hostname). res_update_conf() -> res_update(res_resolv_conf, res_resolv_conf_tm, res_resolv_conf_info, @@ -590,15 +588,13 @@ getbyname(Name, Type) -> getbysearch(Name, Dot, [Dom | Ds], Type, _) -> case hostent_by_domain(Name ++ Dot ++ Dom, Type) of - {ok, HEnt} -> {ok, HEnt}; - Error -> - getbysearch(Name, Dot, Ds, Type, Error) + {ok, _HEnt}=Ok -> Ok; + Error -> getbysearch(Name, Dot, Ds, Type, Error) end; getbysearch(_Name, _Dot, [], _Type, Error) -> Error. - %% %% get_searchlist %% @@ -609,7 +605,6 @@ get_searchlist() -> end. - make_hostent(Name, Addrs, Aliases, ?S_A) -> #hostent { h_name = Name, @@ -638,20 +633,22 @@ make_hostent(Name, Datas, Aliases, Type) -> hostent_by_domain(Domain, Type) -> ?dbg("hostent_by_domain: ~p~n", [Domain]), - hostent_by_domain(stripdot(Domain), [], Type). + hostent_by_domain(stripdot(Domain), [], [], Type). -hostent_by_domain(Domain, Aliases, Type) -> +hostent_by_domain(Domain, Aliases, LAliases, Type) -> case lookup_type(Domain, Type) of [] -> case lookup_cname(Domain) of [] -> {error, nxdomain}; [CName | _] -> - case lists:member(CName, [Domain | Aliases]) of + LDomain = tolower(Domain), + case lists:member(CName, [LDomain | LAliases]) of true -> {error, nxdomain}; false -> - hostent_by_domain(CName, [Domain | Aliases], Type) + hostent_by_domain(CName, [Domain | Aliases], + [LDomain | LAliases], Type) end end; Addrs -> @@ -676,24 +673,26 @@ lookup_rr(Domain, Class, Type) -> %% match data field directly and cache RRs. %% res_hostent_by_domain(Domain, Type, Rec) -> - res_cache_answer(Rec), - RRs = Rec#dns_rec.anlist, + RRs = lists:map(fun lower_rr/1, Rec#dns_rec.anlist), + res_cache_answer(Rec#dns_rec{anlist = RRs}), ?dbg("res_hostent_by_domain: ~p - ~p~n", [Domain, RRs]), - res_hostent_by_domain(stripdot(Domain), [], Type, RRs). + res_hostent_by_domain(stripdot(Domain), [], [], Type, RRs). -res_hostent_by_domain(Domain, Aliases, Type, RRs) -> - case res_lookup_type(Domain, Type, RRs) of +res_hostent_by_domain(Domain, Aliases, LAliases, Type, RRs) -> + LDomain = tolower(Domain), + case res_lookup_type(LDomain, Type, RRs) of [] -> - case res_lookup_type(Domain, ?S_CNAME, RRs) of + case res_lookup_type(LDomain, ?S_CNAME, RRs) of [] -> {error, nxdomain}; [CName | _] -> - case lists:member(CName, [Domain | Aliases]) of + case lists:member(tolower(CName), [LDomain | LAliases]) of true -> {error, nxdomain}; false -> res_hostent_by_domain(CName, [Domain | Aliases], - Type, RRs) + [LDomain | LAliases], Type, + RRs) end end; Addrs -> @@ -726,7 +725,8 @@ gethostbyaddr(IP) -> %% res_gethostbyaddr(IP, Rec) -> {ok, {IP1, HType, HLen}} = dnt(IP), - res_cache_answer(Rec), + RRs = lists:map(fun lower_rr/1, Rec#dns_rec.anlist), + res_cache_answer(Rec#dns_rec{anlist = RRs}), ent_gethostbyaddr(Rec#dns_rec.anlist, IP1, HType, HLen). ent_gethostbyaddr(RRs, IP, AddrType, Length) -> @@ -844,11 +844,15 @@ lookup_socket(Socket) when is_port(Socket) -> %% node_auth Ls - Default authenication %% node_crypt Ls - Default encryption %% + +-spec init([]) -> {'ok', state()}. + init([]) -> process_flag(trap_exit, true), Db = ets:new(inet_db, [public, named_table]), reset_db(Db), - Cache = ets:new(inet_cache, [public, bag, {keypos,2}, named_table]), + CacheOpts = [public, bag, {keypos,#dns_rr.domain}, named_table], + Cache = ets:new(inet_cache, CacheOpts), BynameOpts = [protected, bag, named_table, {keypos,1}], ByaddrOpts = [protected, bag, named_table, {keypos,3}], HostsByname = ets:new(inet_hosts_byname, BynameOpts), @@ -897,18 +901,28 @@ reset_db(Db) -> %% {stop, Reason, Reply, State} | (terminate/2 is called) %% {stop, Reason, Reply, State} (terminate/2 is called) %%---------------------------------------------------------------------- + +-spec handle_call(term(), {pid(), term()}, state()) -> + {'reply', term(), state()} | {'stop', 'normal', 'ok', state()}. + handle_call(Request, From, #state{db=Db}=State) -> case Request of {load_hosts_file,IPNmAs} when is_list(IPNmAs) -> - NIPs = lists:flatten([ [{N,if tuple_size(IP) =:= 4 -> inet; - tuple_size(IP) =:= 8 -> inet6 - end,IP} || N <- [Nm|As]] - || {IP,Nm,As} <- IPNmAs]), + NIPs = + lists:flatten( + [ [{N, + if tuple_size(IP) =:= 4 -> inet; + tuple_size(IP) =:= 8 -> inet6 + end,IP} || N <- [Nm|As]] + || {IP,Nm,As} <- IPNmAs]), Byname = State#state.hosts_file_byname, Byaddr = State#state.hosts_file_byaddr, ets:delete_all_objects(Byname), ets:delete_all_objects(Byaddr), - ets:insert(Byname, NIPs), + %% Byname has lowercased names while Byaddr keep the name casing. + %% This is to be able to reconstruct the original + %% /etc/hosts entry. + ets:insert(Byname, [{tolower(N),Type,IP} || {N,Type,IP} <- NIPs]), ets:insert(Byaddr, NIPs), {reply, ok, State}; @@ -937,16 +951,14 @@ handle_call(Request, From, #state{db=Db}=State) -> {reply, ok, State}; {add_rr, RR} when is_record(RR, dns_rr) -> - RR1 = lower_rr(RR), - ?dbg("add_rr: ~p~n", [RR1]), - do_add_rr(RR1, Db, State), + ?dbg("add_rr: ~p~n", [RR]), + do_add_rr(RR, Db, State), {reply, ok, State}; {del_rr, RR} when is_record(RR, dns_rr) -> - RR1 = lower_rr(RR), %% note. del_rr will handle wildcards !!! Cache = State#state.cache, - ets:match_delete(Cache, RR1), + ets:match_delete(Cache, RR), {reply, ok, State}; {lookup_rr, Domain, Class, Type} -> @@ -1111,7 +1123,7 @@ handle_call(Request, From, #state{db=Db}=State) -> {set_cache_refresh, Time} when is_integer(Time), Time > 0 -> Time1 = ((Time+999) div 1000)*1000, %% round up ets:insert(Db, {cache_refresh_interval, Time1}), - stop_timer(State#state.cache_timer), + _ = stop_timer(State#state.cache_timer), {reply, ok, State#state{cache_timer = init_timer()}}; clear_hosts -> @@ -1125,7 +1137,7 @@ handle_call(Request, From, #state{db=Db}=State) -> reset -> reset_db(Db), - stop_timer(State#state.cache_timer), + _ = stop_timer(State#state.cache_timer), {reply, ok, State#state{cache_timer = init_timer()}}; {add_rc_list, List} -> @@ -1138,13 +1150,15 @@ handle_call(Request, From, #state{db=Db}=State) -> {reply, error, State} end. - %%---------------------------------------------------------------------- %% Func: handle_cast/2 %% Returns: {noreply, State} | %% {noreply, State, Timeout} | %% {stop, Reason, State} (terminate/2 is called) %%---------------------------------------------------------------------- + +-spec handle_cast(term(), state()) -> {'noreply', state()}. + handle_cast(_Msg, State) -> {noreply, State}. @@ -1154,6 +1168,9 @@ handle_cast(_Msg, State) -> %% {noreply, State, Timeout} | %% {stop, Reason, State} (terminate/2 is called) %%---------------------------------------------------------------------- + +-spec handle_info(term(), state()) -> {'noreply', state()}. + handle_info(refresh_timeout, State) -> do_refresh_cache(State#state.cache), {noreply, State#state{cache_timer = init_timer()}}; @@ -1166,8 +1183,11 @@ handle_info(_Info, State) -> %% Purpose: Shutdown the server %% Returns: any (ignored by gen_server) %%---------------------------------------------------------------------- + +-spec terminate(term(), state()) -> 'ok'. + terminate(_Reason, State) -> - stop_timer(State#state.cache_timer), + _ = stop_timer(State#state.cache_timer), ok. %%%---------------------------------------------------------------------- @@ -1186,7 +1206,8 @@ handle_set_file(Option, Fname, TagTm, TagInfo, ParseFun, From, File = filename:flatten(Fname), ets:insert(Db, {res_optname(Option), File}), ets:insert(Db, {TagInfo, undefined}), - ets:insert(Db, {TagTm, 0}), + TimeZero = - (?RES_FILE_UPDATE_TM + 1), % Early enough + ets:insert(Db, {TagTm, TimeZero}), {reply,ok,State}; true -> File = filename:flatten(Fname), @@ -1216,15 +1237,19 @@ handle_set_file(ParseFun, Bin, From, State) -> handle_rc_list(Opts, From, State) end. +%% Byname has lowercased names while Byaddr keep the name casing. +%% This is to be able to reconstruct the original /etc/hosts entry. + do_add_host(Byname, Byaddr, Names, Type, IP) -> do_del_host(Byname, Byaddr, IP), - NIPs = [{tolower(N),Type,IP} || N <- Names], - ets:insert(Byname, NIPs), - ets:insert(Byaddr, NIPs), + ets:insert(Byname, [{tolower(N),Type,IP} || N <- Names]), + ets:insert(Byaddr, [{N,Type,IP} || N <- Names]), ok. do_del_host(Byname, Byaddr, IP) -> - [ets:delete_object(Byname, NIP) || NIP <- ets:lookup(Byaddr, IP)], + _ = + [ets:delete_object(Byname, {tolower(Name),Type,Addr}) || + {Name,Type,Addr} <- ets:lookup(Byaddr, IP)], ets:delete(Byaddr, IP), ok. @@ -1342,28 +1367,26 @@ do_add_rr(RR, Db, State) -> TM = times(), case alloc_entry(Db, CacheDb, TM) of true -> - cache_rr(Db, CacheDb, RR#dns_rr { tm = TM, - cnt = TM }); + cache_rr(Db, CacheDb, RR#dns_rr{tm = TM, cnt = TM}); _ -> false end. cache_rr(_Db, Cache, RR) -> %% delete possible old entry - ets:match_delete(Cache, RR#dns_rr { cnt = '_', tm = '_', ttl = '_', - bm = '_', func = '_'}), + ets:match_delete(Cache, RR#dns_rr{cnt = '_', tm = '_', ttl = '_', + bm = '_', func = '_'}), ets:insert(Cache, RR). times() -> - {Mega,Secs,_} = erlang:now(), - Mega*1000000 + Secs. + erlang:convert_time_unit(erlang:monotonic_time() - erlang:system_info(start_time),native,seconds). %% lookup and remove old entries do_lookup_rr(Domain, Class, Type) -> - match_rr(#dns_rr { domain = tolower(Domain), class = Class,type = Type, - cnt = '_', tm = '_', ttl = '_', - bm = '_', func = '_', data = '_'}). + match_rr(#dns_rr{domain = tolower(Domain), class = Class,type = Type, + cnt = '_', tm = '_', ttl = '_', + bm = '_', func = '_', data = '_'}). match_rr(RR) -> filter_rr(ets:match_object(inet_cache, RR), times()). @@ -1383,25 +1406,27 @@ filter_rr([RR | RRs], Time) -> [RR | filter_rr(RRs, Time)]; filter_rr([], _Time) -> []. - +%% Lower case the domain name before storage. %% -%% Lower case the domain name before storage -%% -lower_rr(RR) -> - Dn = RR#dns_rr.domain, - if is_list(Dn) -> - RR#dns_rr { domain = tolower(Dn) }; - true -> RR - end. +lower_rr(#dns_rr{domain=Domain}=RR) when is_list(Domain) -> + RR#dns_rr { domain = tolower(Domain) }; +lower_rr(RR) -> RR. %% -%% Map upper-case to lower-case +%% Case fold upper-case to lower-case according to RFC 4343 +%% "Domain Name System (DNS) Case Insensitivity Clarification". +%% %% NOTE: this code is in kernel and we don't want to relay -%% to much on stdlib +%% to much on stdlib. Furthermore string:to_lower/1 +%% does not follow RFC 4343. %% tolower([]) -> []; -tolower([C|Cs]) when C >= $A, C =< $Z -> [(C-$A)+$a|tolower(Cs)]; -tolower([C|Cs]) -> [C|tolower(Cs)]. +tolower([C|Cs]) when is_integer(C) -> + if C >= $A, C =< $Z -> + [(C-$A)+$a|tolower(Cs)]; + true -> + [C|tolower(Cs)] + end. dn_ip6_int(A,B,C,D,E,F,G,H) -> dnib(H) ++ dnib(G) ++ dnib(F) ++ dnib(E) ++ @@ -1414,7 +1439,7 @@ dn_in_addr_arpa(A,B,C,D) -> integer_to_list(A) ++ ".in-addr.arpa". dnib(X) -> - [ hex(X), $., hex(X bsr 4), $., hex(X bsr 8), $., hex(X bsr 12), $.]. + [hex(X), $., hex(X bsr 4), $., hex(X bsr 8), $., hex(X bsr 12), $.]. hex(X) -> X4 = (X band 16#f), @@ -1509,12 +1534,7 @@ alloc_entry(CacheDb, OldSize, TM, N) -> delete_n_oldest(CacheDb, TM, OldestTM, N) -> DelTM = trunc((TM - OldestTM) * 0.3) + OldestTM, - case delete_older(CacheDb, DelTM, N) of - 0 -> - false; - _ -> - true - end. + delete_older(CacheDb, DelTM, N) =/= 0. %% Delete entries with latest access time older than TM. %% Delete max N number of entries. diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl index 669a361c9d..d5f982cc51 100644 --- a/lib/kernel/src/inet_dns.erl +++ b/lib/kernel/src/inet_dns.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(inet_dns). @@ -129,27 +130,33 @@ do_decode(<<Id:16, RA:1,PR:1,_:2,Rcode:4, QdCount:16,AnCount:16,NsCount:16,ArCount:16, QdBuf/binary>>=Buffer) -> - {AnBuf,QdList} = decode_query_section(QdBuf,QdCount,Buffer), - {NsBuf,AnList} = decode_rr_section(AnBuf,AnCount,Buffer), - {ArBuf,NsList} = decode_rr_section(NsBuf,NsCount,Buffer), - {Rest,ArList} = decode_rr_section(ArBuf,ArCount,Buffer), + {AnBuf,QdList,QdTC} = decode_query_section(QdBuf,QdCount,Buffer), + {NsBuf,AnList,AnTC} = decode_rr_section(AnBuf,AnCount,Buffer), + {ArBuf,NsList,NsTC} = decode_rr_section(NsBuf,NsCount,Buffer), + {Rest,ArList,ArTC} = decode_rr_section(ArBuf,ArCount,Buffer), case Rest of <<>> -> + HdrTC = decode_boolean(TC), DnsHdr = #dns_header{id=Id, qr=decode_boolean(QR), opcode=decode_opcode(Opcode), aa=decode_boolean(AA), - tc=decode_boolean(TC), + tc=HdrTC, rd=decode_boolean(RD), ra=decode_boolean(RA), pr=decode_boolean(PR), rcode=Rcode}, - #dns_rec{header=DnsHdr, - qdlist=QdList, - anlist=AnList, - nslist=NsList, - arlist=ArList}; + case QdTC or AnTC or NsTC or ArTC of + true when not HdrTC -> + throw(?DECODE_ERROR); + _ -> + #dns_rec{header=DnsHdr, + qdlist=QdList, + anlist=AnList, + nslist=NsList, + arlist=ArList} + end; _ -> %% Garbage data after DNS message throw(?DECODE_ERROR) @@ -161,8 +168,10 @@ do_decode(_) -> decode_query_section(Bin, N, Buffer) -> decode_query_section(Bin, N, Buffer, []). +decode_query_section(<<>>=Rest, N, _Buffer, Qs) -> + {Rest,reverse(Qs),N =/= 0}; decode_query_section(Rest, 0, _Buffer, Qs) -> - {Rest,reverse(Qs)}; + {Rest,reverse(Qs),false}; decode_query_section(Bin, N, Buffer, Qs) -> case decode_name(Bin, Buffer) of {<<Type:16,Class:16,Rest/binary>>,Name} -> @@ -179,8 +188,10 @@ decode_query_section(Bin, N, Buffer, Qs) -> decode_rr_section(Bin, N, Buffer) -> decode_rr_section(Bin, N, Buffer, []). +decode_rr_section(<<>>=Rest, N, _Buffer, RRs) -> + {Rest,reverse(RRs),N =/= 0}; decode_rr_section(Rest, 0, _Buffer, RRs) -> - {Rest,reverse(RRs)}; + {Rest,reverse(RRs),false}; decode_rr_section(Bin, N, Buffer, RRs) -> case decode_name(Bin, Buffer) of {<<T:16/unsigned,C:16/unsigned,TTL:4/binary, diff --git a/lib/kernel/src/inet_dns.hrl b/lib/kernel/src/inet_dns.hrl index 1b69f31a4d..07226bbf5c 100644 --- a/lib/kernel/src/inet_dns.hrl +++ b/lib/kernel/src/inet_dns.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/kernel/src/inet_dns_record_adts.pl b/lib/kernel/src/inet_dns_record_adts.pl index b1d8fab939..c89d837098 100644 --- a/lib/kernel/src/inet_dns_record_adts.pl +++ b/lib/kernel/src/inet_dns_record_adts.pl @@ -2,18 +2,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2009. All Rights Reserved. +# Copyright Ericsson AB 2009-2016. 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. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -56,7 +57,8 @@ while(<DATA>) { $" = ','; $\ = "\n"; -while( my ($Name, $r) = each(%Names)) { +foreach my $Name (sort keys %Names) { + my $r = $Names{$Name}; # Create substitutions for this Name my ($Record, @Fields) = @{ $r }; my @FieldMatchValues; @@ -73,6 +75,10 @@ while( my ($Name, $r) = each(%Names)) { # "@Values" = "V1,V2"...",VN" my @D = @DATA; foreach my $line (@D) { + # Ignore !name lines + if ($line =~ s/^\!(\S+)\s+//) { + next if $1 eq $Name; + } my $m = 1; # For leading * iterate $n times, otherwise once $line =~ s/^\s*[*]// and $m = $n; @@ -105,7 +111,8 @@ while( my ($Name, $r) = each(%Names)) { for my $i ( 0 .. $#INDEX ) { my $line = $INDEX[$i]; if ($line =~ s/^[*]//) { - while( my ($Name, $r) = each(%Names)) { + foreach my $Name (sort keys %Names) { + my $r = $Names{$Name}; my ($Record) = @{ $r }; $_ = $line; s/Name\b/$Name/g; @@ -155,9 +162,9 @@ make_Name() -> \ make_Name(L) when is_list(L) -> \ make_Name(#Record{}, L). -%% Generate #Record{} with one updated field -%% -*make_Name(Field, Value) -> \ +!dns_rr_opt %% Generate #Record{} with one updated field +!dns_rr_opt %% +!dns_rr_opt *make_Name(Field, Value) -> \ #Record{Field=Value}; %% %% Update #Record{} from property list diff --git a/lib/kernel/src/inet_gethost_native.erl b/lib/kernel/src/inet_gethost_native.erl index fabe9bf8b3..9e76c08365 100644 --- a/lib/kernel/src/inet_gethost_native.erl +++ b/lib/kernel/src/inet_gethost_native.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -106,8 +107,11 @@ pool_size = 4, % Number of C processes in pool. statistics % Statistics record (records error causes). }). +-type state() :: #state{}. %% The supervisor bridge code +-spec init([]) -> {'ok', pid(), pid()} | {'error', term()}. + init([]) -> % Called by supervisor_bridge:start_link Ref = make_ref(), SaveTE = process_flag(trap_exit,true), @@ -151,11 +155,13 @@ run_once() -> {Port, {data, <<1:32, BinReply/binary>>}} -> Pid ! {R, {ok, BinReply}} after Timeout -> - Pid ! {R,{error,timeout}} + Pid ! {R, {error, timeout}} end. -terminate(_Reason,Pid) -> - (catch exit(Pid,kill)), +-spec terminate(term(), pid()) -> 'ok'. + +terminate(_Reason, Pid) -> + (catch exit(Pid, kill)), ok. %%----------------------------------------------------------------------- @@ -232,7 +238,7 @@ handle_message({Port, {data, Data}}, State = #state{port = Port}) -> State; Req -> lists:foreach(fun({P,R,TR}) -> - ?CANCEL_TIMER(TR), + _= ?CANCEL_TIMER(TR), P ! {R, {ok, BinReply}} @@ -271,7 +277,7 @@ handle_message({timeout, Pid, RID}, State) -> {last, {LP,LR,_}} -> LP ! {LR, {error,timeout}}, %% Remove the whole request structure... - pick_request(State, RID), + _ = pick_request(State, RID), %% Also cancel the request to the port program... (catch port_command(State#state.port, <<RID:32,?OP_CANCEL_REQUEST>>)) @@ -337,14 +343,14 @@ pick_client(State,RID,Clid) -> {last, SoleClient}; % Note, not removed, the caller % should cleanup request data CList -> - case lists:keysearch(Clid,1,CList) of - {value, Client} -> + case lists:keyfind(Clid,1,CList) of + false -> + false; + Client -> NCList = lists:keydelete(Clid,1,CList), ets:insert(State#state.requests, R#request{clients = NCList}), - {more, Client}; - false -> - false + {more, Client} end end end. @@ -382,8 +388,7 @@ restart_port(#state{port = Port, requests = Requests}) -> end, Requests), NewPort. - - + do_open_port(Poolsize, ExtraArgs) -> try @@ -431,6 +436,7 @@ system_continue(_Parent, _, State) -> system_terminate(Reason, _Parent, _, _State) -> exit(Reason). +-spec system_code_change(state(), module(), term(), term()) -> {'ok', state()}. system_code_change(State, _Module, _OldVsn, _Extra) -> {ok, State}. %% Nothing to do in this version. @@ -498,8 +504,7 @@ getit(Req, DefaultName) -> Pid, Reason} -> {error, Reason} end, - catch erlang:demonitor(Ref2), - receive {'DOWN',Ref2,_,_,_} -> ok after 0 -> ok end, + catch erlang:demonitor(Ref2, [flush]), Res2 end. @@ -513,7 +518,7 @@ do_start(Sup, C) -> {error, {{already_started, Pid}, _Child}} when is_pid(Pid) -> ok; {error, already_present} -> - supervisor:delete_child(Sup, Child), + _ = supervisor:delete_child(Sup, Child), do_start(Sup, C) end. diff --git a/lib/kernel/src/inet_hosts.erl b/lib/kernel/src/inet_hosts.erl index df1d4fc0be..0bdf00ac30 100644 --- a/lib/kernel/src/inet_hosts.erl +++ b/lib/kernel/src/inet_hosts.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -38,9 +39,12 @@ gethostbyname(_) -> {error, formerr}. gethostbyname(Name, Type) when is_list(Name), is_atom(Type) -> - case gethostbyname(Name, Type, inet_hosts_byname, inet_hosts_byaddr) of + %% Byname has lowercased names while Byaddr keep the name casing. + %% This is to be able to reconstruct the original /etc/hosts entry. + N = inet_db:tolower(Name), + case gethostbyname(N, Type, inet_hosts_byname, inet_hosts_byaddr) of false -> - case gethostbyname(Name, Type, + case gethostbyname(N, Type, inet_hosts_file_byname, inet_hosts_file_byaddr) of false -> {error,nxdomain}; diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index cf357b7fba..4e8f59a3b9 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -24,12 +25,15 @@ %% %% family codes to open +-define(INET_AF_UNSPEC, 0). -define(INET_AF_INET, 1). -define(INET_AF_INET6, 2). -define(INET_AF_ANY, 3). % Fake for ANY in any address family -define(INET_AF_LOOPBACK, 4). % Fake for LOOPBACK in any address family +-define(INET_AF_LOCAL, 5). % For Unix Domain address family +-define(INET_AF_UNDEFINED, 6). % For any unknown address family -%% type codes (gettype, INET_REQ_GETTYPE) +%% type codes to open and gettype - INET_REQ_GETTYPE -define(INET_TYPE_STREAM, 1). -define(INET_TYPE_DGRAM, 2). -define(INET_TYPE_SEQPACKET, 3). @@ -46,6 +50,7 @@ -define(INET_PASSIVE, 0). -define(INET_ACTIVE, 1). -define(INET_ONCE, 2). % Active once then passive +-define(INET_MULTI, 3). % Active N then passive %% state codes (getstatus, INET_REQ_GETSTATUS) -define(INET_F_OPEN, 16#0001). @@ -82,16 +87,24 @@ -define(INET_REQ_IFGET, 22). -define(INET_REQ_IFSET, 23). -define(INET_REQ_SUBSCRIBE, 24). +-define(INET_REQ_GETIFADDRS, 25). +-define(INET_REQ_ACCEPT, 26). +-define(INET_REQ_LISTEN, 27). +-define(INET_REQ_IGNOREFD, 28). +-define(INET_REQ_GETLADDRS, 29). +-define(INET_REQ_GETPADDRS, 30). + %% TCP requests --define(TCP_REQ_ACCEPT, 40). --define(TCP_REQ_LISTEN, 41). +%%-define(TCP_REQ_ACCEPT, 40). MOVED +%%-define(TCP_REQ_LISTEN, 41). MERGED -define(TCP_REQ_RECV, 42). -define(TCP_REQ_UNRECV, 43). -define(TCP_REQ_SHUTDOWN, 44). %% UDP and SCTP requests -define(PACKET_REQ_RECV, 60). --define(SCTP_REQ_LISTEN, 61). +%%-define(SCTP_REQ_LISTEN, 61). MERGED -define(SCTP_REQ_BINDX, 62). %% Multi-home SCTP bind +-define(SCTP_REQ_PEELOFF, 63). %% subscribe codes, INET_REQ_SUBSCRIBE -define(INET_SUBS_EMPTY_OUT_Q, 1). @@ -99,7 +112,7 @@ %% reply codes for *_REQ_* -define(INET_REP_ERROR, 0). -define(INET_REP_OK, 1). --define(INET_REP_SCTP, 2). +-define(INET_REP, 2). %% INET, TCP and UDP options: -define(INET_OPT_REUSEADDR, 0). @@ -118,6 +131,7 @@ -define(UDP_OPT_MULTICAST_LOOP, 13). -define(UDP_OPT_ADD_MEMBERSHIP, 14). -define(UDP_OPT_DROP_MEMBERSHIP, 15). +-define(INET_OPT_IPV6_V6ONLY, 16). % "Local" options: codes start from 20: -define(INET_LOPT_BUFFER, 20). -define(INET_LOPT_HEADER, 21). @@ -128,13 +142,18 @@ -define(INET_LOPT_EXITONCLOSE, 26). -define(INET_LOPT_TCP_HIWTRMRK, 27). -define(INET_LOPT_TCP_LOWTRMRK, 28). --define(INET_LOPT_BIT8, 29). -define(INET_LOPT_TCP_SEND_TIMEOUT, 30). -define(INET_LOPT_TCP_DELAY_SEND, 31). -define(INET_LOPT_PACKET_SIZE, 32). -define(INET_LOPT_READ_PACKETS, 33). -define(INET_OPT_RAW, 34). -define(INET_LOPT_TCP_SEND_TIMEOUT_CLOSE, 35). +-define(INET_LOPT_MSGQ_HIWTRMRK, 36). +-define(INET_LOPT_MSGQ_LOWTRMRK, 37). +-define(INET_LOPT_NETNS, 38). +-define(INET_LOPT_TCP_SHOW_ECONNRESET, 39). +-define(INET_LOPT_LINE_DELIM, 40). +-define(INET_OPT_TCLASS, 41). % Specific SCTP options: separate range: -define(SCTP_OPT_RTOINFO, 100). -define(SCTP_OPT_ASSOCINFO, 101). @@ -180,12 +199,6 @@ -define(TCP_PB_HTTP_BIN,13). -define(TCP_PB_HTTPH_BIN,14). -%% bit options, INET_LOPT_BIT8 --define(INET_BIT8_CLEAR, 0). --define(INET_BIT8_SET, 1). --define(INET_BIT8_ON, 2). --define(INET_BIT8_OFF, 3). - %% getstat, INET_REQ_GETSTAT -define(INET_STAT_RECV_CNT, 1). @@ -369,7 +382,7 @@ { ifaddr = any, %% bind to interface address port = 0, %% bind to port (default is dynamic port) - fd = -1, %% fd >= 0 => already bound + fd = -1, %% fd >= 0 => already bound opts = [] %% [{active,true}] added in inet:connect_options }). @@ -398,6 +411,7 @@ ifaddr, port = 0, fd = -1, + type = seqpacket, opts = [{mode, binary}, {buffer, ?SCTP_DEF_BUFSZ}, {sndbuf, ?SCTP_DEF_BUFSZ}, diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl index 3bd5fa0958..b0a3ee3008 100644 --- a/lib/kernel/src/inet_parse.erl +++ b/lib/kernel/src/inet_parse.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -20,8 +21,9 @@ %% Parser for all kinds of ineternet configuration files +%% Avoid warning for local function error/2 clashing with autoimported BIF. +-compile({no_auto_import,[error/2]}). -export([hosts/1, hosts/2]). --export([hosts_vxworks/1]). -export([protocols/1, protocols/2]). -export([netmasks/1, netmasks/2]). -export([networks/1, networks/2]). @@ -35,7 +37,7 @@ -export([ipv4_address/1, ipv6_address/1]). -export([ipv4strict_address/1, ipv6strict_address/1]). --export([address/1]). +-export([address/1, strict_address/1]). -export([visible_string/1, domain/1]). -export([ntoa/1, dots/1]). -export([split_line/1]). @@ -105,18 +107,6 @@ hosts(Fname,File) -> parse_file(Fname, File, Fn). %% -------------------------------------------------------------------------- -%% Parse hostShow vxworks style -%% Syntax: -%% Name IP [Aliases] \n -%% -------------------------------------------------------------------------- -hosts_vxworks(Hosts) -> - Fn = fun([Name, Address | Aliases]) -> - {ok,IP} = address(Address), - {IP, Name, Aliases} - end, - parse_file(Hosts, Fn). - -%% -------------------------------------------------------------------------- %% Parse resolv file unix style %% Syntax: %% domain Domain \n @@ -289,9 +279,6 @@ networks(Fname, File) -> %% %% -------------------------------------------------------------------------- -parse_file(File, Fn) -> - parse_file(noname, File, Fn). - parse_file(Fname, {fd,Fd}, Fn) -> parse_fd(Fname,Fd, 1, Fn, []); parse_file(Fname, {chars,Cs}, Fn) when is_list(Cs) -> @@ -302,7 +289,7 @@ parse_file(_, File, Fn) -> case file:open(File, [read]) of {ok, Fd} -> Result = parse_fd(File,Fd, 1, Fn, []), - file:close(Fd), + _ = file:close(Fd), Result; Error -> Error end. @@ -470,6 +457,17 @@ address(Cs) when is_list(Cs) -> address(_) -> {error, einval}. +%%Parse ipv4 strict address or ipv6 strict address +strict_address(Cs) when is_list(Cs) -> + case ipv4strict_address(Cs) of + {ok,IP} -> + {ok,IP}; + _ -> + ipv6strict_address(Cs) + end; +strict_address(_) -> + {error, einval}. + %% %% Parse IPv4 address: %% d1.d2.d3.d4 @@ -678,28 +676,22 @@ ipv6_addr_done(Ar, Br, N) -> ipv6_addr_done(Ar) -> list_to_tuple(lists:reverse(Ar)). -%% Collect Hex digits -hex(Cs) -> hex(Cs, []). +%% Collect 1-4 Hex digits +hex(Cs) -> hex(Cs, [], 4). %% -hex([C|Cs], R) when C >= $0, C =< $9 -> - hex(Cs, [C|R]); -hex([C|Cs], R) when C >= $a, C =< $f -> - hex(Cs, [C|R]); -hex([C|Cs], R) when C >= $A, C =< $F -> - hex(Cs, [C|R]); -hex(Cs, [_|_]=R) when is_list(Cs) -> +hex([C|Cs], R, N) when C >= $0, C =< $9, N > 0 -> + hex(Cs, [C|R], N-1); +hex([C|Cs], R, N) when C >= $a, C =< $f, N > 0 -> + hex(Cs, [C|R], N-1); +hex([C|Cs], R, N) when C >= $A, C =< $F, N > 0 -> + hex(Cs, [C|R], N-1); +hex(Cs, [_|_]=R, _) when is_list(Cs) -> {lists:reverse(R),Cs}; -hex(_, _) -> +hex(_, _, _) -> erlang:error(badarg). %% Hex string to integer -hex_to_int(Cs0) -> - case strip0(Cs0) of - Cs when length(Cs) =< 4 -> - erlang:list_to_integer("0"++Cs, 16); - _ -> - erlang:error(badarg) - end. +hex_to_int(Cs) -> erlang:list_to_integer(Cs, 16). %% Dup onto head of existing list dup(0, _, L) -> @@ -725,7 +717,9 @@ ntoa({0,0,0,0,0,16#ffff,A,B}) -> "::FFFF:" ++ dig_to_dec(A) ++ "." ++ dig_to_dec(B); ntoa({_,_,_,_,_,_,_,_}=T) -> %% Find longest sequence of zeros, at least 2, to replace with "::" - ntoa(tuple_to_list(T), []). + ntoa(tuple_to_list(T), []); +ntoa(_) -> + {error, einval}. %% Find first double zero ntoa([], R) -> diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index 9b9e078898..90e49ddfdf 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% %% RFC 1035, 2671, 2782, 2915. @@ -47,24 +48,99 @@ false -> ok end). +-type res_option() :: + {alt_nameservers, [nameserver()]} + | {edns, 0 | false} + | {inet6, boolean()} + | {nameservers, [nameserver()]} + | {recurse, boolean()} + | {retry, integer()} + | {timeout, integer()} + | {udp_payload_size, integer()} + | {usevc, boolean()}. + +-type nameserver() :: {inet:ip_address(), Port :: 1..65535}. + +-type res_error() :: formerr | qfmterror | servfail | nxdomain | + notimp | refused | badvers | timeout. + +-type dns_name() :: string(). + +-type rr_type() :: a | aaaa | cname | gid | hinfo | ns | mb | md | mg | mf + | minfo | mx | naptr | null | ptr | soa | spf | srv | txt + | uid | uinfo | unspec | wks. + +-type dns_class() :: in | chaos | hs | any. + +-type dns_msg() :: term(). + +-type dns_data() :: + dns_name() + | inet:ip4_address() + | inet:ip6_address() + | {MName :: dns_name(), + RName :: dns_name(), + Serial :: integer(), + Refresh :: integer(), + Retry :: integer(), + Expiry :: integer(), + Minimum :: integer()} + | {inet:ip4_address(), Proto :: integer(), BitMap :: binary()} + | {CpuString :: string(), OsString :: string()} + | {RM :: dns_name(), EM :: dns_name()} + | {Prio :: integer(), dns_name()} + | {Prio :: integer(),Weight :: integer(),Port :: integer(),dns_name()} + | {Order :: integer(),Preference :: integer(),Flags :: string(), + Services :: string(),Regexp :: string(), dns_name()} + | [string()] + | binary(). + %% -------------------------------------------------------------------------- %% resolve: %% %% Nameserver query %% +-spec resolve(Name, Class, Type) -> {ok, dns_msg()} | Error when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Error :: {error, Reason} | {error,{Reason,dns_msg()}}, + Reason :: inet:posix() | res_error(). + resolve(Name, Class, Type) -> resolve(Name, Class, Type, [], infinity). +-spec resolve(Name, Class, Type, Opts) -> + {ok, dns_msg()} | Error when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Opts :: [Opt], + Opt :: res_option() | verbose | atom(), + Error :: {error, Reason} | {error,{Reason,dns_msg()}}, + Reason :: inet:posix() | res_error(). + resolve(Name, Class, Type, Opts) -> resolve(Name, Class, Type, Opts, infinity). +-spec resolve(Name, Class, Type, Opts, Timeout) -> + {ok, dns_msg()} | Error when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Opts :: [Opt], + Opt :: res_option() | verbose | atom(), + Timeout :: timeout(), + Error :: {error, Reason} | {error,{Reason,dns_msg()}}, + Reason :: inet:posix() | res_error(). + resolve(Name, Class, Type, Opts, Timeout) -> case nsdname(Name) of {ok, Nm} -> Timer = inet:start_timer(Timeout), Res = res_query(Nm, Class, Type, Opts, Timer), - inet:stop_timer(Timer), + _ = inet:stop_timer(Timer), Res; Error -> Error @@ -76,20 +152,38 @@ resolve(Name, Class, Type, Opts, Timeout) -> %% Convenience wrapper to resolve/3,4,5 that filters out all answer data %% fields of the class and type asked for. +-spec lookup(Name, Class, Type) -> [dns_data()] when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(). + lookup(Name, Class, Type) -> lookup(Name, Class, Type, []). +-spec lookup(Name, Class, Type, Opts) -> [dns_data()] when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Opts :: [res_option() | verbose]. + lookup(Name, Class, Type, Opts) -> lookup(Name, Class, Type, Opts, infinity). +-spec lookup(Name, Class, Type, Opts, Timeout) -> [dns_data()] when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Opts :: [res_option() | verbose], + Timeout :: timeout(). + lookup(Name, Class, Type, Opts, Timeout) -> lookup_filter(resolve(Name, Class, Type, Opts, Timeout), Class, Type). lookup_filter({ok,#dns_rec{anlist=Answers}}, Class, Type) -> [A#dns_rr.data || A <- Answers, - A#dns_rr.class =:= Class, - A#dns_rr.type =:= Type]; + Class =:= any orelse A#dns_rr.class =:= Class, + Type =:= any orelse A#dns_rr.type =:= Type]; lookup_filter({error,_}, _, _) -> []. %% -------------------------------------------------------------------------- @@ -101,17 +195,55 @@ lookup_filter({error,_}, _, _) -> []. %% %% To be deprecated +-spec nslookup(Name, Class, Type) -> {ok, dns_msg()} | {error, Reason} when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Reason :: inet:posix() | res_error(). + nslookup(Name, Class, Type) -> do_nslookup(Name, Class, Type, [], infinity). +-spec nslookup(Name, Class, Type, Timeout) -> + {ok, dns_msg()} | {error, Reason} when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Timeout :: timeout(), + Reason :: inet:posix() | res_error(); + (Name, Class, Type, Nameservers) -> + {ok, dns_msg()} | {error, Reason} when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Nameservers :: [nameserver()], + Reason :: inet:posix() | res_error(). + nslookup(Name, Class, Type, Timeout) when is_integer(Timeout), Timeout >= 0 -> do_nslookup(Name, Class, Type, [], Timeout); nslookup(Name, Class, Type, NSs) -> % For backwards compatibility nnslookup(Name, Class, Type, NSs). % with OTP R6B only +-spec nnslookup(Name, Class, Type, Nameservers) -> + {ok, dns_msg()} | {error, Reason} when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Nameservers :: [nameserver()], + Reason :: inet:posix(). + nnslookup(Name, Class, Type, NSs) -> nnslookup(Name, Class, Type, NSs, infinity). +-spec nnslookup(Name, Class, Type, Nameservers, Timeout) -> + {ok, dns_msg()} | {error, Reason} when + Name :: dns_name() | inet:ip_address(), + Class :: dns_class(), + Type :: rr_type(), + Timeout :: timeout(), + Nameservers :: [nameserver()], + Reason :: inet:posix(). + nnslookup(Name, Class, Type, NSs, Timeout) -> do_nslookup(Name, Class, Type, [{nameservers,NSs}], Timeout). @@ -192,12 +324,23 @@ make_options(Opts, [Name|Names]) -> %% %% -------------------------------------------------------------------------- +-spec gethostbyaddr(Address) -> {ok, Hostent} | {error, Reason} when + Address :: inet:ip_address(), + Hostent :: inet:hostent(), + Reason :: inet:posix() | res_error(). + gethostbyaddr(IP) -> gethostbyaddr_tm(IP,false). +-spec gethostbyaddr(Address, Timeout) -> {ok, Hostent} | {error, Reason} when + Address :: inet:ip_address(), + Timeout :: timeout(), + Hostent :: inet:hostent(), + Reason :: inet:posix() | res_error(). + gethostbyaddr(IP,Timeout) -> Timer = inet:start_timer(Timeout), Res = gethostbyaddr_tm(IP,Timer), - inet:stop_timer(Timer), + _ = inet:stop_timer(Timer), Res. gethostbyaddr_tm({A,B,C,D} = IP, Timer) when ?ip(A,B,C,D) -> @@ -249,6 +392,11 @@ res_gethostbyaddr(Addr, IP, Timer) -> %% Caches the answer. %% -------------------------------------------------------------------------- +-spec gethostbyname(Name) -> {ok, Hostent} | {error, Reason} when + Name :: dns_name(), + Hostent :: inet:hostent(), + Reason :: inet:posix() | res_error(). + gethostbyname(Name) -> case inet_db:res_option(inet6) of true -> @@ -257,13 +405,27 @@ gethostbyname(Name) -> gethostbyname_tm(Name, inet, false) end. +-spec gethostbyname(Name, Family) -> {ok, Hostent} | {error, Reason} when + Name :: dns_name(), + Hostent :: inet:hostent(), + Family :: inet:address_family(), + Reason :: inet:posix() | res_error(). + gethostbyname(Name,Family) -> gethostbyname_tm(Name,Family,false). +-spec gethostbyname(Name, Family, Timeout) -> + {ok, Hostent} | {error, Reason} when + Name :: dns_name(), + Hostent :: inet:hostent(), + Timeout :: timeout(), + Family :: inet:address_family(), + Reason :: inet:posix() | res_error(). + gethostbyname(Name,Family,Timeout) -> Timer = inet:start_timer(Timeout), Res = gethostbyname_tm(Name,Family,Timer), - inet:stop_timer(Timer), + _ = inet:stop_timer(Timer), Res. gethostbyname_tm(Name,inet,Timer) -> @@ -298,18 +460,31 @@ gethostbyname_tm(_Name, _Family, _Timer) -> %% %% getbyname(domain_name(), Type) => {ok, hostent()} | {error, Reason} %% -%% where domain_name() is domain string or atom and Type is ?S_A, ?S_MX ... +%% where domain_name() is domain string and Type is ?S_A, ?S_MX ... %% %% Caches the answer. %% -------------------------------------------------------------------------- +-spec getbyname(Name, Type) -> {ok, Hostent} | {error, Reason} when + Name :: dns_name(), + Type :: rr_type(), + Hostent :: inet:hostent(), + Reason :: inet:posix() | res_error(). + getbyname(Name, Type) -> getbyname_tm(Name,Type,false). +-spec getbyname(Name, Type, Timeout) -> {ok, Hostent} | {error, Reason} when + Name :: dns_name(), + Type :: rr_type(), + Timeout :: timeout(), + Hostent :: inet:hostent(), + Reason :: inet:posix() | res_error(). + getbyname(Name, Type, Timeout) -> Timer = inet:start_timer(Timeout), Res = getbyname_tm(Name, Type, Timer), - inet:stop_timer(Timer), + _ = inet:stop_timer(Timer), Res. getbyname_tm(Name, Type, Timer) when is_list(Name) -> @@ -539,27 +714,41 @@ udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer) when ?ip(A,B,C,D), ?port(Port) -> gen_udp:send(I, IP, Port, Buffer). -udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout) +udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout, Decode) when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout); -udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout) + do_udp_recv(I, IP, Port, Timeout, Decode, time_now(), Timeout); +udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout, Decode) when ?ip(A,B,C,D), ?port(Port) -> - do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout). - -do_udp_recv(Recv, IP, Port, Timeout) -> - do_udp_recv(Recv, IP, Port, Timeout, - if Timeout =/= 0 -> erlang:now(); true -> undefined end). - -do_udp_recv(Recv, IP, Port, Timeout, Then) -> - case Recv(Timeout) of - {ok,{IP,Port,Answer}} -> - {ok,Answer,erlang:max(0, Timeout - now_ms(erlang:now(), Then))}; - {ok,_} when Timeout =:= 0 -> - {error,timeout}; - {ok,_} -> - Now = erlang:now(), - T = erlang:max(0, Timeout - now_ms(Now, Then)), - do_udp_recv(Recv, IP, Port, T, Now); + do_udp_recv(I, IP, Port, Timeout, Decode, time_now(), Timeout). + +do_udp_recv(_I, _IP, _Port, 0, _Decode, _Start, _T) -> + timeout; +do_udp_recv(I, IP, Port, Timeout, Decode, Start, T) -> + case gen_udp:recv(I, 0, T) of + {ok,Reply} -> + case Decode(Reply) of + false when T =:= 0 -> + %% This is a compromize between the hard way i.e + %% in the clause below if NewT becomes 0 bailout + %% immediately and risk that the right reply lies + %% ahead after some bad id replies, and the + %% forgiving way i.e go on with Timeout 0 until + %% the right reply comes or no reply (timeout) + %% which opens for a DOS attack by a malicious + %% DNS server flooding with bad id replies causing + %% an infinite loop here. + %% + %% Timeout is used as a sanity limit counter + %% just to put an end to the loop. + NewTimeout = erlang:max(0, Timeout - 50), + do_udp_recv(I, IP, Port, NewTimeout, Decode, Start, T); + false -> + Now = time_now(), + NewT = erlang:max(0, Timeout - now_ms(Now, Start)), + do_udp_recv(I, IP, Port, Timeout, Decode, Start, NewT); + Result -> + Result + end; Error -> Error end. @@ -580,6 +769,17 @@ udp_close(#sock{inet=I,inet6=I6}) -> %% end %% end %% +%% But that man page also says dig always use num_servers = 1. +%% +%% Our man page says: timeout/retry, then double for next retry, i.e +%% for i = 0 to retry - 1 +%% foreach nameserver +%% send query +%% wait((time * (2**i)) / retry) +%% end +%% end +%% +%% And that is what the code seems to do, now fixed, hopefully... do_query(_Q, [], _Timer) -> {error,nxdomain}; @@ -589,18 +789,16 @@ do_query(#q{options=#options{retry=Retry}}=Q, NSs, Timer) -> query_retries(_Q, _NSs, _Timer, Retry, Retry, S) -> udp_close(S), {error,timeout}; +query_retries(_Q, [], _Timer, _Retry, _I, S) -> + udp_close(S), + {error,timeout}; query_retries(Q, NSs, Timer, Retry, I, S0) -> - Num = length(NSs), - if Num =:= 0 -> - {error,timeout}; - true -> - case query_nss(Q, NSs, Timer, Retry, I, S0, []) of - {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers - query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S); - {S,Result} -> - udp_close(S), - Result - end + case query_nss(Q, NSs, Timer, Retry, I, S0, []) of + {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers + query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S); + {S,Result} -> + udp_close(S), + Result end. query_nss(_Q, [], _Timer, _Retry, _I, S, ErrNSs) -> @@ -610,13 +808,13 @@ query_nss(#q{edns=undefined}=Q, NSs, Timer, Retry, I, S, ErrNSs) -> query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) -> query_nss_edns(Q, NSs, Timer, Retry, I, S, ErrNSs). -query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options, - edns={Id,Buffer}}=Q, - [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) -> - {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer, - Retry, I, Options, PSz), +query_nss_edns( + #q{options=#options{udp_payload_size=PSz}=Options,edns={Id,Buffer}}=Q, + [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) -> + {S,Res}=Reply = + query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, PSz), case Res of - timeout -> {S,{error,timeout}}; + timeout -> {S,{error,timeout}}; % Bailout timeout {ok,_} -> Reply; {error,{nxdomain,_}} -> Reply; {error,{E,_}} when E =:= qfmterror; E =:= notimp; E =:= servfail; @@ -628,17 +826,19 @@ query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options, query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) end. -query_nss_dns(#q{dns=Qdns}=Q0, [{IP,Port}=NS|NSs], - Timer, Retry, I, S0, ErrNSs) -> +query_nss_dns( + #q{dns=Qdns}=Q0, + [{IP,Port}=NS|NSs], Timer, Retry, I, S0, ErrNSs) -> #q{options=Options,dns={Id,Buffer}}=Q = if is_function(Qdns, 0) -> Q0#q{dns=Qdns()}; true -> Q0 end, - {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer, - Retry, I, Options, ?PACKETSZ), + {S,Res}=Reply = + query_ns( + S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, ?PACKETSZ), case Res of - timeout -> {S,{error,timeout}}; + timeout -> {S,{error,timeout}}; % Bailout timeout {ok,_} -> Reply; {error,{E,_}} when E =:= nxdomain; E =:= qfmterror -> Reply; {error,E} when E =:= fmt; E =:= enetunreach; E =:= econnrefused -> @@ -652,48 +852,66 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, PSz) -> case UseVC orelse iolist_size(Buffer) > PSz of true -> - {S0,query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose)}; + TcpTimeout = inet:timeout(Tm*5, Timer), + {S0,query_tcp(TcpTimeout, Id, Buffer, IP, Port, Verbose)}; false -> case udp_open(S0, IP) of {ok,S} -> - {S,case query_udp(S, Id, Buffer, IP, Port, Timer, - Retry, I, Tm, Verbose) of - {ok,#dns_rec{header=H}} when H#dns_header.tc -> - query_tcp(Tm, Id, Buffer, - IP, Port, Timer, Verbose); - Reply -> Reply - end}; + Timeout = + inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), + {S, + case query_udp( + S, Id, Buffer, IP, Port, Timeout, Verbose) of + {ok,#dns_rec{header=H}} when H#dns_header.tc -> + TcpTimeout = inet:timeout(Tm*5, Timer), + query_tcp( + TcpTimeout, Id, Buffer, IP, Port, Verbose); + Reply -> Reply + end}; Error -> {S0,Error} end end. -query_udp(S, Id, Buffer, IP, Port, Timer, Retry, I, Tm, Verbose) -> - Timeout = inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), +query_udp(_S, _Id, _Buffer, _IP, _Port, 0, _Verbose) -> + timeout; +query_udp(S, Id, Buffer, IP, Port, Timeout, Verbose) -> ?verbose(Verbose, "Try UDP server : ~p:~p (timeout=~w)\n", - [IP, Port, Timeout]), - udp_connect(S, IP, Port), - udp_send(S, IP, Port, Buffer), - query_udp_recv(S, IP, Port, Id, Timeout, Verbose). - -query_udp_recv(S, IP, Port, Id, Timeout, Verbose) -> - case udp_recv(S, IP, Port, Timeout) of - {ok,Answer,T} -> - case decode_answer(Answer, Id, Verbose) of - {error, badid} -> - query_udp_recv(S, IP, Port, Id, T, Verbose); - Reply -> Reply + [IP,Port,Timeout]), + case + case udp_connect(S, IP, Port) of + ok -> + udp_send(S, IP, Port, Buffer); + E1 -> + E1 end of + ok -> + Decode = + fun ({RecIP,RecPort,Answer}) + when RecIP =:= IP, RecPort =:= Port -> + case decode_answer(Answer, Id, Verbose) of + {error,badid} -> + false; + Reply -> + Reply + end; + ({_,_,_}) -> + false + end, + case udp_recv(S, IP, Port, Timeout, Decode) of + {ok,_}=Result -> + Result; + E2 -> + ?verbose(Verbose, "UDP server error: ~p\n", [E2]), + E2 end; - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "UDP server timeout\n", []), - timeout; - Error -> - ?verbose(Verbose, "UDP server error: ~p\n", [Error]), - Error + E3 -> + ?verbose(Verbose, "UDP send failed: ~p\n", [E3]), + {error,econnrefused} end. -query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) -> - Timeout = inet:timeout(Tm*5, Timer), +query_tcp(0, _Id, _Buffer, _IP, _Port, _Verbose) -> + timeout; +query_tcp(Timeout, Id, Buffer, IP, Port, Verbose) -> ?verbose(Verbose, "Try TCP server : ~p:~p (timeout=~w)\n", [IP, Port, Timeout]), Family = case IP of @@ -704,30 +922,28 @@ query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) -> [{active,false},{packet,2},binary,Family], Timeout) of {ok, S} -> - gen_tcp:send(S, Buffer), - case gen_tcp:recv(S, 0, Timeout) of - {ok, Answer} -> - gen_tcp:close(S), - case decode_answer(Answer, Id, Verbose) of - {ok, _} = OK -> OK; - {error, badid} -> {error, servfail}; - Error -> Error + case gen_tcp:send(S, Buffer) of + ok -> + case gen_tcp:recv(S, 0, Timeout) of + {ok, Answer} -> + gen_tcp:close(S), + case decode_answer(Answer, Id, Verbose) of + {ok, _} = OK -> OK; + {error, badid} -> {error, servfail}; + Error -> Error + end; + Error -> + gen_tcp:close(S), + ?verbose(Verbose, "TCP server recv error: ~p\n", + [Error]), + Error end; Error -> gen_tcp:close(S), - case Error of - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "TCP server recv timeout\n", []), - timeout; - _ -> - ?verbose(Verbose, "TCP server recv error: ~p\n", - [Error]), - Error - end + ?verbose(Verbose, "TCP server send error: ~p\n", + [Error]), + Error end; - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "TCP server connect timeout\n", []), - timeout; Error -> ?verbose(Verbose, "TCP server error: ~p\n", [Error]), Error @@ -842,5 +1058,9 @@ dns_msg(Msg) -> end. -compile({inline, [now_ms/2]}). -now_ms({Meg1,Sec1,Mic1}, {Meg0,Sec0,Mic0}) -> - ((Meg1-Meg0)*1000000 + (Sec1-Sec0))*1000 + ((Mic1-Mic0) div 1000). +now_ms(Int1, Int0) -> + Int1 - Int0. + +-compile({inline, [time_now/0]}). +time_now() -> + erlang:monotonic_time(1000). diff --git a/lib/kernel/src/inet_res.hrl b/lib/kernel/src/inet_res.hrl index bfaf32a1ba..774b4074a5 100644 --- a/lib/kernel/src/inet_res.hrl +++ b/lib/kernel/src/inet_res.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/kernel/src/inet_sctp.erl b/lib/kernel/src/inet_sctp.erl index 795bf83807..8569cacb29 100644 --- a/lib/kernel/src/inet_sctp.erl +++ b/lib/kernel/src/inet_sctp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,32 +30,28 @@ -include("inet_sctp.hrl"). -include("inet_int.hrl"). +-define(PROTO, sctp). -define(FAMILY, inet). -export([getserv/1,getaddr/1,getaddr/2,translate_ip/1]). --export([open/1,close/1,listen/2,connect/5,sendmsg/3,recv/2]). +-export([open/1,close/1,listen/2,peeloff/2,connect/5]). +-export([sendmsg/3,send/4,recv/2]). getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> - inet:getservbyname(Name, sctp); -getserv(_) -> - {error,einval}. - -getaddr(Address) -> - inet:getaddr(Address, ?FAMILY). -getaddr(Address, Timer) -> - inet:getaddr_tm(Address, ?FAMILY, Timer). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO); +getserv(_) -> {error,einval}. -translate_ip(IP) -> - inet:translate_ip(IP, ?FAMILY). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). open(Opts) -> case inet:sctp_options(Opts, ?MODULE) of - {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,opts=SOs}} -> - inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, ?MODULE); + {ok,#sctp_opts{fd=Fd,ifaddr=Addr,port=Port,type=Type,opts=SOs}} -> + inet:open(Fd, Addr, Port, SOs, ?PROTO, ?FAMILY, Type, ?MODULE); Error -> Error end. @@ -64,6 +61,14 @@ close(S) -> listen(S, Flag) -> prim_inet:listen(S, Flag). +peeloff(S, AssocId) -> + case prim_inet:peeloff(S, AssocId) of + {ok, NewS}=Result -> + inet_db:register_socket(NewS, ?MODULE), + Result; + Error -> Error + end. + %% A non-blocking connect is implemented when the initial call is to %% gen_sctp:connect_init which passes the value nowait as the Timer connect(S, Addr, Port, Opts, Timer) -> @@ -102,7 +107,7 @@ connect(S, Addr, Port, Opts, Timer) -> connect_get_assoc(S, Addr, Port, false, Timer) -> case recv(S, inet:timeout(Timer)) of - {ok, {Addr, Port, [], #sctp_assoc_change{state=St}=Ev}} -> + {ok, {Addr, Port, _, #sctp_assoc_change{state=St}=Ev}} -> if St =:= comm_up -> %% Yes, successfully connected, return the whole %% sctp_assoc_change event (containing, in particular, @@ -123,16 +128,19 @@ connect_get_assoc(S, Addr, Port, false, Timer) -> connect_get_assoc(S, Addr, Port, Active, Timer) -> Timeout = inet:timeout(Timer), receive - {sctp,S,Addr,Port,{[],#sctp_assoc_change{state=St}=Ev}} -> - case Active of - once -> - prim_inet:setopt(S, active, once); - _ -> ok - end, - if St =:= comm_up -> + {sctp,S,Addr,Port,{_,#sctp_assoc_change{state=St}=Ev}} -> + SetOptRes = + case Active of + once -> prim_inet:setopt(S, active, once); + _ -> ok + end, + case {St, SetOptRes} of + {comm_up, ok} -> {ok,Ev}; - true -> - {error,Ev} + {_, ok} -> + {error,Ev}; + {_, Error} -> + Error end after Timeout -> {error,timeout} @@ -141,5 +149,24 @@ connect_get_assoc(S, Addr, Port, Active, Timer) -> sendmsg(S, SRI, Data) -> prim_inet:sendmsg(S, SRI, Data). +send(S, AssocId, Stream, Data) -> + case prim_inet:getopts( + S, + [{sctp_default_send_param,#sctp_sndrcvinfo{assoc_id=AssocId}}]) of + {ok, + [{sctp_default_send_param, + #sctp_sndrcvinfo{ + flags=Flags, context=Context, ppid=PPID, timetolive=TTL}}]} -> + prim_inet:sendmsg( + S, + #sctp_sndrcvinfo{ + flags=Flags, context=Context, ppid=PPID, timetolive=TTL, + assoc_id=AssocId, stream=Stream}, + Data); + _ -> + prim_inet:sendmsg( + S, #sctp_sndrcvinfo{assoc_id=AssocId, stream=Stream}, Data) + end. + recv(S, Timeout) -> prim_inet:recvfrom(S, 0, Timeout). diff --git a/lib/kernel/src/inet_tcp.erl b/lib/kernel/src/inet_tcp.erl index 6dadccd6a9..dac6b3119d 100644 --- a/lib/kernel/src/inet_tcp.erl +++ b/lib/kernel/src/inet_tcp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -26,23 +27,45 @@ -export([controlling_process/2]). -export([fdopen/2]). +-export([family/0, mask/2, parse_address/1]). % inet_tcp_dist -export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). - +-export([translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet). +-define(PROTO, tcp). +-define(TYPE, stream). + +%% my address family +family() -> ?FAMILY. + +%% Apply netmask on address +mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4}. + +%% Parse address string +parse_address(Host) -> + inet_parse:ipv4strict_address(Host). + %% inet_tcp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,tcp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_tcp address lookup -getaddr(Address) -> inet:getaddr(Address, inet). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr_tm(Address, ?FAMILY, Timer). %% inet_tcp address lookup -getaddrs(Address) -> inet:getaddrs(Address, inet). -getaddrs(Address,Timer) -> inet:getaddrs_tm(Address,inet,Timer). - +getaddrs(Address) -> inet:getaddrs(Address, ?FAMILY). +getaddrs(Address, Timer) -> inet:getaddrs_tm(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). + %% %% Send data on a socket %% @@ -62,7 +85,7 @@ unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). %% shutdown(Socket, How) -> prim_inet:shutdown(Socket, How). - + %% %% Close a socket (async) %% @@ -73,7 +96,7 @@ close(Socket) -> %% Set controlling process %% controlling_process(Socket, NewOwner) -> - inet:tcp_controlling_process(Socket, NewOwner). + inet:tcp_controlling_process(Socket, NewOwner). %% %% Connect @@ -83,23 +106,28 @@ connect(Address, Port, Opts) -> connect(Address, Port, Opts, infinity) -> do_connect(Address, Port, Opts, infinity); -connect(Address, Port, Opts, Timeout) when is_integer(Timeout), - Timeout >= 0 -> +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> do_connect(Address, Port, Opts, Timeout). -do_connect({A,B,C,D}, Port, Opts, Time) when ?ip(A,B,C,D), ?port(Port) -> - case inet:connect_options(Opts, inet) of +do_connect(Addr = {A,B,C,D}, Port, Opts, Time) + when ?ip(A,B,C,D), ?port(Port) -> + case inet:connect_options(Opts, ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #connect_opts{fd=Fd, - ifaddr=BAddr={Ab,Bb,Cb,Db}, - port=BPort, - opts=SockOpts}} + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr = {Ab,Bb,Cb,Db}, + port = BPort, + opts = SockOpts}} when ?ip(Ab,Bb,Cb,Db), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> - case prim_inet:connect(S, {A,B,C,D}, Port, Time) of - ok -> {ok,S}; - Error -> prim_inet:close(S), Error + case prim_inet:connect(S, Addr, Port, Time) of + ok -> {ok,S}; + Error -> prim_inet:close(S), Error end; Error -> Error end; @@ -110,14 +138,18 @@ do_connect({A,B,C,D}, Port, Opts, Time) when ?ip(A,B,C,D), ?port(Port) -> %% Listen %% listen(Port, Opts) -> - case inet:listen_options([{port,Port} | Opts], inet) of - {error,Reason} -> exit(Reason); - {ok, #listen_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D}, - port=BPort, - opts=SockOpts}=R} + case inet:listen_options([{port,Port} | Opts], ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D}, + port = BPort, + opts = SockOpts} = R} when ?ip(A,B,C,D), ?port(BPort) -> - case inet:open(Fd,BAddr,BPort,SockOpts,tcp,inet,?MODULE) of + case inet:open( + Fd, BAddr, BPort, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of {ok, S} -> case prim_inet:listen(S, R#listen_opts.backlog) of ok -> {ok, S}; @@ -131,23 +163,24 @@ listen(Port, Opts) -> %% %% Accept %% -accept(L) -> +accept(L) -> case prim_inet:accept(L) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. - -accept(L,Timeout) -> - case prim_inet:accept(L,Timeout) of + +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of {ok, S} -> inet_db:register_socket(S, ?MODULE), {ok,S}; Error -> Error end. + %% %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, tcp, inet, ?MODULE). + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl index 7f935c2b36..8c8fe86811 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,9 +24,16 @@ -export([listen/1, accept/1, accept_connection/5, setup/5, close/1, select/1, is_node_name/1]). +%% Optional +-export([setopts/2, getopts/2]). + +%% Generalized dist API +-export([gen_listen/2, gen_accept/2, gen_accept_connection/6, + gen_setup/6, gen_select/2]). + %% internal exports --export([accept_loop/2,do_accept/6,do_setup/6,getstat/1,tick/1]). +-export([accept_loop/3,do_accept/7,do_setup/7,getstat/1,tick/2]). -import(error_logger,[error_msg/2]). @@ -33,15 +41,6 @@ --define(to_port(Socket, Data, Opts), - case inet_tcp:send(Socket, Data, Opts) of - {error, closed} -> - self() ! {tcp_closed, Socket}, - {error, closed}; - R -> - R - end). - -include("dist.hrl"). -include("dist_util.hrl"). @@ -52,8 +51,15 @@ %% ------------------------------------------------------------ select(Node) -> + gen_select(inet_tcp, Node). + +gen_select(Driver, Node) -> case split_node(atom_to_list(Node), $@, []) of - [_,_Host] -> true; + [_, Host] -> + case inet:getaddr(Host, Driver:family()) of + {ok,_} -> true; + _ -> false + end; _ -> false end. @@ -63,17 +69,25 @@ select(Node) -> %% ------------------------------------------------------------ listen(Name) -> - case do_listen([{active, false}, {packet,2}, {reuseaddr, true}]) of + gen_listen(inet_tcp, Name). + +gen_listen(Driver, Name) -> + case do_listen(Driver, [{active, false}, {packet,2}, {reuseaddr, true}]) of {ok, Socket} -> - TcpAddress = get_tcp_address(Socket), + TcpAddress = get_tcp_address(Driver, Socket), {_,Port} = TcpAddress#net_address.address, - {ok, Creation} = erl_epmd:register_node(Name, Port), - {ok, {Socket, TcpAddress, Creation}}; + ErlEpmd = net_kernel:epmd_module(), + case ErlEpmd:register_node(Name, Port, Driver) of + {ok, Creation} -> + {ok, {Socket, TcpAddress, Creation}}; + Error -> + Error + end; Error -> Error end. -do_listen(Options0) -> +do_listen(Driver, Options) -> {First,Last} = case application:get_env(kernel,inet_dist_listen_min) of {ok,N} when is_integer(N) -> case application:get_env(kernel, @@ -86,46 +100,59 @@ do_listen(Options0) -> _ -> {0,0} end, - Options = case application:get_env(kernel, inet_dist_use_interface) of - {ok, Ip} -> - [{ip, Ip} | Options0]; - _ -> - Options0 - end, - do_listen(First, Last, [{backlog,128}|Options]). - -do_listen(First,Last,_) when First > Last -> + do_listen(Driver, First, Last, listen_options([{backlog,128}|Options])). + +do_listen(_Driver, First,Last,_) when First > Last -> {error,eaddrinuse}; -do_listen(First,Last,Options) -> - case inet_tcp:listen(First, Options) of +do_listen(Driver, First,Last,Options) -> + case Driver:listen(First, Options) of {error, eaddrinuse} -> - do_listen(First+1,Last,Options); + do_listen(Driver, First+1,Last,Options); Other -> Other end. +listen_options(Opts0) -> + Opts1 = + case application:get_env(kernel, inet_dist_use_interface) of + {ok, Ip} -> + [{ip, Ip} | Opts0]; + _ -> + Opts0 + end, + case application:get_env(kernel, inet_dist_listen_options) of + {ok,ListenOpts} -> + ListenOpts ++ Opts1; + _ -> + Opts1 + end. + + %% ------------------------------------------------------------ %% Accepts new connection attempts from other Erlang nodes. %% ------------------------------------------------------------ accept(Listen) -> - spawn_opt(?MODULE, accept_loop, [self(), Listen], [link, {priority, max}]). + gen_accept(inet_tcp, Listen). + +gen_accept(Driver, Listen) -> + spawn_opt(?MODULE, accept_loop, [Driver, self(), Listen], [link, {priority, max}]). -accept_loop(Kernel, Listen) -> - case inet_tcp:accept(Listen) of +accept_loop(Driver, Kernel, Listen) -> + case Driver:accept(Listen) of {ok, Socket} -> - Kernel ! {accept,self(),Socket,inet,tcp}, - controller(Kernel, Socket), - accept_loop(Kernel, Listen); + Kernel ! {accept,self(),Socket,Driver:family(),tcp}, + _ = controller(Driver, Kernel, Socket), + accept_loop(Driver, Kernel, Listen); Error -> exit(Error) end. -controller(Kernel, Socket) -> +controller(Driver, Kernel, Socket) -> receive {Kernel, controller, Pid} -> flush_controller(Pid, Socket), - inet_tcp:controlling_process(Socket, Pid), + Driver:controlling_process(Socket, Pid), flush_controller(Pid, Socket), Pid ! {self(), controller}; {Kernel, unsupported_protocol} -> @@ -150,15 +177,18 @@ flush_controller(Pid, Socket) -> %% ------------------------------------------------------------ accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + gen_accept_connection(inet_tcp, AcceptPid, Socket, MyNode, Allowed, SetupTime). + +gen_accept_connection(Driver, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> spawn_opt(?MODULE, do_accept, - [self(), AcceptPid, Socket, MyNode, Allowed, SetupTime], + [Driver, self(), AcceptPid, Socket, MyNode, Allowed, SetupTime], [link, {priority, max}]). -do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> +do_accept(Driver, Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> receive {AcceptPid, controller} -> Timer = dist_util:start_timer(SetupTime), - case check_ip(Socket) of + case check_ip(Driver, Socket) of true -> HSData = #hs_data{ kernel_pid = Kernel, @@ -167,9 +197,8 @@ do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> timer = Timer, this_flags = 0, allowed = Allowed, - f_send = fun(S,D) -> inet_tcp:send(S,D) end, - f_recv = fun(S,N,T) -> inet_tcp:recv(S,N,T) - end, + f_send = fun Driver:send/2, + f_recv = fun Driver:recv/3, f_setopts_pre_nodeup = fun(S) -> inet:setopts(S, @@ -188,9 +217,11 @@ do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> f_getll = fun(S) -> inet:getll(S) end, - f_address = fun get_remote_id/2, - mf_tick = fun ?MODULE:tick/1, - mf_getstat = fun ?MODULE:getstat/1 + f_address = fun(S, Node) -> get_remote_id(Driver, S, Node) end, + mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end, + mf_getstat = fun ?MODULE:getstat/1, + mf_setopts = fun ?MODULE:setopts/2, + mf_getopts = fun ?MODULE:getopts/2 }, dist_util:handshake_other_started(HSData); {false,IP} -> @@ -215,18 +246,18 @@ nodelay() -> _ -> {nodelay, true} end. - + %% ------------------------------------------------------------ %% Get remote information about a Socket. %% ------------------------------------------------------------ -get_remote_id(Socket, Node) -> +get_remote_id(Driver, Socket, Node) -> case inet:peername(Socket) of {ok,Address} -> case split_node(atom_to_list(Node), $@, []) of [_,Host] -> #net_address{address=Address,host=Host, - protocol=tcp,family=inet}; + protocol=tcp,family=Driver:family()}; _ -> %% No '@' or more than one '@' in node name. ?shutdown(no_node) @@ -241,24 +272,31 @@ get_remote_id(Socket, Node) -> %% ------------------------------------------------------------ setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> + gen_setup(inet_tcp, Node, Type, MyNode, LongOrShortNames, SetupTime). + +gen_setup(Driver, Node, Type, MyNode, LongOrShortNames, SetupTime) -> spawn_opt(?MODULE, do_setup, - [self(), Node, Type, MyNode, LongOrShortNames, SetupTime], + [Driver, self(), Node, Type, MyNode, LongOrShortNames, SetupTime], [link, {priority, max}]). -do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> +do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> ?trace("~p~n",[{inet_tcp_dist,self(),setup,Node}]), - [Name, Address] = splitnode(Node, LongOrShortNames), - case inet:getaddr(Address, inet) of + [Name, Address] = splitnode(Driver, Node, LongOrShortNames), + AddressFamily = Driver:family(), + case inet:getaddr(Address, AddressFamily) of {ok, Ip} -> Timer = dist_util:start_timer(SetupTime), - case erl_epmd:port_please(Name, Ip) of + ErlEpmd = net_kernel:epmd_module(), + case ErlEpmd:port_please(Name, Ip) of {port, TcpPort, Version} -> ?trace("port_please(~p) -> version ~p~n", [Node,Version]), dist_util:reset_timer(Timer), - case inet_tcp:connect(Ip, TcpPort, - [{active, false}, - {packet,2}]) of + case + Driver:connect( + Ip, TcpPort, + connect_options([{active, false}, {packet, 2}])) + of {ok, Socket} -> HSData = #hs_data{ kernel_pid = Kernel, @@ -268,8 +306,8 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> timer = Timer, this_flags = 0, other_version = Version, - f_send = fun inet_tcp:send/2, - f_recv = fun inet_tcp:recv/3, + f_send = fun Driver:send/2, + f_recv = fun Driver:recv/3, f_setopts_pre_nodeup = fun(S) -> inet:setopts @@ -287,6 +325,7 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> {packet, 4}, nodelay()]) end, + f_getll = fun inet:getll/1, f_address = fun(_,_) -> @@ -294,11 +333,13 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> address = {Ip,TcpPort}, host = Address, protocol = tcp, - family = inet} + family = AddressFamily} end, - mf_tick = fun ?MODULE:tick/1, + mf_tick = fun(S) -> ?MODULE:tick(Driver, S) end, mf_getstat = fun ?MODULE:getstat/1, - request_type = Type + request_type = Type, + mf_setopts = fun ?MODULE:setopts/2, + mf_getopts = fun ?MODULE:getopts/2 }, dist_util:handshake_we_started(HSData); _ -> @@ -320,6 +361,14 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> ?shutdown(Node) end. +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + ConnectOpts ++ Opts; + _ -> + Opts + end. + %% %% Close a socket. %% @@ -328,18 +377,23 @@ close(Socket) -> %% If Node is illegal terminate the connection setup!! -splitnode(Node, LongOrShortNames) -> +splitnode(Driver, Node, LongOrShortNames) -> case split_node(atom_to_list(Node), $@, []) of [Name|Tail] when Tail =/= [] -> Host = lists:append(Tail), case split_node(Host, $., []) of [_] when LongOrShortNames =:= longnames -> - error_msg("** System running to use " - "fully qualified " - "hostnames **~n" - "** Hostname ~s is illegal **~n", - [Host]), - ?shutdown(Node); + case Driver:parse_address(Host) of + {ok, _} -> + [Name, Host]; + _ -> + error_msg("** System running to use " + "fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node) + end; L when length(L) > 1, LongOrShortNames =:= shortnames -> error_msg("** System NOT running to use fully qualified " "hostnames **~n" @@ -365,26 +419,26 @@ split_node([], _, Ack) -> [lists:reverse(Ack)]. %% ------------------------------------------------------------ %% Fetch local information about a Socket. %% ------------------------------------------------------------ -get_tcp_address(Socket) -> +get_tcp_address(Driver, Socket) -> {ok, Address} = inet:sockname(Socket), {ok, Host} = inet:gethostname(), #net_address { address = Address, host = Host, protocol = tcp, - family = inet + family = Driver:family() }. %% ------------------------------------------------------------ %% Do only accept new connection attempts from nodes at our %% own LAN, if the check_ip environment parameter is true. %% ------------------------------------------------------------ -check_ip(Socket) -> +check_ip(Driver, Socket) -> case application:get_env(check_ip) of {ok, true} -> case get_ifs(Socket) of {ok, IFs, IP} -> - check_ip(IFs, IP); + check_ip(Driver, IFs, IP); _ -> ?shutdown(no_node) end; @@ -403,20 +457,14 @@ get_ifs(Socket) -> Error end. -check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> - case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of +check_ip(Driver, [{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {Driver:mask(Netmask, PeerIP), Driver:mask(Netmask, OwnIP)} of {M, M} -> true; - _ -> check_ip(IFs, PeerIP) + _ -> check_ip(Driver, IFs, PeerIP) end; -check_ip([], PeerIP) -> +check_ip(_Driver, [], PeerIP) -> {false, PeerIP}. -mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> - {M1 band IP1, - M2 band IP2, - M3 band IP3, - M4 band IP4}. - is_node_name(Node) when is_atom(Node) -> case split_node(atom_to_list(Node), $@, []) of [_, _Host] -> true; @@ -425,8 +473,14 @@ is_node_name(Node) when is_atom(Node) -> is_node_name(_Node) -> false. -tick(Sock) -> - ?to_port(Sock,[],[force]). +tick(Driver, Socket) -> + case Driver:send(Socket, [], [force]) of + {error, closed} -> + self() ! {tcp_closed, Socket}, + {error, closed}; + R -> + R + end. getstat(Socket) -> case inet:getstat(Socket, [recv_cnt, send_cnt, send_pend]) of @@ -446,3 +500,12 @@ split_stat([], R, W, P) -> {ok, R, W, P}. +setopts(S, Opts) -> + case [Opt || {K,_}=Opt <- Opts, + K =:= active orelse K =:= deliver orelse K =:= packet] of + [] -> inet:setopts(S,Opts); + Opts1 -> {error, {badopts,Opts1}} + end. + +getopts(S, Opts) -> + inet:getopts(S, Opts). diff --git a/lib/kernel/src/inet_udp.erl b/lib/kernel/src/inet_udp.erl index 9a4089ab19..8a8aa8ecca 100644 --- a/lib/kernel/src/inet_udp.erl +++ b/lib/kernel/src/inet_udp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,52 +24,66 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([getserv/1, getaddr/1, getaddr/2]). +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). -include("inet_int.hrl"). +-define(FAMILY, inet). +-define(PROTO, udp). +-define(TYPE, dgram). -define(RECBUF, (8*1024)). - %% inet_udp port lookup getserv(Port) when is_integer(Port) -> {ok, Port}; -getserv(Name) when is_atom(Name) -> inet:getservbyname(Name,udp). +getserv(Name) when is_atom(Name) -> inet:getservbyname(Name, ?PROTO). %% inet_udp address lookup -getaddr(Address) -> inet:getaddr(Address, inet). -getaddr(Address,Timer) -> inet:getaddr_tm(Address, inet, Timer). +getaddr(Address) -> inet:getaddr(Address, ?FAMILY). +getaddr(Address, Timer) -> inet:getaddr(Address, ?FAMILY, Timer). + +%% inet_udp special this side addresses +translate_ip(IP) -> inet:translate_ip(IP, ?FAMILY). +-spec open(_) -> {ok, inet:socket()} | {error, atom()}. open(Port) -> open(Port, []). +-spec open(_, _) -> {ok, inet:socket()} | {error, atom()}. open(Port, Opts) -> case inet:udp_options( [{port,Port}, {recbuf, ?RECBUF} | Opts], - inet) of + ?MODULE) of {error, Reason} -> exit(Reason); - {ok, #udp_opts{fd=Fd, - ifaddr=BAddr={A,B,C,D}, - port=BPort, - opts=SockOpts}} when ?ip(A,B,C,D), ?port(BPort) -> - inet:open(Fd,BAddr,BPort,SockOpts,udp,inet,?MODULE); + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr = {A,B,C,D}, + port = BPort, + opts = SockOpts}} + when ?ip(A,B,C,D), ?port(BPort) -> + inet:open( + Fd, BAddr, BPort, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); {ok, _} -> exit(badarg) end. -send(S,{A,B,C,D},P,Data) when ?ip(A,B,C,D), ?port(P) -> - prim_inet:sendto(S, {A,B,C,D}, P, Data). +send(S, {A,B,C,D} = Addr, P, Data) + when ?ip(A,B,C,D), ?port(P) -> + prim_inet:sendto(S, Addr, P, Data). send(S, Data) -> prim_inet:sendto(S, {0,0,0,0}, 0, Data). -connect(S, {A,B,C,D}, P) when ?ip(A,B,C,D), ?port(P) -> - prim_inet:connect(S, {A,B,C,D}, P). +connect(S, Addr = {A,B,C,D}, P) + when ?ip(A,B,C,D), ?port(P) -> + prim_inet:connect(S, Addr, P). -recv(S,Len) -> +recv(S, Len) -> prim_inet:recvfrom(S, Len). -recv(S,Len,Time) -> +recv(S, Len, Time) -> prim_inet:recvfrom(S, Len, Time). +-spec close(inet:socket()) -> ok. close(S) -> inet:udp_close(S). @@ -87,9 +102,9 @@ controlling_process(Socket, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, - optuniquify([{recbuf, ?RECBUF} | Opts]), - udp, inet, ?MODULE). + inet:fdopen( + Fd, optuniquify([{recbuf, ?RECBUF} | Opts]), + ?PROTO, ?FAMILY, ?TYPE, ?MODULE). %% Remove all duplicate options from an option list. diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index 17ab84c177..d184223524 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -28,7 +29,6 @@ application_starter, auth, code, - packages, code_server, dist_util, erl_boot_server, @@ -55,6 +55,8 @@ inet_tcp_dist, kernel, kernel_config, + local_tcp, + local_udp, net, net_adm, net_kernel, @@ -115,6 +117,7 @@ pg2]}, {applications, []}, {env, [{error_logger, tty}]}, - {mod, {kernel, []}} + {mod, {kernel, []}}, + {runtime_dependencies, ["erts-8.1", "stdlib-3.0", "sasl-3.0"]} ] }. diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index 54a63833e6..82cf73cbda 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -1 +1,26 @@ -{"%VSN%",[],[]}. +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +{"%VSN%", + %% Up from - max one major revision back + [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + {<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* + %% Down to - max one major revision back + [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + {<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* +}. diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl index 92ee7b441a..3d0ef81318 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -32,8 +33,13 @@ start(_, []) -> case supervisor:start_link({local, kernel_sup}, kernel, []) of {ok, Pid} -> Type = get_error_logger_type(), - error_logger:swap_handler(Type), - {ok, Pid, []}; + case error_logger:swap_handler(Type) of + ok -> {ok, Pid, []}; + Error -> + %% Not necessary since the node will crash anyway: + exit(Pid, shutdown), + Error + end; Error -> Error end. @@ -92,7 +98,7 @@ init([]) -> {kernel_config, start_link, []}, permanent, 2000, worker, [kernel_config]}, Code = {code_server, - {code, start_link, get_code_args()}, + {code, start_link, []}, permanent, 2000, worker, [code]}, File = {file_server_2, {file_server, start_link, []}, @@ -112,7 +118,7 @@ init([]) -> [{local, kernel_safe_sup}, ?MODULE, safe]}, permanent, infinity, supervisor, [?MODULE]}, {ok, {SupFlags, - [File, Code, StdError, User, + [Code, File, StdError, User, Config, SafeSupervisor]}}; _ -> Rpc = {rex, {rpc, start_link, []}, @@ -134,8 +140,8 @@ init([]) -> [{local, kernel_safe_sup}, ?MODULE, safe]}, permanent, infinity, supervisor, [?MODULE]}, {ok, {SupFlags, - [Rpc, Global, InetDb | DistAC] ++ - [NetSup, Glo_grp, File, Code, + [Code, Rpc, Global, InetDb | DistAC] ++ + [NetSup, Glo_grp, File, StdError, User, Config, SafeSupervisor] ++ Timer}} end; init(safe) -> @@ -143,13 +149,14 @@ init(safe) -> Boot = start_boot_server(), DiskLog = start_disk_log(), Pg2 = start_pg2(), - {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. -get_code_args() -> - case init:get_argument(nostick) of - {ok, [[]]} -> [[nostick]]; - _ -> [] - end. + %% Run the on_load handlers for all modules that have been + %% loaded so far. Running them at this point means that + %% on_load handlers can safely call kernel processes + %% (and in particular call code:priv_dir/1 or code:lib_dir/1). + init:run_on_load_handlers(), + + {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. start_dist_ac() -> Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}], diff --git a/lib/kernel/src/kernel_config.erl b/lib/kernel/src/kernel_config.erl index e5e9a0498d..535083ef27 100644 --- a/lib/kernel/src/kernel_config.erl +++ b/lib/kernel/src/kernel_config.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(kernel_config). @@ -40,6 +41,9 @@ start_link() -> gen_server:start_link(kernel_config, [], []). %%----------------------------------------------------------------- %% Callback functions from gen_server %%----------------------------------------------------------------- + +-spec init([]) -> {'ok', []} | {'stop', term()}. + init([]) -> process_flag(trap_exit, true), case sync_nodes() of @@ -59,18 +63,28 @@ init([]) -> {stop, Error} end. +-spec handle_info(term(), State) -> {'noreply', State}. + handle_info(_, State) -> {noreply, State}. +-spec terminate(term(), term()) -> 'ok'. + terminate(_Reason, _State) -> ok. +-spec handle_call(term(), term(), State) -> {'reply', 'ok', State}. + handle_call('__not_used', _From, State) -> {reply, ok, State}. +-spec handle_cast(term(), State) -> {'noreply', State}. + handle_cast('__not_used', State) -> {noreply, State}. +-spec code_change(term(), State, term()) -> {'ok', State}. + code_change(_OldVsn, State, _Extra) -> {ok, State}. @@ -79,9 +93,9 @@ code_change(_OldVsn, State, _Extra) -> %%----------------------------------------------------------------- sync_nodes() -> case catch get_sync_data() of - {error, Reason} -> - error_logger:format("~p", [Reason]), - {error, Reason}; + {error, Reason} = Error -> + error_logger:format("~tp", [Reason]), + Error; {infinity, MandatoryNodes, OptionalNodes} -> case wait_nodes(MandatoryNodes, OptionalNodes) of ok -> @@ -108,7 +122,7 @@ send_timeout(Timeout, Pid) -> end. wait_nodes(Mandatory, Optional) -> - net_kernel:monitor_nodes(true), + ok = net_kernel:monitor_nodes(true), lists:foreach(fun(Node) -> case net_adm:ping(Node) of pong -> self() ! {nodeup, Node}; @@ -116,7 +130,9 @@ wait_nodes(Mandatory, Optional) -> end end, Mandatory ++ Optional), - rec_nodes(Mandatory, Optional). + R = rec_nodes(Mandatory, Optional), + ok = net_kernel:monitor_nodes(false), + R. rec_nodes([], []) -> ok; rec_nodes(Mandatory, Optional) -> diff --git a/lib/kernel/src/local_tcp.erl b/lib/kernel/src/local_tcp.erl new file mode 100644 index 0000000000..90e0fa2162 --- /dev/null +++ b/lib/kernel/src/local_tcp.erl @@ -0,0 +1,178 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(local_tcp). + +%% Socket server for TCP/IP + +-export([connect/3, connect/4, listen/2, accept/1, accept/2, close/1]). +-export([send/2, send/3, recv/2, recv/3, unrecv/2]). +-export([shutdown/2]). +-export([controlling_process/2]). +-export([fdopen/2]). + +-export([getserv/1, getaddr/1, getaddr/2, getaddrs/1, getaddrs/2]). +-export([translate_ip/1]). + +-include("inet_int.hrl"). + +-define(FAMILY, local). +-define(PROTO, tcp). +-define(TYPE, stream). + +%% port lookup +getserv(0) -> {ok, 0}. + +%% no address lookup +getaddr({?FAMILY, _} = Address) -> {ok, Address}. +getaddr({?FAMILY, _} = Address, _Timer) -> {ok, Address}. + +%% no address lookup +getaddrs({?FAMILY, _} = Address) -> {ok, [Address]}. +getaddrs({?FAMILY, _} = Address, _Timer) -> {ok, [Address]}. + +%% special this side addresses +translate_ip(IP) -> IP. + +%% +%% Send data on a socket +%% +send(Socket, Packet, Opts) -> prim_inet:send(Socket, Packet, Opts). +send(Socket, Packet) -> prim_inet:send(Socket, Packet, []). + +%% +%% Receive data from a socket (inactive only) +%% +recv(Socket, Length) -> prim_inet:recv(Socket, Length). +recv(Socket, Length, Timeout) -> prim_inet:recv(Socket, Length, Timeout). + +unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). + +%% +%% Shutdown one end of a socket +%% +shutdown(Socket, How) -> + prim_inet:shutdown(Socket, How). + +%% +%% Close a socket (async) +%% +close(Socket) -> + inet:tcp_close(Socket). + +%% +%% Set controlling process +%% FIXME: move messages to new owner!!! +%% +controlling_process(Socket, NewOwner) -> + inet:tcp_controlling_process(Socket, NewOwner). + +%% +%% Connect +%% +connect(Address, Port, Opts) -> + do_connect(Address, Port, Opts, infinity). +%% +connect(Address, Port, Opts, infinity) -> + do_connect(Address, Port, Opts, infinity); +connect(Address, Port, Opts, Timeout) + when is_integer(Timeout), Timeout >= 0 -> + do_connect(Address, Port, Opts, Timeout). + +do_connect(Addr = {?FAMILY, _}, 0, Opts, Time) -> + case inet:connect_options(Opts, ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #connect_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts}} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + case inet:open( + Fd, + case BAddr of + any -> + undefined; + _ -> + BAddr + end, + 0, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of + {ok, S} -> + case prim_inet:connect(S, Addr, 0, Time) of + ok -> {ok,S}; + Error -> prim_inet:close(S), Error + end; + Error -> Error + end; + {ok, _} -> exit(badarg) + end. + +%% +%% Listen +%% +listen(0, Opts) -> + case inet:listen_options([{port,0} | Opts], ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #listen_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts} = R} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + case inet:open( + Fd, BAddr, 0, SockOpts, + ?PROTO, ?FAMILY, ?TYPE, ?MODULE) of + {ok, S} -> + case prim_inet:listen(S, R#listen_opts.backlog) of + ok -> {ok, S}; + Error -> prim_inet:close(S), Error + end; + Error -> Error + end; + {ok, _} -> exit(badarg) + end. + +%% +%% Accept +%% +accept(L) -> + case prim_inet:accept(L) of + {ok, S} -> + inet_db:register_socket(S, ?MODULE), + {ok,S}; + Error -> Error + end. +%% +accept(L, Timeout) -> + case prim_inet:accept(L, Timeout) of + {ok, S} -> + inet_db:register_socket(S, ?MODULE), + {ok,S}; + Error -> Error + end. + +%% +%% Create a port/socket from a file descriptor +%% +fdopen(Fd, Opts) -> + inet:open(Fd, undefined, 0, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/local_udp.erl b/lib/kernel/src/local_udp.erl new file mode 100644 index 0000000000..481a8c4910 --- /dev/null +++ b/lib/kernel/src/local_udp.erl @@ -0,0 +1,106 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(local_udp). + +-export([open/1, open/2, close/1]). +-export([send/2, send/4, recv/2, recv/3, connect/3]). +-export([controlling_process/2]). +-export([fdopen/2]). + +-export([getserv/1, getaddr/1, getaddr/2, translate_ip/1]). + +-include("inet_int.hrl"). + +-define(FAMILY, local). +-define(PROTO, udp). +-define(TYPE, dgram). + + +%% port lookup +getserv(0) -> {ok, 0}. + +%% no address lookup +getaddr({?FAMILY, _} = Address) -> {ok, Address}. +getaddr({?FAMILY, _} = Address, _Timer) -> {ok, Address}. + +%% special this side addresses +translate_ip(IP) -> IP. + +open(0) -> open(0, []). +%% +open(0, Opts) -> + case inet:udp_options( + [{port,0} | Opts], + ?MODULE) of + {error, Reason} -> exit(Reason); + {ok, + #udp_opts{ + fd = Fd, + ifaddr = BAddr, + port = 0, + opts = SockOpts}} + when tuple_size(BAddr) =:= 2, element(1, BAddr) =:= ?FAMILY; + BAddr =:= any -> + inet:open( + Fd, + case BAddr of + any -> + undefined; + _ -> + BAddr + end, + 0, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); + {ok, _} -> exit(badarg) + end. + +send(S, Addr = {?FAMILY,_}, 0, Data) -> + prim_inet:sendto(S, Addr, 0, Data). +%% +send(S, Data) -> + prim_inet:sendto(S, {?FAMILY,<<>>}, 0, Data). + +connect(S, Addr = {?FAMILY,_}, 0) -> + prim_inet:connect(S, Addr, 0). + +recv(S, Len) -> + prim_inet:recvfrom(S, Len). +%% +recv(S, Len, Time) -> + prim_inet:recvfrom(S, Len, Time). + +close(S) -> + inet:udp_close(S). + +%% +%% Set controlling process: +%% 1) First sync socket into a known state +%% 2) Move all messages onto the new owners message queue +%% 3) Commit the owner +%% 4) Wait for ack of new Owner (since socket does some link and unlink) +%% + +controlling_process(Socket, NewOwner) -> + inet:udp_controlling_process(Socket, NewOwner). + +%% +%% Create a port/socket from a file descriptor +%% +fdopen(Fd, Opts) -> + inet:fdopen(Fd, Opts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE). diff --git a/lib/kernel/src/net.erl b/lib/kernel/src/net.erl index e8f4b6ba26..2d0ae2ed0c 100644 --- a/lib/kernel/src/net.erl +++ b/lib/kernel/src/net.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/kernel/src/net_address.hrl b/lib/kernel/src/net_address.hrl deleted file mode 100644 index 5342076507..0000000000 --- a/lib/kernel/src/net_address.hrl +++ /dev/null @@ -1,28 +0,0 @@ -%% -%% %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% -%% - -%% Generic address format - --record(net_address, - { - address, %% opaque address - host, %% host name - protocol, %% protocol - family %% address family - }). diff --git a/lib/kernel/src/net_adm.erl b/lib/kernel/src/net_adm.erl index 737b1ecee9..8ec275b88b 100644 --- a/lib/kernel/src/net_adm.erl +++ b/lib/kernel/src/net_adm.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -35,7 +36,11 @@ %% Try to read .hosts.erlang file in %% 1. cwd , 2. $HOME 3. init:root_dir() --spec host_file() -> [atom()] | {'error',atom() | {integer(),atom(),_}}. +-spec host_file() -> Hosts | {error, Reason} when + Hosts :: [Host :: atom()], + %% Copied from file:path_consult/2: + Reason :: file:posix() | badarg | terminated | system_limit + | {Line :: integer(), Mod :: module(), Term :: term()}. host_file() -> Home = case init:get_argument(home) of @@ -50,7 +55,8 @@ host_file() -> %% Check whether a node is up or down %% side effect: set up a connection to Node if there not yet is one. --spec ping(atom()) -> 'pang' | 'pong'. +-spec ping(Node) -> pong | pang when + Node :: atom(). ping(Node) when is_atom(Node) -> case catch gen:call({net_kernel, Node}, @@ -63,7 +69,8 @@ ping(Node) when is_atom(Node) -> pang end. --spec localhost() -> string(). +-spec localhost() -> Name when + Name :: string(). localhost() -> {ok, Host} = inet:gethostname(), @@ -73,23 +80,28 @@ localhost() -> end. --spec names() -> {'ok', [{string(), integer()}]} | {'error', _}. +-spec names() -> {ok, [{Name, Port}]} | {error, Reason} when + Name :: string(), + Port :: non_neg_integer(), + Reason :: address | file:posix(). names() -> names(localhost()). --spec names(atom() | string()) -> {'ok', [{string(), integer()}]} | {'error', _}. + +-spec names(Host) -> {ok, [{Name, Port}]} | {error, Reason} when + Host :: atom() | string() | inet:ip_address(), + Name :: string(), + Port :: non_neg_integer(), + Reason :: address | file:posix(). names(Hostname) -> - case inet:gethostbyname(Hostname) of - {ok, {hostent, _Name, _ , _Af, _Size, [Addr | _]}} -> - erl_epmd:names(Addr); - Else -> - Else - end. + ErlEpmd = net_kernel:epmd_module(), + ErlEpmd:names(Hostname). --spec dns_hostname(atom() | string()) -> - {'ok', string()} | {'error', atom() | string()}. +-spec dns_hostname(Host) -> {ok, Name} | {error, Host} when + Host :: atom() | string(), + Name :: string(). dns_hostname(Hostname) -> case inet:gethostbyname(Hostname) of @@ -118,7 +130,7 @@ dns_hostname(Hostname) -> -spec ping_list([atom()]) -> [atom()]. ping_list(Nodelist) -> - net_kernel:monitor_nodes(true), + ok = net_kernel:monitor_nodes(true), Sofar = ping_first(Nodelist, nodes()), collect_new(Sofar, Nodelist). @@ -144,7 +156,7 @@ collect_new(Sofar, Nodelist) -> collect_new([Node | Sofar], Nodelist) end after 3000 -> - net_kernel:monitor_nodes(false), + ok = net_kernel:monitor_nodes(false), Sofar end. @@ -164,7 +176,8 @@ collect_new(Sofar, Nodelist) -> world() -> world(silent). --spec world(verbosity()) -> [node()]. +-spec world(Arg) -> [node()] when + Arg :: verbosity(). world(Verbose) -> case net_adm:host_file() of @@ -172,12 +185,15 @@ world(Verbose) -> Hosts -> expand_hosts(Hosts, Verbose) end. --spec world_list([atom()]) -> [node()]. +-spec world_list(Hosts) -> [node()] when + Hosts :: [atom()]. world_list(Hosts) when is_list(Hosts) -> expand_hosts(Hosts, silent). --spec world_list([atom()], verbosity()) -> [node()]. +-spec world_list(Hosts, Arg) -> [node()] when + Hosts :: [atom()], + Arg :: verbosity(). world_list(Hosts, Verbose) when is_list(Hosts) -> expand_hosts(Hosts, Verbose). diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 9875044844..0c679e7349 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -52,18 +53,27 @@ -define(tckr_dbg(X), ok). -endif. -%% User Interface Exports --export([start/1, start_link/1, stop/0, - kernel_apply/3, +%% Documented API functions. + +-export([allow/1, + connect_node/1, monitor_nodes/1, monitor_nodes/2, + setopts/2, + getopts/2, + start/1, + stop/0]). + +%% Exports for internal use. + +-export([start_link/2, + kernel_apply/3, longnames/0, - allow/1, protocol_childspecs/0, epmd_module/0]). -export([connect/1, disconnect/1, hidden_connect/1, passive_cnct/1]). --export([connect_node/1, hidden_connect_node/1]). %% explicit connect +-export([hidden_connect_node/1]). %% explicit connect -export([set_net_ticktime/1, set_net_ticktime/2, get_net_ticktime/0]). -export([node_info/1, node_info/2, nodes_info/0, @@ -72,7 +82,8 @@ -export([publish_on_node/1, update_publish_nodes/1]). -%% Internal Exports +%% Internal exports for spawning processes. + -export([do_spawn/3, spawn_func/6, ticker/2, @@ -94,7 +105,7 @@ connecttime, %% the connection setuptime. connections, %% table of connections conn_owners = [], %% List of connection owner pids, - pend_owners = [], %% List of potential owners + pend_owners = [], %% List of potential owners listen, %% list of #listen allowed, %% list of allowed nodes in a restricted system verbose = 0, %% level of verboseness @@ -102,7 +113,7 @@ }). -record(listen, { - listen, %% listen pid + listen, %% listen socket accept, %% accepting pid address, %% #net_address module %% proto module @@ -142,11 +153,29 @@ -include("net_address.hrl"). +%%% BIF + +-export([dflag_unicode_io/1]). + +-spec dflag_unicode_io(pid()) -> boolean(). + +dflag_unicode_io(_) -> + erlang:nif_error(undef). + +%%% End of BIF + %% Interface functions kernel_apply(M,F,A) -> request({apply,M,F,A}). + +-spec allow(Nodes) -> ok | error when + Nodes :: [node()]. allow(Nodes) -> request({allow, Nodes}). + longnames() -> request(longnames). + +-spec stop() -> ok | {error, Reason} when + Reason :: not_allowed | not_found. stop() -> erl_distribution:stop(). node_info(Node) -> get_node_info(Node). @@ -158,10 +187,28 @@ i(Node) -> print_info(Node). verbose(Level) when is_integer(Level) -> request({verbose, Level}). +-spec set_net_ticktime(NetTicktime, TransitionPeriod) -> Res when + NetTicktime :: pos_integer(), + TransitionPeriod :: non_neg_integer(), + Res :: unchanged + | change_initiated + | {ongoing_change_to, NewNetTicktime}, + NewNetTicktime :: pos_integer(). set_net_ticktime(T, TP) when is_integer(T), T > 0, is_integer(TP), TP >= 0 -> ticktime_res(request({new_ticktime, T*250, TP*1000})). + +-spec set_net_ticktime(NetTicktime) -> Res when + NetTicktime :: pos_integer(), + Res :: unchanged + | change_initiated + | {ongoing_change_to, NewNetTicktime}, + NewNetTicktime :: pos_integer(). set_net_ticktime(T) when is_integer(T) -> set_net_ticktime(T, ?DEFAULT_TRANSITION_PERIOD). + +-spec get_net_ticktime() -> Res when + Res :: NetTicktime | {ongoing_change_to, NetTicktime} | ignored, + NetTicktime :: pos_integer(). get_net_ticktime() -> ticktime_res(request(ticktime)). @@ -171,6 +218,9 @@ get_net_ticktime() -> %% flags (we may want to move it elsewhere later). In order to easily %% be backward compatible, errors are created here when process_flag() %% fails. +-spec monitor_nodes(Flag) -> ok | Error when + Flag :: boolean(), + Error :: error | {error, term()}. monitor_nodes(Flag) -> case catch process_flag(monitor_nodes, Flag) of true -> ok; @@ -178,6 +228,13 @@ monitor_nodes(Flag) -> _ -> mk_monitor_nodes_error(Flag, []) end. +-spec monitor_nodes(Flag, Options) -> ok | Error when + Flag :: boolean(), + Options :: [Option], + Option :: {node_type, NodeType} + | nodedown_reason, + NodeType :: visible | hidden | all, + Error :: error | {error, term()}. monitor_nodes(Flag, Opts) -> case catch process_flag({monitor_nodes, Opts}, Flag) of true -> ok; @@ -209,6 +266,8 @@ publish_on_node(Node) when is_atom(Node) -> update_publish_nodes(Ns) -> request({update_publish_nodes, Ns}). +-spec connect_node(Node) -> boolean() | ignored when + Node :: node(). %% explicit connects connect_node(Node) when is_atom(Node) -> request({connect, normal, Node}). @@ -232,7 +291,7 @@ do_connect(Node, Type, WaitForBarred) -> %% Type = normal | hidden %% "connected from other end.~n",[Node]), true; {Pid, false} -> - ?connect_failure(Node,{barred_connection, + ?connect_failure(Node,{barred_connection, ets:lookup(sys_dist, Node)}), %%io:format("Net Kernel: barred connection (~p) " %% "- failure.~n",[Node]), @@ -244,12 +303,12 @@ do_connect(Node, Type, WaitForBarred) -> %% Type = normal | hidden {ok, never} -> ?connect_failure(Node,{dist_auto_connect,never}), false; - % This might happen due to connection close + % This might happen due to connection close % not beeing propagated to user space yet. - % Save the day by just not connecting... + % Save the day by just not connecting... {ok, once} when Else =/= [], (hd(Else))#connection.state =:= up -> - ?connect_failure(Node,{barred_connection, + ?connect_failure(Node,{barred_connection, ets:lookup(sys_dist, Node)}), false; _ -> @@ -258,26 +317,26 @@ do_connect(Node, Type, WaitForBarred) -> %% Type = normal | hidden end. passive_connect_monitor(Parent, Node) -> - monitor_nodes(true,[{node_type,all}]), + ok = monitor_nodes(true,[{node_type,all}]), case lists:member(Node,nodes([connected])) of true -> - monitor_nodes(false,[{node_type,all}]), + ok = monitor_nodes(false,[{node_type,all}]), Parent ! {self(),true}; _ -> Ref = make_ref(), Tref = erlang:send_after(connecttime(),self(),Ref), receive Ref -> - monitor_nodes(false,[{node_type,all}]), + ok = monitor_nodes(false,[{node_type,all}]), Parent ! {self(), false}; {nodeup,Node,_} -> - monitor_nodes(false,[{node_type,all}]), - erlang:cancel_timer(Tref), + ok = monitor_nodes(false,[{node_type,all}]), + _ = erlang:cancel_timer(Tref), Parent ! {self(),true} end end. - -%% If the net_kernel isn't running we ignore all requests to the + +%% If the net_kernel isn't running we ignore all requests to the %% kernel, thus basically accepting them :-) request(Req) -> case whereis(net_kernel) of @@ -292,18 +351,18 @@ request(Req) -> start(Args) -> erl_distribution:start(Args). -%% This is the main startup routine for net_kernel -%% The defaults are longnames and a ticktime of 15 secs to the tcp_drv. +%% This is the main startup routine for net_kernel (only for internal +%% use by the Kernel application. -start_link([Name]) -> - start_link([Name, longnames]); +start_link([Name], CleanHalt) -> + start_link([Name, longnames], CleanHalt); +start_link([Name, LongOrShortNames], CleanHalt) -> + start_link([Name, LongOrShortNames, 15000], CleanHalt); -start_link([Name, LongOrShortNames]) -> - start_link([Name, LongOrShortNames, 15000]); - -start_link([Name, LongOrShortNames, Ticktime]) -> - case gen_server:start_link({local, net_kernel}, net_kernel, - {Name, LongOrShortNames, Ticktime}, []) of +start_link([Name, LongOrShortNames, Ticktime], CleanHalt) -> + Args = {Name, LongOrShortNames, Ticktime, CleanHalt}, + case gen_server:start_link({local, net_kernel}, ?MODULE, + Args, []) of {ok, Pid} -> {ok, Pid}; {error, {already_started, Pid}} -> @@ -312,34 +371,26 @@ start_link([Name, LongOrShortNames, Ticktime]) -> exit(nodistribution) end. -%% auth:get_cookie should only be able to return an atom -%% tuple cookies are unknowns - -init({Name, LongOrShortNames, TickT}) -> +init({Name, LongOrShortNames, TickT, CleanHalt}) -> process_flag(trap_exit,true), - case init_node(Name, LongOrShortNames) of + case init_node(Name, LongOrShortNames, CleanHalt) of {ok, Node, Listeners} -> process_flag(priority, max), Ticktime = to_integer(TickT), Ticker = spawn_link(net_kernel, ticker, [self(), Ticktime]), - case auth:get_cookie(Node) of - Cookie when is_atom(Cookie) -> - {ok, #state{name = Name, - node = Node, - type = LongOrShortNames, - tick = #tick{ticker = Ticker, time = Ticktime}, - connecttime = connecttime(), - connections = - ets:new(sys_dist,[named_table, - protected, - {keypos, 2}]), - listen = Listeners, - allowed = [], - verbose = 0 - }}; - _ELSE -> - {stop, {error,{bad_cookie, Node}}} - end; + {ok, #state{name = Name, + node = Node, + type = LongOrShortNames, + tick = #tick{ticker = Ticker, time = Ticktime}, + connecttime = connecttime(), + connections = + ets:new(sys_dist,[named_table, + protected, + {keypos, #connection.node}]), + listen = Listeners, + allowed = [], + verbose = 0 + }}; Error -> {stop, Error} end. @@ -390,27 +441,27 @@ handle_call({disconnect, Node}, From, State) -> {Reply, State1} = do_disconnect(Node, State), async_reply({reply, Reply, State1}, From); -%% +%% %% The spawn/4 BIF ends up here. -%% +%% handle_call({spawn,M,F,A,Gleader},{From,Tag},State) when is_pid(From) -> do_spawn([no_link,{From,Tag},M,F,A,Gleader],[],State); -%% +%% %% The spawn_link/4 BIF ends up here. -%% +%% handle_call({spawn_link,M,F,A,Gleader},{From,Tag},State) when is_pid(From) -> do_spawn([link,{From,Tag},M,F,A,Gleader],[],State); -%% +%% %% The spawn_opt/5 BIF ends up here. -%% +%% handle_call({spawn_opt,M,F,A,O,L,Gleader},{From,Tag},State) when is_pid(From) -> do_spawn([L,{From,Tag},M,F,A,Gleader],O,State); -%% +%% %% Only allow certain nodes. -%% +%% handle_call({allow, Nodes}, From, State) -> case all_atoms(Nodes) of true -> @@ -421,17 +472,17 @@ handle_call({allow, Nodes}, From, State) -> async_reply({reply,error,State}, From) end; -%% +%% %% authentication, used by auth. Simply works as this: %% if the message comes through, the other node IS authorized. -%% +%% handle_call({is_auth, _Node}, From, State) -> async_reply({reply,yes,State}, From); -%% +%% %% Not applicable any longer !? -%% -handle_call({apply,_Mod,_Fun,_Args}, {From,Tag}, State) +%% +handle_call({apply,_Mod,_Fun,_Args}, {From,Tag}, State) when is_pid(From), node(From) =:= node() -> async_gen_server_reply({From,Tag}, not_implemented), % Port = State#state.port, @@ -503,7 +554,42 @@ handle_call({new_ticktime,T,TP}, From, #state{tick = #tick{ticker = Tckr, handle_call({new_ticktime,_T,_TP}, From, #state{tick = #tick_change{time = T}} = State) -> - async_reply({reply, {ongoing_change_to, T}, State}, From). + async_reply({reply, {ongoing_change_to, T}, State}, From); + +handle_call({setopts, new, Opts}, From, State) -> + Ret = setopts_new(Opts, State), + async_reply({reply, Ret, State}, From); + +handle_call({setopts, Node, Opts}, From, State) -> + Return = + case ets:lookup(sys_dist, Node) of + [Conn] when Conn#connection.state =:= up -> + case call_owner(Conn#connection.owner, {setopts, Opts}) of + {ok, Ret} -> Ret; + _ -> {error, noconnection} + end; + + _ -> + {error, noconnection} + end, + async_reply({reply, Return, State}, From); + +handle_call({getopts, Node, Opts}, From, State) -> + Return = + case ets:lookup(sys_dist, Node) of + [Conn] when Conn#connection.state =:= up -> + case call_owner(Conn#connection.owner, {getopts, Opts}) of + {ok, Ret} -> Ret; + _ -> {error, noconnection} + end; + + _ -> + {error, noconnection} + end, + async_reply({reply, Return, State}, From); + +handle_call(_Msg, _From, State) -> + {noreply, State}. %% ------------------------------------------------------------ %% handle_cast. @@ -571,7 +657,7 @@ handle_info({accept,AcceptPid,Socket,Family,Proto}, State) -> %% %% A node has successfully been connected. %% -handle_info({SetupPid, {nodeup,Node,Address,Type,Immediate}}, +handle_info({SetupPid, {nodeup,Node,Address,Type,Immediate}}, State) -> case {Immediate, ets:lookup(sys_dist, Node)} of {true, [Conn]} when Conn#connection.state =:= pending, @@ -659,7 +745,7 @@ handle_info({From,registered_send,To,Mess},State) -> send(From,To,Mess), {noreply,State}; -%% badcookies SHOULD not be sent +%% badcookies SHOULD not be sent %% (if someone does erlang:set_cookie(node(),foo) this may be) handle_info({From,badcookie,_To,_Mess}, State) -> error_logger:error_msg("~n** Got OLD cookie from ~w~n", @@ -688,7 +774,7 @@ handle_info(transition_period_end, how = How}} = State) -> ?tckr_dbg(transition_period_ended), case How of - shorter -> Tckr ! {new_ticktime, T}; + shorter -> Tckr ! {new_ticktime, T}, done; _ -> done end, {noreply,State#state{tick = #tick{ticker = Tckr, time = T}}}; @@ -707,7 +793,7 @@ handle_info(X, State) -> %% 4. The ticker process. %% (5. Garbage pid.) %% -%% The process type function that handled the process throws +%% The process type function that handled the process throws %% the handle_info return value ! %% ----------------------------------------------------------- @@ -997,9 +1083,9 @@ ticker(Kernel, Tick) when is_integer(Tick) -> ticker_loop(Kernel, Tick). to_integer(T) when is_integer(T) -> T; -to_integer(T) when is_atom(T) -> +to_integer(T) when is_atom(T) -> list_to_integer(atom_to_list(T)); -to_integer(T) when is_list(T) -> +to_integer(T) when is_list(T) -> list_to_integer(T). ticker_loop(Kernel, Tick) -> @@ -1007,7 +1093,7 @@ ticker_loop(Kernel, Tick) -> {new_ticktime, NewTick} -> ?tckr_dbg({ticker_changed_time, Tick, NewTick}), ?MODULE:ticker_loop(Kernel, NewTick) - after Tick -> + after Tick -> Kernel ! tick, ?MODULE:ticker_loop(Kernel, Tick) end. @@ -1055,7 +1141,7 @@ send(_From,To,Mess) -> -ifdef(UNUSED). safesend(Name,Mess) when is_atom(Name) -> - case whereis(Name) of + case whereis(Name) of undefined -> Mess; P when is_pid(P) -> @@ -1149,20 +1235,20 @@ get_proto_mod(Family,Protocol,[L|Ls]) -> true -> get_proto_mod(Family,Protocol,Ls) end; -get_proto_mod(_Family, _Protocol, []) -> +get_proto_mod(_Family, _Protocol, []) -> error. %% -------- Initialisation functions ------------------------ -init_node(Name, LongOrShortNames) -> - {NameWithoutHost,_Host} = lists:splitwith(fun($@)->false;(_)->true end, - atom_to_list(Name)), +init_node(Name, LongOrShortNames, CleanHalt) -> + {NameWithoutHost0,_Host} = split_node(Name), case create_name(Name, LongOrShortNames, 1) of {ok,Node} -> - case start_protos(list_to_atom(NameWithoutHost),Node) of - {ok, Ls} -> + NameWithoutHost = list_to_atom(NameWithoutHost0), + case start_protos(NameWithoutHost, Node, CleanHalt) of + {ok, Ls} -> {ok, Node, Ls}; - Error -> + Error -> Error end; Error -> @@ -1171,9 +1257,9 @@ init_node(Name, LongOrShortNames) -> %% Create the node name create_name(Name, LongOrShortNames, Try) -> - put(longnames, case LongOrShortNames of - shortnames -> false; - longnames -> true + put(longnames, case LongOrShortNames of + shortnames -> false; + longnames -> true end), {Head,Host1} = create_hostpart(Name, LongOrShortNames), case Host1 of @@ -1193,8 +1279,7 @@ create_name(Name, LongOrShortNames, Try) -> end. create_hostpart(Name, LongOrShortNames) -> - {Head,Host} = lists:splitwith(fun($@)->false;(_)->true end, - atom_to_list(Name)), + {Head,Host} = split_node(Name), Host1 = case {Host,LongOrShortNames} of {[$@,_|_],longnames} -> {ok,Host}; @@ -1221,8 +1306,11 @@ create_hostpart(Name, LongOrShortNames) -> end, {Head,Host1}. +split_node(Name) -> + lists:splitwith(fun(C) -> C =/= $@ end, atom_to_list(Name)). + +%% %% -%% %% protocol_childspecs() -> case init:get_argument(proto_dist) of @@ -1232,7 +1320,7 @@ protocol_childspecs() -> protocol_childspecs(["inet_tcp"]) end. -protocol_childspecs([]) -> +protocol_childspecs([]) -> []; protocol_childspecs([H|T]) -> Mod = list_to_atom(H ++ "_dist"), @@ -1242,16 +1330,16 @@ protocol_childspecs([H|T]) -> _ -> protocol_childspecs(T) end. - - + + %% %% epmd_module() -> module_name of erl_epmd or similar gen_server_module. %% epmd_module() -> case init:get_argument(epmd_module) of - {ok,[[Module]]} -> - Module; + {ok,[[Module]]} -> + list_to_atom(Module); _ -> erl_epmd end. @@ -1260,21 +1348,26 @@ epmd_module() -> %% Start all protocols %% -start_protos(Name,Node) -> +start_protos(Name, Node, CleanHalt) -> case init:get_argument(proto_dist) of {ok, [Protos]} -> - start_protos(Name,Protos, Node); + start_protos(Name, Protos, Node, CleanHalt); _ -> - start_protos(Name,["inet_tcp"], Node) + start_protos(Name, ["inet_tcp"], Node, CleanHalt) end. -start_protos(Name,Ps, Node) -> - case start_protos(Name, Ps, Node, []) of - [] -> {error, badarg}; - Ls -> {ok, Ls} +start_protos(Name, Ps, Node, CleanHalt) -> + case start_protos(Name, Ps, Node, [], CleanHalt) of + [] -> + case CleanHalt of + true -> halt(1); + false -> {error, badarg} + end; + Ls -> + {ok, Ls} end. -start_protos(Name, [Proto | Ps], Node, Ls) -> +start_protos(Name, [Proto | Ps], Node, Ls, CleanHalt) -> Mod = list_to_atom(Proto ++ "_dist"), case catch Mod:listen(Name) of {ok, {Socket, Address, Creation}} -> @@ -1287,33 +1380,48 @@ start_protos(Name, [Proto | Ps], Node, Ls) -> address = Address, accept = AcceptPid, module = Mod }, - start_protos(Name,Ps, Node, [L|Ls]); + start_protos(Name,Ps, Node, [L|Ls], CleanHalt); _ -> Mod:close(Socket), - error_logger:info_msg("Invalid node name: ~p~n", [Node]), - start_protos(Name, Ps, Node, Ls) + S = "invalid node name: " ++ atom_to_list(Node), + proto_error(CleanHalt, Proto, S), + start_protos(Name, Ps, Node, Ls, CleanHalt) end; {'EXIT', {undef,_}} -> - error_logger:info_msg("Protocol: ~p: not supported~n", [Proto]), - start_protos(Name,Ps, Node, Ls); + proto_error(CleanHalt, Proto, "not supported"), + start_protos(Name, Ps, Node, Ls, CleanHalt); {'EXIT', Reason} -> - error_logger:info_msg("Protocol: ~p: register error: ~p~n", - [Proto, Reason]), - start_protos(Name,Ps, Node, Ls); + register_error(CleanHalt, Proto, Reason), + start_protos(Name, Ps, Node, Ls, CleanHalt); {error, duplicate_name} -> - error_logger:info_msg("Protocol: ~p: the name " ++ - atom_to_list(Node) ++ - " seems to be in use by another Erlang node", - [Proto]), - start_protos(Name,Ps, Node, Ls); + S = "the name " ++ atom_to_list(Node) ++ + " seems to be in use by another Erlang node", + proto_error(CleanHalt, Proto, S), + start_protos(Name, Ps, Node, Ls, CleanHalt); {error, Reason} -> - error_logger:info_msg("Protocol: ~p: register/listen error: ~p~n", - [Proto, Reason]), - start_protos(Name,Ps, Node, Ls) + register_error(CleanHalt, Proto, Reason), + start_protos(Name, Ps, Node, Ls, CleanHalt) end; -start_protos(_,[], _Node, Ls) -> +start_protos(_, [], _Node, Ls, _CleanHalt) -> Ls. +register_error(false, Proto, Reason) -> + S = io_lib:format("register/listen error: ~p", [Reason]), + proto_error(false, Proto, lists:flatten(S)); +register_error(true, Proto, Reason) -> + S = "Protocol '" ++ Proto ++ "': register/listen error: ", + erlang:display_string(S), + erlang:display(Reason). + +proto_error(CleanHalt, Proto, String) -> + S = "Protocol '" ++ Proto ++ "': " ++ String ++ "\n", + case CleanHalt of + false -> + error_logger:info_msg(S); + true -> + erlang:display_string(S) + end. + set_node(Node, Creation) when node() =:= nonode@nohost -> case catch erlang:setnode(Node, Creation) of true -> @@ -1459,7 +1567,7 @@ display_info({Node, Info}, {I,O}) -> integer_to_list(In), integer_to_list(Out), Address), {I+In,O+Out}. -fmt_address(undefined) -> +fmt_address(undefined) -> "-"; fmt_address(A) -> case A#net_address.family of @@ -1527,9 +1635,100 @@ async_gen_server_reply(From, Msg) -> ok -> ok; nosuspend -> - spawn(fun() -> catch erlang:send(Pid, M, [noconnect]) end); + _ = spawn(fun() -> catch erlang:send(Pid, M, [noconnect]) end), + ok; noconnect -> ok; % The gen module takes care of this case. - {'EXIT', _}=EXIT -> - EXIT + {'EXIT', _} -> + ok end. + +call_owner(Owner, Msg) -> + Mref = monitor(process, Owner), + Owner ! {self(), Mref, Msg}, + receive + {Mref, Reply} -> + erlang:demonitor(Mref, [flush]), + {ok, Reply}; + {'DOWN', Mref, _, _, _} -> + error + end. + + +-spec setopts(Node, Options) -> ok | {error, Reason} | ignored when + Node :: node() | new, + Options :: [inet:socket_setopt()], + Reason :: inet:posix() | noconnection. + +setopts(Node, Opts) when is_atom(Node), is_list(Opts) -> + request({setopts, Node, Opts}). + +setopts_new(Opts, State) -> + %% First try setopts on listening socket(s) + %% Bail out on failure. + %% If successful, we are pretty sure Opts are ok + %% and we continue with config params and pending connections. + case setopts_on_listen(Opts, State#state.listen) of + ok -> + setopts_new_1(Opts); + Fail -> Fail + end. + +setopts_on_listen(_, []) -> ok; +setopts_on_listen(Opts, [#listen {listen = LSocket, module = Mod} | T]) -> + try Mod:setopts(LSocket, Opts) of + ok -> + setopts_on_listen(Opts, T); + Fail -> Fail + catch + error:undef -> {error, enotsup} + end. + +setopts_new_1(Opts) -> + ConnectOpts = case application:get_env(kernel, inet_dist_connect_options) of + {ok, CO} -> CO; + _ -> [] + end, + application:set_env(kernel, inet_dist_connect_options, + merge_opts(Opts,ConnectOpts)), + ListenOpts = case application:get_env(kernel, inet_dist_listen_options) of + {ok, LO} -> LO; + _ -> [] + end, + application:set_env(kernel, inet_dist_listen_options, + merge_opts(Opts, ListenOpts)), + case lists:keyfind(nodelay, 1, Opts) of + {nodelay, ND} when is_boolean(ND) -> + application:set_env(kernel, dist_nodelay, ND); + _ -> ignore + end, + + %% Update any pending connections + PendingConns = ets:select(sys_dist, [{'_', + [{'=/=',{element,#connection.state,'$_'},up}], + ['$_']}]), + lists:foreach(fun(#connection{state = pending, owner = Owner}) -> + call_owner(Owner, {setopts, Opts}); + (#connection{state = up_pending, pending_owner = Owner}) -> + call_owner(Owner, {setopts, Opts}); + (_) -> ignore + end, PendingConns), + ok. + +merge_opts([], B) -> + B; +merge_opts([H|T], B0) -> + {Key, _} = H, + B1 = lists:filter(fun({K,_}) -> K =/= Key end, B0), + merge_opts(T, [H | B1]). + +-spec getopts(Node, Options) -> + {'ok', OptionValues} | {'error', Reason} | ignored when + Node :: node(), + Options :: [inet:socket_getopt()], + OptionValues :: [inet:socket_setopt()], + Reason :: inet:posix() | noconnection. + +getopts(Node, Opts) when is_atom(Node), is_list(Opts) -> + request({getopts, Node, Opts}). + diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index d0b498edc9..03d4324992 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -24,33 +25,119 @@ -include("file.hrl"). --spec type() -> 'vxworks' | {'unix',atom()} | {'win32',atom()} | {'ose',atom()}. -type() -> - case erlang:system_info(os_type) of - {vxworks, _} -> - vxworks; - Else -> Else +%%% BIFs + +-export([getenv/0, getenv/1, getenv/2, getpid/0, + perf_counter/0, perf_counter/1, + putenv/2, system_time/0, system_time/1, + timestamp/0, unsetenv/1]). + +-spec getenv() -> [string()]. + +getenv() -> erlang:nif_error(undef). + +-spec getenv(VarName) -> Value | false when + VarName :: string(), + Value :: string(). + +getenv(_) -> + erlang:nif_error(undef). + +-spec getenv(VarName, DefaultValue) -> Value when + VarName :: string(), + DefaultValue :: string(), + Value :: string(). + +getenv(VarName, DefaultValue) -> + case os:getenv(VarName) of + false -> + DefaultValue; + Value -> + Value end. --spec version() -> string() | {non_neg_integer(),non_neg_integer(),non_neg_integer()}. +-spec getpid() -> Value when + Value :: string(). + +getpid() -> + erlang:nif_error(undef). + +-spec perf_counter() -> Counter when + Counter :: integer(). + +perf_counter() -> + erlang:nif_error(undef). + +-spec perf_counter(Unit) -> integer() when + Unit :: erlang:time_unit(). + +perf_counter(Unit) -> + erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit). + +-spec putenv(VarName, Value) -> true when + VarName :: string(), + Value :: string(). + +putenv(_, _) -> + erlang:nif_error(undef). + +-spec system_time() -> integer(). + +system_time() -> + erlang:nif_error(undef). + +-spec system_time(Unit) -> integer() when + Unit :: erlang:time_unit(). + +system_time(_Unit) -> + erlang:nif_error(undef). + +-spec timestamp() -> Timestamp when + Timestamp :: erlang:timestamp(). + +timestamp() -> + erlang:nif_error(undef). + +-spec unsetenv(VarName) -> true when + VarName :: string(). + +unsetenv(_) -> + erlang:nif_error(undef). + +%%% End of BIFs + +-spec type() -> {Osfamily, Osname} when + Osfamily :: unix | win32, + Osname :: atom(). + +type() -> + erlang:system_info(os_type). + +-spec version() -> VersionString | {Major, Minor, Release} when + VersionString :: string(), + Major :: non_neg_integer(), + Minor :: non_neg_integer(), + Release :: non_neg_integer(). version() -> erlang:system_info(os_version). --spec find_executable(string()) -> string() | 'false'. +-spec find_executable(Name) -> Filename | 'false' when + Name :: string(), + Filename :: string(). find_executable(Name) -> - case os:getenv("PATH") of - false -> find_executable(Name, []); - Path -> find_executable(Name, Path) - end. + find_executable(Name, os:getenv("PATH", "")). --spec find_executable(string(), string()) -> string() | 'false'. +-spec find_executable(Name, Path) -> Filename | 'false' when + Name :: string(), + Path :: string(), + Filename :: string(). find_executable(Name, Path) -> Extensions = extensions(), case filename:pathtype(Name) of relative -> find_executable1(Name, split_path(Path), Extensions); _ -> - case verify_executable(Name, Extensions) of + case verify_executable(Name, Extensions, Extensions) of {ok, Complete} -> Complete; error -> @@ -60,7 +147,7 @@ find_executable(Name, Path) -> find_executable1(Name, [Base|Rest], Extensions) -> Complete0 = filename:join(Base, Name), - case verify_executable(Complete0, Extensions) of + case verify_executable(Complete0, Extensions, Extensions) of {ok, Complete} -> Complete; error -> @@ -69,36 +156,44 @@ find_executable1(Name, [Base|Rest], Extensions) -> find_executable1(_Name, [], _Extensions) -> false. -verify_executable(Name0, [Ext|Rest]) -> +verify_executable(Name0, [Ext|Rest], OrigExtensions) -> Name1 = Name0 ++ Ext, - case os:type() of - vxworks -> - %% We consider all existing VxWorks files to be executable - case file:read_file_info(Name1) of - {ok, _} -> - {ok, Name1}; - _ -> - verify_executable(Name0, Rest) - end; + case file:read_file_info(Name1) of + {ok, #file_info{type=regular,mode=Mode}} + when Mode band 8#111 =/= 0 -> + %% XXX This test for execution permission is not fool-proof + %% on Unix, since we test if any execution bit is set. + {ok, Name1}; _ -> - case file:read_file_info(Name1) of - {ok, #file_info{mode=Mode}} when Mode band 8#111 =/= 0 -> - %% XXX This test for execution permission is not full-proof - %% on Unix, since we test if any execution bit is set. - {ok, Name1}; - _ -> - verify_executable(Name0, Rest) - end + verify_executable(Name0, Rest, OrigExtensions) end; -verify_executable(_, []) -> +verify_executable(Name, [], OrigExtensions) when OrigExtensions =/= [""] -> %% Windows + %% Will only happen on windows, hence case insensitivity + case can_be_full_name(string:to_lower(Name),OrigExtensions) of + true -> + verify_executable(Name,[""],[""]); + _ -> + error + end; +verify_executable(_, [], _) -> error. +can_be_full_name(_Name,[]) -> + false; +can_be_full_name(Name,[H|T]) -> + case lists:suffix(H,Name) of %% Name is in lowercase, cause this is a windows thing + true -> + true; + _ -> + can_be_full_name(Name,T) + end. + split_path(Path) -> case type() of {win32, _} -> {ok,Curr} = file:get_cwd(), split_path(Path, $;, [], [Curr]); - _ -> + _ -> split_path(Path, $:, [], []) end. @@ -118,181 +213,68 @@ reverse_element([$"|T]) -> %" reverse_element(List) -> lists:reverse(List). --spec extensions() -> [string()]. +-spec extensions() -> [string(),...]. +%% Extensions in lower case extensions() -> case type() of {win32, _} -> [".exe",".com",".cmd",".bat"]; - {unix, _} -> [""]; - vxworks -> [""] + {unix, _} -> [""] end. %% Executes the given command in the default shell for the operating system. --spec cmd(atom() | string() | [string()]) -> string(). +-spec cmd(Command) -> string() when + Command :: atom() | io_lib:chars(). cmd(Cmd) -> validate(Cmd), - case type() of - {unix, _} -> - unix_cmd(Cmd); - {win32, Wtype} -> - Command = case {os:getenv("COMSPEC"),Wtype} of - {false,windows} -> lists:concat(["command.com /c", Cmd]); - {false,_} -> lists:concat(["cmd /c", Cmd]); - {Cspec,_} -> lists:concat([Cspec," /c",Cmd]) - end, - Port = open_port({spawn, Command}, [stream, in, eof, hide]), - get_data(Port, []); - %% VxWorks uses a 'sh -c hook' in 'vxcall.c' to run os:cmd. - vxworks -> - Command = lists:concat(["sh -c '", Cmd, "'"]), - Port = open_port({spawn, Command}, [stream, in, eof]), - get_data(Port, []) + {SpawnCmd, SpawnOpts, SpawnInput, Eot} = mk_cmd(os:type(), Cmd), + Port = open_port({spawn, SpawnCmd}, [binary, stderr_to_stdout, + stream, in, hide | SpawnOpts]), + MonRef = erlang:monitor(port, Port), + true = port_command(Port, SpawnInput), + Bytes = get_data(Port, MonRef, Eot, []), + demonitor(MonRef, [flush]), + String = unicode:characters_to_list(Bytes), + if %% Convert to unicode list if possible otherwise return bytes + is_list(String) -> String; + true -> binary_to_list(Bytes) end. -unix_cmd(Cmd) -> - Tag = make_ref(), - {Pid,Mref} = erlang:spawn_monitor( - fun() -> - process_flag(trap_exit, true), - Port = start_port(), - erlang:port_command(Port, mk_cmd(Cmd)), - exit({Tag,unix_get_data(Port)}) - end), - receive - {'DOWN',Mref,_,Pid,{Tag,Result}} -> - Result; - {'DOWN',Mref,_,Pid,Reason} -> - exit(Reason) - end. - -%% The -s flag implies that only the positional parameters are set, -%% and the commands are read from standard input. We set the -%% $1 parameter for easy identification of the resident shell. -%% --define(SHELL, "/bin/sh -s unix:cmd 2>&1"). --define(PORT_CREATOR_NAME, os_cmd_port_creator). - -%% -%% Serializing open_port through a process to avoid smp lock contention -%% when many concurrent os:cmd() want to do vfork (OTP-7890). -%% --spec start_port() -> port(). -start_port() -> - Ref = make_ref(), - Request = {Ref,self()}, - {Pid, Mon} = case whereis(?PORT_CREATOR_NAME) of - undefined -> - spawn_monitor(fun() -> - start_port_srv(Request) - end); - P -> - P ! Request, - M = erlang:monitor(process, P), - {P, M} - end, - receive - {Ref, Port} when is_port(Port) -> - erlang:demonitor(Mon, [flush]), - Port; - {Ref, Error} -> - erlang:demonitor(Mon, [flush]), - exit(Error); - {'DOWN', Mon, process, Pid, _Reason} -> - start_port() - end. - -start_port_srv(Request) -> - %% We don't want a group leader of some random application. Use - %% kernel_sup's group leader. - {group_leader, GL} = process_info(whereis(kernel_sup), - group_leader), - true = group_leader(GL, self()), - process_flag(trap_exit, true), - StayAlive = try register(?PORT_CREATOR_NAME, self()) - catch - error:_ -> false - end, - start_port_srv_loop(Request, StayAlive). - -start_port_srv_loop({Ref,Client}, StayAlive) -> - Reply = try open_port({spawn, ?SHELL},[stream]) of - Port when is_port(Port) -> - (catch port_connect(Port, Client)), - unlink(Port), - Port - catch - error:Reason -> - {Reason,erlang:get_stacktrace()} - end, - Client ! {Ref,Reply}, - case StayAlive of - true -> start_port_srv_loop(get_open_port_request(), true); - false -> exiting - end. - -get_open_port_request() -> - receive - {Ref, Client} = Request when is_reference(Ref), - is_pid(Client) -> - Request; - _Junk -> - get_open_port_request() - end. - -%% -%% unix_get_data(Port) -> Result -%% -unix_get_data(Port) -> - unix_get_data(Port, []). - -unix_get_data(Port, Sofar) -> - receive - {Port,{data, Bytes}} -> - case eot(Bytes) of - {done, Last} -> - lists:flatten([Sofar|Last]); - more -> - unix_get_data(Port, [Sofar|Bytes]) - end; - {'EXIT', Port, _} -> - lists:flatten(Sofar) - end. - -%% -%% eot(String) -> more | {done, Result} -%% -eot(Bs) -> - eot(Bs, []). - -eot([4| _Bs], As) -> - {done, lists:reverse(As)}; -eot([B| Bs], As) -> - eot(Bs, [B| As]); -eot([], _As) -> - more. - -%% -%% mk_cmd(Cmd) -> {ok, ShellCommandString} | {error, ErrorString} -%% -%% We do not allow any input to Cmd (hence commands that want -%% to read from standard input will return immediately). -%% Standard error is redirected to standard output. -%% -%% We use ^D (= EOT = 4) to mark the end of the stream. -%% -mk_cmd(Cmd) when is_atom(Cmd) -> % backward comp. - mk_cmd(atom_to_list(Cmd)); -mk_cmd(Cmd) -> - %% We insert a new line after the command, in case the command - %% contains a comment character. - io_lib:format("(~s\n) </dev/null; echo \"\^D\"\n", [Cmd]). - +mk_cmd({win32,Wtype}, Cmd) -> + Command = case {os:getenv("COMSPEC"),Wtype} of + {false,windows} -> lists:concat(["command.com /c", Cmd]); + {false,_} -> lists:concat(["cmd /c", Cmd]); + {Cspec,_} -> lists:concat([Cspec," /c",Cmd]) + end, + {Command, [], [], <<>>}; +mk_cmd(OsType,Cmd) when is_atom(Cmd) -> + mk_cmd(OsType, atom_to_list(Cmd)); +mk_cmd(_,Cmd) -> + %% Have to send command in like this in order to make sh commands like + %% cd and ulimit available + {"/bin/sh -s unix:cmd", [out], + %% We insert a new line after the command, in case the command + %% contains a comment character. + %% + %% The </dev/null closes stdin, which means that programs + %% that use a closed stdin as an termination indicator works. + %% An example of such a program is 'more'. + %% + %% The "echo ^D" is used to indicate that the program has executed + %% and we should return any output we have gotten. We cannot use + %% termination of the child or closing of stdin/stdout as then + %% starting background jobs from os:cmd will block os:cmd. + %% + %% I tried changing this to be "better", but got bombarded with + %% backwards incompatibility bug reports, so leave this as it is. + ["(", unicode:characters_to_binary(Cmd), "\n) </dev/null; echo \"\^D\"\n"], + <<$\^D>>}. validate(Atom) when is_atom(Atom) -> ok; validate(List) when is_list(List) -> validate1(List). -validate1([C|Rest]) when is_integer(C), 0 =< C, C < 256 -> +validate1([C|Rest]) when is_integer(C) -> validate1(Rest); validate1([List|Rest]) when is_list(List) -> validate1(List), @@ -300,21 +282,50 @@ validate1([List|Rest]) when is_list(List) -> validate1([]) -> ok. -get_data(Port, Sofar) -> +get_data(Port, MonRef, Eot, Sofar) -> receive {Port, {data, Bytes}} -> - get_data(Port, [Sofar|Bytes]); - {Port, eof} -> - Port ! {self(), close}, - receive - {Port, closed} -> - true - end, - receive - {'EXIT', Port, _} -> - ok - after 1 -> % force context switch - ok - end, - lists:flatten(Sofar) + case eot(Bytes, Eot) of + more -> + get_data(Port, MonRef, Eot, [Sofar,Bytes]); + Last -> + catch port_close(Port), + flush_until_down(Port, MonRef), + iolist_to_binary([Sofar, Last]) + end; + {'DOWN', MonRef, _, _, _} -> + flush_exit(Port), + iolist_to_binary(Sofar) + end. + +eot(_Bs, <<>>) -> + more; +eot(Bs, Eot) -> + case binary:match(Bs, Eot) of + nomatch -> more; + {Pos, _} -> + binary:part(Bs,{0, Pos}) + end. + +%% When port_close returns we know that all the +%% messages sent have been sent and that the +%% DOWN message is after them all. +flush_until_down(Port, MonRef) -> + receive + {Port, {data, _Bytes}} -> + flush_until_down(Port, MonRef); + {'DOWN', MonRef, _, _, _} -> + flush_exit(Port) + end. + +%% The exit signal is always delivered before +%% the down signal, so we can be sure that if there +%% was an exit message sent, it will be in the +%% mailbox now. +flush_exit(Port) -> + receive + {'EXIT', Port, _} -> + ok + after 0 -> + ok end. diff --git a/lib/kernel/src/packages.erl b/lib/kernel/src/packages.erl deleted file mode 100644 index e0b1f36b85..0000000000 --- a/lib/kernel/src/packages.erl +++ /dev/null @@ -1,158 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-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(packages). - --export([to_string/1, concat/1, concat/2, is_valid/1, is_segmented/1, - split/1, last/1, first/1, strip_last/1, find_modules/1, - find_modules/2]). - -%% A package name (or a package-qualified module name) may be an atom or -%% a string (list of nonnegative integers) - not a deep list, and not a -%% list containing atoms. A name may be empty, but may not contain two -%% consecutive period (`.') characters or end with a period character. - --type package_name() :: atom() | string(). - --spec to_string(package_name()) -> string(). -to_string(Name) when is_atom(Name) -> - atom_to_list(Name); -to_string(Name) -> - Name. - -%% `concat' does not insert a leading period if the first segment is -%% empty. However, the result may contain leading, consecutive or -%% dangling period characters, if any of the segments after the first -%% are empty. Use 'is_valid' to check the result if necessary. - --spec concat(package_name(), package_name()) -> string(). -concat(A, B) -> - concat([A, B]). - --spec concat([package_name()]) -> string(). -concat([H | T]) when is_atom(H) -> - concat([atom_to_list(H) | T]); -concat(["" | T]) -> - concat_1(T); -concat(L) -> - concat_1(L). - -concat_1([H | T]) when is_atom(H) -> - concat_1([atom_to_list(H) | T]); -concat_1([H]) -> - H; -concat_1([H | T]) -> - H ++ "." ++ concat_1(T); -concat_1([]) -> - ""; -concat_1(Name) -> - erlang:error({badarg, Name}). - --spec is_valid(package_name()) -> boolean(). -is_valid(Name) when is_atom(Name) -> - is_valid_1(atom_to_list(Name)); -is_valid([$. | _]) -> - false; -is_valid(Name) -> - is_valid_1(Name). - -is_valid_1([$.]) -> false; -is_valid_1([$., $. | _]) -> false; -is_valid_1([H | T]) when is_integer(H), H >= 0 -> - is_valid_1(T); -is_valid_1([]) -> true; -is_valid_1(_) -> false. - --spec split(package_name()) -> [string()]. -split(Name) when is_atom(Name) -> - split_1(atom_to_list(Name), []); -split(Name) -> - split_1(Name, []). - -split_1([$. | T], Cs) -> - [lists:reverse(Cs) | split_1(T, [])]; -split_1([H | T], Cs) when is_integer(H), H >= 0 -> - split_1(T, [H | Cs]); -split_1([], Cs) -> - [lists:reverse(Cs)]; -split_1(_, _) -> - erlang:error(badarg). - -%% This is equivalent to testing if `split(Name)' yields a list of -%% length larger than one (i.e., if the name can be split into two or -%% more segments), but is cheaper. - --spec is_segmented(package_name()) -> boolean(). -is_segmented(Name) when is_atom(Name) -> - is_segmented_1(atom_to_list(Name)); -is_segmented(Name) -> - is_segmented_1(Name). - -is_segmented_1([$. | _]) -> true; -is_segmented_1([H | T]) when is_integer(H), H >= 0 -> - is_segmented_1(T); -is_segmented_1([]) -> false; -is_segmented_1(_) -> - erlang:error(badarg). - --spec last(package_name()) -> string(). -last(Name) -> - last_1(split(Name)). - -last_1([H]) -> H; -last_1([_ | T]) -> last_1(T). - --spec first(package_name()) -> [string()]. -first(Name) -> - first_1(split(Name)). - -first_1([H | T]) when T =/= [] -> [H | first_1(T)]; -first_1(_) -> []. - --spec strip_last(package_name()) -> string(). -strip_last(Name) -> - concat(first(Name)). - -%% This finds all modules available for a given package, using the -%% current code server search path. (There is no guarantee that the -%% modules are loadable; only that the object files exist.) - --spec find_modules(package_name()) -> [string()]. -find_modules(P) -> - find_modules(P, code:get_path()). - --spec find_modules(package_name(), [string()]) -> [string()]. -find_modules(P, Paths) -> - P1 = filename:join(packages:split(P)), - find_modules(P1, Paths, code:objfile_extension(), sets:new()). - -find_modules(P, [Path | Paths], Ext, S0) -> - case file:list_dir(filename:join(Path, P)) of - {ok, Fs} -> - Fs1 = [F || F <- Fs, filename:extension(F) =:= Ext], - S1 = lists:foldl(fun (F, S) -> - F1 = filename:rootname(F, Ext), - sets:add_element(F1, S) - end, - S0, Fs1), - find_modules(P, Paths, Ext, S1); - _ -> - find_modules(P, Paths, Ext, S0) - end; -find_modules(_P, [], _Ext, S) -> - sets:to_list(S). diff --git a/lib/kernel/src/pg2.erl b/lib/kernel/src/pg2.erl index cb9fec2ffe..edf4aedde2 100644 --- a/lib/kernel/src/pg2.erl +++ b/lib/kernel/src/pg2.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -30,20 +31,22 @@ %%% Exported functions %%% --spec start_link() -> {'ok', pid()} | {'error', term()}. +-spec start_link() -> {'ok', pid()} | {'error', any()}. start_link() -> gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). --spec start() -> {'ok', pid()} | {'error', term()}. +-spec start() -> {'ok', pid()} | {'error', any()}. start() -> ensure_started(). --spec create(term()) -> 'ok'. +-type name() :: any(). + +-spec create(Name :: name()) -> 'ok'. create(Name) -> - ensure_started(), + _ = ensure_started(), case ets:member(pg2_table, {group, Name}) of false -> global:trans({{?MODULE, Name}, self()}, @@ -55,22 +58,21 @@ create(Name) -> ok end. --type name() :: term(). - --spec delete(name()) -> 'ok'. +-spec delete(Name :: name()) -> 'ok'. delete(Name) -> - ensure_started(), + _ = ensure_started(), global:trans({{?MODULE, Name}, self()}, fun() -> gen_server:multi_call(?MODULE, {delete, Name}) end), ok. --spec join(name(), pid()) -> 'ok' | {'error', {'no_such_group', term()}}. +-spec join(Name, Pid :: pid()) -> 'ok' | {'error', {'no_such_group', Name}} + when Name :: name(). join(Name, Pid) when is_pid(Pid) -> - ensure_started(), + _ = ensure_started(), case ets:member(pg2_table, {group, Name}) of false -> {error, {no_such_group, Name}}; @@ -83,10 +85,11 @@ join(Name, Pid) when is_pid(Pid) -> ok end. --spec leave(name(), pid()) -> 'ok' | {'error', {'no_such_group', name()}}. +-spec leave(Name, Pid :: pid()) -> 'ok' | {'error', {'no_such_group', Name}} + when Name :: name(). leave(Name, Pid) when is_pid(Pid) -> - ensure_started(), + _ = ensure_started(), case ets:member(pg2_table, {group, Name}) of false -> {error, {no_such_group, Name}}; @@ -99,12 +102,11 @@ leave(Name, Pid) when is_pid(Pid) -> ok end. --type get_members_ret() :: [pid()] | {'error', {'no_such_group', name()}}. +-spec get_members(Name) -> [pid()] | {'error', {'no_such_group', Name}} + when Name :: name(). --spec get_members(name()) -> get_members_ret(). - get_members(Name) -> - ensure_started(), + _ = ensure_started(), case ets:member(pg2_table, {group, Name}) of true -> group_members(Name); @@ -112,10 +114,11 @@ get_members(Name) -> {error, {no_such_group, Name}} end. --spec get_local_members(name()) -> get_members_ret(). +-spec get_local_members(Name) -> [pid()] | {'error', {'no_such_group', Name}} + when Name :: name(). get_local_members(Name) -> - ensure_started(), + _ = ensure_started(), case ets:member(pg2_table, {group, Name}) of true -> local_group_members(Name); @@ -123,45 +126,50 @@ get_local_members(Name) -> {error, {no_such_group, Name}} end. --spec which_groups() -> [name()]. +-spec which_groups() -> [Name :: name()]. which_groups() -> - ensure_started(), + _ = ensure_started(), all_groups(). --type gcp_error_reason() :: {'no_process', term()} | {'no_such_group', term()}. - --spec get_closest_pid(term()) -> pid() | {'error', gcp_error_reason()}. +-spec get_closest_pid(Name) -> pid() | {'error', Reason} when + Name :: name(), + Reason :: {'no_process', Name} | {'no_such_group', Name}. get_closest_pid(Name) -> case get_local_members(Name) of [Pid] -> Pid; [] -> - {_,_,X} = erlang:now(), case get_members(Name) of [] -> {error, {no_process, Name}}; Members -> - lists:nth((X rem length(Members))+1, Members) + random_element(Members) end; Members when is_list(Members) -> - {_,_,X} = erlang:now(), - lists:nth((X rem length(Members))+1, Members); + random_element(Members); Else -> Else end. +random_element(List) -> + X = abs(erlang:monotonic_time() + bxor erlang:unique_integer()), + lists:nth((X rem length(List)) + 1, List). + %%% %%% Callback functions from gen_server %%% -record(state, {}). --spec init([]) -> {'ok', #state{}}. +-type state() :: #state{}. + +-spec init(Arg :: []) -> {'ok', state()}. init([]) -> Ns = nodes(), - net_kernel:monitor_nodes(true), + ok = net_kernel:monitor_nodes(true), lists:foreach(fun(N) -> {?MODULE, N} ! {new_pg2, node()}, self() ! {nodeup, N} @@ -169,13 +177,13 @@ init([]) -> pg2_table = ets:new(pg2_table, [ordered_set, protected, named_table]), {ok, #state{}}. --type call() :: {'create', name()} - | {'delete', name()} - | {'join', name(), pid()} - | {'leave', name(), pid()}. - --spec handle_call(call(), _, #state{}) -> - {'reply', 'ok', #state{}}. +-spec handle_call(Call :: {'create', Name} + | {'delete', Name} + | {'join', Name, Pid :: pid()} + | {'leave', Name, Pid :: pid()}, + From :: {pid(),Tag :: any()}, + State :: state()) -> {'reply', 'ok', state()} + when Name :: name(). handle_call({create, Name}, _From, S) -> assure_group(Name), @@ -195,11 +203,10 @@ handle_call(Request, From, S) -> [Request, From]), {noreply, S}. --type all_members() :: [[name(),...]]. --type cast() :: {'exchange', node(), all_members()} - | {'del_member', name(), pid()}. - --spec handle_cast(cast(), #state{}) -> {'noreply', #state{}}. +-spec handle_cast(Cast :: {'exchange', node(), Names :: [[Name,...]]} + | {'del_member', Name, Pid :: pid()}, + State :: state()) -> {'noreply', state()} + when Name :: name(). handle_cast({exchange, _Node, List}, S) -> store(List), @@ -208,7 +215,8 @@ handle_cast(_, S) -> %% Ignore {del_member, Name, Pid}. {noreply, S}. --spec handle_info(tuple(), #state{}) -> {'noreply', #state{}}. +-spec handle_info(Tuple :: tuple(), State :: state()) -> + {'noreply', state()}. handle_info({'DOWN', MonitorRef, process, _Pid, _Info}, S) -> member_died(MonitorRef), @@ -222,7 +230,7 @@ handle_info({new_pg2, Node}, S) -> handle_info(_, S) -> {noreply, S}. --spec terminate(term(), #state{}) -> 'ok'. +-spec terminate(Reason :: any(), State :: state()) -> 'ok'. terminate(_Reason, _S) -> true = ets:delete(pg2_table), @@ -251,7 +259,9 @@ terminate(_Reason, _S) -> %%% Pid is a member of group Name. store(List) -> - _ = [assure_group(Name) andalso [join_group(Name, P) || P <- Members] || + _ = [(assure_group(Name) + andalso + [join_group(Name, P) || P <- Members -- group_members(Name)]) || [Name, Members] <- List], ok. @@ -277,7 +287,7 @@ member_died(Ref) -> join_group(Name, Pid) -> Ref_Pid = {ref, Pid}, - try _ = ets:update_counter(pg2_table, Ref_Pid, {4, +1}) + try _ = ets:update_counter(pg2_table, Ref_Pid, {4, +1}), true catch _:_ -> {RPid, Ref} = do_monitor(Pid), true = ets:insert(pg2_table, {Ref_Pid, RPid, Ref, 1}), diff --git a/lib/kernel/src/ram_file.erl b/lib/kernel/src/ram_file.erl index d996650948..e427d130b7 100644 --- a/lib/kernel/src/ram_file.erl +++ b/lib/kernel/src/ram_file.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(ram_file). @@ -24,11 +25,12 @@ -export([open/2, close/1]). -export([write/2, read/2, copy/3, pread/2, pread/3, pwrite/2, pwrite/3, - position/2, truncate/1, sync/1]). + position/2, truncate/1, datasync/1, sync/1]). %% Specialized file operations -export([get_size/1, get_file/1, set_file/2, get_file_close/1]). --export([compress/1, uncompress/1, uuencode/1, uudecode/1]). +-export([compress/1, uncompress/1, uuencode/1, uudecode/1, advise/4]). +-export([allocate/3]). -export([open_mode/1]). %% used by ftp-file @@ -60,6 +62,7 @@ -define(RAM_FILE_TRUNCATE, 14). -define(RAM_FILE_PREAD, 17). -define(RAM_FILE_PWRITE, 18). +-define(RAM_FILE_FDATASYNC, 19). %% Other operations -define(RAM_FILE_GET, 30). @@ -70,6 +73,8 @@ -define(RAM_FILE_UUENCODE, 35). -define(RAM_FILE_UUDECODE, 36). -define(RAM_FILE_SIZE, 37). +-define(RAM_FILE_ADVISE, 38). +-define(RAM_FILE_ALLOCATE, 39). %% Open modes for RAM_FILE_OPEN -define(RAM_FILE_MODE_READ, 1). @@ -90,6 +95,14 @@ -define(RAM_FILE_RESP_NUMBER, 3). -define(RAM_FILE_RESP_INFO, 4). +%% POSIX file advises +-define(POSIX_FADV_NORMAL, 0). +-define(POSIX_FADV_RANDOM, 1). +-define(POSIX_FADV_SEQUENTIAL, 2). +-define(POSIX_FADV_WILLNEED, 3). +-define(POSIX_FADV_DONTNEED, 4). +-define(POSIX_FADV_NOREUSE, 5). + %% -------------------------------------------------------------------------- %% Generic file contents operations. %% @@ -167,6 +180,8 @@ copy(#file_descriptor{module = ?MODULE} = Source, %% XXX Should be moved down to the driver for optimization. file:copy_opened(Source, Dest, Length). +datasync(#file_descriptor{module = ?MODULE, data = Port}) -> + call_port(Port, <<?RAM_FILE_FDATASYNC>>). sync(#file_descriptor{module = ?MODULE, data = Port}) -> call_port(Port, <<?RAM_FILE_FSYNC>>). @@ -349,6 +364,33 @@ uudecode(#file_descriptor{module = ?MODULE, data = Port}) -> uudecode(#file_descriptor{}) -> {error, enotsup}. +advise(#file_descriptor{module = ?MODULE, data = Port}, Offset, + Length, Advise) -> + Cmd0 = <<?RAM_FILE_ADVISE, Offset:64/signed, Length:64/signed>>, + case Advise of + normal -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NORMAL:32/signed>>); + random -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_RANDOM:32/signed>>); + sequential -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_SEQUENTIAL:32/signed>>); + will_need -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_WILLNEED:32/signed>>); + dont_need -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_DONTNEED:32/signed>>); + no_reuse -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NOREUSE:32/signed>>); + _ -> + {error, einval} + end; +advise(#file_descriptor{}, _Offset, _Length, _Advise) -> + {error, enotsup}. + +allocate(#file_descriptor{module = ?MODULE, data = Port}, Offset, Length) -> + call_port(Port, <<?RAM_FILE_ALLOCATE, Offset:64/signed, Length:64/signed>>); +allocate(#file_descriptor{}, _Offset, _Length) -> + {error, enotsup}. + %%%----------------------------------------------------------------- diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index d69f2a12ad..bd6ea26678 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-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. -%% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(rpc). @@ -22,7 +23,7 @@ %% facility %% This code used to reside in net.erl, but has now been moved to -%% a searate module. +%% a separate module. -define(NAME, rex). @@ -51,26 +52,44 @@ parallel_eval/1, pmap/3, pinfo/1, pinfo/2]). -%% Deprecated calls. --deprecated([{safe_multi_server_call,2},{safe_multi_server_call,3}]). --export([safe_multi_server_call/2,safe_multi_server_call/3]). - %% gen_server exports --export([init/1,handle_call/3,handle_cast/2,handle_info/2, +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2, code_change/3]). %% Internals -export([proxy_user_flush/0]). +-export_type([key/0]). + +%%------------------------------------------------------------------------ + +-type state() :: map(). + %%------------------------------------------------------------------------ + +%% The rex server may receive a huge amount of +%% messages. Make sure that they are stored off heap to +%% avoid exessive GCs. + +-define(SPAWN_OPTS, [{spawn_opt,[{message_queue_data,off_heap}]}]). + %% Remote execution and broadcasting facility +-spec start() -> {'ok', pid()} | 'ignore' | {'error', term()}. + start() -> - gen_server:start({local,?NAME},?MODULE,[],[]). + gen_server:start({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS). + +-spec start_link() -> {'ok', pid()} | 'ignore' | {'error', term()}. start_link() -> - gen_server:start_link({local,?NAME},?MODULE,[],[]). + %% The rex server process may receive a huge amount of + %% messages. Make sure that they are stored off heap to + %% avoid exessive GCs. + gen_server:start_link({local,?NAME}, ?MODULE, [], ?SPAWN_OPTS). + +-spec stop() -> term(). stop() -> stop(?NAME). @@ -78,10 +97,16 @@ stop() -> stop(Rpc) -> gen_server:call(Rpc, stop, infinity). --spec init([]) -> {'ok', gb_tree()}. +-spec init([]) -> {'ok', state()}. + init([]) -> process_flag(trap_exit, true), - {ok, gb_trees:empty()}. + {ok, maps:new()}. + +-spec handle_call(term(), term(), state()) -> + {'noreply', state()} | + {'reply', term(), state()} | + {'stop', 'normal', 'stopped', state()}. handle_call({call, Mod, Fun, Args, Gleader}, To, S) -> handle_call_call(Mod, Fun, Args, Gleader, To, S); @@ -102,67 +127,58 @@ handle_call(stop, _To, S) -> handle_call(_, _To, S) -> {noreply, S}. % Ignore ! +-spec handle_cast(term(), state()) -> {'noreply', state()}. handle_cast({cast, Mod, Fun, Args, Gleader}, S) -> - spawn( - fun() -> - set_group_leader(Gleader), - apply(Mod, Fun, Args) - end), - {noreply, S}; + spawn(fun() -> + set_group_leader(Gleader), + apply(Mod, Fun, Args) + end), + {noreply, S}; handle_cast(_, S) -> {noreply, S}. % Ignore ! +-spec handle_info(term(), state()) -> {'noreply', state()}. +handle_info({'DOWN', _, process, Caller, normal}, S) -> + {noreply, maps:remove(Caller, S)}; handle_info({'DOWN', _, process, Caller, Reason}, S) -> - case gb_trees:lookup(Caller, S) of - {value, To} -> - receive - {Caller, {reply, Reply}} -> - gen_server:reply(To, Reply) - after 0 -> - gen_server:reply(To, {badrpc, {'EXIT', Reason}}) - end, - {noreply, gb_trees:delete(Caller, S)}; - none -> - {noreply, S} - end; -handle_info({Caller, {reply, Reply}}, S) -> - case gb_trees:lookup(Caller, S) of - {value, To} -> - receive - {'DOWN', _, process, Caller, _} -> - gen_server:reply(To, Reply), - {noreply, gb_trees:delete(Caller, S)} - end; - none -> - {noreply, S} + case maps:get(Caller, S, undefined) of + undefined -> + {noreply, S}; + {_, _} = To -> + gen_server:reply(To, {badrpc, {'EXIT', Reason}}), + {noreply, maps:remove(Caller, S)} end; handle_info({From, {sbcast, Name, Msg}}, S) -> - case catch Name ! Msg of %% use catch to get the printout - {'EXIT', _} -> - From ! {?NAME, node(), {nonexisting_name, Name}}; - _ -> - From ! {?NAME, node(), node()} - end, - {noreply,S}; + _ = case catch Name ! Msg of %% use catch to get the printout + {'EXIT', _} -> + From ! {?NAME, node(), {nonexisting_name, Name}}; + _ -> + From ! {?NAME, node(), node()} + end, + {noreply, S}; handle_info({From, {send, Name, Msg}}, S) -> - case catch Name ! {From, Msg} of %% use catch to get the printout - {'EXIT', _} -> - From ! {?NAME, node(), {nonexisting_name, Name}}; - _ -> - ok %% It's up to Name to respond !!!!! - end, - {noreply,S}; + _ = case catch Name ! {From, Msg} of %% use catch to get the printout + {'EXIT', _} -> + From ! {?NAME, node(), {nonexisting_name, Name}}; + _ -> + ok %% It's up to Name to respond !!!!! + end, + {noreply, S}; handle_info({From, {call,Mod,Fun,Args,Gleader}}, S) -> %% Special for hidden C node's, uugh ... handle_call_call(Mod, Fun, Args, Gleader, {From,?NAME}, S); handle_info(_, S) -> - {noreply,S}. + {noreply, S}. + +-spec terminate(term(), state()) -> 'ok'. terminate(_, _S) -> ok. +-spec code_change(term(), state(), term()) -> {'ok', state()}. + code_change(_, S, _) -> {ok, S}. @@ -170,7 +186,6 @@ code_change(_, S, _) -> %% Auxiliary function to avoid a false dialyzer warning -- do not inline %% handle_call_call(Mod, Fun, Args, Gleader, To, S) -> - RpcServer = self(), %% Spawn not to block the rpc server. {Caller,_} = erlang:spawn_monitor( @@ -185,9 +200,9 @@ handle_call_call(Mod, Fun, Args, Gleader, To, S) -> Result -> Result end, - RpcServer ! {self(), {reply, Reply}} + gen_server:reply(To, Reply) end), - {noreply, gb_trees:insert(Caller, To, S)}. + {noreply, maps:put(Caller, To, S)}. %% RPC aid functions .... @@ -209,7 +224,7 @@ proxy_user() -> case whereis(rex_proxy_user) of Pid when is_pid(Pid) -> Pid; undefined -> - Pid = spawn(fun()-> proxy_user_loop() end), + Pid = spawn(fun() -> proxy_user_loop() end), try register(rex_proxy_user,Pid) of true -> Pid catch error:_ -> % spawn race, kill and try again @@ -226,6 +241,8 @@ proxy_user_loop() -> undefined -> proxy_user_loop() end. +-spec proxy_user_flush() -> no_return(). + proxy_user_flush() -> %% Forward all received messages to 'user' receive Msg -> @@ -240,30 +257,58 @@ proxy_user_flush() -> %% THE rpc client interface --spec call(node(), atom(), atom(), [term()]) -> term(). +-spec call(Node, Module, Function, Args) -> Res | {badrpc, Reason} when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()], + Res :: term(), + Reason :: term(). call(N,M,F,A) when node() =:= N -> %% Optimize local call local_call(M, F, A); call(N,M,F,A) -> do_call(N, {call,M,F,A,group_leader()}, infinity). --spec call(node(), atom(), atom(), [term()], timeout()) -> term(). - -call(N,M,F,A,_Timeout) when node() =:= N -> %% Optimize local call +-spec call(Node, Module, Function, Args, Timeout) -> + Res | {badrpc, Reason} when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()], + Res :: term(), + Reason :: term(), + Timeout :: timeout(). + +call(N,M,F,A,infinity) when node() =:= N -> %% Optimize local call local_call(M,F,A); call(N,M,F,A,infinity) -> do_call(N, {call,M,F,A,group_leader()}, infinity); call(N,M,F,A,Timeout) when is_integer(Timeout), Timeout >= 0 -> do_call(N, {call,M,F,A,group_leader()}, Timeout). --spec block_call(node(), atom(), atom(), [term()]) -> term(). +-spec block_call(Node, Module, Function, Args) -> Res | {badrpc, Reason} when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()], + Res :: term(), + Reason :: term(). block_call(N,M,F,A) when node() =:= N -> %% Optimize local call local_call(M,F,A); block_call(N,M,F,A) -> do_call(N, {block_call,M,F,A,group_leader()}, infinity). --spec block_call(node(), atom(), atom(), [term()], timeout()) -> term(). +-spec block_call(Node, Module, Function, Args, Timeout) -> + Res | {badrpc, Reason} when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()], + Res :: term(), + Reason :: term(), + Timeout :: timeout(). block_call(N,M,F,A,_Timeout) when node() =:= N -> %% Optimize local call local_call(M, F, A); @@ -303,8 +348,12 @@ do_call(Node, Request, Timeout) -> rpc_check_t({'EXIT', {timeout,_}}) -> {badrpc, timeout}; rpc_check_t(X) -> rpc_check(X). -rpc_check({'EXIT', {{nodedown,_},_}}) -> {badrpc, nodedown}; -rpc_check({'EXIT', X}) -> exit(X); +rpc_check({'EXIT', {{nodedown,_},_}}) -> + {badrpc, nodedown}; +rpc_check({'EXIT', _}=Exit) -> + %% Should only happen if the rex process on the other node + %% died. + {badrpc, Exit}; rpc_check(X) -> X. @@ -316,7 +365,13 @@ rpc_check(X) -> X. %% The entire call is packed into an atomic transaction which %% either succeeds or fails, i.e. never hangs (unless the server itself hangs). --spec server_call(node(), atom(), term(), term()) -> term() | {'error', 'nodedown'}. +-spec server_call(Node, Name, ReplyWrapper, Msg) -> Reply | {error, Reason} when + Node :: node(), + Name :: atom(), + ReplyWrapper :: term(), + Msg :: term(), + Reply :: term(), + Reason :: nodedown. server_call(Node, Name, ReplyWrapper, Msg) when is_atom(Node), is_atom(Name) -> @@ -329,17 +384,16 @@ server_call(Node, Name, ReplyWrapper, Msg) {'DOWN', Ref, _, _, _} -> {error, nodedown}; {ReplyWrapper, Node, Reply} -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, _, _, _} -> - Reply - after 0 -> - Reply - end + erlang:demonitor(Ref, [flush]), + Reply end end. --spec cast(node(), atom(), atom(), [term()]) -> 'true'. +-spec cast(Node, Module, Function, Args) -> true when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()]. cast(Node, Mod, Fun, Args) when Node =:= node() -> catch spawn(Mod, Fun, Args), @@ -349,18 +403,23 @@ cast(Node, Mod, Fun, Args) -> true. -%% Asynchronous broadcast, returns nothing, it's just send'n prey --spec abcast(atom(), term()) -> 'abcast'. +%% Asynchronous broadcast, returns nothing, it's just send 'n' pray +-spec abcast(Name, Msg) -> abcast when + Name :: atom(), + Msg :: term(). abcast(Name, Mess) -> abcast([node() | nodes()], Name, Mess). --spec abcast([node()], atom(), term()) -> 'abcast'. +-spec abcast(Nodes, Name, Msg) -> abcast when + Nodes :: [node()], + Name :: atom(), + Msg :: term(). abcast([Node|Tail], Name, Mess) -> Dest = {Name,Node}, case catch erlang:send(Dest, Mess, [noconnect]) of - noconnect -> spawn(erlang, send, [Dest,Mess]); + noconnect -> spawn(erlang, send, [Dest,Mess]), ok; _ -> ok end, abcast(Tail, Name, Mess); @@ -373,23 +432,39 @@ abcast([], _,_) -> abcast. %% message when we return from the call, we can't know that they have %% processed the message though. --spec sbcast(atom(), term()) -> {[node()], [node()]}. +-spec sbcast(Name, Msg) -> {GoodNodes, BadNodes} when + Name :: atom(), + Msg :: term(), + GoodNodes :: [node()], + BadNodes :: [node()]. sbcast(Name, Mess) -> sbcast([node() | nodes()], Name, Mess). --spec sbcast([node()], atom(), term()) -> {[node()], [node()]}. +-spec sbcast(Nodes, Name, Msg) -> {GoodNodes, BadNodes} when + Name :: atom(), + Msg :: term(), + Nodes :: [node()], + GoodNodes :: [node()], + BadNodes :: [node()]. sbcast(Nodes, Name, Mess) -> Monitors = send_nodes(Nodes, ?NAME, {sbcast, Name, Mess}, []), rec_nodes(?NAME, Monitors). --spec eval_everywhere(atom(), atom(), [term()]) -> 'abcast'. +-spec eval_everywhere(Module, Function, Args) -> abcast when + Module :: module(), + Function :: atom(), + Args :: [term()]. eval_everywhere(Mod, Fun, Args) -> eval_everywhere([node() | nodes()] , Mod, Fun, Args). --spec eval_everywhere([node()], atom(), atom(), [term()]) -> 'abcast'. +-spec eval_everywhere(Nodes, Module, Function, Args) -> abcast when + Nodes :: [node()], + Module :: module(), + Function :: atom(), + Args :: [term()]. eval_everywhere(Nodes, Mod, Fun, Args) -> gen_server:abcast(Nodes, ?NAME, {cast,Mod,Fun,Args,group_leader()}). @@ -417,33 +492,47 @@ start_monitor(Node, Name) -> {Node,erlang:monitor(process, {Name, Node})} end. -%% Cancels a monitor started with Ref=erlang:monitor(_, _), -%% i.e return value {Node, Ref} from start_monitor/2 above. -unmonitor(Ref) when is_reference(Ref) -> - erlang:demonitor(Ref), - receive - {'DOWN', Ref, _, _, _} -> - true - after 0 -> - true - end. - %% Call apply(M,F,A) on all nodes in parallel --spec multicall(atom(), atom(), [term()]) -> {[_], [node()]}. +-spec multicall(Module, Function, Args) -> {ResL, BadNodes} when + Module :: module(), + Function :: atom(), + Args :: [term()], + ResL :: [term()], + BadNodes :: [node()]. multicall(M, F, A) -> multicall(M, F, A, infinity). --spec multicall([node()], atom(), atom(), [term()]) -> {[_], [node()]} - ; (atom(), atom(), [term()], timeout()) -> {[_], [node()]}. +-spec multicall(Nodes, Module, Function, Args) -> {ResL, BadNodes} when + Nodes :: [node()], + Module :: module(), + Function :: atom(), + Args :: [term()], + ResL :: [term()], + BadNodes :: [node()]; + (Module, Function, Args, Timeout) -> {ResL, BadNodes} when + Module :: module(), + Function :: atom(), + Args :: [term()], + Timeout :: timeout(), + ResL :: [term()], + BadNodes :: [node()]. multicall(Nodes, M, F, A) when is_list(Nodes) -> multicall(Nodes, M, F, A, infinity); multicall(M, F, A, Timeout) -> multicall([node() | nodes()], M, F, A, Timeout). --spec multicall([node()], atom(), atom(), [term()], timeout()) -> {[_], [node()]}. +-spec multicall(Nodes, Module, Function, Args, Timeout) -> + {ResL, BadNodes} when + Nodes :: [node()], + Module :: module(), + Function :: atom(), + Args :: [term()], + Timeout :: timeout(), + ResL :: [term()], + BadNodes :: [node()]. multicall(Nodes, M, F, A, infinity) when is_list(Nodes), is_atom(M), is_atom(F), is_list(A) -> @@ -472,26 +561,27 @@ do_multicall(Nodes, M, F, A, Timeout) -> %% %% There is no apparent order among the replies. --spec multi_server_call(atom(), term()) -> {[_], [node()]}. +-spec multi_server_call(Name, Msg) -> {Replies, BadNodes} when + Name :: atom(), + Msg :: term(), + Replies :: [Reply :: term()], + BadNodes :: [node()]. multi_server_call(Name, Msg) -> multi_server_call([node() | nodes()], Name, Msg). --spec multi_server_call([node()], atom(), term()) -> {[_], [node()]}. +-spec multi_server_call(Nodes, Name, Msg) -> {Replies, BadNodes} when + Nodes :: [node()], + Name :: atom(), + Msg :: term(), + Replies :: [Reply :: term()], + BadNodes :: [node()]. multi_server_call(Nodes, Name, Msg) when is_list(Nodes), is_atom(Name) -> Monitors = send_nodes(Nodes, Name, Msg, []), rec_nodes(Name, Monitors). -%% Deprecated functions. Were only needed when communicating with R6 nodes. - -safe_multi_server_call(Name, Msg) -> - multi_server_call(Name, Msg). - -safe_multi_server_call(Nodes, Name, Msg) -> - multi_server_call(Nodes, Name, Msg). - rec_nodes(Name, Nodes) -> rec_nodes(Name, Nodes, [], []). @@ -504,10 +594,10 @@ rec_nodes(Name, [{N,R} | Tail], Badnodes, Replies) -> rec_nodes(Name, Tail, [N|Badnodes], Replies); {?NAME, N, {nonexisting_name, _}} -> %% used by sbcast() - unmonitor(R), + erlang:demonitor(R, [flush]), rec_nodes(Name, Tail, [N|Badnodes], Replies); {Name, N, Reply} -> %% Name is bound !!! - unmonitor(R), + erlang:demonitor(R, [flush]), rec_nodes(Name, Tail, Badnodes, [Reply|Replies]) end. @@ -516,7 +606,14 @@ rec_nodes(Name, [{N,R} | Tail], Badnodes, Replies) -> %% rpc's towards the same node. I.e. it returns immediately and %% it returns a Key that can be used in a subsequent yield(Key). --spec async_call(node(), atom(), atom(), [term()]) -> pid(). +-opaque key() :: pid(). + +-spec async_call(Node, Module, Function, Args) -> Key when + Node :: node(), + Module :: module(), + Function :: atom(), + Args :: [term()], + Key :: key(). async_call(Node, Mod, Fun, Args) -> ReplyTo = self(), @@ -526,20 +623,28 @@ async_call(Node, Mod, Fun, Args) -> ReplyTo ! {self(), {promise_reply, R}} %% self() is key end). --spec yield(pid()) -> term(). +-spec yield(Key) -> Res | {badrpc, Reason} when + Key :: key(), + Res :: term(), + Reason :: term(). yield(Key) when is_pid(Key) -> {value,R} = do_yield(Key, infinity), R. --spec nb_yield(pid(), timeout()) -> {'value', _} | 'timeout'. +-spec nb_yield(Key, Timeout) -> {value, Val} | timeout when + Key :: key(), + Timeout :: timeout(), + Val :: (Res :: term()) | {badrpc, Reason :: term()}. nb_yield(Key, infinity=Inf) when is_pid(Key) -> do_yield(Key, Inf); nb_yield(Key, Timeout) when is_pid(Key), is_integer(Timeout), Timeout >= 0 -> do_yield(Key, Timeout). --spec nb_yield(pid()) -> {'value', _} | 'timeout'. +-spec nb_yield(Key) -> {value, Val} | timeout when + Key :: key(), + Val :: (Res :: term()) | {badrpc, Reason :: term()}. nb_yield(Key) when is_pid(Key) -> do_yield(Key, 0). @@ -559,7 +664,12 @@ do_yield(Key, Timeout) -> %% ArgL === [{M,F,Args},........] %% Returns a lists of the evaluations in the same order as %% given to ArgL --spec parallel_eval([{atom(), atom(), [_]}]) -> [_]. +-spec parallel_eval(FuncCalls) -> ResL when + FuncCalls :: [{Module, Function, Args}], + Module :: module(), + Function :: atom(), + Args :: [term()], + ResL :: [term()]. parallel_eval(ArgL) -> Nodes = [node() | nodes()], @@ -576,7 +686,13 @@ map_nodes([{M,F,A}|Tail],[Node|MoreNodes], Original) -> %% Parallel version of lists:map/3 with exactly the same %% arguments and return value as lists:map/3, %% except that it calls exit/1 if a network error occurs. --spec pmap({atom(),atom()}, [term()], [term()]) -> [term()]. +-spec pmap(FuncSpec, ExtraArgs, List1) -> List2 when + FuncSpec :: {Module,Function}, + Module :: module(), + Function :: atom(), + ExtraArgs :: [term()], + List1 :: [Elem :: term()], + List2 :: [term()]. pmap({M,F}, As, List) -> check(parallel_eval(build_args(M,F,As, List, [])), []). @@ -593,15 +709,25 @@ check([], Ack) -> Ack. %% location transparent version of process_info --spec pinfo(pid()) -> [{atom(), _}] | 'undefined'. +-spec pinfo(Pid) -> [{Item, Info}] | undefined when + Pid :: pid(), + Item :: atom(), + Info :: term(). pinfo(Pid) when node(Pid) =:= node() -> process_info(Pid); pinfo(Pid) -> call(node(Pid), erlang, process_info, [Pid]). --spec pinfo(pid(), Item) -> {Item, _} | 'undefined' | [] - when is_subtype(Item, atom()). +-spec pinfo(Pid, Item) -> {Item, Info} | undefined | [] when + Pid :: pid(), + Item :: atom(), + Info :: term(); + (Pid, ItemList) -> [{Item, Info}] | undefined | [] when + Pid :: pid(), + Item :: atom(), + ItemList :: [Item], + Info :: term(). pinfo(Pid, Item) when node(Pid) =:= node() -> process_info(Pid, Item); diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index 78c3040f21..cc0c10909b 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -22,7 +23,9 @@ -define(SEQ_TRACE_SEND, 1). %(1 << 0) -define(SEQ_TRACE_RECEIVE, 2). %(1 << 1) -define(SEQ_TRACE_PRINT, 4). %(1 << 2) --define(SEQ_TRACE_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4) +-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5) -export([set_token/1, set_token/2, @@ -36,17 +39,19 @@ %%--------------------------------------------------------------------------- --type flag() :: 'send' | 'receive' | 'print' | 'timestamp'. +-type flag() :: 'send' | 'receive' | 'print' | 'timestamp' | 'monotonic_timestamp' | 'strict_monotonic_timestamp'. -type component() :: 'label' | 'serial' | flag(). --type value() :: non_neg_integer() - | {non_neg_integer(), non_neg_integer()} - | boolean(). --type token_pair() :: {component(), value()}. +-type value() :: (Integer :: non_neg_integer()) + | {Previous :: non_neg_integer(), + Current :: non_neg_integer()} + | (Bool :: boolean()). %%--------------------------------------------------------------------------- --type token() :: [] | {integer(), boolean(), _, _, _}. --spec set_token(token()) -> token() | 'ok'. +-type token() :: {integer(), boolean(), _, _, _}. +-spec set_token(Token) -> PreviousToken | 'ok' when + Token :: [] | token(), + PreviousToken :: [] | token(). set_token([]) -> erlang:seq_trace(sequential_trace_token,[]); @@ -58,28 +63,35 @@ set_token({Flags,Label,Serial,_From,Lastcnt}) -> %% expects that, the BIF can however "unofficially" handle atoms as well, and %% atoms can be used if only Erlang nodes are involved --spec set_token(component(), value()) -> token_pair(). +-spec set_token(Component, Val) -> {Component, OldVal} when + Component :: component(), + Val :: value(), + OldVal :: value(). set_token(Type, Val) -> erlang:seq_trace(Type, Val). --spec get_token() -> term(). +-spec get_token() -> [] | token(). get_token() -> element(2,process_info(self(),sequential_trace_token)). --spec get_token(component()) -> token_pair(). - +-spec get_token(Component) -> {Component, Val} when + Component :: component(), + Val :: value(). get_token(Type) -> erlang:seq_trace_info(Type). --spec print(term()) -> 'ok'. +-spec print(TraceInfo) -> 'ok' when + TraceInfo :: term(). print(Term) -> erlang:seq_trace_print(Term), ok. --spec print(integer(), term()) -> 'ok'. +-spec print(Label, TraceInfo) -> 'ok' when + Label :: integer(), + TraceInfo :: term(). print(Label, Term) when is_atom(Label) -> erlang:error(badarg, [Label, Term]); @@ -94,14 +106,27 @@ reset_trace() -> %% reset_trace(Pid) -> % this might be a useful function too --type tracer() :: pid() | port() | 'false'. +-type tracer() :: (Pid :: pid()) | port() | + (TracerModule :: {module(), term()}) | + 'false'. --spec set_system_tracer(tracer()) -> tracer(). +-spec set_system_tracer(Tracer) -> OldTracer when + Tracer :: tracer(), + OldTracer :: tracer(). -set_system_tracer(Pid) -> - erlang:system_flag(sequential_tracer, Pid). +set_system_tracer({Module, State} = Tracer) -> + case erlang:module_loaded(Module) of + false -> + Module:enabled(trace_status, erlang:self(), State); + true -> + ok + end, + erlang:system_flag(sequential_tracer, Tracer); +set_system_tracer(Tracer) -> + erlang:system_flag(sequential_tracer, Tracer). --spec get_system_tracer() -> tracer(). +-spec get_system_tracer() -> Tracer when + Tracer :: tracer(). get_system_tracer() -> element(2, erlang:system_info(sequential_tracer)). @@ -113,7 +138,7 @@ get_system_tracer() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% set_token2([{Type,Val}|T]) -> - erlang:seq_trace(Type, Val), + _ = erlang:seq_trace(Type, Val), set_token2(T); set_token2([]) -> ok. @@ -122,5 +147,9 @@ decode_flags(Flags) -> Print = (Flags band ?SEQ_TRACE_PRINT) > 0, Send = (Flags band ?SEQ_TRACE_SEND) > 0, Rec = (Flags band ?SEQ_TRACE_RECEIVE) > 0, - Ts = (Flags band ?SEQ_TRACE_TIMESTAMP) > 0, - [{print,Print},{send,Send},{'receive',Rec},{timestamp,Ts}]. + NowTs = (Flags band ?SEQ_TRACE_NOW_TIMESTAMP) > 0, + StrictMonTs = (Flags band ?SEQ_TRACE_STRICT_MON_TIMESTAMP) > 0, + MonTs = (Flags band ?SEQ_TRACE_MON_TIMESTAMP) > 0, + [{print,Print},{send,Send},{'receive',Rec},{timestamp,NowTs}, + {strict_monotonic_timestamp, StrictMonTs}, + {monotonic_timestamp, MonTs}]. diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 73901d9896..5d649e5f94 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -1,19 +1,20 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 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. -%% +%% +%% Copyright Ericsson AB 2009-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% -module(standard_error). @@ -24,8 +25,6 @@ -define(NAME, standard_error). -define(PROCNAME_SUP, standard_error_sup). -%% Internal exports --export([server/1, server/2]). %% Defines for control ops -define(CTRL_OP_GET_WINSIZE,100). @@ -33,13 +32,19 @@ %% %% The basic server and start-up. %% +-spec start_link() -> 'ignore' | {'error',term()} | {'ok',pid()}. + start_link() -> supervisor_bridge:start_link({local, ?PROCNAME_SUP}, ?MODULE, []). +-spec terminate(term(), pid()) -> 'ok'. + terminate(_Reason,Pid) -> (catch exit(Pid,kill)), ok. +-spec init([]) -> {'error','no_stderror'} | {'ok',pid(),pid()}. + init([]) -> case (catch start_port([out,binary])) of Pid when is_pid(Pid) -> @@ -48,31 +53,24 @@ init([]) -> {error,no_stderror} end. - start_port(PortSettings) -> - Id = spawn(?MODULE,server,[{fd,2,2},PortSettings]), - register(?NAME,Id), + Id = spawn(fun () -> server({fd,2,2}, PortSettings) end), + register(?NAME, Id), Id. - -server(Pid) when is_pid(Pid) -> - process_flag(trap_exit, true), - link(Pid), - run(Pid). - server(PortName,PortSettings) -> process_flag(trap_exit, true), Port = open_port(PortName,PortSettings), run(Port). run(P) -> - put(unicode,false), + put(encoding, latin1), server_loop(P). server_loop(Port) -> receive {io_request,From,ReplyAs,Request} when is_pid(From) -> - do_io_request(Request, From, ReplyAs, Port), + _ = do_io_request(Request, From, ReplyAs, Port), server_loop(Port); {'EXIT',Port,badsig} -> % Ignore badsig errors server_loop(Port); @@ -82,17 +80,15 @@ server_loop(Port) -> server_loop(Port) end. - get_fd_geometry(Port) -> case (catch port_control(Port,?CTRL_OP_GET_WINSIZE,[])) of - List when is_list(List), length(List) =:= 8 -> + List when length(List) =:= 8 -> <<W:32/native,H:32/native>> = list_to_binary(List), {W,H}; _ -> error end. - %% NewSaveBuffer = io_request(Request, FromPid, ReplyAs, Port, SaveBuffer) do_io_request(Req, From, ReplyAs, Port) -> @@ -100,25 +96,47 @@ do_io_request(Req, From, ReplyAs, Port) -> io_reply(From, ReplyAs, Reply). %% New in R13B -% Wide characters (Unicode) -io_request({put_chars,Encoding,Chars}, Port) -> % Binary new in R9C - put_chars(wrap_characters_to_binary(Chars,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end), Port); -io_request({put_chars,Encoding,Mod,Func,Args}, Port) -> - Result = case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - wrap_characters_to_binary(Data,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end); - Undef -> - Undef - end, - put_chars(Result, Port); +%% Encoding option (unicode/latin1) +io_request({put_chars,unicode,Chars}, Port) -> + case wrap_characters_to_binary(Chars, unicode, get(encoding)) of + error -> + {error,{error,put_chars}}; + Bin -> + put_chars(Bin, Port) + end; +io_request({put_chars,unicode,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case wrap_characters_to_binary(Data, unicode, get(encoding)) of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + error -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Chars}, Port) -> + case catch unicode:characters_to_binary(Chars, latin1, get(encoding)) of + Data when is_binary(Data) -> + put_chars(Data, Port); + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case + catch unicode:characters_to_binary(Data, latin1, get(encoding)) + of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + _ -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; %% BC if called from pre-R13 node io_request({put_chars,Chars}, Port) -> io_request({put_chars,latin1,Chars}, Port); @@ -139,10 +157,10 @@ io_request({get_geometry,rows},Port) -> _ -> {error,{error,enotsup}} end; -io_request({getopts,[]}, Port) -> - getopts(Port); -io_request({setopts,Opts}, Port) when is_list(Opts) -> - setopts(Opts, Port); +io_request(getopts, _Port) -> + getopts(); +io_request({setopts,Opts}, _Port) when is_list(Opts) -> + setopts(Opts); io_request({requests,Reqs}, Port) -> io_requests(Reqs, {ok,ok}, Port); io_request(R, _Port) -> %Unknown request @@ -180,53 +198,49 @@ io_reply(From, ReplyAs, Reply) -> %% put_chars put_chars(Chars, Port) when is_binary(Chars) -> - put_port(Chars, Port), - {ok,ok}; -put_chars(Chars, Port) -> - case catch list_to_binary(Chars) of - Binary when is_binary(Binary) -> - put_chars(Binary, Port); - _ -> - {error,{error,put_chars}} - end. + _ = put_port(Chars, Port), + {ok,ok}. %% setopts -setopts(Opts0,Port) -> - Opts = proplists:unfold( - proplists:substitute_negations( - [{latin1,unicode}], - Opts0)), +setopts(Opts0) -> + Opts = expand_encoding(Opts0), case check_valid_opts(Opts) of - true -> - do_setopts(Opts,Port); - false -> - {error,{error,enotsup}} + true -> + do_setopts(Opts); + false -> + {error,{error,enotsup}} end. + check_valid_opts([]) -> true; -check_valid_opts([{unicode,Valid}|T]) when Valid =:= true; Valid =:= utf8; Valid =:= false -> +check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; + Valid =:= utf8; Valid =:= latin1 -> check_valid_opts(T); check_valid_opts(_) -> false. -do_setopts(Opts, _Port) -> - case proplists:get_value(unicode,Opts) of - Valid when Valid =:= true; Valid =:= utf8 -> - put(unicode,true); - false -> - put(unicode,false); - undefined -> - ok +expand_encoding([]) -> + []; +expand_encoding([latin1 | T]) -> + [{encoding,latin1} | expand_encoding(T)]; +expand_encoding([unicode | T]) -> + [{encoding,unicode} | expand_encoding(T)]; +expand_encoding([H|T]) -> + [H|expand_encoding(T)]. + +do_setopts(Opts) -> + case proplists:get_value(encoding, Opts) of + Valid when Valid =:= unicode; Valid =:= utf8 -> + put(encoding, unicode); + latin1 -> + put(encoding, latin1); + undefined -> + ok end, {ok,ok}. -getopts(_Port) -> - Uni = {unicode, case get(unicode) of - true -> - true; - _ -> - false - end}, +getopts() -> + Uni = {encoding,get(encoding)}, {ok,[Uni]}. wrap_characters_to_binary(Chars,From,To) -> @@ -237,17 +251,17 @@ wrap_characters_to_binary(Chars,From,To) -> _Else -> 16#10ffff end, - unicode:characters_to_binary( - [ case X of - $\n -> - if - TrNl -> - "\r\n"; - true -> - $\n - end; - High when High > Limit -> - ["\\x{",erlang:integer_to_list(X, 16),$}]; - Ordinary -> - Ordinary - end || X <- unicode:characters_to_list(Chars,From) ],unicode,To). + case catch unicode:characters_to_list(Chars, From) of + L when is_list(L) -> + unicode:characters_to_binary( + [ case X of + $\n when TrNl -> + "\r\n"; + High when High > Limit -> + ["\\x{",erlang:integer_to_list(X, 16),$}]; + Low -> + Low + end || X <- L ], unicode, To); + _ -> + error + end. diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl index 17dc5a56a2..a5cc7b0ec1 100644 --- a/lib/kernel/src/user.erl +++ b/lib/kernel/src/user.erl @@ -1,23 +1,24 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% 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. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(user). --compile( [ inline, { inline_size, 100 } ] ). +-compile(inline). %% Basic standard i/o server for user interface port. @@ -26,9 +27,6 @@ -define(NAME, user). -%% Internal exports --export([server/1, server/2]). - %% Defines for control ops -define(CTRL_OP_GET_WINSIZE,100). @@ -43,7 +41,7 @@ start([Mod,Fun|Args]) -> %% Mod,Fun,Args should return a pid. That process is supposed to act %% as the io port. Pid = apply(Mod, Fun, Args), % This better work! - Id = spawn(?MODULE, server, [Pid]), + Id = spawn(fun() -> server(Pid) end), register(?NAME, Id), Id. @@ -52,8 +50,8 @@ start_out() -> start_port([out,binary]). start_port(PortSettings) -> - Id = spawn(?MODULE,server,[{fd,0,1},PortSettings]), - register(?NAME,Id), + Id = spawn(fun() -> server({fd,0,1}, PortSettings) end), + register(?NAME, Id), Id. %% Return the pid of the shell process. @@ -72,7 +70,6 @@ interfaces(User) -> [] end. - server(Pid) when is_pid(Pid) -> process_flag(trap_exit, true), link(Pid), @@ -85,7 +82,7 @@ server(PortName,PortSettings) -> run(P) -> put(read_mode,list), - put(unicode,false), + put(encoding,latin1), case init:get_argument(noshell) of %% non-empty list -> noshell {ok, [_|_]} -> @@ -104,14 +101,14 @@ catch_loop(Port, Shell, Q) -> new_shell -> exit(Shell, kill), catch_loop(Port, start_new_shell()); - {unknown_exit,{Shell,Reason},_} -> % shell has exited + {unknown_exit,{Shell,Reason},_} -> % shell has exited case Reason of normal -> - put_chars("*** ", Port, []); + put_port(<<"*** ">>, Port); _ -> - put_chars("*** ERROR: ", Port, []) + put_port(<<"*** ERROR: ">>, Port) end, - put_chars("Shell process terminated! ***\n", Port, []), + put_port(<<"Shell process terminated! ***\n">>, Port), catch_loop(Port, start_new_shell()); {unknown_exit,_,Q1} -> catch_loop(Port, Shell, Q1); @@ -172,7 +169,7 @@ server_loop(Port, Q) -> get_fd_geometry(Port) -> case (catch port_control(Port,?CTRL_OP_GET_WINSIZE,[])) of - List when is_list(List), length(List) =:= 8 -> + List when length(List) =:= 8 -> <<W:32/native,H:32/native>> = list_to_binary(List), {W,H}; _ -> @@ -185,53 +182,55 @@ get_fd_geometry(Port) -> do_io_request(Req, From, ReplyAs, Port, Q0) -> case io_request(Req, Port, Q0) of {_Status,Reply,Q1} -> - io_reply(From, ReplyAs, Reply), + _ = io_reply(From, ReplyAs, Reply), Q1; {exit,What} -> - send_port(Port, close), + ok = send_port(Port, close), exit(What) end. %% New in R13B %% Encoding option (unicode/latin1) io_request({put_chars,unicode,Chars}, Port, Q) -> % Binary new in R9C - put_chars(wrap_characters_to_binary(Chars,unicode, - case get(unicode) of - true -> unicode; - _ -> latin1 - end), Port, Q); + case wrap_characters_to_binary(Chars, unicode, get(encoding)) of + error -> + {error,{error,put_chars},Q}; + Bin -> + put_chars(Bin, Port, Q) + end; io_request({put_chars,unicode,Mod,Func,Args}, Port, Q) -> - Result = case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - wrap_characters_to_binary(Data,unicode, - case get(unicode) of - true -> unicode; - _ -> latin1 - end); - Undef -> - Undef - end, - put_chars(Result, Port, Q); + case catch apply(Mod,Func,Args) of + Data when is_list(Data); is_binary(Data) -> + case wrap_characters_to_binary(Data, unicode, get(encoding)) of + Bin when is_binary(Bin) -> + put_chars(Bin, Port, Q); + error -> + {error,{error,put_chars},Q} + end; + Undef -> + put_chars(Undef, Port, Q) + end; io_request({put_chars,latin1,Chars}, Port, Q) -> % Binary new in R9C - Data = case get(unicode) of - true -> - unicode:characters_to_binary(Chars,latin1,unicode); - false -> - erlang:iolist_to_binary(Chars) - end, - put_chars(Data, Port, Q); + case catch unicode:characters_to_binary(Chars, latin1, get(encoding)) of + Data when is_binary(Data) -> + put_chars(Data, Port, Q); + _ -> + {error,{error,put_chars},Q} + end; io_request({put_chars,latin1,Mod,Func,Args}, Port, Q) -> - Result = case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - unicode:characters_to_binary(Data,latin1, - case get(unicode) of - true -> unicode; - _ -> latin1 - end); - Undef -> - Undef - end, - put_chars(Result, Port, Q); + case catch apply(Mod,Func,Args) of + Data when is_list(Data); is_binary(Data) -> + case + catch unicode:characters_to_binary(Data,latin1,get(encoding)) + of + Bin when is_binary(Bin) -> + put_chars(Bin, Port, Q); + _ -> + {error,{error,put_chars},Q} + end; + Undef -> + put_chars(Undef, Port, Q) + end; io_request({get_chars,Enc,Prompt,N}, Port, Q) -> % New in R9C get_chars(Prompt, io_lib, collect_chars, N, Port, Q, Enc); io_request({get_line,Enc,Prompt}, Port, Q) -> @@ -301,7 +300,8 @@ put_port(List, Port) -> %% send_port(Port, Command) send_port(Port, Command) -> - Port ! {self(),Command}. + Port ! {self(),Command}, + ok. %% io_reply(From, ReplyAs, Reply) %% The function for sending i/o command acknowledgement. @@ -312,7 +312,7 @@ io_reply(From, ReplyAs, Reply) -> %% put_chars put_chars(Chars, Port, Q) when is_binary(Chars) -> - put_port(Chars, Port), + ok = put_port(Chars, Port), {ok,ok,Q}; put_chars(Chars, Port, Q) -> case catch list_to_binary(Chars) of @@ -355,9 +355,9 @@ check_valid_opts(_) -> do_setopts(Opts, _Port, Q) -> case proplists:get_value(encoding,Opts) of Valid when Valid =:= unicode; Valid =:= utf8 -> - put(unicode,true); + put(encoding,unicode); latin1 -> - put(unicode,false); + put(encoding,latin1); undefined -> ok end, @@ -373,29 +373,23 @@ do_setopts(Opts, _Port, Q) -> end. getopts(_Port,Q) -> - Bin = {binary, case get(read_mode) of - binary -> - true; - _ -> - false - end}, - Uni = {encoding, case get(unicode) of - true -> - unicode; - _ -> - latin1 - end}, + Bin = {binary, get(read_mode) =:= binary}, + Uni = {encoding, get(encoding)}, {ok,[Bin,Uni],Q}. - get_line_bin(Prompt,Port,Q, Enc) -> - prompt(Port, Prompt), - case {get(eof),queue:is_empty(Q)} of - {true,true} -> - {ok,eof,Q}; - _ -> - get_line(Prompt,Port, Q, [], Enc) + case prompt(Port, Prompt) of + error -> + {error,{error,get_line},Q}; + ok -> + case {get(eof),queue:is_empty(Q)} of + {true,true} -> + {ok,eof,Q}; + _ -> + get_line(Prompt,Port, Q, [], Enc) + end end. + get_line(Prompt, Port, Q, Acc, Enc) -> case queue:is_empty(Q) of true -> @@ -412,8 +406,12 @@ get_line(Prompt, Port, Q, Acc, Enc) -> get_line(Prompt, Port, Q, Acc, Enc); {io_request,From,ReplyAs,Request} when is_pid(From) -> do_io_request(Request, From, ReplyAs, Port, queue:new()), - prompt(Port, Prompt), - get_line(Prompt, Port, Q, Acc, Enc); + case prompt(Port, Prompt) of + error -> + {error,{error,get_line},Q}; + ok -> + get_line(Prompt, Port, Q, Acc, Enc) + end; {'EXIT',From,What} when node(From) =:= node() -> {exit,What} end; @@ -446,6 +444,7 @@ srch(<<X:8,_/binary>>,X,N) -> {match,[{N,1}]}; srch(<<_:8,T/binary>>,X,N) -> srch(T,X,N+1). + get_line_doit(Prompt, Port, Q, Accu, Enc) -> case queue:is_empty(Q) of true -> @@ -584,31 +583,36 @@ binrev(L, T) -> %% end %% end %% end. -%% get_chars(Prompt, Module, Function, XtraArg, Port, Queue) +%% get_chars(Prompt, Module, Function, XtraArg, Port, Queue, Encoding) %% Gets characters from the input port until the applied function %% returns {stop,Result,RestBuf}. Does not block output until input -%% has been received. +%% has been received. Encoding is the encoding of the data sent to +%% the client and to Function. %% Returns: %% {Status,Result,NewQueue} %% {exit,Reason} %% Entry function. -get_chars(Prompt, M, F, Xa, Port, Q, Fmt) -> - prompt(Port, Prompt), - case {get(eof),queue:is_empty(Q)} of - {true,true} -> - {ok,eof,Q}; - _ -> - get_chars(Prompt, M, F, Xa, Port, Q, start, Fmt) +get_chars(Prompt, M, F, Xa, Port, Q, Enc) -> + case prompt(Port, Prompt) of + error -> + {error,{error,get_chars},Q}; + ok -> + case {get(eof),queue:is_empty(Q)} of + {true,true} -> + {ok,eof,Q}; + _ -> + get_chars(Prompt, M, F, Xa, Port, Q, start, Enc) + end end. %% First loop. Wait for port data. Respond to output requests. -get_chars(Prompt, M, F, Xa, Port, Q, State, Fmt) -> +get_chars(Prompt, M, F, Xa, Port, Q, State, Enc) -> case queue:is_empty(Q) of true -> receive {Port,{data,Bytes}} -> - get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Fmt); + get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Enc); {Port, eof} -> put(eof, true), {ok, eof, []}; @@ -619,41 +623,45 @@ get_chars(Prompt, M, F, Xa, Port, Q, State, Fmt) -> do_io_request(Req, From, ReplyAs, Port, queue:new()), %Keep Q over this call %% No prompt. - get_chars(Prompt, M, F, Xa, Port, Q, State, Fmt); + get_chars(Prompt, M, F, Xa, Port, Q, State, Enc); {io_request,From,ReplyAs,Request} when is_pid(From) -> get_chars_req(Prompt, M, F, Xa, Port, Q, State, - Request, From, ReplyAs, Fmt); + Request, From, ReplyAs, Enc); {'EXIT',From,What} when node(From) =:= node() -> {exit,What} end; false -> - get_chars_apply(State, M, F, Xa, Port, Q, Fmt) + get_chars_apply(State, M, F, Xa, Port, Q, Enc) end. get_chars_req(Prompt, M, F, XtraArg, Port, Q, State, - Req, From, ReplyAs, Fmt) -> + Req, From, ReplyAs, Enc) -> do_io_request(Req, From, ReplyAs, Port, queue:new()), %Keep Q over this call - prompt(Port, Prompt), - get_chars(Prompt, M, F, XtraArg, Port, Q, State, Fmt). + case prompt(Port, Prompt) of + error -> + {error,{error,get_chars},Q}; + ok -> + get_chars(Prompt, M, F, XtraArg, Port, Q, State, Enc) + end. %% Second loop. Pass data to client as long as it wants more. %% A ^G in data interrupts loop if 'noshell' is not undefined. -get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Fmt) -> +get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Enc) -> case get(shell) of noshell -> - get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, Bytes),Fmt); + get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, Bytes),Enc); _ -> case contains_ctrl_g_or_ctrl_c(Bytes) of false -> get_chars_apply(State, M, F, Xa, Port, - queue:snoc(Q, Bytes),Fmt); + queue:snoc(Q, Bytes),Enc); _ -> throw(new_shell) end end. -get_chars_apply(State0, M, F, Xa, Port, Q, Fmt) -> - case catch M:F(State0, cast(queue:head(Q),Fmt), Fmt, Xa) of +get_chars_apply(State0, M, F, Xa, Port, Q, Enc) -> + case catch M:F(State0, cast(queue:head(Q),Enc), Enc, Xa) of {stop,Result,<<>>} -> {ok,Result,queue:tail(Q)}; {stop,Result,[]} -> @@ -662,32 +670,32 @@ get_chars_apply(State0, M, F, Xa, Port, Q, Fmt) -> {ok,Result,queue:tail(Q)}; {stop,Result,Buf} -> {ok,Result,queue:cons(Buf, queue:tail(Q))}; - {'EXIT',_} -> + {'EXIT',_Why} -> {error,{error,err_func(M, F, Xa)},queue:new()}; State1 -> - get_chars_more(State1, M, F, Xa, Port, queue:tail(Q), Fmt) + get_chars_more(State1, M, F, Xa, Port, queue:tail(Q), Enc) end. -get_chars_more(State, M, F, Xa, Port, Q, Fmt) -> +get_chars_more(State, M, F, Xa, Port, Q, Enc) -> case queue:is_empty(Q) of true -> case get(eof) of undefined -> receive {Port,{data,Bytes}} -> - get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Fmt); + get_chars_bytes(State, M, F, Xa, Port, Q, Bytes, Enc); {Port,eof} -> put(eof, true), get_chars_apply(State, M, F, Xa, Port, - queue:snoc(Q, eof), Fmt); + queue:snoc(Q, eof), Enc); {'EXIT',From,What} when node(From) =:= node() -> {exit,What} end; _ -> - get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, eof), Fmt) + get_chars_apply(State, M, F, Xa, Port, queue:snoc(Q, eof), Enc) end; false -> - get_chars_apply(State, M, F, Xa, Port, Q, Fmt) + get_chars_apply(State, M, F, Xa, Port, Q, Enc) end. @@ -696,13 +704,15 @@ get_chars_more(State, M, F, Xa, Port, Q, Fmt) -> %% common case, reduces execution time by 20% prompt(_Port, '') -> ok; - prompt(Port, Prompt) -> - put_port(wrap_characters_to_binary(io_lib:format_prompt(Prompt),unicode, - case get(unicode) of - true -> unicode; - _ -> latin1 - end), Port). + Encoding = get(encoding), + PromptString = io_lib:format_prompt(Prompt, Encoding), + case wrap_characters_to_binary(PromptString, unicode, Encoding) of + Bin when is_binary(Bin) -> + put_port(Bin, Port); + error -> + error + end. %% Convert error code to make it look as before err_func(io_lib, get_until, {_,F,_}) -> @@ -719,72 +729,90 @@ contains_ctrl_g_or_ctrl_c(BinOrList)-> end. %% Convert a buffer between list and binary -cast(Data, _Format) when is_atom(Data) -> +cast(Data, _Encoding) when is_atom(Data) -> Data; -cast(Data, Format) -> - cast(Data, get(read_mode), Format, get(unicode)). +cast(Data, Encoding) -> + IoEncoding = get(encoding), + cast(Data, get(read_mode), IoEncoding, Encoding). -cast(B, binary, latin1, false) when is_binary(B) -> +cast(B, binary, latin1, latin1) when is_binary(B) -> B; -cast(B, binary, latin1, true) when is_binary(B) -> - unicode:characters_to_binary(B, unicode, latin1); -cast(L, binary, latin1, false) -> - erlang:iolist_to_binary(L); -cast(L, binary, latin1, true) -> - case unicode:characters_to_binary( - erlang:iolist_to_binary(L),unicode,latin1) of % may fail - {error,_,_} -> exit({no_translation, unicode, latin1}); - Else -> Else +cast(L, binary, latin1, latin1) -> + case catch erlang:iolist_to_binary(L) of + Bin when is_binary(Bin) -> Bin; + _ -> exit({no_translation, latin1, latin1}) + end; +cast(Data, binary, unicode, latin1) when is_binary(Data); is_list(Data) -> + case catch unicode:characters_to_binary(Data, unicode, latin1) of + Bin when is_binary(Bin) -> Bin; + _ -> exit({no_translation, unicode, latin1}) end; -cast(B, binary, unicode, true) when is_binary(B) -> +cast(Data, binary, latin1, unicode) when is_binary(Data); is_list(Data) -> + case catch unicode:characters_to_binary(Data, latin1, unicode) of + Bin when is_binary(Bin) -> Bin; + _ -> exit({no_translation, latin1, unicode}) + end; +cast(B, binary, unicode, unicode) when is_binary(B) -> B; -cast(B, binary, unicode, false) when is_binary(B) -> - unicode:characters_to_binary(B,latin1,unicode); -cast(L, binary, unicode, true) -> - % possibly a list containing UTF-8 encoded characters - unicode:characters_to_binary(erlang:iolist_to_binary(L)); -cast(L, binary, unicode, false) -> - unicode:characters_to_binary(L, latin1, unicode); -cast(L, list, latin1, UniTerm) -> - case UniTerm of - true -> % Convert input characters to protocol format (i.e latin1) - case unicode:characters_to_list( - erlang:iolist_to_binary(L),unicode) of % may fail - {error,_,_} -> exit({no_translation, unicode, latin1}); - Else -> [ case X of - High when High > 255 -> - exit({no_translation, unicode, latin1}); - Low -> - Low - end || X <- Else ] - end; - _ -> - binary_to_list(erlang:iolist_to_binary(L)) +cast(L, binary, unicode, unicode) -> + case catch unicode:characters_to_binary(L, unicode) of + Bin when is_binary(Bin) -> Bin; + _ -> exit({no_translation, unicode, unicode}) end; -cast(L, list, unicode, UniTerm) -> - unicode:characters_to_list(erlang:iolist_to_binary(L), - case UniTerm of - true -> unicode; - _ -> latin1 - end); -cast(Other, _, _,_) -> - Other. - -wrap_characters_to_binary(Chars,unicode,latin1) -> - case unicode:characters_to_binary(Chars,unicode,latin1) of - {error,_,_} -> - list_to_binary( - [ case X of - High when High > 255 -> - ["\\x{",erlang:integer_to_list(X, 16),$}]; - Low -> - Low - end || X <- unicode:characters_to_list(Chars,unicode) ]); - Bin -> - Bin +cast(B, list, latin1, latin1) when is_binary(B) -> + binary_to_list(B); +cast(L, list, latin1, latin1) -> + case catch erlang:iolist_to_binary(L) of + Bin when is_binary(Bin) -> binary_to_list(Bin); + _ -> exit({no_translation, latin1, latin1}) end; - -wrap_characters_to_binary(Bin,From,From) when is_binary(Bin) -> +cast(Data, list, unicode, latin1) when is_binary(Data); is_list(Data) -> + case catch unicode:characters_to_list(Data, unicode) of + Chars when is_list(Chars) -> + [ case X of + High when High > 255 -> + exit({no_translation, unicode, latin1}); + Low -> + Low + end || X <- Chars ]; + _ -> + exit({no_translation, unicode, latin1}) + end; +cast(Data, list, latin1, unicode) when is_binary(Data); is_list(Data) -> + case catch unicode:characters_to_list(Data, latin1) of + Chars when is_list(Chars) -> Chars; + _ -> exit({no_translation, latin1, unicode}) + end; +cast(Data, list, unicode, unicode) when is_binary(Data); is_list(Data) -> + case catch unicode:characters_to_list(Data, unicode) of + Chars when is_list(Chars) -> Chars; + _ -> exit({no_translation, unicode, unicode}) + end. + +wrap_characters_to_binary(Chars, unicode, latin1) -> + case catch unicode:characters_to_binary(Chars, unicode, latin1) of + Bin when is_binary(Bin) -> + Bin; + _ -> + case catch unicode:characters_to_list(Chars, unicode) of + L when is_list(L) -> + list_to_binary( + [ case X of + High when High > 255 -> + ["\\x{",erlang:integer_to_list(X, 16),$}]; + Low -> + Low + end || X <- L ]); + _ -> + error + end + end; +wrap_characters_to_binary(Bin, From, From) when is_binary(Bin) -> Bin; -wrap_characters_to_binary(Chars,From,To) -> - unicode:characters_to_binary(Chars,From,To). +wrap_characters_to_binary(Chars, From, To) -> + case catch unicode:characters_to_binary(Chars, From, To) of + Bin when is_binary(Bin) -> + Bin; + _ -> + error + end. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index c34f2ddeb0..b794d4f45e 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,6 +30,7 @@ -define(OP_INSC,2). -define(OP_DELC,3). -define(OP_BEEP,4). +-define(OP_PUTC_SYNC,5). % Control op -define(CTRL_OP_GET_WINSIZE,100). -define(CTRL_OP_GET_UNICODE_STATE,101). @@ -117,8 +119,9 @@ server1(Iport, Oport, Shell) -> {Curr,Shell1} = case init:get_argument(remsh) of {ok,[[Node]]} -> - RShell = {list_to_atom(Node),shell,start,[]}, - RGr = group:start(self(), RShell), + ANode = list_to_atom(Node), + RShell = {ANode,shell,start,[]}, + RGr = group:start(self(), RShell, rem_sh_opts(ANode)), {RGr,RShell}; E when E =:= error ; E =:= {ok,[[]]} -> {group:start(self(), Shell),Shell} @@ -128,11 +131,15 @@ server1(Iport, Oport, Shell) -> Gr = gr_add_cur(Gr1, Curr, Shell1), %% Print some information. io_request({put_chars, unicode, - flatten(io_lib:format("~s\n", + flatten(io_lib:format("~ts\n", [erlang:system_info(system_version)]))}, Iport, Oport), + %% Enter the server loop. - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, {false, queue:new()}). + +rem_sh_opts(Node) -> + [{expand_fun,fun(B)-> rpc:call(Node,edlin_expand,expand,[B]) end}]. %% start_user() %% Start a group leader process and register it as 'user', unless, @@ -154,42 +161,41 @@ start_user() -> User end. -server_loop(Iport, Oport, User, Gr) -> +server_loop(Iport, Oport, User, Gr, IOQueue) -> Curr = gr_cur_pid(Gr), put(current_group, Curr), - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, IOQueue). -server_loop(Iport, Oport, Curr, User, Gr) -> +server_loop(Iport, Oport, Curr, User, Gr, {Resp, IOQ} = IOQueue) -> receive {Iport,{data,Bs}} -> BsBin = list_to_binary(Bs), Unicode = unicode:characters_to_list(BsBin,utf8), - port_bytes(Unicode, Iport, Oport, Curr, User, Gr); + port_bytes(Unicode, Iport, Oport, Curr, User, Gr, IOQueue); {Iport,eof} -> Curr ! {self(),eof}, - server_loop(Iport, Oport, Curr, User, Gr); - {User,Req} -> % never block from user! - io_request(Req, Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,tty_geometry} -> - Curr ! {self(),tty_geometry,get_tty_geometry(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,get_unicode_state} -> - Curr ! {self(),get_unicode_state,get_unicode_state(Iport)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,set_unicode_state, Bool} -> - Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, - server_loop(Iport, Oport, Curr, User, Gr); - {Curr,Req} -> - io_request(Req, Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + Req when element(1,Req) =:= User orelse element(1,Req) =:= Curr, + tuple_size(Req) =:= 2 orelse tuple_size(Req) =:= 3 -> + %% We match {User|Curr,_}|{User|Curr,_,_} + NewQ = handle_req(Req, Iport, Oport, IOQueue), + server_loop(Iport, Oport, Curr, User, Gr, NewQ); + {Oport,ok} -> + %% We get this ok from the port, in io_request we store + %% info about where to send reply at head of queue + {Origin,Reply} = Resp, + Origin ! {reply,Reply}, + NewQ = handle_req(next, Iport, Oport, {false, IOQ}), + server_loop(Iport, Oport, Curr, User, Gr, NewQ); {'EXIT',Iport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); {'EXIT',Oport,_R} -> - server_loop(Iport, Oport, Curr, User, Gr); + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); + {'EXIT',User,shutdown} -> % force data to port + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); {'EXIT',User,_R} -> % keep 'user' alive NewU = start_user(), - server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {})); + server_loop(Iport, Oport, Curr, NewU, gr_set_num(Gr, 1, NewU, {}), IOQueue); {'EXIT',Pid,R} -> % shell and group leader exit case gr_cur_pid(Gr) of Pid when R =/= die , @@ -209,53 +215,88 @@ server_loop(Iport, Oport, Curr, User, Gr) -> {ok,Gr2} = gr_set_cur(gr_set_num(Gr1, Ix, Pid1, {shell,start,Params}), Ix), put(current_group, Pid1), - server_loop(Iport, Oport, Pid1, User, Gr2); + server_loop(Iport, Oport, Pid1, User, Gr2, IOQueue); _ -> % remote shell io_requests([{put_chars,unicode,"(^G to start new job) ***\n"}], Iport, Oport), - server_loop(Iport, Oport, Curr, User, Gr1) + server_loop(Iport, Oport, Curr, User, Gr1, IOQueue) end; _ -> % not current, just remove it - server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid)) + server_loop(Iport, Oport, Curr, User, gr_del_pid(Gr, Pid), IOQueue) end; _X -> %% Ignore unknown messages. - server_loop(Iport, Oport, Curr, User, Gr) + server_loop(Iport, Oport, Curr, User, Gr, IOQueue) end. +%% We always handle geometry and unicode requests +handle_req({Curr,tty_geometry},Iport,_Oport,IOQueue) -> + Curr ! {self(),tty_geometry,get_tty_geometry(Iport)}, + IOQueue; +handle_req({Curr,get_unicode_state},Iport,_Oport,IOQueue) -> + Curr ! {self(),get_unicode_state,get_unicode_state(Iport)}, + IOQueue; +handle_req({Curr,set_unicode_state, Bool},Iport,_Oport,IOQueue) -> + Curr ! {self(),set_unicode_state,set_unicode_state(Iport,Bool)}, + IOQueue; +handle_req(next,Iport,Oport,{false,IOQ}=IOQueue) -> + case queue:out(IOQ) of + {empty,_} -> + IOQueue; + {{value,{Origin,Req}},ExecQ} -> + case io_request(Req, Iport, Oport) of + ok -> + handle_req(next,Iport,Oport,{false,ExecQ}); + Reply -> + {{Origin,Reply}, ExecQ} + end + end; +handle_req(Msg,Iport,Oport,{false,IOQ}=IOQueue) -> + empty = queue:peek(IOQ), + {Origin,Req} = Msg, + case io_request(Req, Iport, Oport) of + ok -> + IOQueue; + Reply -> + {{Origin,Reply}, IOQ} + end; +handle_req(Msg,_Iport,_Oport,{Resp, IOQ}) -> + %% All requests are queued when we have outstanding sync put_chars + {Resp, queue:in(Msg,IOQ)}. + %% port_bytes(Bytes, InPort, OutPort, CurrentProcess, UserProcess, Group) %% Check the Bytes from the port to see if it contains a ^G. If so, %% either escape to switch_loop or restart the shell. Otherwise send %% the bytes to Curr. -port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr) -> - handle_escape(Iport, Oport, User, Gr); +port_bytes([$\^G|_Bs], Iport, Oport, _Curr, User, Gr, IOQueue) -> + handle_escape(Iport, Oport, User, Gr, IOQueue); -port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr) -> - interrupt_shell(Iport, Oport, Curr, User, Gr); +port_bytes([$\^C|_Bs], Iport, Oport, Curr, User, Gr, IOQueue) -> + interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue); -port_bytes([B], Iport, Oport, Curr, User, Gr) -> +port_bytes([B], Iport, Oport, Curr, User, Gr, IOQueue) -> Curr ! {self(),{data,[B]}}, - server_loop(Iport, Oport, Curr, User, Gr); -port_bytes(Bs, Iport, Oport, Curr, User, Gr) -> + server_loop(Iport, Oport, Curr, User, Gr, IOQueue); +port_bytes(Bs, Iport, Oport, Curr, User, Gr, IOQueue) -> case member($\^G, Bs) of true -> - handle_escape(Iport, Oport, User, Gr); + handle_escape(Iport, Oport, User, Gr, IOQueue); false -> Curr ! {self(),{data,Bs}}, - server_loop(Iport, Oport, Curr, User, Gr) + server_loop(Iport, Oport, Curr, User, Gr, IOQueue) end. -interrupt_shell(Iport, Oport, Curr, User, Gr) -> +interrupt_shell(Iport, Oport, Curr, User, Gr, IOQueue) -> case gr_get_info(Gr, Curr) of undefined -> ok; % unknown _ -> exit(Curr, interrupt) end, - server_loop(Iport, Oport, Curr, User, Gr). + server_loop(Iport, Oport, Curr, User, Gr, IOQueue). -handle_escape(Iport, Oport, User, Gr) -> +handle_escape(Iport, Oport, User, Gr, IOQueue) -> case application:get_env(stdlib, shell_esc) of {ok,abort} -> Pid = gr_cur_pid(Gr), @@ -274,11 +315,14 @@ handle_escape(Iport, Oport, User, Gr) -> Pid1 = group:start(self(), {shell,start,[]}), io_request({put_chars,unicode,"\n"}, Iport, Oport), server_loop(Iport, Oport, User, - gr_add_cur(Gr1, Pid1, {shell,start,[]})); + gr_add_cur(Gr1, Pid1, {shell,start,[]}), IOQueue); _ -> % {ok,jcl} | undefined io_request({put_chars,unicode,"\nUser switch command\n"}, Iport, Oport), - server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr)) + %% init edlin used by switch command and have it copy the + %% text buffer from current group process + edlin:init(gr_cur_pid(Gr)), + server_loop(Iport, Oport, User, switch_loop(Iport, Oport, Gr), IOQueue) end. switch_loop(Iport, Oport, Gr) -> @@ -414,7 +458,7 @@ list_commands(Iport, Oport) -> true -> []; false -> - [{put_chars,unicode," q - quit erlang\n"}] + [{put_chars, unicode," q - quit erlang\n"}] end, io_requests([{put_chars, unicode," c [nn] - connect to job\n"}, {put_chars, unicode," i [nn] - interrupt job\n"}, @@ -484,21 +528,22 @@ set_unicode_state(Iport, Bool) -> %% io_request(Request, InPort, OutPort) %% io_requests(Requests, InPort, OutPort) - -io_request({put_chars, unicode,Cs}, _Iport, Oport) -> - Oport ! {self(),{command,[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)]}}; -io_request({move_rel,N}, _Iport, Oport) -> - Oport ! {self(),{command,[?OP_MOVE|put_int16(N, [])]}}; -io_request({insert_chars,unicode,Cs}, _Iport, Oport) -> - Oport ! {self(),{command,[?OP_INSC|unicode:characters_to_binary(Cs,utf8)]}}; -io_request({delete_chars,N}, _Iport, Oport) -> - Oport ! {self(),{command,[?OP_DELC|put_int16(N, [])]}}; -io_request(beep, _Iport, Oport) -> - Oport ! {self(),{command,[?OP_BEEP]}}; -io_request({requests,Rs}, Iport, Oport) -> - io_requests(Rs, Iport, Oport); -io_request(_R, _Iport, _Oport) -> - ok. +%% Note: InPort is unused. + +io_request(Request, Iport, Oport) -> + try io_command(Request) of + {command,_} = Command -> + Oport ! {self(),Command}, + ok; + {Command,Reply} -> + Oport ! {self(),Command}, + Reply + catch + {requests,Rs} -> + io_requests(Rs, Iport, Oport); + _ -> + ok + end. io_requests([R|Rs], Iport, Oport) -> io_request(R, Iport, Oport), @@ -509,6 +554,27 @@ io_requests([], _Iport, _Oport) -> put_int16(N, Tail) -> [(N bsr 8)band 255,N band 255|Tail]. +%% When a put_chars_sync command is used, user_drv guarantees that +%% the bytes have been put in the buffer of the port before an acknowledgement +%% is sent back to the process sending the request. This command was added in +%% OTP 18 to make sure that data sent from io:format is actually printed +%% to the console before the vm stops when calling erlang:halt(integer()). +-dialyzer({no_improper_lists, io_command/1}). +io_command({put_chars_sync, unicode,Cs,Reply}) -> + {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply}; +io_command({put_chars, unicode,Cs}) -> + {command,[?OP_PUTC|unicode:characters_to_binary(Cs,utf8)]}; +io_command({move_rel,N}) -> + {command,[?OP_MOVE|put_int16(N, [])]}; +io_command({insert_chars,unicode,Cs}) -> + {command,[?OP_INSC|unicode:characters_to_binary(Cs,utf8)]}; +io_command({delete_chars,N}) -> + {command,[?OP_DELC|put_int16(N, [])]}; +io_command(beep) -> + {command,[?OP_BEEP]}; +io_command(Else) -> + throw(Else). + %% gr_new() %% gr_get_num(Group, Index) %% gr_get_info(Group, Pid) diff --git a/lib/kernel/src/user_sup.erl b/lib/kernel/src/user_sup.erl index 35b7ff0cfe..c1fb1b1a48 100644 --- a/lib/kernel/src/user_sup.erl +++ b/lib/kernel/src/user_sup.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. 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. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -45,7 +46,7 @@ init([]) -> Pid = start_slave(Master), {ok, Pid, Pid}; {M, F, A} -> - case start_user({M, F}, A) of + case start_user(M, F, A) of {ok, Pid} -> {ok, Pid, Pid}; Error -> @@ -95,8 +96,8 @@ terminate(_Reason, UserPid) -> %% is guaranteed that the user is started. %%----------------------------------------------------------------- -start_user(Func,A) -> - apply(Func, A), +start_user(Mod, Func, A) -> + apply(Mod, Func, A), wait_for_user_p(100). wait_for_user_p(0) -> diff --git a/lib/kernel/src/wrap_log_reader.erl b/lib/kernel/src/wrap_log_reader.erl index 5030d3aed5..3a984e56c7 100644 --- a/lib/kernel/src/wrap_log_reader.erl +++ b/lib/kernel/src/wrap_log_reader.erl @@ -1,19 +1,20 @@ %% %% %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. -%% +%% +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% %% %CopyrightEnd% %% @@ -30,6 +31,8 @@ -export([open/1, open/2, chunk/1, chunk/2, close/1]). +-export_type([continuation/0]). + -include("disk_log.hrl"). -record(wrap_reader, @@ -37,10 +40,12 @@ cont :: dlog_cont(), % disk_log's continuation record file :: file:filename(), % file name without extension file_no :: non_neg_integer(), % current file number - mod_time :: date_time(), % modification time of current file + mod_time :: file:date_time(), % modification time of current file first_no :: non_neg_integer() | 'one' % first read file number }). +-opaque continuation() :: #wrap_reader{}. + %% %% Exported functions %% @@ -50,9 +55,11 @@ %% is not yet reached, we are on the first 'round' of filling the wrap %% files. --type open_ret() :: {'ok', #wrap_reader{}} | {'error', tuple()}. +-type open_ret() :: {'ok', Continuation :: continuation()} + | {'error', Reason :: tuple()}. --spec open(atom() | string()) -> open_ret(). +-spec open(Filename) -> open_ret() when + Filename :: string() | atom(). open(File) when is_atom(File) -> open(atom_to_list(File)); @@ -77,7 +84,9 @@ open(File) when is_list(File) -> Error end. --spec open(atom() | string(), integer()) -> open_ret(). +-spec open(Filename, N) -> open_ret() when + Filename :: string() | atom(), + N :: integer(). open(File, FileNo) when is_atom(File), is_integer(FileNo) -> open(atom_to_list(File), FileNo); @@ -100,22 +109,29 @@ open(File, FileNo) when is_list(File), is_integer(FileNo) -> Error end. --spec close(#wrap_reader{}) -> 'ok' | {'error', atom()}. +-spec close(Continuation) -> 'ok' | {'error', Reason} when + Continuation :: continuation(), + Reason :: file:posix(). close(#wrap_reader{fd = FD}) -> file:close(FD). --type chunk_ret() :: {#wrap_reader{}, [term()]} - | {#wrap_reader{}, [term()], non_neg_integer()} - | {#wrap_reader{}, 'eof'} - | {'error', term()}. +-type chunk_ret() :: {Continuation2, Terms :: [term()]} + | {Continuation2, + Terms :: [term()], + Badbytes :: non_neg_integer()} + | {Continuation2, 'eof'} + | {'error', Reason :: term()}. --spec chunk(#wrap_reader{}) -> chunk_ret(). +-spec chunk(Continuation) -> chunk_ret() when + Continuation :: continuation(). chunk(WR = #wrap_reader{}) -> chunk(WR, ?MAX_CHUNK_SIZE, 0). --spec chunk(#wrap_reader{}, 'infinity' | pos_integer()) -> chunk_ret(). +-spec chunk(Continuation, N) -> chunk_ret() when + Continuation :: continuation(), + N :: infinity | pos_integer(). chunk(WR = #wrap_reader{}, infinity) -> chunk(WR, ?MAX_CHUNK_SIZE, 0); @@ -134,7 +150,7 @@ open_int(File, FileNo, FirstFileNo) -> {ok, Head} -> case disk_log_1:is_head(Head) of no -> - file:close(Fd), + _ = file:close(Fd), {error, {not_a_log_file, FName}}; _ -> % yes or yes_not_closed case last_mod_time(FName) of @@ -146,12 +162,12 @@ open_int(File, FileNo, FirstFileNo) -> first_no = FirstFileNo}, {ok, WR}; {error, E} -> - file:close(Fd), + _ = file:close(Fd), {error, {file_error, FName, E}} end end; _Other -> - file:close(Fd), + _ = file:close(Fd), {error, {not_a_log_file, FName}} end; _Other -> @@ -265,7 +281,7 @@ read_next_file(WR, N, NewFileNo, Bad) -> true -> case open_int(File, NewFileNo, FirstFileNo) of {ok, NWR} -> - close(WR), %% Now we can safely close the old file. + _ = close(WR), %% Now we can safely close the old file. chunk(NWR, N, Bad); Error -> Error |