1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%% A primary loader, provides two different methods to fetch a file:
22%% efile and inet. The efile method is simple communication with a
23%% port program.
24%%
25%% The distribution loading was removed and replaced with
26%% inet loading
27%%
28%% The start_it/4 function initializes a record with callback
29%% functions used to handle the interface functions.
30%%
31
32-module(erl_prim_loader).
33
34%% If the macro DEBUG is defined during compilation,
35%% debug printouts are done through erlang:display/1.
36%% Activate this feature by starting the compiler
37%% with> erlc -DDEBUG ...
38%% or by> setenv ERL_COMPILER_FLAGS DEBUG
39%% before running make (in the OTP make system)
40%% (the example is for tcsh)
41
42-include("inet_boot.hrl").
43
44%% Public
45-export([start/0, set_path/1, get_path/0, get_file/1,
46         list_dir/1, read_file_info/1, read_link_info/1, get_cwd/0, get_cwd/1]).
47
48%% Used by erl_boot_server
49-export([prim_init/0, prim_get_file/2, prim_list_dir/2,
50         prim_read_file_info/3, prim_get_cwd/2]).
51
52%% Used by escript and code
53-export([set_primary_archive/4]).
54
55%% Used by test suites
56-export([purge_archive_cache/0]).
57
58%% Used by init and the code server.
59-export([get_modules/2,get_modules/3, is_basename/1]).
60
61-include_lib("kernel/include/file.hrl").
62
63-type host() :: atom().
64
65-record(prim_state, {debug :: boolean(),
66		     primary_archive}).
67-type prim_state() :: #prim_state{}.
68
69-record(state,
70        {loader            :: 'efile' | 'inet',
71         hosts = []        :: [host()], % hosts list (to boot from)
72         data              :: 'noport' | port(), % data port etc
73         timeout           :: timeout(),	 % idle timeout
74         prim_state        :: prim_state()}).    % state for efile code loader
75
76-define(EFILE_IDLE_TIMEOUT, (6*60*1000)).	%purge archives
77-define(INET_IDLE_TIMEOUT, (60*1000)). 		%tear down connection timeout
78
79%% Defines for inet as prim_loader
80-define(INET_FAMILY, inet).
81-define(INET_ADDRESS, {0,0,0,0}).
82
83-ifdef(DEBUG).
84-define(dbg(Tag, Data), erlang:display({Tag,Data})).
85-else.
86-define(dbg(Tag, Data), true).
87-endif.
88
89-define(SAFE2(Expr, State),
90        fun() ->
91                case catch Expr of
92                    {'EXIT',XXXReason} -> {{error,XXXReason}, State};
93                    XXXRes -> XXXRes
94                end
95        end()).
96
97debug(#prim_state{debug = Deb}, Term) ->
98    case Deb of
99        false -> ok;
100        true  -> erlang:display(Term)
101    end.
102
103%%% --------------------------------------------------------
104%%% Interface Functions.
105%%% --------------------------------------------------------
106
107-spec start() ->
108	    {'ok', Pid} | {'error', What} when
109      Pid :: pid(),
110      What :: term().
111start() ->
112    Self = self(),
113    Pid = spawn_link(fun() -> start_it(Self) end),
114    receive
115        {Pid,ok} ->
116            {ok,Pid};
117        {'EXIT',Pid,Reason} ->
118            {error,Reason}
119    end.
120
121start_it(Parent) ->
122    process_flag(trap_exit, true),
123    register(erl_prim_loader, self()),
124    Loader = case init:get_argument(loader) of
125		 {ok,[[Loader0]]} ->
126		     Loader0;
127		 error ->
128		     "efile"
129	     end,
130    case Loader of
131	"efile" -> start_efile(Parent);
132	"inet" -> start_inet(Parent)
133    end.
134
135%% Hosts must be a list of form ['1.2.3.4' ...]
136start_inet(Parent) ->
137    Hosts = case init:get_argument(hosts) of
138		{ok,[Hosts0]} -> Hosts0;
139		_ -> []
140	    end,
141    AL = ipv4_list(Hosts),
142    ?dbg(addresses, AL),
143    {ok,Tcp} = find_master(AL),
144    init_ack(Parent),
145    PS = prim_init(),
146    State = #state {loader = inet,
147                    hosts = AL,
148                    data = Tcp,
149                    timeout = ?INET_IDLE_TIMEOUT,
150                    prim_state = PS},
151    loop(State, Parent, []).
152
153start_efile(Parent) ->
154    %% Check that we started in a valid directory.
155    case prim_file:get_cwd() of
156	{error, _} ->
157	    %% At this point in the startup, we have no error_logger at all.
158	    Report = "Invalid current directory or invalid filename "
159		"mode: loader cannot read current directory\n",
160	    erlang:display(Report),
161	    exit({error, invalid_current_directory});
162	_ ->
163	    init_ack(Parent)
164    end,
165    PS = prim_init(),
166    State = #state {loader = efile,
167                    data = noport,
168                    timeout = ?EFILE_IDLE_TIMEOUT,
169                    prim_state = PS},
170    loop(State, Parent, []).
171
172init_ack(Pid) ->
173    Pid ! {self(),ok},
174    ok.
175
176-spec set_path(Path) -> 'ok' when
177      Path :: [Dir :: string()].
178set_path(Paths) when is_list(Paths) ->
179    request({set_path,Paths}).
180
181-spec get_path() -> {'ok', Path} when
182      Path :: [Dir :: string()].
183get_path() ->
184    request({get_path,[]}).
185
186-spec get_file(Filename) -> {'ok', Bin, FullName} | 'error' when
187      Filename :: atom() | string(),
188      Bin :: binary(),
189      FullName :: string().
190get_file(File) when is_atom(File) ->
191    get_file(atom_to_list(File));
192get_file(File) ->
193    check_file_result(get_file, File, request({get_file,File})).
194
195-spec list_dir(Dir) -> {'ok', Filenames} | 'error' when
196      Dir :: string(),
197      Filenames :: [Filename :: string()].
198list_dir(Dir) ->
199    check_file_result(list_dir, Dir, request({list_dir,Dir})).
200
201-spec read_file_info(Filename) -> {'ok', FileInfo} | 'error' when
202      Filename :: string(),
203      FileInfo :: file:file_info().
204read_file_info(File) ->
205    check_file_result(read_file_info, File, request({read_file_info,File})).
206
207-spec read_link_info(Filename) -> {'ok', FileInfo} | 'error' when
208      Filename :: string(),
209      FileInfo :: file:file_info().
210read_link_info(File) ->
211    check_file_result(read_link_info, File, request({read_link_info,File})).
212
213-spec get_cwd() -> {'ok', string()} | 'error'.
214get_cwd() ->
215    check_file_result(get_cwd, [], request({get_cwd,[]})).
216
217-spec get_cwd(string()) -> {'ok', string()} | 'error'.
218get_cwd(Drive) ->
219    check_file_result(get_cwd, Drive, request({get_cwd,[Drive]})).
220
221-spec set_primary_archive(File :: string() | 'undefined',
222			  ArchiveBin :: binary() | 'undefined',
223			  FileInfo :: #file_info{} | 'undefined',
224			  ParserFun :: fun())
225			 -> {ok, [string()]} | {error,_}.
226
227set_primary_archive(undefined, undefined, undefined, ParserFun) ->
228    request({set_primary_archive, undefined, undefined, undefined, ParserFun});
229set_primary_archive(File, ArchiveBin, FileInfo, ParserFun)
230  when is_list(File), is_binary(ArchiveBin), is_record(FileInfo, file_info) ->
231    request({set_primary_archive, File, ArchiveBin, FileInfo, ParserFun}).
232
233%% NOTE: Does not close the primary archive. Only closes all
234%% open zip files kept in the cache. Should be called before an archive
235%% file is to be removed (for example in the test suites).
236
237-spec purge_archive_cache() -> 'ok' | {'error', _}.
238purge_archive_cache() ->
239    request(purge_archive_cache).
240
241-spec get_modules([module()],
242		  fun((atom(), string(), binary()) ->
243			     {'ok',any()} | {'error',any()})) ->
244			 {'ok',{[any()],[any()]}}.
245
246get_modules(Modules, Fun) ->
247    request({get_modules,{Modules,Fun}}).
248
249-spec get_modules([module()],
250		  fun((atom(), string(), binary()) ->
251			     {'ok',any()} | {'error',any()}),
252		  [string()]) ->
253			 {'ok',{[any()],[any()]}}.
254
255get_modules(Modules, Fun, Path) ->
256    request({get_modules,{Modules,Fun,Path}}).
257
258request(Req) ->
259    Loader = whereis(erl_prim_loader),
260    Loader ! {self(),Req},
261    receive
262        {Loader,Res} ->
263            Res;
264        {'EXIT',Loader,_What} ->
265            error
266    end.
267
268check_file_result(_, _, {error,enoent}) ->
269    error;
270check_file_result(_, _, {error,enotdir}) ->
271    error;
272check_file_result(_, _, {error,einval}) ->
273    error;
274check_file_result(Func, Target, {error,Reason}) ->
275    case (catch atom_to_list(Reason)) of
276        {'EXIT',_} ->                           % exit trapped
277            error;
278        Errno ->                                % errno
279            Process = case process_info(self(), registered_name) of
280                          {registered_name,R} ->
281                              "Process: " ++ atom_to_list(R) ++ ".";
282                          _ ->
283                              ""
284                      end,
285            TargetStr =
286                if is_atom(Target) -> atom_to_list(Target);
287                   is_list(Target) -> Target;
288                   true -> []
289                end,
290            Report =
291                case TargetStr of
292                    [] ->
293                        "File operation error: " ++ Errno ++ ". " ++
294                        "Function: " ++ atom_to_list(Func) ++ ". " ++ Process;
295                    _ ->
296                        "File operation error: " ++ Errno ++ ". " ++
297                        "Target: " ++ TargetStr ++ ". " ++
298                        "Function: " ++ atom_to_list(Func) ++ ". " ++ Process
299                end,
300            %% This is equal to calling logger:error/2 which
301            %% we don't want to do from code_server during system boot.
302            %% We don't want to call logger:timestamp() either.
303            logger ! {log,error,#{label=>{?MODULE,file_error},report=>Report},
304                      #{pid=>self(),
305                        gl=>group_leader(),
306                        time=>os:system_time(microsecond),
307                        error_logger=>#{tag=>error_report,
308                                        type=>std_error}}},
309            error
310    end;
311check_file_result(_, _, Other) ->
312    Other.
313
314%%% --------------------------------------------------------
315%%% The main loop.
316%%% --------------------------------------------------------
317
318loop(St0, Parent, Paths) ->
319    receive
320	{Pid,{set_path,NewPaths}} when is_pid(Pid) ->
321	    Pid ! {self(),ok},
322	    loop(St0, Parent, to_strs(NewPaths));
323        {Pid,Req} when is_pid(Pid) ->
324	    case handle_request(Req, Paths, St0) of
325		ignore ->
326		    ok;
327		{Resp,#state{}=St1} ->
328		    Pid ! {self(),Resp},
329                    loop(St1, Parent, Paths);
330		{_,State2,_} ->
331                    exit({bad_state,Req,State2})
332            end;
333        {'EXIT',Parent,W} ->
334            _ = handle_stop(St0),
335            exit(W);
336        {'EXIT',P,W} ->
337            St1 = handle_exit(St0, P, W),
338            loop(St1, Parent, Paths);
339        _Message ->
340            loop(St0, Parent, Paths)
341    after St0#state.timeout ->
342            St1 = handle_timeout(St0, Parent),
343            loop(St1, Parent, Paths)
344    end.
345
346handle_request(Req, Paths, St0) ->
347    case Req of
348	{get_path,_} ->
349	    {{ok,Paths},St0};
350	{get_file,File} ->
351	    handle_get_file(St0, Paths, File);
352	{get_modules,{Modules,Fun}} ->
353	    handle_get_modules(St0, Modules, Fun, Paths);
354	{get_modules,{Modules,Fun,ModPaths}} ->
355	    handle_get_modules(St0, Modules, Fun, ModPaths);
356	{list_dir,Dir} ->
357	    handle_list_dir(St0, Dir);
358	{read_file_info,File} ->
359	    handle_read_file_info(St0, File);
360	{read_link_info,File} ->
361	    handle_read_link_info(St0, File);
362	{get_cwd,[]} ->
363	    handle_get_cwd(St0, []);
364	{get_cwd,[_]=Args} ->
365	    handle_get_cwd(St0, Args);
366	{set_primary_archive,File,ArchiveBin,FileInfo,ParserFun} ->
367	    handle_set_primary_archive(St0, File, ArchiveBin,
368				       FileInfo, ParserFun);
369	purge_archive_cache ->
370	    handle_purge_archive_cache(St0);
371	_ ->
372	    ignore
373    end.
374
375handle_get_file(State = #state{loader = efile}, Paths, File) ->
376    ?SAFE2(efile_get_file_from_port(State, File, Paths), State);
377handle_get_file(State = #state{loader = inet}, Paths, File) ->
378    ?SAFE2(inet_get_file_from_port(State, File, Paths), State).
379
380handle_set_primary_archive(State= #state{loader = efile}, File, ArchiveBin, FileInfo, ParserFun) ->
381    ?SAFE2(efile_set_primary_archive(State, File, ArchiveBin, FileInfo, ParserFun), State).
382
383handle_purge_archive_cache(#state{loader = efile}=State) ->
384    prim_purge_cache(),
385    {ok,State}.
386
387handle_list_dir(State = #state{loader = efile}, Dir) ->
388    ?SAFE2(efile_list_dir(State, Dir), State);
389handle_list_dir(State = #state{loader = inet}, Dir) ->
390    ?SAFE2(inet_list_dir(State, Dir), State).
391
392handle_read_file_info(State = #state{loader = efile}, File) ->
393    ?SAFE2(efile_read_file_info(State, File, true), State);
394handle_read_file_info(State = #state{loader = inet}, File) ->
395    ?SAFE2(inet_read_file_info(State, File), State).
396
397handle_read_link_info(State = #state{loader = efile}, File) ->
398    ?SAFE2(efile_read_file_info(State, File, false), State);
399handle_read_link_info(State = #state{loader = inet}, File) ->
400    ?SAFE2(inet_read_link_info(State, File), State).
401
402handle_get_cwd(State = #state{loader = efile}, Drive) ->
403    ?SAFE2(efile_get_cwd(State, Drive), State);
404handle_get_cwd(State = #state{loader = inet}, Drive) ->
405    ?SAFE2(inet_get_cwd(State, Drive), State).
406
407handle_stop(State = #state{loader = efile}) ->
408    State;
409handle_stop(State = #state{loader = inet}) ->
410    inet_stop_port(State).
411
412handle_exit(State = #state{loader = efile}, _Who, _Reason) ->
413    State;
414handle_exit(State = #state{loader = inet}, Who, Reason) ->
415    inet_exit_port(State, Who, Reason).
416
417handle_timeout(State = #state{loader = efile}, Parent) ->
418    efile_timeout_handler(State, Parent);
419handle_timeout(State = #state{loader = inet}, Parent) ->
420    inet_timeout_handler(State, Parent).
421
422%%% --------------------------------------------------------
423%%% Functions which handle efile as prim_loader (default).
424%%% --------------------------------------------------------
425
426
427%% -> {{ok,BinFile,File},State} | {{error,Reason},State}
428efile_get_file_from_port(State, File, Paths) ->
429    case is_basename(File) of
430        false ->                        % get absolute file name.
431            efile_get_file_from_port2(State, File);
432        true when Paths =:= [] ->       % get plain file name.
433            efile_get_file_from_port2(State, File);
434        true ->                         % use paths.
435            efile_get_file_from_port3(State, File, Paths)
436    end.
437
438efile_get_file_from_port2(#state{prim_state = PS} = State, File) ->
439    {Res, PS2} = prim_get_file(PS, File),
440    case Res of
441        {error,port_died} ->
442            exit('prim_load port died');
443        {error,Reason} ->
444            {{error,Reason},State#state{prim_state = PS2}};
445        {ok,BinFile} ->
446            {{ok,BinFile,File},State#state{prim_state = PS2}}
447    end.
448
449efile_get_file_from_port3(State, File, [P | Paths]) ->
450    case efile_get_file_from_port2(State, join(P, File)) of
451        {{error,Reason},State1} when Reason =/= emfile ->
452            case Paths of
453                [] ->                           % return last error
454                    {{error,Reason},State1};
455                _ ->                            % try more paths
456                    efile_get_file_from_port3(State1, File, Paths)
457            end;
458        Result ->
459            Result
460    end;
461efile_get_file_from_port3(State, _File, []) ->
462    {{error,enoent},State}.
463
464efile_set_primary_archive(#state{prim_state = PS} = State, File,
465			  ArchiveBin, FileInfo, ParserFun) ->
466    {Res, PS2} = prim_set_primary_archive(PS, File, ArchiveBin,
467					  FileInfo, ParserFun),
468    {Res,State#state{prim_state = PS2}}.
469
470efile_list_dir(#state{prim_state = PS} = State, Dir) ->
471    {Res, PS2} = prim_list_dir(PS, Dir),
472    {Res, State#state{prim_state = PS2}}.
473
474efile_read_file_info(#state{prim_state = PS} = State, File, FollowLinks) ->
475    {Res, PS2} = prim_read_file_info(PS, File, FollowLinks),
476    {Res, State#state{prim_state = PS2}}.
477
478efile_get_cwd(#state{prim_state = PS} = State, Drive) ->
479    {Res, PS2} = prim_get_cwd(PS, Drive),
480    {Res, State#state{prim_state = PS2}}.
481
482efile_timeout_handler(State, _Parent) ->
483    prim_purge_cache(),
484    State.
485
486%%% --------------------------------------------------------
487%%% Read and process severals modules in parallel.
488%%% --------------------------------------------------------
489
490handle_get_modules(#state{loader=efile}=St, Ms, Process, Paths) ->
491    Primary = (St#state.prim_state)#prim_state.primary_archive,
492    Res = case efile_any_archives(Paths, Primary) of
493	      false ->
494		  efile_get_mods_par(Ms, Process, Paths);
495	      true ->
496		  Get = fun efile_get_file_from_port/3,
497		  gm_get_mods(St, Get, Ms, Process, Paths)
498	  end,
499    {Res,St};
500handle_get_modules(#state{loader=inet}=St, Ms, Process, Paths) ->
501    Get = fun inet_get_file_from_port/3,
502    {gm_get_mods(St, Get, Ms, Process, Paths),St}.
503
504efile_get_mods_par(Ms, Process, Paths) ->
505    Self = self(),
506    Ref = make_ref(),
507    GmSpawn = fun() ->
508		      efile_gm_spawn({Self,Ref}, Ms, Process, Paths)
509	      end,
510    _ = spawn_link(GmSpawn),
511    N = length(Ms),
512    efile_gm_recv(N, Ref, [], []).
513
514efile_any_archives([H|T], Primary) ->
515    case name_split(Primary, H) of
516	{file,_} -> efile_any_archives(T, Primary);
517	{archive,_,_} -> true
518    end;
519efile_any_archives([], _) ->
520    false.
521
522efile_gm_recv(0, _Ref, Succ, Fail) ->
523    {ok,{Succ,Fail}};
524efile_gm_recv(N, Ref, Succ, Fail) ->
525    receive
526	{Ref,Mod,{ok,Res}} ->
527	    efile_gm_recv(N-1, Ref, [{Mod,Res}|Succ], Fail);
528	{Ref,Mod,{error,Res}} ->
529	    efile_gm_recv(N-1, Ref, Succ, [{Mod,Res}|Fail])
530    end.
531
532efile_gm_spawn(ParentRef, Ms, Process, Paths) ->
533    efile_gm_spawn_1(0, Ms, ParentRef, Process, Paths).
534
535efile_gm_spawn_1(N, Ms, ParentRef, Process, Paths) when N >= 32 ->
536    receive
537	{'DOWN',_,process,_,_} ->
538	    efile_gm_spawn_1(N-1, Ms, ParentRef, Process, Paths)
539    end;
540efile_gm_spawn_1(N, [M|Ms], ParentRef, Process, Paths) ->
541    Get = fun() -> efile_gm_get(Paths, M, ParentRef, Process) end,
542    _ = spawn_monitor(Get),
543    efile_gm_spawn_1(N+1, Ms, ParentRef, Process, Paths);
544efile_gm_spawn_1(_, [], _, _, _) ->
545    ok.
546
547efile_gm_get(Paths, Mod, ParentRef, Process) ->
548    File = atom_to_list(Mod) ++ init:objfile_extension(),
549    efile_gm_get_1(Paths, File, Mod, ParentRef, Process).
550
551efile_gm_get_1([P|Ps], File0, Mod, {Parent,Ref}=PR, Process) ->
552    File = join(P, File0),
553    try prim_file:read_file(File) of
554	{ok,Bin} ->
555	    Res = gm_process(Mod, File, Bin, Process),
556	    Parent ! {Ref,Mod,Res};
557	Error ->
558	    _ = check_file_result(get_modules, File, Error),
559	    efile_gm_get_1(Ps, File0, Mod, PR, Process)
560    catch
561	_:Reason ->
562	    Res = {error,{crash,Reason}},
563	    Parent ! {Ref,Mod,Res}
564    end;
565efile_gm_get_1([], _, Mod, {Parent,Ref}, _Process) ->
566    Parent ! {Ref,Mod,{error,enoent}}.
567
568gm_get_mods(St, Get, Ms, Process, Paths) ->
569    gm_get_mods(St, Get, Ms, Process, Paths, [], []).
570
571gm_get_mods(St, Get, [M|Ms], Process, Paths, Succ, Fail) ->
572    File = atom_to_list(M) ++ init:objfile_extension(),
573    case gm_arch_get(St, Get, M, File, Paths, Process) of
574	{ok,Res} ->
575	    gm_get_mods(St, Get, Ms, Process, Paths,
576			[{M,Res}|Succ], Fail);
577	{error,Res} ->
578	    gm_get_mods(St, Get, Ms, Process, Paths,
579			Succ, [{M,Res}|Fail])
580    end;
581gm_get_mods(_St, _Get, [], _, _, Succ, Fail) ->
582    {ok,{Succ,Fail}}.
583
584gm_arch_get(St, Get, Mod, File, Paths, Process) ->
585    case Get(St, File, Paths) of
586	{{error,_}=E,_} ->
587	    E;
588	{{ok,Bin,Full},_} ->
589	    gm_process(Mod, Full, Bin, Process)
590    end.
591
592gm_process(Mod, File, Bin, Process) ->
593    try Process(Mod, File, Bin) of
594	{ok,_}=Res -> Res;
595	{error,_}=Res -> Res;
596	Other -> {error,{bad_return,Other}}
597    catch
598	_:Error ->
599	    {error,{crash,Error}}
600    end.
601
602
603%%% --------------------------------------------------------
604%%% Functions which handle inet prim_loader
605%%% --------------------------------------------------------
606
607%%
608%% Connect to a boot master
609%% return {ok, Socket}  TCP
610%% AL is a list of boot servers (including broadcast addresses)
611%%
612find_master(AL) ->
613    find_master(AL, ?EBOOT_RETRY, ?EBOOT_REQUEST_DELAY, ?EBOOT_SHORT_RETRY_SLEEP,
614               ?EBOOT_UNSUCCESSFUL_TRIES, ?EBOOT_LONG_RETRY_SLEEP).
615
616find_master(AL, Retry, ReqDelay, SReSleep, Tries, LReSleep) ->
617    {ok,U} = ll_udp_open(0),
618    find_master(U, Retry, AL, ReqDelay, SReSleep, [], Tries, LReSleep).
619
620%%
621%% Master connect loop
622%%
623find_master(U, Retry, AddrL, ReqDelay, SReSleep, Ignore, Tries, LReSleep) ->
624    case find_loop(U, Retry, AddrL, ReqDelay, SReSleep, Ignore,
625                   Tries, LReSleep) of
626        [] ->
627            find_master(U, Retry, AddrL, ReqDelay, SReSleep, Ignore,
628                        Tries, LReSleep);
629        Servers ->
630            ?dbg(servers, Servers),
631            case connect_master(Servers) of
632                {ok, Socket} ->
633                    ll_close(U),
634                    {ok, Socket};
635                _Error ->
636                    find_master(U, Retry, AddrL, ReqDelay, SReSleep,
637                                Servers ++ Ignore, Tries, LReSleep)
638            end
639    end.
640
641connect_master([{_Prio,IP,Port} | Servers]) ->
642    case ll_tcp_connect(0, IP, Port) of
643        {ok, S} -> {ok, S};
644        _Error -> connect_master(Servers)
645    end;
646connect_master([]) ->
647    {error, ebusy}.
648
649%%
650%% Always return a list of boot servers or hang.
651%%
652find_loop(U, Retry, AL, ReqDelay, SReSleep, Ignore, Tries, LReSleep) ->
653    case find_loop(U, Retry, AL, ReqDelay, []) of
654        [] ->                                   % no response from any server
655            erlang:display({erl_prim_loader,'no server found'}), % lifesign
656            Tries1 =
657		if Tries > 0 ->
658			sleep(SReSleep),
659			Tries - 1;
660		   true ->
661			sleep(LReSleep),
662			0
663		end,
664            find_loop(U, Retry, AL, ReqDelay, SReSleep, Ignore, Tries1, LReSleep);
665        Servers ->
666            keysort(1, Servers -- Ignore)
667    end.
668
669%% broadcast or send
670find_loop(_U, 0, _AL, _Delay, Acc) ->
671    Acc;
672find_loop(U, Retry, AL, Delay, Acc) ->
673    send_all(U, AL, [?EBOOT_REQUEST, erlang:system_info(version)]),
674    find_collect(U, Retry-1, AL, Delay, Acc).
675
676find_collect(U,Retry,AL,Delay,Acc) ->
677    receive
678        {udp, U, IP, _Port, [$E,$B,$O,$O,$T,$R,Priority,T1,T0 | _Version]} ->
679            Elem = {Priority,IP,T1*256+T0},
680            ?dbg(got, Elem),
681            case member(Elem, Acc) of
682                false  -> find_collect(U, Retry, AL, Delay, [Elem | Acc]);
683                true -> find_collect(U, Retry, AL, Delay, Acc)
684            end;
685        _Garbage ->
686            ?dbg(collect_garbage, _Garbage),
687            find_collect(U, Retry, AL, Delay, Acc)
688    after Delay ->
689            ?dbg(collected, Acc),
690            case keymember(0, 1, Acc) of  %% got high priority server?
691                true -> Acc;
692                false -> find_loop(U, Retry, AL, Delay, Acc)
693            end
694    end.
695
696
697sleep(Time) ->
698    receive after Time -> ok end.
699
700inet_exit_port(State, Port, _Reason) when State#state.data =:= Port ->
701    State#state{data = noport, timeout = infinity};
702inet_exit_port(State, _, _) ->
703    State.
704
705
706inet_timeout_handler(State, _Parent) ->
707    Tcp = State#state.data,
708    if is_port(Tcp) -> ll_close(Tcp);
709       true -> ok
710    end,
711    State#state{timeout = infinity, data = noport}.
712
713%% -> {{ok,BinFile,Tag},State} | {{error,Reason},State}
714inet_get_file_from_port(State, File, Paths) ->
715    case is_basename(File) of
716        false ->                        % get absolute file name.
717            inet_send_and_rcv({get,File}, File, State);
718        true when Paths =:= [] ->       % get plain file name.
719            inet_send_and_rcv({get,File}, File, State);
720        true ->                         % use paths.
721            inet_get_file_from_port1(File, Paths, State)
722    end.
723
724inet_get_file_from_port1(File, [P | Paths], State) ->
725    File1 = join(P, File),
726    case inet_send_and_rcv({get,File1}, File1, State) of
727        {{error,Reason},State1} ->
728            case Paths of
729                [] ->                           % return last error
730                    {{error,Reason},State1};
731                _ ->                            % try more paths
732                    inet_get_file_from_port1(File, Paths, State1)
733            end;
734        Result -> Result
735    end;
736inet_get_file_from_port1(_File, [], State) ->
737    {{error,file_not_found},State}.
738
739inet_send_and_rcv(Msg, Tag, State) when State#state.data =:= noport ->
740    {ok,Tcp} = find_master(State#state.hosts),     %% reconnect
741    inet_send_and_rcv(Msg, Tag, State#state{data = Tcp,
742					    timeout = ?INET_IDLE_TIMEOUT});
743inet_send_and_rcv(Msg, Tag, #state{data = Tcp, timeout = Timeout} = State) ->
744    prim_inet:send(Tcp, term_to_binary(Msg)),
745    receive
746        {tcp,Tcp,BinMsg} ->
747            case catch binary_to_term(BinMsg) of
748                {get,{ok,BinFile}} ->
749                    {{ok,BinFile,Tag},State};
750                {_Cmd,Res={ok,_}} ->
751                    {Res,State};
752                {_Cmd,{error,Error}} ->
753                    {{error,Error},State};
754                {error,Error} ->
755                    {{error,Error},State};
756                {'EXIT',Error} ->
757                    {{error,Error},State}
758            end;
759        {tcp_closed,Tcp} ->
760            %% Ok we must reconnect
761            inet_send_and_rcv(Msg, Tag, State#state{data = noport});
762        {tcp_error,Tcp,_Reason} ->
763            %% Ok we must reconnect
764            inet_send_and_rcv(Msg, Tag, inet_stop_port(State));
765        {'EXIT', Tcp, _} ->
766            %% Ok we must reconnect
767            inet_send_and_rcv(Msg, Tag, State#state{data = noport})
768    after Timeout ->
769            %% Ok we must reconnect
770            inet_send_and_rcv(Msg, Tag, inet_stop_port(State))
771    end.
772
773%% -> {{ok,List},State} | {{error,Reason},State}
774inet_list_dir(State, Dir) ->
775    inet_send_and_rcv({list_dir,Dir}, list_dir, State).
776
777%% -> {{ok,Info},State} | {{error,Reason},State}
778inet_read_file_info(State, File) ->
779    inet_send_and_rcv({read_file_info,File}, read_file_info, State).
780
781%% -> {{ok,Info},State} | {{error,Reason},State}
782inet_read_link_info(State, File) ->
783    inet_send_and_rcv({read_link_info,File}, read_link_info, State).
784
785%% -> {{ok,Cwd},State} | {{error,Reason},State}
786inet_get_cwd(State, []) ->
787    inet_send_and_rcv(get_cwd, get_cwd, State);
788inet_get_cwd(State, [Drive]) ->
789    inet_send_and_rcv({get_cwd,Drive}, get_cwd, State).
790
791inet_stop_port(#state{data=Tcp}=State) ->
792    prim_inet:close(Tcp),
793    State#state{data=noport}.
794
795%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
796%%
797%% Direct inet_drv access
798%%
799%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
800
801tcp_options() ->
802    [{mode,binary}, {packet,4}, {active, true}, {deliver,term}].
803
804tcp_timeout() ->
805    15000.
806
807%% options for udp  [list, {broadcast, true}, {active,true}]
808udp_options() ->
809    [{mode,list}, {active, true}, {deliver,term}, {broadcast,true}].
810%%
811%% INET version IPv4 addresses
812%%
813ll_tcp_connect(LocalPort, IP, RemotePort) ->
814    case ll_open_set_bind(tcp, ?INET_FAMILY, stream, tcp_options(),
815                          ?INET_ADDRESS, LocalPort) of
816        {ok,S} ->
817            case prim_inet:connect(S, IP, RemotePort, tcp_timeout()) of
818                ok -> {ok, S};
819                Error -> port_error(S, Error)
820            end;
821        Error -> Error
822    end.
823
824%%
825%% Open and initialize an udp port for broadcast
826%%
827ll_udp_open(P) ->
828    ll_open_set_bind(udp, ?INET_FAMILY, dgram, udp_options(), ?INET_ADDRESS, P).
829
830
831ll_open_set_bind(Protocol, Family, Type, SOpts, IP, Port) ->
832    case prim_inet:open(Protocol, Family, Type) of
833        {ok, S} ->
834            case prim_inet:setopts(S, SOpts) of
835                ok ->
836                    case prim_inet:bind(S, IP, Port) of
837                        {ok,_} ->
838                            {ok, S};
839                        Error -> port_error(S, Error)
840                    end;
841                Error -> port_error(S, Error)
842            end;
843        Error -> Error
844    end.
845
846
847ll_close(S) ->
848    unlink(S),
849    exit(S, kill).
850
851port_error(S, Error) ->
852    unlink(S),
853    prim_inet:close(S),
854    Error.
855
856%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
857
858-spec prim_init() -> prim_state().
859prim_init() ->
860    Deb =
861        case init:get_argument(loader_debug) of
862            {ok, _} -> true;
863            error -> false
864        end,
865    cache_new(#prim_state{debug = Deb}).
866
867prim_purge_cache() ->
868    do_prim_purge_cache(get()).
869
870do_prim_purge_cache([{Key,Val}|T]) ->
871    case Val of
872	{Cache,_FI} ->
873	    catch clear_cache(Key, Cache);
874	_ ->
875	    ok
876    end,
877    do_prim_purge_cache(T);
878do_prim_purge_cache([]) ->
879    ok.
880
881prim_set_primary_archive(PS, undefined, undefined, undefined, _ParserFun) ->
882    debug(PS, {set_primary_archive, clean}),
883    case PS#prim_state.primary_archive of
884        undefined ->
885            Res = {error, enoent},
886            debug(PS, {return, Res}),
887            {Res, PS};
888        ArchiveFile ->
889            {primary, PrimZip, _FI, _ParserFun2} = erase(ArchiveFile),
890            ok = prim_zip:close(PrimZip),
891            PS2 = PS#prim_state{primary_archive = undefined},
892            Res = {ok, []},
893            debug(PS2, {return, Res}),
894            {Res, PS2}
895    end;
896
897prim_set_primary_archive(PS, ArchiveFile0, ArchiveBin,
898			 #file_info{} = FileInfo, ParserFun)
899  when is_list(ArchiveFile0), is_binary(ArchiveBin) ->
900    %% Try the archive file
901    debug(PS, {set_primary_archive, ArchiveFile0, byte_size(ArchiveBin)}),
902    ArchiveFile = real_path(absname(ArchiveFile0)),
903    {Res3, PS3} =
904        case PS#prim_state.primary_archive of
905            undefined ->
906                case load_prim_archive(ArchiveFile, ArchiveBin, FileInfo) of
907                    {ok, PrimZip, FI, Ebins} ->
908                        debug(PS, {set_primary_archive, Ebins}),
909                        put(ArchiveFile, {primary, PrimZip, FI, ParserFun}),
910                        {{ok, Ebins},
911                         PS#prim_state{primary_archive = ArchiveFile}};
912                    Error ->
913                        debug(PS, {set_primary_archive, Error}),
914                        {Error, PS}
915                end;
916            OldArchiveFile ->
917                debug(PS, {set_primary_archive, clean}),
918                {primary, PrimZip, _FI, _ParserFun} = erase(OldArchiveFile),
919                ok = prim_zip:close(PrimZip),
920                PS2 = PS#prim_state{primary_archive = undefined},
921                prim_set_primary_archive(PS2, ArchiveFile, ArchiveBin,
922					 FileInfo, ParserFun)
923        end,
924    debug(PS3, {return, Res3}),
925    {Res3, PS3}.
926
927-spec prim_get_file(prim_state(), file:filename()) -> {_, prim_state()}.
928prim_get_file(PS, File) ->
929    debug(PS, {get_file, File}),
930    {Res2, PS2} =
931        case name_split(PS#prim_state.primary_archive, File) of
932            {file, PrimFile} ->
933                Res = prim_file:read_file(PrimFile),
934                {Res, PS};
935            {archive, ArchiveFile, FileInArchive} ->
936                debug(PS, {archive_get_file, ArchiveFile, FileInArchive}),
937                FileComponents = path_split(FileInArchive),
938                Fun =
939                    fun({Components, _GetInfo, GetBin}, Acc) ->
940                            if
941                                Components =:= FileComponents ->
942                                    {false, {ok, GetBin()}};
943                                true ->
944                                    {true, Acc}
945                            end
946                    end,
947                apply_archive(PS, Fun, {error, enoent}, ArchiveFile)
948        end,
949    debug(PS, {return, Res2}),
950    {Res2, PS2}.
951
952-spec prim_list_dir(prim_state(), file:filename()) ->
953	 {{'ok', [file:filename()]}, prim_state()}
954       | {{'error', term()}, prim_state()}.
955prim_list_dir(PS, Dir) ->
956    debug(PS, {list_dir, Dir}),
957    {Res2, PS3} =
958        case name_split(PS#prim_state.primary_archive, Dir) of
959            {file, PrimDir} ->
960                Res = prim_file:list_dir(PrimDir),
961                {Res, PS};
962            {archive, ArchiveFile, FileInArchive} ->
963                debug(PS, {archive_list_dir, ArchiveFile, FileInArchive}),
964                DirComponents = path_split(FileInArchive),
965                Fun =
966                    fun({Components, _GetInfo, _GetBin}, {Status, Names} = Acc) ->
967                            case Components of
968                                [RevName | DC] when DC =:= DirComponents ->
969                                    case RevName of
970                                        "" ->
971                                            %% The listed directory
972                                            {true, {ok, Names}};
973                                        _ ->
974                                            %% Plain file
975                                            Name = reverse(RevName),
976                                            {true, {Status, [Name | Names]}}
977                                    end;
978                                ["", RevName | DC] when DC =:= DirComponents ->
979                                    %% Directory
980                                    Name = reverse(RevName),
981                                    {true, {Status, [Name | Names]}};
982                                [RevName] when DirComponents =:= [""] ->
983                                    %% File in top directory
984                                    Name = reverse(RevName),
985                                    {true, {ok, [Name | Names]}};
986                                ["", RevName] when DirComponents =:= [""] ->
987                                    %% Directory in top directory
988                                    Name = reverse(RevName),
989                                    {true, {ok, [Name | Names]}};
990                                _ ->
991                                    %% No match
992                                    {true, Acc}
993                            end
994                    end,
995                {{Status, Names}, PS2} =
996                    apply_archive(PS, Fun, {error, []}, ArchiveFile),
997                case Status of
998                    ok    -> {{ok, Names}, PS2};
999                    error -> {{error, enotdir}, PS2}
1000                end
1001        end,
1002    debug(PS, {return, Res2}),
1003    {Res2, PS3}.
1004
1005-spec prim_read_file_info(prim_state(), file:filename(), boolean()) ->
1006	{{'ok', #file_info{}}, prim_state()}
1007      | {{'error', term()}, prim_state()}.
1008prim_read_file_info(PS, File, FollowLinks) ->
1009    debug(PS, {read_file_info, File}),
1010    {Res2, PS2} =
1011        case name_split(PS#prim_state.primary_archive, File) of
1012            {file, PrimFile} ->
1013                case FollowLinks of
1014                    true -> {prim_file:read_file_info(PrimFile), PS};
1015                    false -> {prim_file:read_link_info(PrimFile), PS}
1016                end;
1017            {archive, ArchiveFile, []} ->
1018                %% Fake top directory
1019                debug(PS, {archive_read_file_info, ArchiveFile}),
1020                case prim_file:read_file_info(ArchiveFile) of
1021                    {ok, FI} ->
1022                        {{ok, FI#file_info{type = directory}}, PS};
1023                    Other ->
1024                        {Other, PS}
1025                end;
1026            {archive, ArchiveFile, FileInArchive} ->
1027                debug(PS, {archive_read_file_info, File}),
1028                FileComponents = path_split(FileInArchive),
1029                Fun =
1030                    fun({Components, GetInfo, _GetBin}, Acc)  ->
1031			    case Components of
1032				["" | F] when F =:= FileComponents ->
1033                                    %% Directory
1034                                    {false, {ok, GetInfo()}};
1035                                F when F =:= FileComponents ->
1036                                    %% Plain file
1037                                    {false, {ok, GetInfo()}};
1038                                _ ->
1039                                    %% No match
1040                                    {true, Acc}
1041                            end
1042                    end,
1043                apply_archive(PS, Fun, {error, enoent}, ArchiveFile)
1044        end,
1045    debug(PS2, {return, Res2}),
1046    {Res2, PS2}.
1047
1048-spec prim_get_cwd(prim_state(), [file:filename()]) ->
1049        {{'error', term()} | {'ok', _}, prim_state()}.
1050prim_get_cwd(PS, []) ->
1051    debug(PS, {get_cwd, []}),
1052    Res = prim_file:get_cwd(),
1053    debug(PS, {return, Res}),
1054    {Res, PS};
1055prim_get_cwd(PS, [Drive]) ->
1056    debug(PS, {get_cwd, Drive}),
1057    Res = prim_file:get_cwd(Drive),
1058    debug(PS, {return, Res}),
1059    {Res, PS}.
1060
1061%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1062
1063apply_archive(PS, Fun, Acc, Archive) ->
1064    case get(Archive) of
1065        undefined ->
1066	    case open_archive(Archive, Acc, Fun) of
1067		{ok, PrimZip, {Acc2, FI, _}} ->
1068		    debug(PS, {cache, ok}),
1069		    put(Archive, {{ok, PrimZip}, FI}),
1070		    {Acc2, PS};
1071		Error ->
1072		    debug(PS, {cache, Error}),
1073		    %% put(Archive, {Error, FI}),
1074		    {Error, PS}
1075	    end;
1076        {primary, PrimZip, FI, ParserFun} ->
1077	    case prim_file:read_file_info(Archive) of
1078                {ok, FI2}
1079		  when FI#file_info.mtime =:= FI2#file_info.mtime ->
1080		    case foldl_archive(PrimZip, Acc, Fun) of
1081			{ok, _PrimZip2, Acc2} ->
1082			    {Acc2, PS};
1083			Error ->
1084			    debug(PS, {primary, Error}),
1085			    {Error, PS}
1086		    end;
1087		{ok, FI2} ->
1088		    ok = clear_cache(Archive, {ok, PrimZip}),
1089		    case load_prim_archive(Archive, FI2, ParserFun) of
1090			{ok, PrimZip2, FI3, _Ebins} ->
1091			    debug(PS, {cache, {update, Archive}}),
1092			    put(Archive, {primary, PrimZip2, FI3, ParserFun});
1093			Error2 ->
1094			    debug(PS, {cache, {clear, Error2}})
1095		    end,
1096		    apply_archive(PS, Fun, Acc, Archive);
1097		Error ->
1098		    debug(PS, {cache, {clear, Error}}),
1099		    ok = clear_cache(Archive, {ok, PrimZip}),
1100		    apply_archive(PS, Fun, Acc, Archive)
1101	    end;
1102        {Cache, FI} ->
1103            case prim_file:read_file_info(Archive) of
1104                {ok, FI2}
1105		  when FI#file_info.mtime =:= FI2#file_info.mtime ->
1106                    case Cache of
1107                        {ok, PrimZip} ->
1108                            case foldl_archive(PrimZip, Acc, Fun) of
1109                                {ok, _PrimZip2, Acc2} ->
1110                                    {Acc2, PS};
1111                                Error ->
1112                                    debug(PS, {cache, {clear, Error}}),
1113                                    ok = clear_cache(Archive, Cache),
1114                                    debug(PS, {cache, Error}),
1115				    erase(Archive),
1116                                    %% put(Archive, {Error, FI}),
1117                                    {Error, PS}
1118                            end;
1119                        Error ->
1120                            debug(PS, {cache, Error}),
1121                            {Error, PS}
1122                    end;
1123                Error ->
1124                    debug(PS, {cache, {clear, Error}}),
1125                    ok = clear_cache(Archive, Cache),
1126                    apply_archive(PS, Fun, Acc, Archive)
1127            end
1128    end.
1129
1130open_archive(Archive, Acc, Fun) ->
1131    case prim_file:read_file_info(Archive) of
1132	{ok, FileInfo} ->
1133	    open_archive(Archive, FileInfo, Acc, Fun);
1134	{error, Reason} ->
1135	    {error, Reason}
1136    end.
1137
1138%% Open the given archive and iterate through all files with an own
1139%% wrapper fun in order to identify each file as a component list as
1140%% returned from path_split/1.
1141%%
1142%% In the archive (zip) file, directory elements might or might not be
1143%% present. To ensure consistency, a directory element is added if it
1144%% does not already exist (ensure_virtual_dirs/6). NOTE that there will
1145%% be no such directory element for the top directory of the archive.
1146open_archive(Archive, FileInfo, Acc, Fun) ->
1147    FakeFI = FileInfo#file_info{type = directory},
1148    Wrapper =
1149	fun({N, GI, GB}, {A, I, Dirs}) ->
1150		Components = path_split(N),
1151		Dirs2 =
1152		    case Components of
1153			["" | Dir] ->
1154			    %% This is a directory
1155			    [Dir | Dirs];
1156			_ ->
1157			    %% This is a regular file
1158			    Dirs
1159		    end,
1160		{Includes, Dirs3, A2} =
1161		    ensure_virtual_dirs(Components, Fun, FakeFI,
1162					[{true, Components}], Dirs2, A),
1163		{_Continue, A3} = Fun({Components, GI, GB}, A2),
1164		{true, Includes, {A3, I, Dirs3}}
1165	end,
1166    prim_zip:open(Wrapper, {Acc, FakeFI, []}, Archive).
1167
1168ensure_virtual_dirs(Components, Fun, FakeFI, Includes, Dirs, Acc) ->
1169    case Components of
1170	[_] ->
1171	    %% Don't add virtual dir for top directory
1172	    {Includes, Dirs, Acc};
1173	[_ | Dir] ->
1174	    case lists:member(Dir, Dirs) of % BIF
1175		false ->
1176		    %% The directory does not yet exist - add it
1177		    GetInfo = fun() -> FakeFI end,
1178		    GetBin = fun() -> <<>> end,
1179		    VirtualDir = ["" | Dir],
1180		    Includes2 = [{true, VirtualDir, GetInfo, GetBin} | Includes],
1181		    Dirs2 = [Dir | Dirs],
1182
1183		    %% Recursively ensure dir elements on all levels
1184		    {I, F, Acc2} = ensure_virtual_dirs(Dir, Fun, FakeFI,
1185						       Includes2, Dirs2, Acc),
1186
1187		    {_Continue, Acc3} = Fun({VirtualDir, GetInfo, GetBin}, Acc2),
1188		    {I, F, Acc3};
1189		true ->
1190		    %% The directory element does already exist
1191		    %% Recursivly ensure dir elements on all levels
1192		    ensure_virtual_dirs(Dir,Fun,FakeFI,Includes,Dirs,Acc)
1193	    end
1194    end.
1195
1196foldl_archive(PrimZip, Acc, Fun) ->
1197    Wrapper =
1198        fun({Components, GI, GB}, A) ->
1199                %% Allow partial iteration at foldl
1200                {Continue, A2} = Fun({Components, GI, GB}, A),
1201                {Continue, true, A2}
1202        end,
1203    prim_zip:foldl(Wrapper, Acc, PrimZip).
1204
1205cache_new(PS) ->
1206    PS.
1207
1208clear_cache(Archive, Cache) ->
1209    erase(Archive),
1210    case Cache of
1211        {ok, PrimZip} ->
1212            prim_zip:close(PrimZip);
1213        {error, _} ->
1214            ok
1215    end.
1216
1217%%% --------------------------------------------------------
1218%%% Misc. functions.
1219%%% --------------------------------------------------------
1220
1221%%% Look for directory separators
1222is_basename(File) ->
1223    case deep_member($/, File) of
1224        true ->
1225            false;
1226        false ->
1227            case erlang:system_info(os_type) of
1228                {win32, _} ->
1229                    case File of
1230                        [_,$: | _] ->
1231			    false;
1232                        _ ->
1233			    not deep_member($\\, File)
1234                    end;
1235                _ ->
1236                    true
1237            end
1238    end.
1239
1240send_all(U, [IP | AL], Cmd) ->
1241    ?dbg(sendto, {U, IP, ?EBOOT_PORT, Cmd}),
1242    prim_inet:sendto(U, IP, ?EBOOT_PORT, Cmd),
1243    send_all(U, AL, Cmd);
1244send_all(_U, [], _) -> ok.
1245
1246join(P, F) ->
1247    P ++ "/" ++ F.
1248
1249member(X, [X|_]) -> true;
1250member(X, [_|Y]) -> member(X, Y);
1251member(_X, [])   -> false.
1252
1253deep_member(X, [X|_]) ->
1254    true;
1255deep_member(X, [List | Y]) when is_list(List) ->
1256    deep_member(X, List) orelse deep_member(X, Y);
1257deep_member(X, [Atom | Y]) when is_atom(Atom) ->
1258    deep_member(X, atom_to_list(Atom)) orelse deep_member(X, Y);
1259deep_member(X, [_ | Y]) ->
1260    deep_member(X, Y);
1261deep_member(_X, [])   ->
1262    false.
1263
1264keymember(X, I, [Y | _]) when element(I,Y) =:= X -> true;
1265keymember(X, I, [_ | T]) -> keymember(X, I, T);
1266keymember(_X, _I, []) -> false.
1267
1268keysort(I, L) -> keysort(I, L, []).
1269
1270keysort(I, [X | L], Ls) ->
1271    keysort(I, L, keyins(X, I, Ls));
1272keysort(_I, [], Ls) -> Ls.
1273
1274keyins(X, I, [Y | T]) when X < element(I,Y) -> [X,Y|T];
1275keyins(X, I, [Y | T]) -> [Y | keyins(X, I, T)];
1276keyins(X, _I, []) -> [X].
1277
1278to_strs([P|Paths]) when is_atom(P) ->
1279    [atom_to_list(P)|to_strs(Paths)];
1280to_strs([P|Paths]) when is_list(P) ->
1281    [P|to_strs(Paths)];
1282to_strs([_|Paths]) ->
1283    to_strs(Paths);
1284to_strs([]) ->
1285    [].
1286
1287reverse([] = L) ->
1288    L;
1289reverse([_] = L) ->
1290    L;
1291reverse([A, B]) ->
1292    [B, A];
1293reverse([A, B | L]) ->
1294    lists:reverse(L, [B, A]). % BIF
1295
1296%% Returns a reversed list of path components, each component itself a
1297%% reversed list (string), e.g.
1298%% /path/to/file -> ["elif","ot","htap",""]
1299%% /path/to/dir/ -> ["","rid","ot","htap",""]
1300%% Note the "" marking leading and trailing / (slash).
1301path_split(List) ->
1302   path_split(List, [], []).
1303
1304path_split([$/ | Tail], Path, Paths) ->
1305    path_split(Tail, [], [Path | Paths]);
1306path_split([Head | Tail], Path, Paths) ->
1307    path_split(Tail, [Head | Path], Paths);
1308path_split([], Path, Paths) ->
1309    [Path | Paths].
1310
1311%% The opposite of path_split/1
1312path_join(Paths) ->
1313    path_join(Paths,[]).
1314
1315path_join([""],Acc) ->
1316    Acc;
1317path_join([Path],Acc) ->
1318    reverse(Path) ++ Acc;
1319path_join([Path|Paths],Acc) ->
1320    path_join(Paths,"/" ++ reverse(Path) ++ Acc).
1321
1322name_split(undefined, File) ->
1323    %% Ignore primary archive
1324    RevExt = reverse(init:archive_extension()),
1325    case archive_split(File, RevExt, []) of
1326        no_split ->
1327            {file, File};
1328	Archive ->
1329	    Archive
1330    end;
1331name_split(ArchiveFile, File0) ->
1332    %% Look first in primary archive
1333    File = absname(File0),
1334    case string_match(real_path(File), ArchiveFile) of
1335        no_match ->
1336            %% Archive or plain file
1337            name_split(undefined, File);
1338        {match, FileInArchive} ->
1339            %% Primary archive
1340	    {archive, ArchiveFile, FileInArchive}
1341    end.
1342
1343string_match([Char | File], [Char | Archive]) ->
1344    string_match(File, Archive);
1345string_match([] = File, []) ->
1346    {match, File};
1347string_match([$/ | File], []) ->
1348    {match, File};
1349string_match(_File, _Archive) ->
1350    no_match.
1351
1352archive_split("/"++File, RevExt, Acc) ->
1353    case is_prefix(RevExt, Acc) of
1354	false ->
1355	    archive_split(File, RevExt, [$/|Acc]);
1356	true ->
1357	    ArchiveFile = absname(reverse(Acc)),
1358	    {archive, ArchiveFile, File}
1359    end;
1360archive_split([H|T], RevExt, Acc) ->
1361    archive_split(T, RevExt, [H|Acc]);
1362archive_split([], RevExt, Acc) ->
1363    case is_prefix(RevExt, Acc) of
1364	false ->
1365	    no_split;
1366	true ->
1367	    ArchiveFile = absname(reverse(Acc)),
1368	    {archive, ArchiveFile, []}
1369    end.
1370
1371is_prefix([H|T1], [H|T2]) -> is_prefix(T1, T2);
1372is_prefix([_|_], _) -> false;
1373is_prefix([], _ ) -> true.
1374
1375%% Parse list of ipv4 addresses
1376ipv4_list([H | T]) ->
1377    case ipv4_address(H) of
1378        {ok,IP} -> [IP | ipv4_list(T)];
1379        _ -> ipv4_list(T)
1380    end;
1381ipv4_list([]) -> [].
1382
1383%%
1384%% Parse Ipv4 address: d1.d2.d3.d4 (from inet_parse)
1385%%
1386%% Return {ok, IP} | {error, einval}
1387%%
1388ipv4_address(Cs) ->
1389    case catch ipv4_addr(Cs, []) of
1390        {'EXIT',_} -> {error,einval};
1391        Addr -> {ok,Addr}
1392    end.
1393
1394ipv4_addr([C | Cs], IP) when C >= $0, C =< $9 -> ipv4_addr(Cs, C-$0, IP).
1395
1396ipv4_addr([$.|Cs], N, IP) when N < 256 -> ipv4_addr(Cs, [N|IP]);
1397ipv4_addr([C|Cs], N, IP) when C >= $0, C =< $9 ->
1398    ipv4_addr(Cs, N*10 + (C-$0), IP);
1399ipv4_addr([], D, [C,B,A]) when D < 256 -> {A,B,C,D}.
1400
1401%% A simplified version of filename:absname/1
1402absname(Name) ->
1403    Name2 = normalize(Name, []),
1404    case pathtype(Name2) of
1405	absolute ->
1406	    Name2;
1407	relative ->
1408	    case prim_file:get_cwd() of
1409		{ok, Cwd} ->
1410		    Cwd ++ "/" ++ Name2;
1411		{error, _} ->
1412		    Name2
1413	    end;
1414	volumerelative ->
1415	    case prim_file:get_cwd() of
1416		{ok, Cwd} ->
1417		    absname_vr(Name2, Cwd);
1418		{error, _} ->
1419		    Name2
1420	    end
1421    end.
1422
1423%% Assumes normalized name
1424absname_vr([$/ | NameRest], [Drive, $\: | _]) ->
1425    %% Absolute path on current drive.
1426    [Drive, $\: | NameRest];
1427absname_vr([Drive, $\: | NameRest], [Drive, $\: | _] = Cwd) ->
1428    %% Relative to current directory on current drive.
1429    Cwd ++ "/" ++ NameRest;
1430absname_vr([Drive, $\: | NameRest], _) ->
1431    %% Relative to current directory on another drive.
1432    case prim_file:get_cwd([Drive, $\:]) of
1433	{ok, DriveCwd}  ->
1434	    DriveCwd ++ "/" ++ NameRest;
1435	{error, _} ->
1436	    [Drive, $\:, $/] ++ NameRest
1437    end.
1438
1439%% Assumes normalized name
1440pathtype(Name) when is_list(Name) ->
1441    case erlang:system_info(os_type) of
1442	{unix, _}  ->
1443	    unix_pathtype(Name);
1444	{win32, _} ->
1445	    win32_pathtype(Name)
1446    end.
1447
1448unix_pathtype(Name) ->
1449    case Name of
1450	[$/|_] ->
1451	    absolute;
1452	[List|Rest] when is_list(List) ->
1453	    unix_pathtype(List++Rest);
1454	[Atom|Rest] when is_atom(Atom) ->
1455	    atom_to_list(Atom)++Rest;
1456	_ ->
1457	    relative
1458    end.
1459
1460win32_pathtype(Name) ->
1461    case Name of
1462	[List|Rest] when is_list(List) ->
1463	    win32_pathtype(List++Rest);
1464	[Atom|Rest] when is_atom(Atom) ->
1465	    win32_pathtype(atom_to_list(Atom)++Rest);
1466	[Char, List | Rest] when is_list(List) ->
1467	    win32_pathtype([Char | List++Rest]);
1468	[$/, $/|_] ->
1469	    absolute;
1470	[$/|_] ->
1471	    volumerelative;
1472	[C1, C2, List | Rest] when is_list(List) ->
1473	    win32_pathtype([C1, C2|List ++ Rest]);
1474	[_Letter, $:, $/|_] ->
1475	    absolute;
1476	[_Letter, $:|_] ->
1477	    volumerelative;
1478	_ ->
1479	    relative
1480    end.
1481
1482normalize(Name, Acc) ->
1483    case Name of
1484	[List | Rest] when is_list(List) ->
1485	    normalize(List ++ Rest, Acc);
1486	[Atom | Rest] when is_atom(Atom) ->
1487	    normalize(atom_to_list(Atom) ++ Rest, Acc);
1488	[$\\ | Chars] ->
1489	    case erlang:system_info(os_type) of
1490                {win32, _} ->
1491		    normalize(Chars, [$/ | Acc]);
1492		_ ->
1493		    normalize(Chars, [$\\ | Acc])
1494	    end;
1495	[Char | Chars] ->
1496	    normalize(Chars, [Char | Acc]);
1497	[] ->
1498	    reverse(Acc)
1499    end.
1500
1501%% Remove .. and . from the path, e.g.
1502%% /path/./to/this/../file -> /path/to/file
1503%% This includes resolving symlinks.
1504%%
1505%% This is done to ensure that paths are totally normalized before
1506%% comparing to find out if a file is inside the primary archive or
1507%% not.
1508real_path(Name) ->
1509    real_path(Name,reverse(path_split(Name)),[],[]).
1510
1511real_path(_Name,[],Acc,_Links) ->
1512    path_join(Acc);
1513real_path(Name,["."|Paths],Acc,Links) ->
1514    real_path(Name,Paths,Acc,Links);
1515real_path(Name,[".."|Paths],[""]=Acc,Links) ->
1516    %% /.. -> / (can't get higher than root)
1517    real_path(Name,Paths,Acc,Links);
1518real_path(Name,[".."|Paths],[Prev|Acc],Links) when Prev=/=".." ->
1519    real_path(Name,Paths,Acc,Links);
1520real_path(Name,[Path|Paths],Acc,Links) ->
1521    This = [Path|Acc],
1522    ThisFile = path_join(This),
1523    case lists:member(ThisFile,Links) of
1524	true -> % circular!!
1525	    Name;
1526	false ->
1527	    case prim_file:read_link(ThisFile) of
1528		{ok,Link} ->
1529		    case reverse(path_split(Link)) of
1530			[""|_] = LinkPaths ->
1531			    real_path(Name,LinkPaths++Paths,[],[ThisFile|Links]);
1532			LinkPaths ->
1533                % windows currently does not allow creation of relative symlinks
1534                % across different drives
1535				case erlang:system_info(os_type) of
1536                 {win32, _} ->
1537                     real_path(Name,LinkPaths++Paths,[],[ThisFile|Links]);
1538                 _ ->
1539                     real_path(Name,LinkPaths++Paths,Acc,[ThisFile|Links])
1540                end
1541		    end;
1542		_ ->
1543		    real_path(Name,Paths,This,Links)
1544	    end
1545    end.
1546
1547load_prim_archive(ArchiveFile, ArchiveBin, #file_info{}=FileInfo) ->
1548    Fun = fun({Components, _GI, _GB}, A) ->
1549		  case Components of
1550		      ["", "nibe", RevApp] -> % Reverse ebin
1551			  %% Collect ebin directories in archive
1552			  Ebin = lists:reverse(RevApp, "/ebin"),
1553			  {true, [Ebin | A]};
1554		      _ ->
1555			  {true, A}
1556		  end
1557	  end,
1558    Ebins0 = [ArchiveFile],
1559    case open_archive({ArchiveFile, ArchiveBin}, FileInfo,
1560		      Ebins0, Fun) of
1561	{ok, PrimZip, {RevEbins, FI, _}} ->
1562	    Ebins = reverse(RevEbins),
1563	    {ok, PrimZip, FI, Ebins};
1564	Error ->
1565	    Error
1566    end;
1567load_prim_archive(ArchiveFile, FileInfo, ParserFun) ->
1568    case ParserFun(ArchiveFile) of
1569	{ok, ArchiveBin} ->
1570	    load_prim_archive(ArchiveFile, ArchiveBin, FileInfo);
1571	Error ->
1572	    Error
1573    end.
1574