diff options
Diffstat (limited to 'lib/kernel/src')
74 files changed, 1944 insertions, 1629 deletions
diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 57dacebde3..2b72f78dcf 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1996-2013. All Rights Reserved. +# 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. @@ -104,6 +104,8 @@ MODULES = \ inet_sctp \ kernel \ kernel_config \ + local_udp \ + local_tcp \ net \ net_adm \ net_kernel \ @@ -244,6 +246,8 @@ $(EBIN)/inet_tcp.beam: inet_int.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)/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 diff --git a/lib/kernel/src/application.erl b/lib/kernel/src/application.erl index 1abfbfb9ec..bc6be2f8f5 100644 --- a/lib/kernel/src/application.erl +++ b/lib/kernel/src/application.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index b1ca2ea64f..0e61153613 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/application_master.erl b/lib/kernel/src/application_master.erl index 85b7efc402..5da2b0b06c 100644 --- a/lib/kernel/src/application_master.erl +++ b/lib/kernel/src/application_master.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/application_master.hrl b/lib/kernel/src/application_master.hrl index f252ce8f16..b03074dbce 100644 --- a/lib/kernel/src/application_master.hrl +++ b/lib/kernel/src/application_master.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/application_starter.erl b/lib/kernel/src/application_starter.erl index 692681b515..f51f9bbc45 100644 --- a/lib/kernel/src/application_starter.erl +++ b/lib/kernel/src/application_starter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/auth.erl b/lib/kernel/src/auth.erl index 78cf1e77be..40feee6bf0 100644 --- a/lib/kernel/src/auth.erl +++ b/lib/kernel/src/auth.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 7237550786..8d0a2fbf66 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. @@ -28,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, @@ -60,7 +64,7 @@ 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, @@ -68,7 +72,10 @@ clash/0, get_mode/0]). +-deprecated({rehash,0,next_major_release}). + -export_type([load_error_rsn/0, load_ret/0]). +-export_type([prepared_code/0]). -include_lib("kernel/include/file.hrl"). @@ -86,6 +93,11 @@ -type loaded_ret_atoms() :: 'cover_compiled' | 'preloaded'. -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]). @@ -246,7 +258,7 @@ is_sticky(Mod) when is_atom(Mod) -> call({is_sticky,Mod}). -spec set_path(Path) -> 'true' | {'error', What} when Path :: [Dir :: file:filename()], - What :: 'bad_directory' | 'bad_path'. + What :: 'bad_directory'. set_path(PathList) when is_list(PathList) -> call({set_path,PathList}). -spec get_path() -> Path when @@ -294,23 +306,328 @@ replace_path(Name, Dir) when (is_atom(Name) orelse is_list(Name)), 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, @@ -322,35 +639,21 @@ start_link(Flags) -> %% us, so the module is loaded. %%----------------------------------------------------------------- -do_start(Flags) -> +do_start() -> + maybe_warn_for_cache(), load_code_server_prerequisites(), - 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, - %% Quietly load native code for all modules loaded so far - Architecture = erlang:system_info(hipe_architecture), - load_native_code_for_all_loaded(Architecture), - Ok2; - Other -> - Other - end; - Other -> - error_logger:error_msg("Can not start code server ~w ~n", [Other]), - {error, crash} - end. + {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 @@ -370,6 +673,16 @@ load_code_server_prerequisites() -> _ = [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), do_s(stdlib), @@ -387,19 +700,12 @@ do_s(Lib) -> 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 @@ -453,30 +759,14 @@ which(File, Base, [Directory|Tail]) -> 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(), @@ -554,6 +844,22 @@ has_ext(Ext, Extlen, File) -> end. %%% +%%% 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. %%% diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 614219794c..48541ec500 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% 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. @@ -22,29 +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]). --define(ANY_NATIVE_CODE_LOADED, any_native_code_loaded). +-type on_load_action() :: + fun((term(), state()) -> {'reply',term(),state()} | + {'noreply',state()}). --record(state, {supervisor, - root, - path, - moddb, - namedb, - cache = no_cache, - mode = interactive, - on_load = []}). +-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(), @@ -59,7 +63,7 @@ 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), @@ -68,20 +72,16 @@ init(Ref, Parent, [Root,Mode0]) -> %% Pre-loaded modules are always sticky. ets:insert(Db, [{M,preloaded},{{sticky,M},true}]) end, erlang:pre_loaded()), - ets:insert(Db, init:fetch_loaded()), - - Mode = - case Mode0 of - minimal -> interactive; - _ -> Mode0 - end, + 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; _ -> @@ -89,24 +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, - - put(?ANY_NATIVE_CODE_LOADED, false), + 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 @@ -125,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); @@ -142,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) -> @@ -155,7 +151,7 @@ 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), loop(State); @@ -168,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) @@ -238,278 +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({load_file,Mod}, From, St) when is_atom(Mod) -> + load_file(Mod, From, St); -handle_call({add_path,Where,Dir0}, {_From,_Tag}, - #state{cache=Cache0,namedb=Namedb,path=Path0}=S) -> - case Cache0 of - no_cache -> - {Resp,Path} = add_path(Where, Dir0, Path0, Namedb), - {reply,Resp,S#state{path=Path}}; - _ -> - Dir = absname(Dir0), %% Cache always expands the path - {Resp,Path} = add_path(Where, Dir, Path0, Namedb), - Cache = update_cache([Dir], Where, Cache0), - {reply,Resp,S#state{path=Path,cache=Cache}} - 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({add_paths,Where,Dirs0}, {_From,_Tag}, - #state{cache=Cache0,namedb=Namedb,path=Path0}=S) -> - case Cache0 of - no_cache -> - {Resp,Path} = add_paths(Where, Dirs0, Path0, Namedb), - {reply,Resp,S#state{path=Path}}; - _ -> - %% Cache always expands the path - Dirs = [absname(Dir) || Dir <- Dirs0], - {Resp,Path} = add_paths(Where, Dirs, Path0, Namedb), - Cache=update_cache(Dirs,Where,Cache0), - {reply,Resp,S#state{cache=Cache,path=Path}} - end; +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({set_path,PathList}, {_From,_Tag}, +handle_call({set_path,PathList}, _From, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path,NewDb} = set_path(PathList, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path,namedb=NewDb})}; + {reply,Resp,S#state{path=Path,namedb=NewDb}}; -handle_call({del_path,Name}, {_From,_Tag}, +handle_call({del_path,Name}, _From, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path} = del_path(Name, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path})}; + {reply,Resp,S#state{path=Path}}; -handle_call({replace_path,Name,Dir}, {_From,_Tag}, +handle_call({replace_path,Name,Dir}, _From, #state{path=Path0,namedb=Namedb}=S) -> {Resp,Path} = replace_path(Name, Dir, Path0, Namedb), - {reply,Resp,rehash_cache(S#state{path=Path})}; + {reply,Resp,S#state{path=Path}}; -handle_call(rehash, {_From,_Tag}, S0) -> - S = create_cache(S0), - {reply,ok,S}; - -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) when is_atom(Mod) -> +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) -> +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), + Status = hipe_result_to_status(Result, S), {reply,Status,S}; -handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> +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), + 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({soft_purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_soft_purge(M),St} - end, Mod0, true, St0); +handle_call({purge,Mod}, _From, St) when is_atom(Mod) -> + {reply,do_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({soft_purge,Mod}, _From, St) when is_atom(Mod) -> + {reply,do_soft_purge(Mod),St}; -handle_call(all_loaded, {_From,_Tag}, S) -> +handle_call({is_loaded,Mod}, _From, St) when is_atom(Mod) -> + {reply,is_loaded(Mod, St#state.moddb),St}; + +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, ParserFun}, {_From,_Tag}, S=#state{mode=Mode}) -> - case erl_prim_loader:set_primary_archive(File, ArchiveBin, FileInfo, ParserFun) 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} = 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,_Tag}, S=#state{mode=Mode}) -> +handle_call(get_mode, _From, S=#state{mode=Mode}) -> {reply, Mode, S}; -handle_call(Other,{_From,_Tag}, S) -> +handle_call({finish_loading,Prepared,EnsureLoaded}, _From, S) -> + {reply,finish_loading(Prepared, EnsureLoaded, S),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:keyfind(Ext, 2, Exts) of - {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. %% -------------------------------------------------------------- @@ -519,7 +382,7 @@ filter_mods([], _, _, _, Cache) -> %% make_path(BundleDir, Bundles0) -> Bundles = choose_bundles(Bundles0), - make_path(BundleDir, Bundles, [], []). + make_path(BundleDir, Bundles, []). choose_bundles(Bundles) -> ArchiveExt = archive_extension(), @@ -529,12 +392,10 @@ choose_bundles(Bundles) -> create_bundle(FullName, ArchiveExt) -> BaseName = filename:basename(FullName, ArchiveExt), - case split(BaseName, "-") of - [_, _|_] = Toks -> - VsnStr = lists:last(Toks), + 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} @@ -605,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 -> - 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. %% @@ -757,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(), @@ -778,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] -> @@ -814,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; _ -> @@ -916,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. @@ -929,59 +808,39 @@ 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), + Name = get_name_from_splitted(Splitted), + 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 -> - 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) @@ -1075,22 +934,28 @@ check_pars(Name,Dir) -> 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; + 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]; _ -> - Dir - end. + Ext = archive_extension(), + case filename:basename(Parent, Ext) of + Parent -> + %% Plain directory. + [Parent,App]; + Archive -> + %% Archive. + [Archive] + end + end; +del_ebin_1([H|T]) -> + [H|del_ebin_1(T)]; +del_ebin_1([]) -> + []. replace_name(Dir, Db) -> case get_name(Dir) of @@ -1206,14 +1071,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. @@ -1222,153 +1087,122 @@ modp(Atom) when is_atom(Atom) -> true; modp(List) when is_list(List) -> int_list(List); modp(_) -> false. -load_abs(File, Mod, Caller, St) -> +load_abs(File, Mod, From, St) -> Ext = objfile_extension(), FileName0 = lists:concat([File, Ext]), FileName = absname(FileName0), 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_list(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 '~w' that resides in sticky dir\n",[Mod]), {reply,{error,sticky_directory},St}; false -> Architecture = erlang:system_info(hipe_architecture), - try_load_module_2(File, Mod, Bin, Caller, Architecture, St) + try_load_module_2(File, Mod, Bin, From, Architecture, St) end. -try_load_module_2(File, Mod, Bin, Caller, undefined, St) -> - try_load_module_3(File, Mod, Bin, Caller, undefined, St); -try_load_module_2(File, Mod, Bin, Caller, Architecture, +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 load_native_code(Mod, Bin, Architecture) of + case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), + ets:insert(Db, [{{native,Mod},true},{Mod,File}]), {reply,Module,St}; no_native -> - try_load_module_3(File, Mod, Bin, Caller, Architecture, St); + 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. -try_load_module_3(File, Mod, Bin, Caller, Architecture, - #state{moddb=Db}=St) -> - case erlang:load_module(Mod, Bin) of - {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), - post_beam_load(Mod, Architecture), - {reply,Module,St}; - {error,on_load} -> - handle_on_load(Mod, File, Caller, St); - {error,What} = Error -> - error_msg("Loading of ~ts failed: ~p\n", [File, What]), - {reply,Error,St} - end. - -load_native_code(Mod, Bin, Architecture) -> - %% 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 -> - Result = hipe_unified_loader:load_native_code(Mod, Bin, - Architecture), - case Result of - {module,_} -> - put(?ANY_NATIVE_CODE_LOADED, true); - _ -> - ok - end, - Result - 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,_} -> - put(?ANY_NATIVE_CODE_LOADED, true), + {module,Mod} -> + ets:insert(Db, [{{native,Mod},true}]), Result; _ -> {error,Result} end. -post_beam_load(Mod, Architecture) -> +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; thus we want to avoid the call if we - %% know that it is not needed. - case get(?ANY_NATIVE_CODE_LOADED) of - true -> hipe_unified_loader:post_beam_load(Mod, Architecture); - false -> ok - end. + %% 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(Mod0, {From,_}=Caller, St0) -> - Mod = to_atom(Mod0), - case pending_on_load(Mod, From, St0) of - no -> load_file_1(Mod, Caller, St0); - {yes,St} -> {noreply,St} - end. - -load_file_1(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_1(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_list(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 @@ -1416,307 +1250,159 @@ 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. - -do_purge(Mod0) -> - Mod = to_atom(Mod0), - case erlang:check_old_code(Mod) of - false -> - false; - true -> - Res = check_proc_code(erlang:processes(), Mod, true), - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, - Res +is_loaded(M, Db) -> + case ets:lookup(Db, M) of + [{M,File}] -> {file,File}; + [] -> false end. -%% 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) +do_purge(Mod) -> + {_WasOld, DidKill} = erts_code_purger:purge(Mod), + DidKill. -do_soft_purge(Mod0) -> - Mod = to_atom(Mod0), - case erlang:check_old_code(Mod) of - false -> - true; - true -> - case check_proc_code(erlang:processes(), Mod, false) of - false -> - false; - true -> - try - erlang:purge_module(Mod) - catch - _:_ -> ignore - end, - true - end - end. +do_soft_purge(Mod) -> + erts_code_purger:soft_purge(Mod). -%% -%% check_proc_code(Pids, Mod, Hard) - Send asynchronous -%% requests to all processes to perform a check_process_code -%% operation. Each process will check their own state and -%% reply with the result. If 'Hard' equals -%% - true, processes that refer 'Mod' will be killed. If -%% any processes were killed true is returned; otherwise, -%% false. -%% - false, and any processes refer 'Mod', false will -%% returned; otherwise, true. -%% -%% Requests will be sent to all processes identified by -%% Pids at once, but without allowing GC to be performed. -%% Check process code operations that are aborted due to -%% GC need, will be restarted allowing GC. However, only -%% ?MAX_CPC_GC_PROCS outstanding operation allowing GC at -%% a time will be allowed. This in order not to blow up -%% memory wise. -%% -%% We also only allow ?MAX_CPC_NO_OUTSTANDING_KILLS -%% outstanding kills. This both in order to avoid flooding -%% our message queue with 'DOWN' messages and limiting the -%% amount of memory used to keep references to all -%% outstanding kills. -%% +is_dir(Path) -> + case erl_prim_loader:read_file_info(Path) of + {ok,#file_info{type=directory}} -> true; + _ -> false + end. -%% We maybe should allow more than two outstanding -%% GC requests, but for now we play it safe... --define(MAX_CPC_GC_PROCS, 2). --define(MAX_CPC_NO_OUTSTANDING_KILLS, 10). - --record(cpc_static, {hard, module, tag}). - --record(cpc_kill, {outstanding = [], - no_outstanding = 0, - waiting = [], - killed = false}). - -check_proc_code(Pids, Mod, Hard) -> - Tag = erlang:make_ref(), - CpcS = #cpc_static{hard = Hard, - module = Mod, - tag = Tag}, - check_proc_code(CpcS, cpc_init(CpcS, Pids, 0), 0, [], #cpc_kill{}, true). - -check_proc_code(#cpc_static{hard = true}, 0, 0, [], - #cpc_kill{outstanding = [], waiting = [], killed = Killed}, - true) -> - %% No outstanding requests. We did a hard check, so result is whether or - %% not we killed any processes... - Killed; -check_proc_code(#cpc_static{hard = false}, 0, 0, [], _KillState, Success) -> - %% No outstanding requests and we did a soft check... - Success; -check_proc_code(#cpc_static{hard = false, tag = Tag} = CpcS, NoReq0, NoGcReq0, - [], _KillState, false) -> - %% Failed soft check; just cleanup the remaining replies corresponding - %% to the requests we've sent... - {NoReq1, NoGcReq1} = receive - {check_process_code, {Tag, _P, GC}, _Res} -> - case GC of - false -> {NoReq0-1, NoGcReq0}; - true -> {NoReq0, NoGcReq0-1} - end - end, - check_proc_code(CpcS, NoReq1, NoGcReq1, [], _KillState, false); -check_proc_code(#cpc_static{tag = Tag} = CpcS, NoReq0, NoGcReq0, NeedGC0, - KillState0, Success) -> - - %% Check if we should request a GC operation - {NoGcReq1, NeedGC1} = case NoGcReq0 < ?MAX_CPC_GC_PROCS of - GcOpAllowed when GcOpAllowed == false; - NeedGC0 == [] -> - {NoGcReq0, NeedGC0}; - _ -> - {NoGcReq0+1, cpc_request_gc(CpcS,NeedGC0)} - end, - - %% Wait for a cpc reply or 'DOWN' message - {NoReq1, NoGcReq2, Pid, Result, KillState1} = cpc_recv(Tag, - NoReq0, - NoGcReq1, - KillState0), - - %% Check the result of the reply - case Result of - aborted -> - %% Operation aborted due to the need to GC in order to - %% determine if the process is referring the module. - %% Schedule the operation for restart allowing GC... - check_proc_code(CpcS, NoReq1, NoGcReq2, [Pid|NeedGC1], KillState1, - Success); - false -> - %% Process not referring the module; done with this process... - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, KillState1, - Success); - true -> - %% Process referring the module... - case CpcS#cpc_static.hard of - false -> - %% ... and soft check. The whole operation failed so - %% no point continuing; clean up and fail... - check_proc_code(CpcS, NoReq1, NoGcReq2, [], KillState1, - false); - true -> - %% ... and hard check; schedule kill of it... - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, - cpc_sched_kill(Pid, KillState1), Success) - end; - 'DOWN' -> - %% Handled 'DOWN' message - check_proc_code(CpcS, NoReq1, NoGcReq2, NeedGC1, - KillState1, Success) +%%% +%%% 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. -cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = []} = KillState) -> - receive - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) - end; -cpc_recv(Tag, NoReq, NoGcReq, - #cpc_kill{outstanding = [R0, R1, R2, R3, R4 | _]} = KillState) -> - receive - {'DOWN', R, process, _, _} when R == R0; - R == R1; - R == R2; - R == R3; - R == R4 -> - cpc_handle_down(NoReq, NoGcReq, R, KillState); - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) - end; -cpc_recv(Tag, NoReq, NoGcReq, #cpc_kill{outstanding = [R|_]} = KillState) -> - receive - {'DOWN', R, process, _, _} -> - cpc_handle_down(NoReq, NoGcReq, R, KillState); - {check_process_code, {Tag, Pid, GC}, Res} -> - cpc_handle_cpc(NoReq, NoGcReq, GC, Pid, Res, KillState) +abort_if_sticky(L, Db) -> + Sticky = [{M,sticky_directory} || {M,_} <- L, is_sticky(M, Db)], + case Sticky of + [] -> {ok,L}; + [_|_] -> {error,Sticky} end. -cpc_handle_down(NoReq, NoGcReq, R, #cpc_kill{outstanding = Rs, - no_outstanding = N} = KillState) -> - {NoReq, NoGcReq, undefined, 'DOWN', - cpc_sched_kill_waiting(KillState#cpc_kill{outstanding = cpc_list_rm(R, Rs), - no_outstanding = N-1})}. - -cpc_list_rm(R, [R|Rs]) -> - Rs; -cpc_list_rm(R0, [R1|Rs]) -> - [R1|cpc_list_rm(R0, Rs)]. - -cpc_handle_cpc(NoReq, NoGcReq, false, Pid, Res, KillState) -> - {NoReq-1, NoGcReq, Pid, Res, KillState}; -cpc_handle_cpc(NoReq, NoGcReq, true, Pid, Res, KillState) -> - {NoReq, NoGcReq-1, Pid, Res, KillState}. - -cpc_sched_kill_waiting(#cpc_kill{waiting = []} = KillState) -> - KillState; -cpc_sched_kill_waiting(#cpc_kill{outstanding = Rs, - no_outstanding = N, - waiting = [P|Ps]} = KillState) -> - R = erlang:monitor(process, P), - exit(P, kill), - KillState#cpc_kill{outstanding = [R|Rs], - no_outstanding = N+1, - waiting = Ps, - killed = true}. - -cpc_sched_kill(Pid, #cpc_kill{no_outstanding = N, waiting = Pids} = KillState) - when N >= ?MAX_CPC_NO_OUTSTANDING_KILLS -> - KillState#cpc_kill{waiting = [Pid|Pids]}; -cpc_sched_kill(Pid, - #cpc_kill{outstanding = Rs, no_outstanding = N} = KillState) -> - R = erlang:monitor(process, Pid), - exit(Pid, kill), - KillState#cpc_kill{outstanding = [R|Rs], - no_outstanding = N+1, - killed = true}. - -cpc_request(#cpc_static{tag = Tag, module = Mod}, Pid, AllowGc) -> - erlang:check_process_code(Pid, Mod, [{async, {Tag, Pid, AllowGc}}, - {allow_gc, AllowGc}]). - -cpc_request_gc(CpcS, [Pid|Pids]) -> - cpc_request(CpcS, Pid, true), - Pids. - -cpc_init(_CpcS, [], NoReqs) -> - NoReqs; -cpc_init(CpcS, [Pid|Pids], NoReqs) -> - cpc_request(CpcS, Pid, false), - cpc_init(CpcS, Pids, NoReqs+1). - -% end of check_proc_code() implementation. +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. -is_loaded(M, Db) -> - case ets:lookup(Db, M) of - [{M,File}] -> {file,File}; - [] -> false +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), Res = case Keep of false -> _ = finish_on_load_report(Mod, OnLoadRes), + _ = erts_code_purger:purge(Mod), {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. @@ -1741,26 +1427,16 @@ finish_on_load_report(Mod, Term) -> %% ------------------------------------------------------- all_loaded(Db) -> - all_l(Db, ets:slot(Db, 0), 1, []). + Ms = ets:fun2ms(fun({M,_}=T) when is_atom(M) -> T end), + ets:select(Db, Ms). -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). - - -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, @@ -1774,6 +1450,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). diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index f5450f30af..9b44021872 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -1310,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)}; @@ -1432,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. diff --git a/lib/kernel/src/disk_log.hrl b/lib/kernel/src/disk_log.hrl index 6c0aea070f..3262d979ee 100644 --- a/lib/kernel/src/disk_log.hrl +++ b/lib/kernel/src/disk_log.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% 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. @@ -152,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_server.erl b/lib/kernel/src/disk_log_server.erl index 735f1e5ceb..78c15d0ad8 100644 --- a/lib/kernel/src/disk_log_server.erl +++ b/lib/kernel/src/disk_log_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/disk_log_sup.erl b/lib/kernel/src/disk_log_sup.erl index c09b3f94d1..db5e3ecb3a 100644 --- a/lib/kernel/src/disk_log_sup.erl +++ b/lib/kernel/src/disk_log_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/dist_ac.erl b/lib/kernel/src/dist_ac.erl index f649f33a53..6c2fa0b6b1 100644 --- a/lib/kernel/src/dist_ac.erl +++ b/lib/kernel/src/dist_ac.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/dist_util.erl b/lib/kernel/src/dist_util.erl index c9fc26d62c..47d0c1b861 100644 --- a/lib/kernel/src/dist_util.erl +++ b/lib/kernel/src/dist_util.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% 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. @@ -118,7 +118,8 @@ make_this_flags(RequestType, OtherNode) -> ?DFLAG_DIST_HDR_ATOM_CACHE bor ?DFLAG_SMALL_ATOM_TAGS bor ?DFLAG_UTF8_ATOMS bor - ?DFLAG_MAP_TAG). + ?DFLAG_MAP_TAG bor + ?DFLAG_BIG_CREATION). handshake_other_started(#hs_data{request_type=ReqType}=HSData0) -> {PreOtherFlags,Node,Version} = recv_name(HSData0), @@ -155,7 +156,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. @@ -196,7 +197,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. @@ -576,13 +577,13 @@ recv_challenge(#hs_data{socket=Socket,other_node=Node, [Node, Challenge,Version]), {Flags,Challenge}; _ -> - ?shutdown(no_node) + ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) catch error:badarg -> - ?shutdown(no_node) + ?shutdown2(no_node, {recv_challenge_failed, no_node, Ns}) end; - _ -> - ?shutdown(no_node) + Other -> + ?shutdown2(no_node, {recv_challenge_failed, Other}) end. @@ -606,10 +607,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, @@ -626,10 +627,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, @@ -639,7 +640,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 @@ -656,10 +657,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. @@ -758,7 +759,7 @@ 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) -> diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl index 4076fab86d..ac81cc9689 100644 --- a/lib/kernel/src/erl_boot_server.erl +++ b/lib/kernel/src/erl_boot_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/erl_ddll.erl b/lib/kernel/src/erl_ddll.erl index 6180510bdd..89a02cc762 100644 --- a/lib/kernel/src/erl_ddll.erl +++ b/lib/kernel/src/erl_ddll.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/erl_distribution.erl b/lib/kernel/src/erl_distribution.erl index 99db7a8bf0..0bec78e938 100644 --- a/lib/kernel/src/erl_distribution.erl +++ b/lib/kernel/src/erl_distribution.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% 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. @@ -21,20 +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,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 c6202dd796..7bc9e2ede3 100644 --- a/lib/kernel/src/erl_epmd.erl +++ b/lib/kernel/src/erl_epmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% 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. @@ -103,6 +103,10 @@ names(EpmdAddr) -> register_node(Name, PortNo) -> 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). @@ -403,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). diff --git a/lib/kernel/src/erl_epmd.hrl b/lib/kernel/src/erl_epmd.hrl index f3585fea5e..3efcc81b55 100644 --- a/lib/kernel/src/erl_epmd.hrl +++ b/lib/kernel/src/erl_epmd.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/erl_reply.erl b/lib/kernel/src/erl_reply.erl index ba046980f6..e1e046cbb4 100644 --- a/lib/kernel/src/erl_reply.erl +++ b/lib/kernel/src/erl_reply.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/error_handler.erl b/lib/kernel/src/error_handler.erl index 095e1163f7..59ca8e690d 100644 --- a/lib/kernel/src/error_handler.erl +++ b/lib/kernel/src/error_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/error_logger.erl b/lib/kernel/src/error_logger.erl index eb231fd155..3523f680a3 100644 --- a/lib/kernel/src/error_logger.erl +++ b/lib/kernel/src/error_logger.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. @@ -435,5 +435,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 39308c0043..7b3f1e313a 100644 --- a/lib/kernel/src/erts_debug.erl +++ b/lib/kernel/src/erts_debug.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% 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. @@ -34,7 +34,8 @@ -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]). + 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(), @@ -86,6 +87,18 @@ dump_links(_) -> 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 @@ -230,7 +243,7 @@ map_size(Map,Seen0,Sum0) -> %% 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:map_type(Map) of + case erts_internal:term_type(Map) of flatmap -> Kt = erts_internal:map_to_tuple_keys(Map), Vs = maps:values(Map), diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 1007f04413..58b601e456 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. @@ -1227,7 +1227,8 @@ change_time(Name, {{AY, AM, AD}, {AH, AMin, ASec}}=Atime, %% Send data using sendfile %% --define(MAX_CHUNK_SIZE, (1 bsl 20)*20). %% 20 MB, has to fit in primary memory +%% 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() | diff --git a/lib/kernel/src/file_server.erl b/lib/kernel/src/file_server.erl index 6df6be7d06..6504174cbc 100644 --- a/lib/kernel/src/file_server.erl +++ b/lib/kernel/src/file_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index a47535b2f8..b133e6fed4 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% 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. @@ -124,8 +124,8 @@ open() -> SockType :: seqpacket | stream, Socket :: sctp_socket(). -open(Opts) when is_list(Opts) -> - Mod = mod(Opts, undefined), +open(Opts0) when is_list(Opts0) -> + {Mod, Opts} = inet:sctp_module(Opts0), case Mod:open(Opts) of {error,badarg} -> erlang:error(badarg, [Opts]); @@ -445,32 +445,3 @@ 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 module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:sctp_module() of - inet_sctp when tuple_size(Address) =:= 8 -> - inet6_sctp; - Mod -> - Mod - end. - -%% Get the SCTP module, but option sctp_module|inet|inet6 overrides -mod([{sctp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_sctp; -mod([inet6|_], _Address) -> - inet6_sctp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 8cb2a725e8..1a21541b7c 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -96,17 +96,17 @@ tos | ipv6_v6only. -type connect_option() :: - {ip, inet:ip_address()} | + {ip, inet:socket_address()} | {fd, Fd :: non_neg_integer()} | - {ifaddr, inet:ip_address()} | + {ifaddr, inet:socket_address()} | inet:address_family() | {port, inet:port_number()} | {tcp_module, module()} | option(). -type listen_option() :: - {ip, inet:ip_address()} | + {ip, inet:socket_address()} | {fd, Fd :: non_neg_integer()} | - {ifaddr, inet:ip_address()} | + {ifaddr, inet:socket_address()} | inet:address_family() | {port, inet:port_number()} | {backlog, B :: non_neg_integer()} | @@ -122,7 +122,7 @@ %% -spec connect(Address, Port, Options) -> {ok, Socket} | {error, Reason} when - Address :: inet:ip_address() | inet:hostname(), + Address :: inet:socket_address() | inet:hostname(), Port :: inet:port_number(), Options :: [connect_option()], Socket :: socket(), @@ -133,7 +133,7 @@ connect(Address, Port, Opts) -> -spec connect(Address, Port, Options, Timeout) -> {ok, Socket} | {error, Reason} when - Address :: inet:ip_address() | inet:hostname(), + Address :: inet:socket_address() | inet:hostname(), Port :: inet:port_number(), Options :: [connect_option()], Timeout :: timeout(), @@ -151,8 +151,8 @@ connect(Address, Port, Opts, Time) -> Error -> Error end. -connect1(Address,Port,Opts,Timer) -> - Mod = mod(Opts, Address), +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 @@ -185,8 +185,8 @@ try_connect([], _Port, _Opts, _Timer, _Mod, Err) -> ListenSocket :: socket(), Reason :: system_limit | inet:posix(). -listen(Port, Opts) -> - Mod = mod(Opts, undefined), +listen(Port, Opts0) -> + {Mod, Opts} = inet:tcp_module(Opts0), case Mod:getserv(Port) of {ok,TP} -> Mod:listen(TP, Opts); @@ -335,32 +335,6 @@ controlling_process(S, NewOwner) -> %% %% Create a port/socket from a file descriptor %% -fdopen(Fd, Opts) -> - Mod = mod(Opts, undefined), +fdopen(Fd, Opts0) -> + {Mod, Opts} = inet:tcp_module(Opts0), Mod:fdopen(Fd, Opts). - -%% Get the tcp_module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:tcp_module() of - inet_tcp when tuple_size(Address) =:= 8 -> - inet6_tcp; - Mod -> - Mod - end. - -%% Get the tcp_module, but option tcp_module|inet|inet6 overrides -mod([{tcp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_tcp; -mod([inet6|_], _Address) -> - inet6_tcp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). - diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 6698d5f0fa..98d2f0bcfb 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -92,18 +92,18 @@ open(Port) -> -spec open(Port, Opts) -> {ok, Socket} | {error, Reason} when Port :: inet:port_number(), Opts :: [Option], - Option :: {ip, inet:ip_address()} + Option :: {ip, inet:socket_address()} | {fd, non_neg_integer()} - | {ifaddr, inet:ip_address()} + | {ifaddr, inet:socket_address()} | inet:address_family() | {port, inet:port_number()} | option(), Socket :: socket(), Reason :: inet:posix(). -open(Port, Opts) -> - Mod = mod(Opts, undefined), - {ok,UP} = Mod:getserv(Port), +open(Port, Opts0) -> + {Mod, Opts} = inet:udp_module(Opts0), + {ok, UP} = Mod:getserv(Port), Mod:open(UP, Opts). -spec close(Socket) -> ok when @@ -114,7 +114,7 @@ close(S) -> -spec send(Socket, Address, Port, Packet) -> ok | {error, Reason} when Socket :: socket(), - Address :: inet:ip_address() | inet:hostname(), + Address :: inet:socket_address() | inet:hostname(), Port :: inet:port_number(), Packet :: iodata(), Reason :: not_owner | inet:posix(). @@ -148,7 +148,7 @@ send(S, Packet) when is_port(S) -> {ok, {Address, Port, Packet}} | {error, Reason} when Socket :: socket(), Length :: non_neg_integer(), - Address :: inet:ip_address(), + Address :: inet:ip_address() | inet:returned_non_ip_address(), Port :: inet:port_number(), Packet :: string() | binary(), Reason :: not_owner | inet:posix(). @@ -166,7 +166,7 @@ recv(S,Len) when is_port(S), is_integer(Len) -> Socket :: socket(), Length :: non_neg_integer(), Timeout :: timeout(), - Address :: inet:ip_address(), + Address :: inet:ip_address() | inet:returned_non_ip_address(), Port :: inet:port_number(), Packet :: string() | binary(), Reason :: not_owner | inet:posix(). @@ -203,32 +203,6 @@ controlling_process(S, NewOwner) -> %% %% Create a port/socket from a file descriptor %% -fdopen(Fd, Opts) -> - Mod = mod(Opts, undefined), +fdopen(Fd, Opts0) -> + {Mod,Opts} = inet:udp_module(Opts0), Mod:fdopen(Fd, Opts). - - -%% Get the udp_module, but IPv6 address overrides default IPv4 -mod(Address) -> - case inet_db:udp_module() of - inet_udp when tuple_size(Address) =:= 8 -> - inet6_udp; - Mod -> - Mod - end. - -%% Get the udp_module, but option udp_module|inet|inet6 overrides -mod([{udp_module,Mod}|_], _Address) -> - Mod; -mod([inet|_], _Address) -> - inet_udp; -mod([inet6|_], _Address) -> - inet6_udp; -mod([{ip, Address}|Opts], _) -> - mod(Opts, Address); -mod([{ifaddr, Address}|Opts], _) -> - mod(Opts, Address); -mod([_|Opts], Address) -> - mod(Opts, Address); -mod([], Address) -> - mod(Address). diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 2be1efaf24..0c73ead7c5 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% 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. @@ -459,17 +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_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 @@ -2068,23 +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 -> - _ = random:seed(erlang:phash2([erlang:node()]), - erlang:monotonic_time(), - erlang:unique_integer()), - ok; - _ -> 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. diff --git a/lib/kernel/src/global_group.erl b/lib/kernel/src/global_group.erl index 848df13c39..8ac0bd9551 100644 --- a/lib/kernel/src/global_group.erl +++ b/lib/kernel/src/global_group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-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. @@ -273,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. @@ -692,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), @@ -718,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), @@ -748,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), diff --git a/lib/kernel/src/global_search.erl b/lib/kernel/src/global_search.erl index 9429295bdb..11b70113e2 100644 --- a/lib/kernel/src/global_search.erl +++ b/lib/kernel/src/global_search.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2011. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl index ea0734e0c9..b5e73117dd 100644 --- a/lib/kernel/src/group.erl +++ b/lib/kernel/src/group.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index ddbbc548dd..087cceb5d8 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -44,7 +44,7 @@ -export([chunk_name/1, %% Only the code and code_server modules may call the entries below! load_native_code/3, - post_beam_load/2, + post_beam_load/1, load_module/4, load/3]). @@ -105,7 +105,7 @@ load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) -> case code:get_chunk(Bin, chunk_name(Architecture)) of undefined -> no_native; NativeCode when is_binary(NativeCode) -> - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), try OldReferencesToPatch = patch_to_emu_step1(Mod), case load_module(Mod, NativeCode, Bin, OldReferencesToPatch, @@ -114,23 +114,23 @@ load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) -> Result -> Result end after - erlang:system_flag(multi_scheduling, unblock) + erlang:system_flag(multi_scheduling, unblock_normal) end end. %%======================================================================== --spec post_beam_load(atom(), hipe_architecture()) -> 'ok'. +-spec post_beam_load([module()]) -> 'ok'. -%% does nothing on a hipe-disabled system -post_beam_load(_Mod, undefined) -> +post_beam_load([])-> ok; -post_beam_load(Mod, _) when is_atom(Mod) -> - erlang:system_flag(multi_scheduling, block), +post_beam_load([_|_]=Mods) -> + erlang:system_flag(multi_scheduling, block_normal), try - patch_to_emu(Mod) + _ = [patch_to_emu(Mod) || Mod <- Mods], + ok after - erlang:system_flag(multi_scheduling, unblock) + erlang:system_flag(multi_scheduling, unblock_normal) end, ok. @@ -151,11 +151,11 @@ version_check(Version, Mod) when is_atom(Mod) -> 'bad_crc' | {'module', Mod} when Mod :: atom(). load_module(Mod, Bin, Beam, Architecture) -> - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), try 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, Architecture) -> @@ -173,11 +173,11 @@ load_module(Mod, Bin, Beam, OldReferencesToPatch, Architecture) -> 'bad_crc' | {'module', Mod} when Mod :: atom(). load(Mod, Bin, Architecture) -> - erlang:system_flag(multi_scheduling, block), + erlang:system_flag(multi_scheduling, block_normal), try load_nosmp(Mod, Bin, Architecture) after - erlang:system_flag(multi_scheduling, unblock) + erlang:system_flag(multi_scheduling, unblock_normal) end. load_nosmp(Mod, Bin, Architecture) -> diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index c1ae99ea24..a91a6ed517 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -37,6 +37,7 @@ 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]). @@ -72,9 +73,9 @@ -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, posix/0, socket/0, - port_number/0]). - + ip6_address/0, ip_address/0, port_number/0, + local_address/0, socket_address/0, returned_non_ip_address/0, + posix/0, socket/0, stat_option/0]). %% imports -import(lists, [append/1, duplicate/2, filter/2, foldl/3]). @@ -97,6 +98,11 @@ 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(). @@ -133,9 +139,11 @@ 'running' | 'multicast' | 'loopback']} | {'hwaddr', ether_address()}. --type address_family() :: 'inet' | 'inet6'. +-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'. @@ -160,26 +168,33 @@ close(Socket) -> end. --spec peername(Socket) -> {ok, {Address, Port}} | {error, posix()} when - Socket :: socket(), - Address :: ip_address(), - Port :: non_neg_integer(). +-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(), port_number()}) -> - '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) -> {ok, [{Address, Port}]} | {error, posix()} when - Socket :: socket(), - Address :: ip_address(), - Port :: non_neg_integer(). +-spec peernames(Socket :: socket()) -> + {ok, + [{ip_address(), port_number()} | + returned_non_ip_address()]} | + {error, posix()}. peernames(Socket) -> prim_inet:peernames(Socket). @@ -195,15 +210,21 @@ peernames(Socket, Assoc) -> prim_inet:peernames(Socket, Assoc). --spec sockname(Socket) -> {ok, {Address, Port}} | {error, posix()} when - Socket :: socket(), - Address :: ip_address(), - Port :: non_neg_integer(). +-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(), port_number()}) -> +-spec setsockname( + Socket :: socket(), + Address :: + {ip_address() | 'any' | 'loopback', + port_number()} | + socket_address()) -> 'ok' | {'error', any()}. setsockname(Socket, {IP,Port}) -> @@ -211,10 +232,11 @@ setsockname(Socket, {IP,Port}) -> setsockname(Socket, undefined) -> prim_inet:setsockname(Socket, undefined). --spec socknames(Socket) -> {ok, [{Address, Port}]} | {error, posix()} when - Socket :: socket(), - Address :: ip_address(), - Port :: non_neg_integer(). +-spec socknames(Socket :: socket()) -> + {ok, + [{ip_address(), port_number()} | + returned_non_ip_address()]} | + {error, posix()}. socknames(Socket) -> prim_inet:socknames(Socket). @@ -439,7 +461,12 @@ getstat(Socket,What) -> 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(Hostname, Family) -> {ok, Hostent} | {error, posix()} when @@ -676,7 +703,7 @@ connect_options() -> 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) -> @@ -693,7 +720,7 @@ connect_options(Opts, Family) -> {ok, R} -> {ok, R#connect_opts { opts = lists:reverse(R#connect_opts.opts), - ifaddr = translate_ip(R#connect_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#connect_opts.ifaddr) }}; Error -> Error end. @@ -708,9 +735,6 @@ con_opt([Opt | Opts], #connect_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 @@ -747,7 +771,7 @@ listen_options() -> 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) -> @@ -764,7 +788,7 @@ listen_options(Opts, Family) -> {ok, R} -> {ok, R#listen_opts { opts = lists:reverse(R#listen_opts.opts), - ifaddr = translate_ip(R#listen_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#listen_opts.ifaddr) }}; Error -> Error end. @@ -780,9 +804,6 @@ list_opt([Opt | Opts], #listen_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 @@ -807,6 +828,19 @@ list_add(Name, Val, #listen_opts{} = R, Opts, 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 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -818,12 +852,12 @@ udp_options() -> 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 { opts = lists:reverse(R#udp_opts.opts), - ifaddr = translate_ip(R#udp_opts.ifaddr, Family) + ifaddr = Mod:translate_ip(R#udp_opts.ifaddr) }}; Error -> Error end. @@ -838,9 +872,6 @@ udp_opt([Opt | Opts], #udp_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 @@ -865,6 +896,11 @@ udp_add(Name, Val, #udp_opts{} = R, Opts, 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 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -921,9 +957,6 @@ sctp_opt([Opt|Opts], Mod, #sctp_opts{} = R, As) -> 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 @@ -965,6 +998,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 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -1023,6 +1061,53 @@ 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. @@ -1230,7 +1315,17 @@ gethostbyaddr_tm_native(Addr, Timer, Opts) -> end. -spec open(Fd_or_OpenOpts :: integer() | list(), - Addr :: ip_address(), + 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 :: socket_protocol(), @@ -1249,13 +1344,12 @@ open(FdO, Addr, Port, Opts, Protocol, Family, Type, Module) 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) -> - bindx(S, Addr, Port); - 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 -> @@ -1273,6 +1367,11 @@ 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); @@ -1313,34 +1412,36 @@ 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) -> - IsAnyAddr = (Addr == {0,0,0,0} orelse Addr == {0,0,0,0,0,0,0,0} - orelse Addr == any), - Bound = Port == 0 andalso IsAnyAddr, + 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 + when Addr =:= undefined; + Bound -> + inet_db:register_socket(S, Module), + {ok, S}; ok -> - case if - Bound -> - %% We do not do any binding if default - %% port+addr options where given in order - %% to keep backwards compatability with - %% pre Erlang/TOP 17 - {ok, ok}; - is_list(Addr) -> - bindx(S, Addr, Port); - true -> - prim_inet:bind(S, Addr, Port) - end of - {ok, _} -> - inet_db:register_socket(S, Module), - {ok, S}; - Error -> - prim_inet:close(S), - Error + 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. diff --git a/lib/kernel/src/inet6_sctp.erl b/lib/kernel/src/inet6_sctp.erl index 5934c269fa..a5503f6f54 100644 --- a/lib/kernel/src/inet6_sctp.erl +++ b/lib/kernel/src/inet6_sctp.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. -%% +%% +%% 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 @@ -14,13 +14,12 @@ %% 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 @@ -31,6 +30,7 @@ -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,peeloff/2,connect/5]). @@ -39,25 +39,19 @@ 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,type=Type,opts=SOs}} -> - inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, Type, ?MODULE); + inet:open(Fd, Addr, Port, SOs, ?PROTO, ?FAMILY, Type, ?MODULE); Error -> Error end. diff --git a/lib/kernel/src/inet6_tcp.erl b/lib/kernel/src/inet6_tcp.erl index 1978307b3c..a0d5d3df70 100644 --- a/lib/kernel/src/inet6_tcp.erl +++ b/lib/kernel/src/inet6_tcp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% 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. @@ -25,13 +25,18 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([family/0, mask/2, parse_address/1]). +-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() -> inet6. +family() -> ?FAMILY. %% Apply netmask on address mask({M1,M2,M3,M4,M5,M6,M7,M8}, {IP1,IP2,IP3,IP4,IP5,IP6,IP7,IP8}) -> @@ -50,15 +55,18 @@ parse_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 @@ -73,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 @@ -86,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!!! %% @@ -100,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,stream,?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; @@ -128,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,stream,?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}; @@ -156,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, stream, ?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 3ab7f269bb..3aa61973af 100644 --- a/lib/kernel/src/inet6_tcp_dist.erl +++ b/lib/kernel/src/inet6_tcp_dist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet6_udp.erl b/lib/kernel/src/inet6_udp.erl index 61c74bf14f..71db0357cd 100644 --- a/lib/kernel/src/inet6_udp.erl +++ b/lib/kernel/src/inet6_udp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% 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. @@ -24,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,dgram,?MODULE); + inet:open( + Fd, BAddr, BPort, SockOpts, ?PROTO, ?FAMILY, ?TYPE, ?MODULE); {ok, _} -> exit(badarg) end. @@ -61,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). @@ -85,4 +101,4 @@ controlling_process(Socket, NewOwner) -> %% Create a port/socket from a file descriptor %% fdopen(Fd, Opts) -> - inet:fdopen(Fd, Opts, udp, inet6, dgram, ?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 ec0d4064e5..adeda604e6 100644 --- a/lib/kernel/src/inet_boot.hrl +++ b/lib/kernel/src/inet_boot.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_config.erl b/lib/kernel/src/inet_config.erl index 803fae846e..4bbc520449 100644 --- a/lib/kernel/src/inet_config.erl +++ b/lib/kernel/src/inet_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -188,9 +188,6 @@ do_load_resolv({win32,Type}, longnames) -> win32_load_from_registry(Type), inet_db:set_lookup([native]); -do_load_resolv({ose,_}, _) -> - inet_db:set_lookup([file]); - do_load_resolv(_, _) -> inet_db:set_lookup([native]). diff --git a/lib/kernel/src/inet_config.hrl b/lib/kernel/src/inet_config.hrl index 7faae8d127..b22ee0f598 100644 --- a/lib/kernel/src/inet_config.hrl +++ b/lib/kernel/src/inet_config.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl index 108a803610..465cec1b45 100644 --- a/lib/kernel/src/inet_db.erl +++ b/lib/kernel/src/inet_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -1206,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), diff --git a/lib/kernel/src/inet_dns.erl b/lib/kernel/src/inet_dns.erl index f344b26228..d5f982cc51 100644 --- a/lib/kernel/src/inet_dns.erl +++ b/lib/kernel/src/inet_dns.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_dns.hrl b/lib/kernel/src/inet_dns.hrl index d1b01bb9c4..07226bbf5c 100644 --- a/lib/kernel/src/inet_dns.hrl +++ b/lib/kernel/src/inet_dns.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_dns_record_adts.pl b/lib/kernel/src/inet_dns_record_adts.pl index 6d719d836e..c89d837098 100644 --- a/lib/kernel/src/inet_dns_record_adts.pl +++ b/lib/kernel/src/inet_dns_record_adts.pl @@ -2,7 +2,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2009-2011. All Rights Reserved. +# 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. diff --git a/lib/kernel/src/inet_gethost_native.erl b/lib/kernel/src/inet_gethost_native.erl index 53294810af..9e76c08365 100644 --- a/lib/kernel/src/inet_gethost_native.erl +++ b/lib/kernel/src/inet_gethost_native.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_hosts.erl b/lib/kernel/src/inet_hosts.erl index e8457fd9d6..0bdf00ac30 100644 --- a/lib/kernel/src/inet_hosts.erl +++ b/lib/kernel/src/inet_hosts.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_int.hrl b/lib/kernel/src/inet_int.hrl index e7c6cf8ae2..c8a8962e78 100644 --- a/lib/kernel/src/inet_int.hrl +++ b/lib/kernel/src/inet_int.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -25,10 +25,13 @@ %% %% 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 to open and gettype - INET_REQ_GETTYPE -define(INET_TYPE_STREAM, 1). @@ -378,7 +381,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 }). diff --git a/lib/kernel/src/inet_parse.erl b/lib/kernel/src/inet_parse.erl index 877745ed55..b0a3ee3008 100644 --- a/lib/kernel/src/inet_parse.erl +++ b/lib/kernel/src/inet_parse.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index e6988ac79b..90e49ddfdf 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_res.hrl b/lib/kernel/src/inet_res.hrl index c77fe30e7a..774b4074a5 100644 --- a/lib/kernel/src/inet_res.hrl +++ b/lib/kernel/src/inet_res.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/inet_sctp.erl b/lib/kernel/src/inet_sctp.erl index 88c8d24143..8569cacb29 100644 --- a/lib/kernel/src/inet_sctp.erl +++ b/lib/kernel/src/inet_sctp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% 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. @@ -30,6 +30,7 @@ -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,peeloff/2,connect/5]). @@ -38,25 +39,19 @@ 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,type=Type,opts=SOs}} -> - inet:open(Fd, Addr, Port, SOs, sctp, ?FAMILY, Type, ?MODULE); + inet:open(Fd, Addr, Port, SOs, ?PROTO, ?FAMILY, Type, ?MODULE); Error -> Error end. diff --git a/lib/kernel/src/inet_tcp.erl b/lib/kernel/src/inet_tcp.erl index f551af9709..dac6b3119d 100644 --- a/lib/kernel/src/inet_tcp.erl +++ b/lib/kernel/src/inet_tcp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% 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. @@ -27,13 +27,18 @@ -export([controlling_process/2]). -export([fdopen/2]). --export([family/0, mask/2, parse_address/1]). +-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() -> inet. +family() -> ?FAMILY. %% Apply netmask on address mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> @@ -48,16 +53,19 @@ parse_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 %% @@ -77,7 +85,7 @@ unrecv(Socket, Data) -> prim_inet:unrecv(Socket, Data). %% shutdown(Socket, How) -> prim_inet:shutdown(Socket, How). - + %% %% Close a socket (async) %% @@ -88,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 @@ -98,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,stream,?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; @@ -125,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,stream,?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}; @@ -146,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, stream, ?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 64b28bb49b..94bde55133 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -73,7 +73,8 @@ gen_listen(Driver, Name) -> {ok, Socket} -> TcpAddress = get_tcp_address(Driver, Socket), {_,Port} = TcpAddress#net_address.address, - case erl_epmd:register_node(Name, Port) of + ErlEpmd = net_kernel:epmd_module(), + case ErlEpmd:register_node(Name, Port, Driver) of {ok, Creation} -> {ok, {Socket, TcpAddress, Creation}}; Error -> @@ -280,7 +281,8 @@ do_setup(Driver, Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> 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]), diff --git a/lib/kernel/src/inet_udp.erl b/lib/kernel/src/inet_udp.erl index 5b2e5120c9..8a8aa8ecca 100644 --- a/lib/kernel/src/inet_udp.erl +++ b/lib/kernel/src/inet_udp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% 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. @@ -24,21 +24,26 @@ -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, []). @@ -47,33 +52,38 @@ open(Port) -> open(Port, []). 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,dgram,?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). @@ -92,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, dgram, ?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 419dc0a2fc..56d1699656 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% 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. @@ -55,6 +55,8 @@ inet_tcp_dist, kernel, kernel_config, + local_tcp, + local_udp, net, net_adm, net_kernel, @@ -116,6 +118,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-7.3", "stdlib-2.6", "sasl-2.6"]} + {runtime_dependencies, ["erts-8.0", "stdlib-3.0", "sasl-3.0"]} ] }. diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index cc9e6f771a..d16e200cb3 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% 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. @@ -18,9 +18,9 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.* - {<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 + [{<<"5\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + {<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* %% Down to - max one major revision back - [{<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-18.* - {<<"3\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-17 + [{<<"5\\.0(\\.[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 5f33f25a0d..3d0ef81318 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. @@ -98,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, []}, @@ -158,12 +158,6 @@ init(safe) -> {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. -get_code_args() -> - case init:get_argument(nostick) of - {ok, [[]]} -> [[nostick]]; - _ -> [] - end. - start_dist_ac() -> Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}], case application:get_env(kernel, start_dist_ac) of diff --git a/lib/kernel/src/kernel_config.erl b/lib/kernel/src/kernel_config.erl index c65728aa53..535083ef27 100644 --- a/lib/kernel/src/kernel_config.erl +++ b/lib/kernel/src/kernel_config.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. 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 f058042bdd..2d0ae2ed0c 100644 --- a/lib/kernel/src/net.erl +++ b/lib/kernel/src/net.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/net_adm.erl b/lib/kernel/src/net_adm.erl index e6a81126c2..8ec275b88b 100644 --- a/lib/kernel/src/net_adm.erl +++ b/lib/kernel/src/net_adm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. @@ -96,7 +96,8 @@ names() -> Reason :: address | file:posix(). names(Hostname) -> - erl_epmd:names(Hostname). + ErlEpmd = net_kernel:epmd_module(), + ErlEpmd:names(Hostname). -spec dns_hostname(Host) -> {ok, Name} | {error, Host} when Host :: atom() | string(), diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 35a54f591e..ac19f4935b 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. @@ -53,18 +53,25 @@ -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, + 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, @@ -73,7 +80,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, @@ -341,18 +349,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}} -> @@ -361,12 +369,9 @@ 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), @@ -1201,12 +1206,12 @@ get_proto_mod(_Family, _Protocol, []) -> %% -------- 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 + NameWithoutHost = list_to_atom(NameWithoutHost0), + case start_protos(NameWithoutHost, Node, CleanHalt) of {ok, Ls} -> {ok, Node, Ls}; Error -> @@ -1240,8 +1245,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}; @@ -1268,6 +1272,9 @@ create_hostpart(Name, LongOrShortNames) -> end, {Head,Host1}. +split_node(Name) -> + lists:splitwith(fun(C) -> C =/= $@ end, atom_to_list(Name)). + %% %% %% @@ -1307,21 +1314,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}} -> @@ -1334,33 +1346,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: ~tp: 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: ~tp: register error: ~tp~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: ~tp: 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: ~tp: register/listen error: ~tp~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 -> diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 3330b38d84..81b70a7fee 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. @@ -27,7 +27,9 @@ %%% BIFs --export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, system_time/0, system_time/1, +-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()]. @@ -60,6 +62,18 @@ getenv(VarName, DefaultValue) -> 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(). @@ -93,7 +107,7 @@ unsetenv(_) -> %%% End of BIFs -spec type() -> {Osfamily, Osname} when - Osfamily :: unix | win32 | ose, + Osfamily :: unix | win32, Osname :: atom(). type() -> @@ -212,174 +226,36 @@ extensions() -> Command :: atom() | io_lib:chars(). cmd(Cmd) -> validate(Cmd), - Bytes = case type() of - {unix, _} -> - unix_cmd(Cmd); - {win32, Wtype} -> - Command0 = 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, - %% open_port/2 awaits string() in Command, but io_lib:chars() can be - %% deep lists according to io_lib module description. - Command = lists:flatten(Command0), - Port = open_port({spawn, Command}, [stream, in, eof, hide]), - get_data(Port, []) - end, - String = unicode:characters_to_list(list_to_binary(Bytes)), + {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 -> 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(ROOT, "/"). --define(ROOT_ANDROID, "/system"). --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_handle(Request), - case StayAlive of - true -> start_port_srv_loop(); - false -> exiting - end. - -start_port_srv_handle({Ref,Client}) -> - Path = case lists:reverse(erlang:system_info(system_architecture)) of - % androideabi - "ibaediordna" ++ _ -> filename:join([?ROOT_ANDROID, ?SHELL]); - _ -> filename:join([?ROOT, ?SHELL]) - end, - Reply = try open_port({spawn, Path},[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}, - ok. - -start_port_srv_loop() -> - receive - {Ref, Client} = Request when is_reference(Ref), - is_pid(Client) -> - start_port_srv_handle(Request); - _Junk -> - ok - end, - start_port_srv_loop(). - -%% -%% 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) + true -> binary_to_list(Bytes) 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. - [$(, unicode:characters_to_binary(Cmd), "\n) </dev/null; echo \"\^D\"\n"]. - +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. + ["(", unicode:characters_to_binary(Cmd), "\n); echo \"\^D\"\n"], + <<$\^D>>}. validate(Atom) when is_atom(Atom) -> ok; @@ -394,21 +270,40 @@ 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, + case eot(Bytes, Eot) of + more -> + get_data(Port, MonRef, Eot, [Sofar,Bytes]); + Last -> + Port ! {self(), close}, + flush_until_closed(Port), + iolist_to_binary([Sofar, Last]) + end; + {'DOWN', MonRef, _, _ , _} -> receive {'EXIT', Port, _} -> ok after 1 -> % force context switch ok end, - lists:flatten(Sofar) + 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. + +flush_until_closed(Port) -> + receive + {Port, {data, _Bytes}} -> + flush_until_closed(Port); + {Port, closed} -> + true end. diff --git a/lib/kernel/src/pg2.erl b/lib/kernel/src/pg2.erl index ab98181b2a..edf4aedde2 100644 --- a/lib/kernel/src/pg2.erl +++ b/lib/kernel/src/pg2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/ram_file.erl b/lib/kernel/src/ram_file.erl index df335f7a8e..e427d130b7 100644 --- a/lib/kernel/src/ram_file.erl +++ b/lib/kernel/src/ram_file.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index d3db8eb80a..21bff02214 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% 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. @@ -52,10 +52,6 @@ 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, terminate/2, code_change/3]). @@ -67,7 +63,7 @@ %%------------------------------------------------------------------------ --type state() :: gb_trees:tree(pid(), {pid(), reference()}). +-type state() :: map(). %%------------------------------------------------------------------------ @@ -95,7 +91,7 @@ stop(Rpc) -> init([]) -> process_flag(trap_exit, true), - {ok, gb_trees:empty()}. + {ok, maps:new()}. -spec handle_call(term(), term(), state()) -> {'noreply', state()} | @@ -134,29 +130,15 @@ handle_cast(_, S) -> -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 @@ -194,7 +176,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( @@ -209,9 +190,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 .... @@ -357,8 +338,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. @@ -587,27 +572,6 @@ multi_server_call(Nodes, Name, Msg) Monitors = send_nodes(Nodes, Name, Msg, []), rec_nodes(Name, Monitors). -%% Deprecated functions. Were only needed when communicating with R6 nodes. - --spec safe_multi_server_call(Name, Msg) -> {Replies, BadNodes} when - Name :: atom(), - Msg :: term(), - Replies :: [Reply :: term()], - BadNodes :: [node()]. - -safe_multi_server_call(Name, Msg) -> - multi_server_call(Name, Msg). - --spec safe_multi_server_call(Nodes, Name, Msg) -> {Replies, BadNodes} when - Nodes :: [node()], - Name :: atom(), - Msg :: term(), - Replies :: [Reply :: term()], - BadNodes :: [node()]. - -safe_multi_server_call(Nodes, Name, Msg) -> - multi_server_call(Nodes, Name, Msg). - rec_nodes(Name, Nodes) -> rec_nodes(Name, Nodes, [], []). @@ -748,6 +712,11 @@ pinfo(Pid) -> -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() -> diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index a7a782c29c..cc0c10909b 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% 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. @@ -106,14 +106,24 @@ reset_trace() -> %% reset_trace(Pid) -> % this might be a useful function too --type tracer() :: (Pid :: pid()) | port() | 'false'. +-type tracer() :: (Pid :: pid()) | port() | + (TracerModule :: {module(), term()}) | + 'false'. -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 when Tracer :: tracer(). diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 74dd004fa6..5d649e5f94 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/user.erl b/lib/kernel/src/user.erl index 77781e0251..a5cc7b0ec1 100644 --- a/lib/kernel/src/user.erl +++ b/lib/kernel/src/user.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/user_sup.erl b/lib/kernel/src/user_sup.erl index 72c3fad3a9..c1fb1b1a48 100644 --- a/lib/kernel/src/user_sup.erl +++ b/lib/kernel/src/user_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% 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. diff --git a/lib/kernel/src/wrap_log_reader.erl b/lib/kernel/src/wrap_log_reader.erl index 6622405d85..3a984e56c7 100644 --- a/lib/kernel/src/wrap_log_reader.erl +++ b/lib/kernel/src/wrap_log_reader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% 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. |