diff options
Diffstat (limited to 'erts/preloaded/src/erl_prim_loader.erl')
| -rw-r--r-- | erts/preloaded/src/erl_prim_loader.erl | 617 |
1 files changed, 340 insertions, 277 deletions
diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl index e8ddfc4a57..b3ec73a60e 100644 --- a/erts/preloaded/src/erl_prim_loader.erl +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -41,38 +42,39 @@ -include("inet_boot.hrl"). %% Public --export([start/3, set_path/1, get_path/0, get_file/1, get_files/2, - list_dir/1, read_file_info/1, get_cwd/0, get_cwd/1]). +-export([start/0, set_path/1, get_path/0, get_file/1, + list_dir/1, read_file_info/1, read_link_info/1, get_cwd/0, get_cwd/1]). %% Used by erl_boot_server -export([prim_init/0, prim_get_file/2, prim_list_dir/2, - prim_read_file_info/2, prim_get_cwd/2]). + prim_read_file_info/3, prim_get_cwd/2]). %% Used by escript and code --export([set_primary_archive/4, release_archives/0]). +-export([set_primary_archive/4]). + +%% Used by test suites +-export([purge_archive_cache/0]). + +%% Used by init and the code server. +-export([get_modules/2,get_modules/3]). -include_lib("kernel/include/file.hrl"). -type host() :: atom(). -record(prim_state, {debug :: boolean(), - cache, primary_archive}). -type prim_state() :: #prim_state{}. -record(state, {loader :: 'efile' | 'inet', hosts = [] :: [host()], % hosts list (to boot from) - id, % not used any more? data :: 'noport' | port(), % data port etc - timeout :: timeout(), % idle timeout - %% Number of timeouts before archives are released - n_timeouts :: non_neg_integer(), - multi_get = false :: boolean(), + timeout :: timeout(), % idle timeout prim_state :: prim_state()}). % state for efile code loader --define(IDLE_TIMEOUT, 60000). %% tear inet connection after 1 minutes --define(N_TIMEOUTS, 6). %% release efile archive after 6 minutes +-define(EFILE_IDLE_TIMEOUT, (6*60*1000)). %purge archives +-define(INET_IDLE_TIMEOUT, (60*1000)). %tear down connection timeout %% Defines for inet as prim_loader -define(INET_FAMILY, inet). @@ -102,26 +104,13 @@ debug(#prim_state{debug = Deb}, Term) -> %%% Interface Functions. %%% -------------------------------------------------------- --spec start(Id, Loader, Hosts) -> +-spec start() -> {'ok', Pid} | {'error', What} when - Id :: term(), - Loader :: atom() | string(), - Hosts :: Host | [Host], - Host :: host(), Pid :: pid(), What :: term(). -start(Id, Pgm, Hosts) when is_atom(Hosts) -> - start(Id, Pgm, [Hosts]); -start(Id, Pgm0, Hosts) -> - Pgm = if - is_atom(Pgm0) -> - atom_to_list(Pgm0); - true -> - Pgm0 - end, +start() -> Self = self(), - Pid = spawn_link(fun() -> start_it(Pgm, Id, Self, Hosts) end), - register(erl_prim_loader, Pid), + Pid = spawn_link(fun() -> start_it(Self) end), receive {Pid,ok} -> {ok,Pid}; @@ -129,26 +118,39 @@ start(Id, Pgm0, Hosts) -> {error,Reason} end. -%% Hosts must be a list of form ['1.2.3.4' ...] -start_it("inet", Id, Pid, Hosts) -> +start_it(Parent) -> process_flag(trap_exit, true), - ?dbg(inet, {Id,Pid,Hosts}), + register(erl_prim_loader, self()), + Loader = case init:get_argument(loader) of + {ok,[[Loader0]]} -> + Loader0; + error -> + "efile" + end, + case Loader of + "efile" -> start_efile(Parent); + "inet" -> start_inet(Parent) + end. + +%% Hosts must be a list of form ['1.2.3.4' ...] +start_inet(Parent) -> + Hosts = case init:get_argument(hosts) of + {ok,[Hosts0]} -> Hosts0; + _ -> [] + end, AL = ipv4_list(Hosts), ?dbg(addresses, AL), {ok,Tcp} = find_master(AL), - init_ack(Pid), + init_ack(Parent), PS = prim_init(), State = #state {loader = inet, hosts = AL, - id = Id, data = Tcp, - timeout = ?IDLE_TIMEOUT, - n_timeouts = ?N_TIMEOUTS, + timeout = ?INET_IDLE_TIMEOUT, prim_state = PS}, - loop(State, Pid, []); + loop(State, Parent, []). -start_it("efile", Id, Pid, _Hosts) -> - process_flag(trap_exit, true), +start_efile(Parent) -> {ok, Port} = prim_file:start(), %% Check that we started in a valid directory. case prim_file:get_cwd(Port) of @@ -159,20 +161,14 @@ start_it("efile", Id, Pid, _Hosts) -> erlang:display(Report), exit({error, invalid_current_directory}); _ -> - init_ack(Pid) + init_ack(Parent) end, - MultiGet = case erlang:system_info(thread_pool_size) of - 0 -> false; - _ -> true - end, PS = prim_init(), State = #state {loader = efile, - id = Id, data = Port, - timeout = infinity, - multi_get = MultiGet, + timeout = ?EFILE_IDLE_TIMEOUT, prim_state = PS}, - loop(State, Pid, []). + loop(State, Parent, []). init_ack(Pid) -> Pid ! {self(),ok}, @@ -197,20 +193,6 @@ get_file(File) when is_atom(File) -> get_file(File) -> check_file_result(get_file, File, request({get_file,File})). --spec get_files([{atom(), string()}], - fun((atom(),binary(),string()) -> 'ok' | {'error', atom()})) -> - 'ok' | {'error', atom()}. -get_files(ModFiles, Fun) -> - case request({get_files,{ModFiles,Fun}}) of - E = {error,_M} -> - E; - {error,Reason,M} -> - check_file_result(get_files, M, {error,Reason}), - {error,M}; - ok -> - ok - end. - -spec list_dir(Dir) -> {'ok', Filenames} | 'error' when Dir :: string(), Filenames :: [Filename :: string()]. @@ -223,6 +205,12 @@ list_dir(Dir) -> read_file_info(File) -> check_file_result(read_file_info, File, request({read_file_info,File})). +-spec read_link_info(Filename) -> {'ok', FileInfo} | 'error' when + Filename :: string(), + FileInfo :: file:file_info(). +read_link_info(File) -> + check_file_result(read_link_info, File, request({read_link_info,File})). + -spec get_cwd() -> {'ok', string()} | 'error'. get_cwd() -> check_file_result(get_cwd, [], request({get_cwd,[]})). @@ -243,10 +231,30 @@ set_primary_archive(File, ArchiveBin, FileInfo, ParserFun) when is_list(File), is_binary(ArchiveBin), is_record(FileInfo, file_info) -> request({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}). --spec release_archives() -> 'ok' | {'error', _}. +%% NOTE: Does not close the primary archive. Only closes all +%% open zip files kept in the cache. Should be called before an archive +%% file is to be removed (for example in the test suites). + +-spec purge_archive_cache() -> 'ok' | {'error', _}. +purge_archive_cache() -> + request(purge_archive_cache). + +-spec get_modules([module()], + fun((atom(), string(), binary()) -> + {'ok',any()} | {'error',any()})) -> + {'ok',{[any()],[any()]}}. + +get_modules(Modules, Fun) -> + request({get_modules,{Modules,Fun}}). + +-spec get_modules([module()], + fun((atom(), string(), binary()) -> + {'ok',any()} | {'error',any()}), + [string()]) -> + {'ok',{[any()],[any()]}}. -release_archives() -> - request(release_archives). +get_modules(Modules, Fun, Path) -> + request({get_modules,{Modules,Fun,Path}}). request(Req) -> Loader = whereis(erl_prim_loader), @@ -262,6 +270,8 @@ check_file_result(_, _, {error,enoent}) -> error; check_file_result(_, _, {error,enotdir}) -> error; +check_file_result(_, _, {error,einval}) -> + error; check_file_result(Func, Target, {error,Reason}) -> case (catch atom_to_list(Reason)) of {'EXIT',_} -> % exit trapped @@ -301,73 +311,63 @@ check_file_result(_, _, Other) -> %%% The main loop. %%% -------------------------------------------------------- -loop(State, Parent, Paths) -> +loop(St0, Parent, Paths) -> receive + {Pid,{set_path,NewPaths}} when is_pid(Pid) -> + Pid ! {self(),ok}, + loop(St0, Parent, to_strs(NewPaths)); {Pid,Req} when is_pid(Pid) -> - %% erlang:display(Req), - {Resp,State2,Paths2} = - case Req of - {set_path,NewPaths} -> - {ok,State,to_strs(NewPaths)}; - {get_path,_} -> - {{ok,Paths},State,Paths}; - {get_file,File} -> - {Res,State1} = handle_get_file(State, Paths, File), - {Res,State1,Paths}; - {get_files,{ModFiles,Fun}} -> - {Res,State1} = handle_get_files(State, ModFiles, Paths, Fun), - {Res,State1,Paths}; - {list_dir,Dir} -> - {Res,State1} = handle_list_dir(State, Dir), - {Res,State1,Paths}; - {read_file_info,File} -> - {Res,State1} = handle_read_file_info(State, File), - {Res,State1,Paths}; - {get_cwd,[]} -> - {Res,State1} = handle_get_cwd(State, []), - {Res,State1,Paths}; - {get_cwd,[_]=Args} -> - {Res,State1} = handle_get_cwd(State, Args), - {Res,State1,Paths}; - {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} -> - {Res,State1} = - handle_set_primary_archive(State, File, - ArchiveBin, FileInfo, - ParserFun), - {Res,State1,Paths}; - release_archives -> - {Res,State1} = handle_release_archives(State), - {Res,State1,Paths}; - _Other -> - {ignore,State,Paths} - end, - if Resp =:= ignore -> ok; - true -> Pid ! {self(),Resp}, ok - end, - if - is_record(State2, state) -> - loop(State2, Parent, Paths2); - true -> - exit({bad_state, Req, State2}) + case handle_request(Req, Paths, St0) of + ignore -> + ok; + {Resp,#state{}=St1} -> + Pid ! {self(),Resp}, + loop(St1, Parent, Paths); + {_,State2,_} -> + exit({bad_state,Req,State2}) end; {'EXIT',Parent,W} -> - _State1 = handle_stop(State), + _ = handle_stop(St0), exit(W); {'EXIT',P,W} -> - State1 = handle_exit(State, P, W), - loop(State1, Parent, Paths); + St1 = handle_exit(St0, P, W), + loop(St1, Parent, Paths); _Message -> - loop(State, Parent, Paths) - after State#state.timeout -> - State1 = handle_timeout(State, Parent), - loop(State1, Parent, Paths) + loop(St0, Parent, Paths) + after St0#state.timeout -> + St1 = handle_timeout(St0, Parent), + loop(St1, Parent, Paths) + end. + +handle_request(Req, Paths, St0) -> + case Req of + {get_path,_} -> + {{ok,Paths},St0}; + {get_file,File} -> + handle_get_file(St0, Paths, File); + {get_modules,{Modules,Fun}} -> + handle_get_modules(St0, Modules, Fun, Paths); + {get_modules,{Modules,Fun,ModPaths}} -> + handle_get_modules(St0, Modules, Fun, ModPaths); + {list_dir,Dir} -> + handle_list_dir(St0, Dir); + {read_file_info,File} -> + handle_read_file_info(St0, File); + {read_link_info,File} -> + handle_read_link_info(St0, File); + {get_cwd,[]} -> + handle_get_cwd(St0, []); + {get_cwd,[_]=Args} -> + handle_get_cwd(St0, Args); + {set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} -> + handle_set_primary_archive(St0, File, ArchiveBin, + FileInfo, ParserFun); + purge_archive_cache -> + handle_purge_archive_cache(St0); + _ -> + ignore end. -handle_get_files(State = #state{multi_get = true}, ModFiles, Paths, Fun) -> - ?SAFE2(efile_multi_get_file_from_port(State, ModFiles, Paths, Fun), State); -handle_get_files(State, _ModFiles, _Paths, _Fun) -> % no multi get - {{error,no_multi_get},State}. - handle_get_file(State = #state{loader = efile}, Paths, File) -> ?SAFE2(efile_get_file_from_port(State, File, Paths), State); handle_get_file(State = #state{loader = inet}, Paths, File) -> @@ -376,8 +376,9 @@ handle_get_file(State = #state{loader = inet}, Paths, File) -> handle_set_primary_archive(State= #state{loader = efile}, File, ArchiveBin, FileInfo, ParserFun) -> ?SAFE2(efile_set_primary_archive(State, File, ArchiveBin, FileInfo, ParserFun), State). -handle_release_archives(State= #state{loader = efile}) -> - ?SAFE2(efile_release_archives(State), State). +handle_purge_archive_cache(#state{loader = efile}=State) -> + prim_purge_cache(), + {ok,State}. handle_list_dir(State = #state{loader = efile}, Dir) -> ?SAFE2(efile_list_dir(State, Dir), State); @@ -385,10 +386,15 @@ handle_list_dir(State = #state{loader = inet}, Dir) -> ?SAFE2(inet_list_dir(State, Dir), State). handle_read_file_info(State = #state{loader = efile}, File) -> - ?SAFE2(efile_read_file_info(State, File), State); + ?SAFE2(efile_read_file_info(State, File, true), State); handle_read_file_info(State = #state{loader = inet}, File) -> ?SAFE2(inet_read_file_info(State, File), State). +handle_read_link_info(State = #state{loader = efile}, File) -> + ?SAFE2(efile_read_file_info(State, File, false), State); +handle_read_link_info(State = #state{loader = inet}, File) -> + ?SAFE2(inet_read_link_info(State, File), State). + handle_get_cwd(State = #state{loader = efile}, Drive) -> ?SAFE2(efile_get_cwd(State, Drive), State); handle_get_cwd(State = #state{loader = inet}, Drive) -> @@ -413,53 +419,6 @@ handle_timeout(State = #state{loader = inet}, Parent) -> %%% Functions which handle efile as prim_loader (default). %%% -------------------------------------------------------- -%%% Reading many files in parallel is an optimization. -%%% See also comment in init.erl. - -%% -> {ok,State} | {{error,Module},State} | {{error,Reason,Module},State} -efile_multi_get_file_from_port(State, ModFiles, Paths, Fun) -> - Ref = make_ref(), - %% More than 200 processes is no gain. - Max = erlang:min(200, erlang:system_info(thread_pool_size)), - efile_multi_get_file_from_port2(ModFiles, 0, Max, State, Paths, Fun, Ref, ok). - -efile_multi_get_file_from_port2([MF | MFs], Out, Max, State, Paths, Fun, Ref, Ret) when Out < Max -> - Self = self(), - _Pid = spawn(fun() -> efile_par_get_file(Ref, State, MF, Paths, Self, Fun) end), - efile_multi_get_file_from_port2(MFs, Out+1, Max, State, Paths, Fun, Ref, Ret); -efile_multi_get_file_from_port2(MFs, Out, Max, _State, Paths, Fun, Ref, Ret) when Out > 0 -> - receive - {Ref, ok, State1} -> - efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Ret); - {Ref, {error,_Mod} = Error, State1} -> - efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Error); - {Ref, MF, {error,emfile,State1}} -> - %% Max can take negative values. Out cannot. - efile_multi_get_file_from_port2([MF | MFs], Out-1, Max-1, State1, Paths, Fun, Ref, Ret); - {Ref, {M,_F}, {error,Error,State1}} -> - efile_multi_get_file_from_port2(MFs, Out-1, 0, State1, Paths, Fun, Ref, {error,Error,M}) - end; -efile_multi_get_file_from_port2(_MFs, 0, _Max, State, _Paths, _Fun, _Ref, Ret) -> - {Ret,State}. - -efile_par_get_file(Ref, State, {Mod,File} = MF, Paths, Pid, Fun) -> - %% One port for each file read in "parallel": - case prim_file:start() of - {ok, Port} -> - Port0 = State#state.data, - State1 = State#state{data = Port}, - R = case efile_get_file_from_port(State1, File, Paths) of - {{error,Reason},State2} -> - {Ref,MF,{error,Reason,State2}}; - {{ok,BinFile,Full},State2} -> - %% Fun(...) -> ok | {error,Mod} - {Ref,Fun(Mod, BinFile, Full),State2#state{data=Port0}} - end, - prim_file:close(Port), - Pid ! R; - {error, Error} -> - Pid ! {Ref,MF,{error,Error,State}} - end. %% -> {{ok,BinFile,File},State} | {{error,Reason},State} efile_get_file_from_port(State, File, Paths) -> @@ -504,16 +463,12 @@ efile_set_primary_archive(#state{prim_state = PS} = State, File, FileInfo, ParserFun), {Res,State#state{prim_state = PS2}}. -efile_release_archives(#state{prim_state = PS} = State) -> - {Res, PS2} = prim_release_archives(PS), - {Res,State#state{prim_state = PS2}}. - efile_list_dir(#state{prim_state = PS} = State, Dir) -> {Res, PS2} = prim_list_dir(PS, Dir), {Res, State#state{prim_state = PS2}}. -efile_read_file_info(#state{prim_state = PS} = State, File) -> - {Res, PS2} = prim_read_file_info(PS, File), +efile_read_file_info(#state{prim_state = PS} = State, File, FollowLinks) -> + {Res, PS2} = prim_read_file_info(PS, File, FollowLinks), {Res, State#state{prim_state = PS2}}. efile_get_cwd(#state{prim_state = PS} = State, Drive) -> @@ -529,15 +484,126 @@ efile_exit_port(State, Port, Reason) when State#state.data =:= Port -> efile_exit_port(State, _Port, _Reason) -> State. -efile_timeout_handler(#state{n_timeouts = N} = State, _Parent) -> - if - N =< 0 -> - {_Res, State2} = efile_release_archives(State), - State2#state{n_timeouts = ?N_TIMEOUTS}; - true -> - State#state{n_timeouts = N - 1} +efile_timeout_handler(State, _Parent) -> + prim_purge_cache(), + State. + +%%% -------------------------------------------------------- +%%% Read and process severals modules in parallel. +%%% -------------------------------------------------------- + +handle_get_modules(#state{loader=efile}=St, Ms, Process, Paths) -> + Primary = (St#state.prim_state)#prim_state.primary_archive, + Res = case efile_any_archives(Paths, Primary) of + false -> + efile_get_mods_par(Ms, Process, Paths); + true -> + Get = fun efile_get_file_from_port/3, + gm_get_mods(St, Get, Ms, Process, Paths) + end, + {Res,St}; +handle_get_modules(#state{loader=inet}=St, Ms, Process, Paths) -> + Get = fun inet_get_file_from_port/3, + {gm_get_mods(St, Get, Ms, Process, Paths),St}. + +efile_get_mods_par(Ms, Process, Paths) -> + Self = self(), + Ref = make_ref(), + GmSpawn = fun() -> + efile_gm_spawn({Self,Ref}, Ms, Process, Paths) + end, + _ = spawn_link(GmSpawn), + N = length(Ms), + efile_gm_recv(N, Ref, [], []). + +efile_any_archives([H|T], Primary) -> + case name_split(Primary, H) of + {file,_} -> efile_any_archives(T, Primary); + {archive,_,_} -> true + end; +efile_any_archives([], _) -> + false. + +efile_gm_recv(0, _Ref, Succ, Fail) -> + {ok,{Succ,Fail}}; +efile_gm_recv(N, Ref, Succ, Fail) -> + receive + {Ref,Mod,{ok,Res}} -> + efile_gm_recv(N-1, Ref, [{Mod,Res}|Succ], Fail); + {Ref,Mod,{error,Res}} -> + efile_gm_recv(N-1, Ref, Succ, [{Mod,Res}|Fail]) + end. + +efile_gm_spawn(ParentRef, Ms, Process, Paths) -> + efile_gm_spawn_1(0, Ms, ParentRef, Process, Paths). + +efile_gm_spawn_1(N, Ms, ParentRef, Process, Paths) when N >= 32 -> + receive + {'DOWN',_,process,_,_} -> + efile_gm_spawn_1(N-1, Ms, ParentRef, Process, Paths) + end; +efile_gm_spawn_1(N, [M|Ms], ParentRef, Process, Paths) -> + Get = fun() -> efile_gm_get(Paths, M, ParentRef, Process) end, + _ = spawn_monitor(Get), + efile_gm_spawn_1(N+1, Ms, ParentRef, Process, Paths); +efile_gm_spawn_1(_, [], _, _, _) -> + ok. + +efile_gm_get(Paths, Mod, ParentRef, Process) -> + File = atom_to_list(Mod) ++ init:objfile_extension(), + efile_gm_get_1(Paths, File, Mod, ParentRef, Process). + +efile_gm_get_1([P|Ps], File0, Mod, {Parent,Ref}=PR, Process) -> + File = join(P, File0), + Res = try prim_file:read_file(File) of + {ok,Bin} -> + gm_process(Mod, File, Bin, Process); + Error -> + _ = check_file_result(get_modules, File, Error), + efile_gm_get_1(Ps, File0, Mod, PR, Process) + catch + _:Reason -> + {error,{crash,Reason}} + end, + Parent ! {Ref,Mod,Res}; +efile_gm_get_1([], _, Mod, {Parent,Ref}, _Process) -> + Parent ! {Ref,Mod,{error,enoent}}. + +gm_get_mods(St, Get, Ms, Process, Paths) -> + gm_get_mods(St, Get, Ms, Process, Paths, [], []). + +gm_get_mods(St, Get, [M|Ms], Process, Paths, Succ, Fail) -> + File = atom_to_list(M) ++ init:objfile_extension(), + case gm_arch_get(St, Get, M, File, Paths, Process) of + {ok,Res} -> + gm_get_mods(St, Get, Ms, Process, Paths, + [{M,Res}|Succ], Fail); + {error,Res} -> + gm_get_mods(St, Get, Ms, Process, Paths, + Succ, [{M,Res}|Fail]) + end; +gm_get_mods(_St, _Get, [], _, _, Succ, Fail) -> + {ok,{Succ,Fail}}. + +gm_arch_get(St, Get, Mod, File, Paths, Process) -> + case Get(St, File, Paths) of + {{error,_}=E,_} -> + E; + {{ok,Bin,Full},_} -> + gm_process(Mod, Full, Bin, Process) + end. + +gm_process(Mod, File, Bin, Process) -> + try Process(Mod, File, Bin) of + {ok,_}=Res -> Res; + {error,_}=Res -> Res; + Other -> {error,{bad_return,Other}} + catch + _:Error -> + {error,{crash,Error}} end. + %%% -------------------------------------------------------- %%% Functions which handle inet prim_loader %%% -------------------------------------------------------- @@ -677,7 +743,7 @@ inet_get_file_from_port1(_File, [], State) -> inet_send_and_rcv(Msg, Tag, State) when State#state.data =:= noport -> {ok,Tcp} = find_master(State#state.hosts), %% reconnect inet_send_and_rcv(Msg, Tag, State#state{data = Tcp, - timeout = ?IDLE_TIMEOUT}); + timeout = ?INET_IDLE_TIMEOUT}); inet_send_and_rcv(Msg, Tag, #state{data = Tcp, timeout = Timeout} = State) -> prim_inet:send(Tcp, term_to_binary(Msg)), receive @@ -716,6 +782,10 @@ inet_list_dir(State, Dir) -> inet_read_file_info(State, File) -> inet_send_and_rcv({read_file_info,File}, read_file_info, State). +%% -> {{ok,Info},State} | {{error,Reason},State} +inet_read_link_info(State, File) -> + inet_send_and_rcv({read_link_info,File}, read_link_info, State). + %% -> {{ok,Cwd},State} | {{error,Reason},State} inet_get_cwd(State, []) -> inet_send_and_rcv(get_cwd, get_cwd, State); @@ -798,32 +868,19 @@ prim_init() -> end, cache_new(#prim_state{debug = Deb}). -prim_release_archives(PS) -> - debug(PS, release_archives), - {Res, PS2} = prim_do_release_archives(PS, get(), []), - debug(PS2, {return, Res}), - {Res, PS2}. - -prim_do_release_archives(PS, [{ArchiveFile, DictVal} | KeyVals], Acc) -> - Res = - case DictVal of - {primary, _PrimZip, _FI, _ParserFun} -> - ok; % Keep primary archive - {Cache, _FI} -> - debug(PS, {release, cache, ArchiveFile}), - erase(ArchiveFile), - clear_cache(ArchiveFile, Cache) - end, - case Res of - ok -> - prim_do_release_archives(PS, KeyVals, Acc); - {error, Reason} -> - prim_do_release_archives(PS, KeyVals, [{ArchiveFile, Reason} | Acc]) - end; -prim_do_release_archives(PS, [], []) -> - {ok, PS#prim_state{primary_archive = undefined}}; -prim_do_release_archives(PS, [], Errors) -> - {{error, Errors}, PS#prim_state{primary_archive = undefined}}. +prim_purge_cache() -> + do_prim_purge_cache(get()). + +do_prim_purge_cache([{Key,Val}|T]) -> + case Val of + {Cache,_FI} -> + catch clear_cache(Key, Cache); + _ -> + ok + end, + do_prim_purge_cache(T); +do_prim_purge_cache([]) -> + ok. prim_set_primary_archive(PS, undefined, undefined, undefined, _ParserFun) -> debug(PS, {set_primary_archive, clean}), @@ -949,16 +1006,18 @@ prim_list_dir(PS, Dir) -> debug(PS, {return, Res2}), {Res2, PS3}. --spec prim_read_file_info(prim_state(), file:filename()) -> +-spec prim_read_file_info(prim_state(), file:filename(), boolean()) -> {{'ok', #file_info{}}, prim_state()} | {{'error', term()}, prim_state()}. -prim_read_file_info(PS, File) -> +prim_read_file_info(PS, File, FollowLinks) -> debug(PS, {read_file_info, File}), {Res2, PS2} = case name_split(PS#prim_state.primary_archive, File) of {file, PrimFile} -> - Res = prim_file:read_file_info(PrimFile), - {Res, PS}; + case FollowLinks of + true -> {prim_file:read_file_info(PrimFile), PS}; + false -> {prim_file:read_link_info(PrimFile), PS} + end; {archive, ArchiveFile, []} -> %% Fake top directory debug(PS, {archive_read_file_info, ArchiveFile}), @@ -1041,7 +1100,7 @@ apply_archive(PS, Fun, Acc, Archive) -> apply_archive(PS, Fun, Acc, Archive); Error -> debug(PS, {cache, {clear, Error}}), - clear_cache(Archive, {ok, PrimZip}), + ok = clear_cache(Archive, {ok, PrimZip}), apply_archive(PS, Fun, Acc, Archive) end; {Cache, FI} -> @@ -1264,70 +1323,62 @@ path_join([Path],Acc) -> path_join([Path|Paths],Acc) -> path_join(Paths,"/" ++ reverse(Path) ++ Acc). -name_split(ArchiveFile, File0) -> - File = absname(File0), - do_name_split(ArchiveFile, File). - -do_name_split(undefined, File) -> +name_split(undefined, File) -> %% Ignore primary archive - case string_split(File, init:archive_extension(), []) of + RevExt = reverse(init:archive_extension()), + case archive_split(File, RevExt, []) of no_split -> - %% Plain file {file, File}; - {split, _RevArchiveBase, RevArchiveFile, []} -> - %% Top dir in archive - ArchiveFile = reverse(RevArchiveFile), - {archive, ArchiveFile, []}; - {split, _RevArchiveBase, RevArchiveFile, [$/ | FileInArchive]} -> - %% File in archive - ArchiveFile = reverse(RevArchiveFile), - {archive, ArchiveFile, FileInArchive}; - {split, _RevArchiveBase, _RevArchiveFile, _FileInArchive} -> - %% False match. Assume plain file - {file, File} + Archive -> + Archive end; -do_name_split(ArchiveFile, File) -> +name_split(ArchiveFile, File0) -> %% Look first in primary archive - case string_match(real_path(File), ArchiveFile, []) of + File = absname(File0), + case string_match(real_path(File), ArchiveFile) of no_match -> %% Archive or plain file - do_name_split(undefined, File); - {match, _RevPrimArchiveFile, FileInArchive} -> + name_split(undefined, File); + {match, FileInArchive} -> %% Primary archive {archive, ArchiveFile, FileInArchive} end. -string_match([Char | File], [Char | Archive], RevTop) -> - string_match(File, Archive, [Char | RevTop]); -string_match([] = File, [], RevTop) -> - {match, RevTop, File}; -string_match([$/ | File], [], RevTop) -> - {match, RevTop, File}; -string_match(_File, _Archive, _RevTop) -> +string_match([Char | File], [Char | Archive]) -> + string_match(File, Archive); +string_match([] = File, []) -> + {match, File}; +string_match([$/ | File], []) -> + {match, File}; +string_match(_File, _Archive) -> no_match. -string_split([Char | File], [Char | Ext] = FullExt, RevTop) -> - RevTop2 = [Char | RevTop], - string_split2(File, Ext, RevTop, RevTop2, File, FullExt, RevTop2); -string_split([Char | File], Ext, RevTop) -> - string_split(File, Ext, [Char | RevTop]); -string_split([], _Ext, _RevTop) -> - no_split. - -string_split2([Char | File], [Char | Ext], RevBase, RevTop, SaveFile, SaveExt, SaveTop) -> - string_split2(File, Ext, RevBase, [Char | RevTop], SaveFile, SaveExt, SaveTop); -string_split2(File, [], RevBase, RevTop, _SaveFile, _SaveExt, _SaveTop) -> - {split, RevBase, RevTop, File}; -string_split2(_, _Ext, _RevBase, _RevTop, SaveFile, SaveExt, SaveTop) -> - string_split(SaveFile, SaveExt, SaveTop). +archive_split("/"++File, RevExt, Acc) -> + case is_prefix(RevExt, Acc) of + false -> + archive_split(File, RevExt, [$/|Acc]); + true -> + ArchiveFile = absname(reverse(Acc)), + {archive, ArchiveFile, File} + end; +archive_split([H|T], RevExt, Acc) -> + archive_split(T, RevExt, [H|Acc]); +archive_split([], RevExt, Acc) -> + case is_prefix(RevExt, Acc) of + false -> + no_split; + true -> + ArchiveFile = absname(reverse(Acc)), + {archive, ArchiveFile, []} + end. + +is_prefix([H|T1], [H|T2]) -> is_prefix(T1, T2); +is_prefix([_|_], _) -> false; +is_prefix([], _ ) -> true. %% Parse list of ipv4 addresses ipv4_list([H | T]) -> - IPV = if is_atom(H) -> ipv4_address(atom_to_list(H)); - is_list(H) -> ipv4_address(H); - true -> {error,einal} - end, - case IPV of + case ipv4_address(H) of {ok,IP} -> [IP | ipv4_list(T)]; _ -> ipv4_list(T) end; @@ -1439,7 +1490,12 @@ normalize(Name, Acc) -> [Atom | Rest] when is_atom(Atom) -> normalize(atom_to_list(Atom) ++ Rest, Acc); [$\\ | Chars] -> - normalize(Chars, [$/ | Acc]); + case erlang:system_info(os_type) of + {win32, _} -> + normalize(Chars, [$/ | Acc]); + _ -> + normalize(Chars, [$\\ | Acc]) + end; [Char | Chars] -> normalize(Chars, [Char | Acc]); [] -> @@ -1478,7 +1534,14 @@ real_path(Name,[Path|Paths],Acc,Links) -> [""|_] = LinkPaths -> real_path(Name,LinkPaths++Paths,[],[ThisFile|Links]); LinkPaths -> - real_path(Name,LinkPaths++Paths,Acc,[ThisFile|Links]) + % windows currently does not allow creation of relative symlinks + % across different drives + case erlang:system_info(os_type) of + {win32, _} -> + real_path(Name,LinkPaths++Paths,[],[ThisFile|Links]); + _ -> + real_path(Name,LinkPaths++Paths,Acc,[ThisFile|Links]) + end end; _ -> real_path(Name,Paths,This,Links) |