aboutsummaryrefslogtreecommitdiffstats
path: root/erts/preloaded/src
diff options
context:
space:
mode:
Diffstat (limited to 'erts/preloaded/src')
-rw-r--r--erts/preloaded/src/Makefile105
-rw-r--r--erts/preloaded/src/erl_prim_loader.erl1406
-rw-r--r--erts/preloaded/src/erlang.erl683
-rw-r--r--erts/preloaded/src/init.erl1372
-rw-r--r--erts/preloaded/src/otp_ring0.erl35
-rw-r--r--erts/preloaded/src/prim_file.erl1168
-rw-r--r--erts/preloaded/src/prim_inet.erl1962
-rw-r--r--erts/preloaded/src/prim_zip.erl604
-rw-r--r--erts/preloaded/src/zip_internal.hrl103
-rw-r--r--erts/preloaded/src/zlib.erl421
10 files changed, 7859 insertions, 0 deletions
diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile
new file mode 100644
index 0000000000..785ad531f3
--- /dev/null
+++ b/erts/preloaded/src/Makefile
@@ -0,0 +1,105 @@
+#
+# %CopyrightBegin%
+#
+# Copyright Ericsson AB 2008-2009. All Rights Reserved.
+#
+# The contents of this file are subject to the Erlang Public License,
+# Version 1.1, (the "License"); you may not use this file except in
+# compliance with the License. You should have received a copy of the
+# Erlang Public License along with this software. If not, it can be
+# retrieved online at http://www.erlang.org/.
+#
+# Software distributed under the License is distributed on an "AS IS"
+# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+# the License for the specific language governing rights and limitations
+# under the License.
+#
+# %CopyrightEnd%
+#
+# Note, this makefile is not called during normal build process, it should
+# be used when the preloaded modules actually are to be updated (i.e. the
+# beam files are to be recompiled, which is normally not done).
+# The beam files are placed in the current directory and should be copied
+# to the ../ebin directory by using the commit target (only works in
+# clearcase).
+
+include $(ERL_TOP)/make/target.mk
+include $(ERL_TOP)/make/$(TARGET)/otp.mk
+
+EBIN=.
+
+STATIC_EBIN=../ebin
+
+include $(ERL_TOP)/erts/vsn.mk
+include $(ERL_TOP)/lib/kernel/vsn.mk
+
+PRE_LOADED_MODULES = \
+ erl_prim_loader \
+ init \
+ prim_file \
+ prim_inet \
+ zlib \
+ prim_zip \
+ otp_ring0 \
+ erlang
+
+RELSYSDIR = $(RELEASE_PATH)/lib/erts-$(VSN)
+# not $(RELEASE_PATH)/erts-$(VSN)/preloaded
+
+ERL_FILES= $(PRE_LOADED_MODULES:%=%.erl)
+
+TARGET_FILES = $(PRE_LOADED_MODULES:%=$(EBIN)/%.$(EMULATOR))
+STATIC_TARGET_FILES = $(PRE_LOADED_MODULES:%=$(STATIC_EBIN)/%.$(EMULATOR))
+
+KERNEL_SRC=$(ERL_TOP)/lib/kernel/src
+KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include
+STDLIB_INCLUDE=$(ERL_TOP)/lib/stdlib/include
+
+ERL_COMPILE_FLAGS += +warn_obsolete_guard -I$(KERNEL_SRC) -I$(KERNEL_INCLUDE)
+
+debug opt: $(TARGET_FILES)
+
+clean:
+ rm -f $(TARGET_FILES)
+
+prepare:
+ cleartool co -nc $(STATIC_EBIN)/*
+ cleartool co -nc $(STATIC_EBIN)
+
+copy:
+ for x in *.beam; do\
+ if test '!' -f $(STATIC_EBIN)/$$x; then\
+ cleartool mkelem -nc $$x;\
+ fi;\
+ done
+ cp *.beam $(STATIC_EBIN)
+
+commit:
+ cleartool ci -ident -nc $(STATIC_EBIN)/*.beam
+ cleartool ci -ident -nc $(STATIC_EBIN)
+
+cancel:
+ -cleartool unco -rm $(STATIC_EBIN)
+ -cleartool unco -rm $(STATIC_EBIN)/*.beam
+
+
+include $(ERL_TOP)/make/otp_release_targets.mk
+
+release_spec:
+ $(INSTALL_DIR) $(RELSYSDIR)/src
+ $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/ebin
+ $(INSTALL_DATA) $(STATIC_TARGET_FILES) $(RELSYSDIR)/ebin
+
+release_docs_spec:
+
+
+list_preloaded:
+ @echo $(PRE_LOADED_MODULES)
+
+# Include dependencies -- list below added by PaN
+$(EBIN)/erl_prim_loader.beam: $(KERNEL_SRC)/inet_boot.hrl $(KERNEL_INCLUDE)/file.hrl
+$(EBIN)/prim_file.beam: $(KERNEL_INCLUDE)/file.hrl
+$(EBIN)/prim_inet.beam: $(KERNEL_SRC)/inet_int.hrl $(KERNEL_INCLUDE)/inet_sctp.hrl
+$(EBIN)/prim_zip.beam: zip_internal.hrl $(KERNEL_INCLUDE)/file.hrl $(STDLIB_INCLUDE)/zip.hrl
+$(EBIN)/init.erl: $(KERNEL_INCLUDE)/file.hrl
diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
new file mode 100644
index 0000000000..399c2bb55d
--- /dev/null
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -0,0 +1,1406 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% A primary loader, provides two different methods to fetch a file:
+%% efile and inet. The efile method is simple communication with a
+%% port program.
+%%
+%% The distribution loading was removed and replaced with
+%% inet loading
+%%
+%% The start_it/4 function initializes a record with callback
+%% functions used to handle the interface functions.
+%%
+
+-module(erl_prim_loader).
+
+%% If the macro DEBUG is defined during compilation,
+%% debug printouts are done through erlang:display/1.
+%% Activate this feature by starting the compiler
+%% with> erlc -DDEBUG ...
+%% or by> setenv ERL_COMPILER_FLAGS DEBUG
+%% before running make (in the OTP make system)
+%% (the example is for tcsh)
+
+-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]).
+
+%% 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]).
+
+%% Used by escript and code
+-export([set_primary_archive/2, release_archives/0]).
+
+%% Internal function. Exported to avoid dialyzer warnings
+-export([concat/1]).
+
+-include_lib("kernel/include/file.hrl").
+
+-type host() :: atom().
+
+-record(state,
+ {loader :: 'efile' | 'inet',
+ hosts = [] :: [host()], % hosts list (to boot from)
+ id, % not used any more?
+ data, % data port etc
+ timeout, % idle timeout
+ n_timeouts, % Number of timeouts before archives are released
+ multi_get = false :: boolean(),
+ 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
+
+%% Defines for inet as prim_loader
+-define(INET_FAMILY, inet).
+-define(INET_ADDRESS, {0,0,0,0}).
+
+-ifdef(DEBUG).
+-define(dbg(Tag, Data), erlang:display({Tag,Data})).
+-else.
+-define(dbg(Tag, Data), true).
+-endif.
+
+-define(SAFE2(Expr, State),
+ fun() ->
+ case catch Expr of
+ {'EXIT',XXXReason} -> {{error,XXXReason}, State};
+ XXXRes -> XXXRes
+ end
+ end()).
+
+-record(prim_state, {debug, cache, primary_archive}).
+
+debug(#prim_state{debug = Deb}, Term) ->
+ case Deb of
+ false -> ok;
+ true -> erlang:display(Term)
+ end.
+
+%%% --------------------------------------------------------
+%%% Interface Functions.
+%%% --------------------------------------------------------
+
+-spec start(term(), atom() | string(), host() | [host()]) ->
+ {'ok', pid()} | {'error', 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,
+ Self = self(),
+ Pid = spawn_link(fun() -> start_it(Pgm, Id, Self, Hosts) end),
+ register(erl_prim_loader, Pid),
+ receive
+ {Pid,ok} ->
+ {ok,Pid};
+ {'EXIT',Pid,Reason} ->
+ {error,Reason}
+ end.
+
+start_it("ose_inet"=Cmd, Id, Pid, Hosts) ->
+ %% Setup reserved port for ose_inet driver (only OSE)
+ case catch erlang:open_port({spawn,Cmd},[binary]) of
+ {'EXIT',Why} ->
+ ?dbg(ose_inet_port_open_fail, Why),
+ Why;
+ OseInetPort ->
+ ?dbg(ose_inet_port, OseInetPort),
+ OseInetPort
+ end,
+ start_it("inet", Id, Pid, Hosts);
+
+%% Hosts must be a list on form ['1.2.3.4' ...]
+start_it("inet", Id, Pid, Hosts) ->
+ process_flag(trap_exit, true),
+ ?dbg(inet, {Id,Pid,Hosts}),
+ AL = ipv4_list(Hosts),
+ ?dbg(addresses, AL),
+ {ok,Tcp} = find_master(AL),
+ init_ack(Pid),
+ PS = prim_init(),
+ State = #state {loader = inet,
+ hosts = AL,
+ id = Id,
+ data = Tcp,
+ timeout = ?IDLE_TIMEOUT,
+ n_timeouts = ?N_TIMEOUTS,
+ prim_state = PS},
+ loop(State, Pid, []);
+
+start_it("efile", Id, Pid, _Hosts) ->
+ process_flag(trap_exit, true),
+ {ok, Port} = prim_file:open([binary]),
+ init_ack(Pid),
+ 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,
+ prim_state = PS},
+ loop(State, Pid, []).
+
+init_ack(Pid) ->
+ Pid ! {self(),ok},
+ ok.
+
+-spec set_path([string()]) -> 'ok'.
+set_path(Paths) when is_list(Paths) ->
+ request({set_path,Paths}).
+
+-spec get_path() -> {'ok', [string()]}.
+get_path() ->
+ request({get_path,[]}).
+
+-spec get_file(atom() | string()) -> {'ok', binary(), string()} | 'error'.
+get_file(File) when is_atom(File) ->
+ get_file(atom_to_list(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(string()) -> {'ok', [string()]} | 'error'.
+list_dir(Dir) ->
+ check_file_result(list_dir, Dir, request({list_dir,Dir})).
+
+%% -> {ok,Info} | error
+-spec read_file_info(string()) -> {'ok', tuple()} | 'error'.
+
+read_file_info(File) ->
+ check_file_result(read_file_info, File, request({read_file_info,File})).
+
+-spec get_cwd() -> {'ok', string()} | 'error'.
+get_cwd() ->
+ check_file_result(get_cwd, [], request({get_cwd,[]})).
+
+-spec get_cwd(string()) -> {'ok', string()} | 'error'.
+get_cwd(Drive) ->
+ check_file_result(get_cwd, Drive, request({get_cwd,[Drive]})).
+
+-spec set_primary_archive(File :: string() | 'undefined',
+ ArchiveBin :: binary() | 'undefined')
+ -> {ok, [string()]} | {error,_}.
+
+set_primary_archive(undefined, undefined) ->
+ request({set_primary_archive, undefined, undefined});
+set_primary_archive(File, ArchiveBin)
+ when is_list(File), is_binary(ArchiveBin) ->
+ request({set_primary_archive, File, ArchiveBin}).
+
+-spec release_archives() -> 'ok' | {'error', _}.
+
+release_archives() ->
+ request(release_archives).
+
+request(Req) ->
+ Loader = whereis(erl_prim_loader),
+ Loader ! {self(),Req},
+ receive
+ {Loader,Res} ->
+ Res;
+ {'EXIT',Loader,_What} ->
+ error
+ end.
+
+check_file_result(_, _, {error,enoent}) ->
+ error;
+check_file_result(_, _, {error,enotdir}) ->
+ error;
+check_file_result(Func, Target, {error,Reason}) ->
+ case (catch atom_to_list(Reason)) of
+ {'EXIT',_} -> % exit trapped
+ error;
+ Errno -> % errno
+ Process = case process_info(self(), registered_name) of
+ {registered_name,R} ->
+ "Process: " ++ atom_to_list(R) ++ ".";
+ _ ->
+ ""
+ end,
+ TargetStr =
+ if is_atom(Target) -> atom_to_list(Target);
+ is_list(Target) -> Target;
+ true -> []
+ end,
+ Report =
+ case TargetStr of
+ [] ->
+ "File operation error: " ++ Errno ++ ". " ++
+ "Function: " ++ atom_to_list(Func) ++ ". " ++ Process;
+ _ ->
+ "File operation error: " ++ Errno ++ ". " ++
+ "Target: " ++ TargetStr ++ ". " ++
+ "Function: " ++ atom_to_list(Func) ++ ". " ++ Process
+ end,
+ %% this is equal to calling error_logger:error_report/1 which
+ %% we don't want to do from code_server during system boot
+ error_logger ! {notify,{error_report,group_leader(),
+ {self(),std_error,Report}}},
+ error
+ end;
+check_file_result(_, _, Other) ->
+ Other.
+
+%%% --------------------------------------------------------
+%%% The main loop.
+%%% --------------------------------------------------------
+
+loop(State, Parent, Paths) ->
+ receive
+ {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,Bin} ->
+ {Res,State1} = handle_set_primary_archive(State, File, Bin),
+ {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}
+ end,
+ if
+ is_record(State2, state) ->
+ loop(State2, Parent, Paths2);
+ true ->
+ exit({bad_state, Req, State2})
+ end;
+ {'EXIT',Parent,W} ->
+ handle_stop(State),
+ exit(W);
+ {'EXIT',P,W} ->
+ State1 = handle_exit(State, P, W),
+ loop(State1, Parent, Paths);
+ _Message ->
+ loop(State, Parent, Paths)
+ after State#state.timeout ->
+ State1 = handle_timeout(State, Parent),
+ loop(State1, Parent, Paths)
+ 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) ->
+ ?SAFE2(inet_get_file_from_port(State, File, Paths), State).
+
+handle_set_primary_archive(State= #state{loader = efile}, File, Bin) ->
+ ?SAFE2(efile_set_primary_archive(State, File, Bin), State).
+
+handle_release_archives(State= #state{loader = efile}) ->
+ ?SAFE2(efile_release_archives(State), State).
+
+handle_list_dir(State = #state{loader = efile}, Dir) ->
+ ?SAFE2(efile_list_dir(State, Dir), State);
+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);
+handle_read_file_info(State = #state{loader = inet}, File) ->
+ ?SAFE2(inet_read_file_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) ->
+ ?SAFE2(inet_get_cwd(State, Drive), State).
+
+handle_stop(State = #state{loader = efile}) ->
+ efile_stop_port(State);
+handle_stop(State = #state{loader = inet}) ->
+ inet_stop_port(State).
+
+handle_exit(State = #state{loader = efile}, Who, Reason) ->
+ efile_exit_port(State, Who, Reason);
+handle_exit(State = #state{loader = inet}, Who, Reason) ->
+ inet_exit_port(State, Who, Reason).
+
+handle_timeout(State = #state{loader = efile}, Parent) ->
+ efile_timeout_handler(State, Parent);
+handle_timeout(State = #state{loader = inet}, Parent) ->
+ inet_timeout_handler(State, Parent).
+
+%%% --------------------------------------------------------
+%%% Functions which handles 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 = 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:open([binary]) 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) ->
+ case is_basename(File) of
+ false -> % get absolute file name.
+ efile_get_file_from_port2(State, File);
+ true when Paths =:= [] -> % get plain file name.
+ efile_get_file_from_port2(State, File);
+ true -> % use paths.
+ efile_get_file_from_port3(State, File, Paths)
+ end.
+
+efile_get_file_from_port2(#state{prim_state = PS} = State, File) ->
+ {Res, PS2} = prim_get_file(PS, File),
+ case Res of
+ {error,port_died} ->
+ exit('prim_load port died');
+ {error,Reason} ->
+ {{error,Reason},State#state{prim_state = PS2}};
+ {ok,BinFile} ->
+ {{ok,BinFile,File},State#state{prim_state = PS2}}
+ end.
+
+efile_get_file_from_port3(State, File, [P | Paths]) ->
+ case efile_get_file_from_port2(State, concat([P,"/",File])) of
+ {{error,Reason},State1} when Reason =/= emfile ->
+ case Paths of
+ [] -> % return last error
+ {{error,Reason},State1};
+ _ -> % try more paths
+ efile_get_file_from_port3(State1, File, Paths)
+ end;
+ Result ->
+ Result
+ end;
+efile_get_file_from_port3(State, _File, []) ->
+ {{error,enoent},State}.
+
+efile_set_primary_archive(#state{prim_state = PS} = State, File, Bin) ->
+ {Res, PS2} = prim_set_primary_archive(PS, File, Bin),
+ {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),
+ {Res, State#state{prim_state = PS2}}.
+
+efile_get_cwd(#state{prim_state = PS} = State, Drive) ->
+ {Res, PS2} = prim_get_cwd(PS, Drive),
+ {Res, State#state{prim_state = PS2}}.
+
+efile_stop_port(#state{data=Port}=State) ->
+ prim_file:close(Port),
+ State#state{data=noport}.
+
+efile_exit_port(State, Port, Reason) when State#state.data =:= Port ->
+ exit({port_died,Reason});
+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}
+ end.
+
+%%% --------------------------------------------------------
+%%% Functions which handles inet prim_loader
+%%% --------------------------------------------------------
+
+%%
+%% Connect to a boot master
+%% return {ok, Socket} TCP
+%% AL is a list of boot servers (including broadcast addresses)
+%%
+find_master(AL) ->
+ find_master(AL, ?EBOOT_RETRY, ?EBOOT_REQUEST_DELAY, ?EBOOT_SHORT_RETRY_SLEEP,
+ ?EBOOT_UNSUCCESSFUL_TRIES, ?EBOOT_LONG_RETRY_SLEEP).
+
+find_master(AL, Retry, ReqDelay, SReSleep, Tries, LReSleep) ->
+ {ok,U} = ll_udp_open(0),
+ find_master(U, Retry, AL, ReqDelay, SReSleep, [], Tries, LReSleep).
+
+%%
+%% Master connect loop
+%%
+find_master(U, Retry, AddrL, ReqDelay, SReSleep, Ignore, Tries, LReSleep) ->
+ case find_loop(U, Retry, AddrL, ReqDelay, SReSleep, Ignore,
+ Tries, LReSleep) of
+ [] ->
+ find_master(U, Retry, AddrL, ReqDelay, SReSleep, Ignore,
+ Tries, LReSleep);
+ Servers ->
+ ?dbg(servers, Servers),
+ case connect_master(Servers) of
+ {ok, Socket} ->
+ ll_close(U),
+ {ok, Socket};
+ _Error ->
+ find_master(U, Retry, AddrL, ReqDelay, SReSleep,
+ Servers ++ Ignore, Tries, LReSleep)
+ end
+ end.
+
+connect_master([{_Prio,IP,Port} | Servers]) ->
+ case ll_tcp_connect(0, IP, Port) of
+ {ok, S} -> {ok, S};
+ _Error -> connect_master(Servers)
+ end;
+connect_master([]) ->
+ {error, ebusy}.
+
+%%
+%% Always return a list of boot servers or hang.
+%%
+find_loop(U, Retry, AL, ReqDelay, SReSleep, Ignore, Tries, LReSleep) ->
+ case find_loop(U, Retry, AL, ReqDelay, []) of
+ [] -> % no response from any server
+ erlang:display({erl_prim_loader,'no server found'}), % lifesign
+ Tries1 = if Tries > 0 ->
+ sleep(SReSleep),
+ Tries - 1;
+ true ->
+ sleep(LReSleep),
+ 0
+ end,
+ find_loop(U, Retry, AL, ReqDelay, SReSleep, Ignore, Tries1, LReSleep);
+ Servers ->
+ keysort(1, Servers -- Ignore)
+ end.
+
+%% broadcast or send
+find_loop(_U, 0, _AL, _Delay, Acc) ->
+ Acc;
+find_loop(U, Retry, AL, Delay, Acc) ->
+ send_all(U, AL, [?EBOOT_REQUEST, erlang:system_info(version)]),
+ find_collect(U, Retry-1, AL, Delay, Acc).
+
+find_collect(U,Retry,AL,Delay,Acc) ->
+ receive
+ {udp, U, IP, _Port, [$E,$B,$O,$O,$T,$R,Priority,T1,T0 | _Version]} ->
+ Elem = {Priority,IP,T1*256+T0},
+ ?dbg(got, Elem),
+ case member(Elem, Acc) of
+ false -> find_collect(U, Retry, AL, Delay, [Elem | Acc]);
+ true -> find_collect(U, Retry, AL, Delay, Acc)
+ end;
+ _Garbage ->
+ ?dbg(collect_garbage, _Garbage),
+ find_collect(U, Retry, AL, Delay, Acc)
+
+ after Delay ->
+ ?dbg(collected, Acc),
+ case keymember(0, 1, Acc) of %% got high priority server?
+ true -> Acc;
+ false -> find_loop(U, Retry, AL, Delay, Acc)
+ end
+ end.
+
+
+sleep(Time) ->
+ receive after Time -> ok end.
+
+inet_exit_port(State, Port, _Reason) when State#state.data =:= Port ->
+ State#state { data = noport, timeout = infinity };
+inet_exit_port(State, _, _) ->
+ State.
+
+
+inet_timeout_handler(State, _Parent) ->
+ Tcp = State#state.data,
+ if is_port(Tcp) -> ll_close(Tcp);
+ true -> ok
+ end,
+ State#state { timeout = infinity, data = noport }.
+
+%% -> {{ok,BinFile,Tag},State} | {{error,Reason},State}
+inet_get_file_from_port(State, File, Paths) ->
+ case is_basename(File) of
+ false -> % get absolute file name.
+ inet_send_and_rcv({get,File}, File, State);
+ true when Paths =:= [] -> % get plain file name.
+ inet_send_and_rcv({get,File}, File, State);
+ true -> % use paths.
+ inet_get_file_from_port1(File, Paths, State)
+ end.
+
+inet_get_file_from_port1(File, [P | Paths], State) ->
+ File1 = concat([P,"/",File]),
+ case inet_send_and_rcv({get,File1}, File1, State) of
+ {{error,Reason},State1} ->
+ case Paths of
+ [] -> % return last error
+ {{error,Reason},State1};
+ _ -> % try more paths
+ inet_get_file_from_port1(File, Paths, State1)
+ end;
+ Result -> Result
+ end;
+inet_get_file_from_port1(_File, [], State) ->
+ {{error,file_not_found},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 });
+inet_send_and_rcv(Msg, Tag, #state{data=Tcp,timeout=Timeout}=State) ->
+ prim_inet:send(Tcp, term_to_binary(Msg)),
+ receive
+ {tcp,Tcp,BinMsg} ->
+ case catch binary_to_term(BinMsg) of
+ {get,{ok,BinFile}} ->
+ {{ok,BinFile,Tag},State};
+ {_Cmd,Res={ok,_}} ->
+ {Res,State};
+ {_Cmd,{error,Error}} ->
+ {{error,Error},State};
+ {error,Error} ->
+ {{error,Error},State};
+ {'EXIT',Error} ->
+ {{error,Error},State}
+ end;
+ {tcp_closed,Tcp} ->
+ %% Ok we must reconnect
+ inet_send_and_rcv(Msg, Tag, State#state { data = noport });
+ {tcp_error,Tcp,_Reason} ->
+ %% Ok we must reconnect
+ inet_send_and_rcv(Msg, Tag, inet_stop_port(State));
+ {'EXIT', Tcp, _} ->
+ %% Ok we must reconnect
+ inet_send_and_rcv(Msg, Tag, State#state { data = noport })
+ after Timeout ->
+ %% Ok we must reconnect
+ inet_send_and_rcv(Msg, Tag, inet_stop_port(State))
+ end.
+
+%% -> {{ok,List},State} | {{error,Reason},State}
+inet_list_dir(State, Dir) ->
+ inet_send_and_rcv({list_dir,Dir}, list_dir, State).
+
+%% -> {{ok,Info},State} | {{error,Reason},State}
+inet_read_file_info(State, File) ->
+ inet_send_and_rcv({read_file_info,File}, read_file_info, State).
+
+%% -> {{ok,Cwd},State} | {{error,Reason},State}
+inet_get_cwd(State, []) ->
+ inet_send_and_rcv(get_cwd, get_cwd, State);
+inet_get_cwd(State, [Drive]) ->
+ inet_send_and_rcv({get_cwd,Drive}, get_cwd, State).
+
+inet_stop_port(#state{data=Tcp}=State) ->
+ prim_inet:close(Tcp),
+ State#state{data=noport}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Direct inet_drv access
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+tcp_options() ->
+ [{mode,binary}, {packet,4}, {active, true}, {deliver,term}].
+
+tcp_timeout() ->
+ 15000.
+
+%% options for udp [list, {broadcast, true}, {active,true}]
+udp_options() ->
+ [{mode,list}, {active, true}, {deliver,term}, {broadcast,true}].
+%%
+%% INET version IPv4 addresses
+%%
+ll_tcp_connect(LocalPort, IP, RemotePort) ->
+ case ll_open_set_bind(tcp, ?INET_FAMILY, tcp_options(),
+ ?INET_ADDRESS, LocalPort) of
+ {ok,S} ->
+ case prim_inet:connect(S, IP, RemotePort, tcp_timeout()) of
+ ok -> {ok, S};
+ Error -> port_error(S, Error)
+ end;
+ Error -> Error
+ end.
+
+%%
+%% Open and initialize an udp port for broadcast
+%%
+ll_udp_open(P) ->
+ ll_open_set_bind(udp, ?INET_FAMILY, udp_options(), ?INET_ADDRESS, P).
+
+
+ll_open_set_bind(Protocol, Family, SOpts, IP, Port) ->
+ case prim_inet:open(Protocol, Family) of
+ {ok, S} ->
+ case prim_inet:setopts(S, SOpts) of
+ ok ->
+ case prim_inet:bind(S, IP, Port) of
+ {ok,_} ->
+ {ok, S};
+ Error -> port_error(S, Error)
+ end;
+ Error -> port_error(S, Error)
+ end;
+ Error -> Error
+ end.
+
+
+ll_close(S) ->
+ unlink(S),
+ exit(S, kill).
+
+port_error(S, Error) ->
+ unlink(S),
+ prim_inet:close(S),
+ Error.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+prim_init() ->
+ Deb =
+ case init:get_argument(loader_debug) of
+ {ok, _} -> true;
+ error -> false
+ 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} ->
+ ok; % Keep primary archive
+ {_Mtime, Cache} ->
+ 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_set_primary_archive(PS, undefined, undefined) ->
+ debug(PS, {set_primary_archive, clean}),
+ case PS#prim_state.primary_archive of
+ undefined ->
+ Res = {error, enoent},
+ debug(PS, {return, Res}),
+ {Res, PS};
+ ArchiveFile ->
+ {primary, PrimZip} = erase(ArchiveFile),
+ ok = prim_zip:close(PrimZip),
+ PS2 = PS#prim_state{primary_archive = undefined},
+ Res = {ok, []},
+ debug(PS2, {return, Res}),
+ {Res, PS2}
+ end;
+prim_set_primary_archive(PS, ArchiveFile, ArchiveBin)
+ when is_list(ArchiveFile), is_binary(ArchiveBin) ->
+ %% Try the archive file
+ debug(PS, {set_primary_archive, ArchiveFile, byte_size(ArchiveBin)}),
+ {Res3, PS3} =
+ case PS#prim_state.primary_archive of
+ undefined ->
+ Fun =
+ fun({Funny, _GI, _GB}, A) ->
+ case Funny of
+ ["", "nibe", RevApp] -> % Reverse ebin
+ %% Collect ebin directories in archive
+ Ebin = reverse(RevApp) ++ "/ebin",
+ {true, [Ebin | A]};
+ _ ->
+ {true, A}
+ end
+ end,
+ Ebins0 = [ArchiveFile],
+ case open_archive({ArchiveFile, ArchiveBin}, Ebins0, Fun) of
+ {ok, PrimZip, RevEbins} ->
+ Ebins = reverse(RevEbins),
+ debug(PS, {set_primary_archive, Ebins}),
+ put(ArchiveFile, {primary, PrimZip}),
+ {{ok, Ebins}, PS#prim_state{primary_archive = ArchiveFile}};
+ Error ->
+ debug(PS, {set_primary_archive, Error}),
+ {Error, PS}
+ end;
+ OldArchiveFile ->
+ debug(PS, {set_primary_archive, clean}),
+ PrimZip = erase(OldArchiveFile),
+ ok = prim_zip:close(PrimZip),
+ PS2 = PS#prim_state{primary_archive = undefined},
+ prim_set_primary_archive(PS2, ArchiveFile, ArchiveBin)
+ end,
+ debug(PS3, {return, Res3}),
+ {Res3, PS3}.
+
+prim_get_file(PS, File) ->
+ debug(PS, {get_file, File}),
+ {Res2, PS2} =
+ case name_split(PS#prim_state.primary_archive, File) of
+ {file, PrimFile} ->
+ Res = prim_file:read_file(PrimFile),
+ {Res, PS};
+ {archive, ArchiveFile, FileInArchive} ->
+ debug(PS, {archive_get_file, ArchiveFile, FileInArchive}),
+ FunnyFile = funny_split(FileInArchive, $/),
+ Fun =
+ fun({Funny, _GetInfo, GetBin}, Acc) ->
+ if
+ Funny =:= FunnyFile ->
+ {false, {ok, GetBin()}};
+ true ->
+ {true, Acc}
+ end
+ end,
+ apply_archive(PS, Fun, {error, enoent}, ArchiveFile)
+ end,
+ debug(PS, {return, Res2}),
+ {Res2, PS2}.
+
+%% -> {{ok,List},State} | {{error,Reason},State}
+prim_list_dir(PS, Dir) ->
+ debug(PS, {list_dir, Dir}),
+ {Res2, PS3} =
+ case name_split(PS#prim_state.primary_archive, Dir) of
+ {file, PrimDir} ->
+ Res = prim_file:list_dir(PrimDir),
+ {Res, PS};
+ {archive, ArchiveFile, FileInArchive} ->
+ debug(PS, {archive_list_dir, ArchiveFile, FileInArchive}),
+ FunnyDir = funny_split(FileInArchive, $/),
+ Fun =
+ fun({Funny, _GetInfo, _GetBin}, {Status, Names} = Acc) ->
+ case Funny of
+ [RevName | FD] when FD =:= FunnyDir ->
+ case RevName of
+ "" ->
+ %% The listed directory
+ {true, {ok, Names}};
+ _ ->
+ %% Plain file
+ Name = reverse(RevName),
+ {true, {Status, [Name | Names]}}
+ end;
+ ["", RevName | FD] when FD =:= FunnyDir ->
+ %% Directory
+ Name = reverse(RevName),
+ {true, {Status, [Name | Names]}};
+ [RevName] when FunnyDir =:= [""] ->
+ %% Top file
+ Name = reverse(RevName),
+ {true, {ok, [Name | Names]}};
+ ["", RevName] when FunnyDir =:= [""] ->
+ %% Top file
+ Name = reverse(RevName),
+ {true, {ok, [Name | Names]}};
+ _ ->
+ %% No match
+ {true, Acc}
+ end
+ end,
+ {{Status, Names}, PS2} =
+ apply_archive(PS, Fun, {error, []}, ArchiveFile),
+ case Status of
+ ok -> {{ok, Names}, PS2};
+ error -> {{error, enotdir}, PS2}
+ end
+ end,
+ debug(PS, {return, Res2}),
+ {Res2, PS3}.
+
+%% -> {{ok,Info},State} | {{error,Reason},State}
+prim_read_file_info(PS, File) ->
+ 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};
+ {archive, ArchiveFile, []} ->
+ %% Fake top directory
+ debug(PS, {archive_read_file_info, ArchiveFile}),
+ case prim_file:read_file_info(ArchiveFile) of
+ {ok, FI} ->
+ {{ok, FI#file_info{type = directory}}, PS};
+ Other ->
+ {Other, PS}
+ end;
+ {archive, ArchiveFile, FileInArchive} ->
+ debug(PS, {archive_read_file_info, File}),
+ FunnyFile = funny_split(FileInArchive, $/),
+ Fun =
+ fun({Funny, GetInfo, _GetBin}, Acc) ->
+ if
+ hd(Funny) =:= "",
+ tl(Funny) =:= FunnyFile ->
+ %% Directory
+ {false, {ok, GetInfo()}};
+ Funny =:= FunnyFile ->
+ %% Plain file
+ {false, {ok, GetInfo()}};
+ true ->
+ %% No match
+ {true, Acc}
+ end
+ end,
+ apply_archive(PS, Fun, {error, enoent}, ArchiveFile)
+ end,
+ debug(PS2, {return, Res2}),
+ {Res2, PS2}.
+
+prim_get_cwd(PS, []) ->
+ debug(PS, {get_cwd, []}),
+ Res = prim_file:get_cwd(),
+ debug(PS, {return, Res}),
+ {Res, PS};
+prim_get_cwd(PS, [Drive]) ->
+ debug(PS, {get_cwd, Drive}),
+ Res = prim_file:get_cwd(Drive),
+ debug(PS, {return, Res}),
+ {Res, PS}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+apply_archive(PS, Fun, Acc, Archive) ->
+ case get(Archive) of
+ undefined ->
+ case prim_file:read_file_info(Archive) of
+ {ok, #file_info{mtime = Mtime}} ->
+ case open_archive(Archive, Acc, Fun) of
+ {ok, PrimZip, Acc2} ->
+ debug(PS, {cache, ok}),
+ put(Archive, {Mtime, {ok, PrimZip}}),
+ {Acc2, PS};
+ Error ->
+ debug(PS, {cache, Error}),
+ put(Archive, {Mtime, Error}),
+ {Error, PS}
+ end;
+ Error ->
+ debug(PS, {cache, Error}),
+ {Error, PS}
+ end;
+ {primary, PrimZip} ->
+ case foldl_archive(PrimZip, Acc, Fun) of
+ {ok, _PrimZip2, Acc2} ->
+ {Acc2, PS};
+ Error ->
+ debug(PS, {primary, Error}),
+ {Error, PS}
+ end;
+ {Mtime, Cache} ->
+ case prim_file:read_file_info(Archive) of
+ {ok, #file_info{mtime = Mtime2}} when Mtime2 =:= Mtime ->
+ case Cache of
+ {ok, PrimZip} ->
+ case foldl_archive(PrimZip, Acc, Fun) of
+ {ok, _PrimZip2, Acc2} ->
+ {Acc2, PS};
+ Error ->
+ debug(PS, {cache, {clear, Error}}),
+ clear_cache(Archive, Cache),
+ debug(PS, {cache, Error}),
+ put(Archive, {Mtime, Error}),
+ {Error, PS}
+ end;
+ Error ->
+ debug(PS, {cache, Error}),
+ {Error, PS}
+ end;
+ Error ->
+ debug(PS, {cache, {clear, Error}}),
+ clear_cache(Archive, Cache),
+ apply_archive(PS, Fun, Acc, Archive)
+ end
+ end.
+
+open_archive(Archive, Acc, Fun) ->
+ Wrapper =
+ fun({N, GI, GB}, A) ->
+ %% Ensure full iteration at open
+ Funny = funny_split(N, $/),
+ {_Continue, A2} = Fun({Funny, GI, GB}, A),
+ {true, {true, Funny}, A2}
+ end,
+ prim_zip:open(Wrapper, Acc, Archive).
+
+foldl_archive(PrimZip, Acc, Fun) ->
+ Wrapper =
+ fun({N, GI, GB}, A) ->
+ %% Allow partial iteration at foldl
+ {Continue, A2} = Fun({N, GI, GB}, A),
+ {Continue, true, A2}
+ end,
+ prim_zip:foldl(Wrapper, Acc, PrimZip).
+
+cache_new(PS) ->
+ PS.
+
+clear_cache(Archive, Cache) ->
+ erase(Archive),
+ case Cache of
+ {ok, PrimZip} ->
+ prim_zip:close(PrimZip);
+ {error, _} ->
+ ok
+ end.
+
+%%% --------------------------------------------------------
+%%% Misc. functions.
+%%% --------------------------------------------------------
+
+%%% Look for directory separators
+is_basename(File) ->
+ case deep_member($/, File) of
+ true ->
+ false;
+ false ->
+ case erlang:system_info(os_type) of
+ {win32, _} ->
+ case File of
+ [_,$: | _] ->
+ false;
+ _ ->
+ not deep_member($\\, File)
+ end;
+ _ ->
+ true
+ end
+ end.
+
+send_all(U, [IP | AL], Cmd) ->
+ ?dbg(sendto, {U, IP, ?EBOOT_PORT, Cmd}),
+ prim_inet:sendto(U, IP, ?EBOOT_PORT, Cmd),
+ send_all(U, AL, Cmd);
+send_all(_U, [], _) -> ok.
+
+concat([A|T]) when is_atom(A) -> %Atom
+ atom_to_list(A) ++ concat(T);
+concat([C|T]) when C >= 0, C =< 255 ->
+ [C|concat(T)];
+concat([S|T]) -> %String
+ S ++ concat(T);
+concat([]) ->
+ [].
+
+member(X, [X|_]) -> true;
+member(X, [_|Y]) -> member(X, Y);
+member(_X, []) -> false.
+
+deep_member(X, [X|_]) ->
+ true;
+deep_member(X, [List | Y]) when is_list(List) ->
+ deep_member(X, List) orelse deep_member(X, Y);
+deep_member(X, [Atom | Y]) when is_atom(Atom) ->
+ deep_member(X, atom_to_list(Atom)) orelse deep_member(X, Y);
+deep_member(X, [_ | Y]) ->
+ deep_member(X, Y);
+deep_member(_X, []) ->
+ false.
+
+keymember(X, I, [Y | _]) when element(I,Y) =:= X -> true;
+keymember(X, I, [_ | T]) -> keymember(X, I, T);
+keymember(_X, _I, []) -> false.
+
+keysort(I, L) -> keysort(I, L, []).
+
+keysort(I, [X | L], Ls) ->
+ keysort(I, L, keyins(X, I, Ls));
+keysort(_I, [], Ls) -> Ls.
+
+keyins(X, I, [Y | T]) when X < element(I,Y) -> [X,Y|T];
+keyins(X, I, [Y | T]) -> [Y | keyins(X, I, T)];
+keyins(X, _I, []) -> [X].
+
+min(X, Y) when X < Y -> X;
+min(_X, Y) -> Y.
+
+to_strs([P|Paths]) when is_atom(P) ->
+ [atom_to_list(P)|to_strs(Paths)];
+to_strs([P|Paths]) when is_list(P) ->
+ [P|to_strs(Paths)];
+to_strs([_|Paths]) ->
+ to_strs(Paths);
+to_strs([]) ->
+ [].
+
+reverse([] = L) ->
+ L;
+reverse([_] = L) ->
+ L;
+reverse([A, B]) ->
+ [B, A];
+reverse([A, B | L]) ->
+ lists:reverse(L, [B, A]). % BIF
+
+%% Returns all lists in reverse order
+funny_split(List, Sep) ->
+ funny_split(List, Sep, [], []).
+
+funny_split([Sep | Tail], Sep, Path, Paths) ->
+ funny_split(Tail, Sep, [], [Path | Paths]);
+funny_split([Head | Tail], Sep, Path, Paths) ->
+ funny_split(Tail, Sep, [Head | Path], Paths);
+funny_split([], _Sep, Path, Paths) ->
+ [Path | Paths].
+
+name_split(ArchiveFile, File0) ->
+ File = absname(File0),
+ do_name_split(ArchiveFile, File).
+
+do_name_split(undefined, File) ->
+ %% Ignore primary archive
+ case string_split(File, init:archive_extension(), []) 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}
+ end;
+do_name_split(ArchiveFile0, File) ->
+ %% Look first in primary archive
+ ArchiveFile = absname(ArchiveFile0),
+ case string_match(File, ArchiveFile, []) of
+ no_match ->
+ %% Archive or plain file
+ do_name_split(undefined, File);
+ {match, _RevPrimArchiveFile, FileInArchive} ->
+ %% Primary archive
+ case FileInArchive of
+ [$/ | FileInArchive2] ->
+ {archive, ArchiveFile, FileInArchive2};
+ _ ->
+ {archive, ArchiveFile, FileInArchive}
+ end
+ end.
+
+string_match([Char | File], [Char | Archive], RevTop) ->
+ string_match(File, Archive, [Char | RevTop]);
+string_match(File, [], RevTop) ->
+ {match, RevTop, File};
+string_match(_File, _Archive, _RevTop) ->
+ 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).
+
+%% 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
+ {ok,IP} -> [IP | ipv4_list(T)];
+ _ -> ipv4_list(T)
+ end;
+ipv4_list([]) -> [].
+
+%%
+%% Parse Ipv4 address: d1.d2.d3.d4 (from inet_parse)
+%%
+%% Return {ok, IP} | {error, einval}
+%%
+ipv4_address(Cs) ->
+ case catch ipv4_addr(Cs, []) of
+ {'EXIT',_} -> {error,einval};
+ Addr -> {ok,Addr}
+ end.
+
+ipv4_addr([C | Cs], IP) when C >= $0, C =< $9 -> ipv4_addr(Cs, C-$0, IP).
+
+ipv4_addr([$.|Cs], N, IP) when N < 256 -> ipv4_addr(Cs, [N|IP]);
+ipv4_addr([C|Cs], N, IP) when C >= $0, C =< $9 ->
+ ipv4_addr(Cs, N*10 + (C-$0), IP);
+ipv4_addr([], D, [C,B,A]) when D < 256 -> {A,B,C,D}.
+
+%% A simplified version of filename:absname/1
+absname(Name) ->
+ Name2 = normalize(Name, []),
+ case pathtype(Name2) of
+ absolute ->
+ Name2;
+ relative ->
+ case prim_file:get_cwd() of
+ {ok, Cwd} ->
+ Cwd ++ "/" ++ Name2;
+ {error, _} ->
+ Name2
+ end;
+ volumerelative ->
+ case prim_file:get_cwd() of
+ {ok, Cwd} ->
+ absname_vr(Name2, Cwd);
+ {error, _} ->
+ Name2
+ end
+ end.
+
+%% Assumes normalized name
+absname_vr([$/ | NameRest], [Drive, $\: | _]) ->
+ %% Absolute path on current drive.
+ [Drive, $\: | NameRest];
+absname_vr([Drive, $\: | NameRest], [Drive, $\: | _] = Cwd) ->
+ %% Relative to current directory on current drive.
+ Cwd ++ "/" ++ NameRest;
+absname_vr([Drive, $\: | NameRest], _) ->
+ %% Relative to current directory on another drive.
+ case prim_file:get_cwd([Drive, $\:]) of
+ {ok, DriveCwd} ->
+ DriveCwd ++ "/" ++ NameRest;
+ {error, _} ->
+ [Drive, $\:, $/] ++ NameRest
+ end.
+
+%% Assumes normalized name
+pathtype(Name) when is_list(Name) ->
+ case erlang:system_info(os_type) of
+ {unix, _} ->
+ unix_pathtype(Name);
+ {win32, _} ->
+ win32_pathtype(Name);
+ {vxworks, _} ->
+ case vxworks_first(Name) of
+ {device, _Rest, _Dev} ->
+ absolute;
+ _ ->
+ relative
+ end;
+ {ose,_} ->
+ unix_pathtype(Name)
+ end.
+
+unix_pathtype(Name) ->
+ case Name of
+ [$/|_] ->
+ absolute;
+ [List|Rest] when is_list(List) ->
+ unix_pathtype(List++Rest);
+ [Atom|Rest] when is_atom(Atom) ->
+ atom_to_list(Atom)++Rest;
+ _ ->
+ relative
+ end.
+
+win32_pathtype(Name) ->
+ case Name of
+ [List|Rest] when is_list(List) ->
+ win32_pathtype(List++Rest);
+ [Atom|Rest] when is_atom(Atom) ->
+ win32_pathtype(atom_to_list(Atom)++Rest);
+ [Char, List | Rest] when is_list(List) ->
+ win32_pathtype([Char | List++Rest]);
+ [$/, $/|_] ->
+ absolute;
+ [$\\, $/|_] ->
+ absolute;
+ [$/, $\\|_] ->
+ absolute;
+ [$\\, $\\|_] ->
+ absolute;
+ [$/|_] ->
+ volumerelative;
+ [$\\|_] ->
+ volumerelative;
+ [C1, C2, List | Rest] when is_list(List) ->
+ pathtype([C1, C2|List ++ Rest]);
+ [_Letter, $:, $/|_] ->
+ absolute;
+ [_Letter, $:, $\\|_] ->
+ absolute;
+ [_Letter, $:|_] ->
+ volumerelative;
+ _ ->
+ relative
+ end.
+
+vxworks_first(Name) ->
+ case Name of
+ [] ->
+ {not_device, [], []};
+ [$/ | T] ->
+ vxworks_first2(device, T, [$/]);
+ [$\\ | T] ->
+ vxworks_first2(device, T, [$/]);
+ [H | T] when is_list(H) ->
+ vxworks_first(H ++ T);
+ [H | T] ->
+ vxworks_first2(not_device, T, [H])
+ end.
+
+vxworks_first2(Devicep, Name, FirstComp) ->
+ case Name of
+ [] ->
+ {Devicep, [], FirstComp};
+ [$/ |T ] ->
+ {Devicep, [$/ | T], FirstComp};
+ [$\\ | T] ->
+ {Devicep, [$/ | T], FirstComp};
+ [$: | T]->
+ {device, T, [$: | FirstComp]};
+ [H | T] when is_list(H) ->
+ vxworks_first2(Devicep, H ++ T, FirstComp);
+ [H | T] ->
+ vxworks_first2(Devicep, T, [H | FirstComp])
+ end.
+
+normalize(Name, Acc) ->
+ case Name of
+ [List | Rest] when is_list(List) ->
+ normalize(List ++ Rest, Acc);
+ [Atom | Rest] when is_atom(Atom) ->
+ normalize(atom_to_list(Atom) ++ Rest, Acc);
+ [$\\ | Chars] ->
+ normalize(Chars, [$/ | Acc]);
+ [Char | Chars] ->
+ normalize(Chars, [Char | Acc]);
+ [] ->
+ reverse(Acc)
+ end.
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
new file mode 100644
index 0000000000..6f92b319b7
--- /dev/null
+++ b/erts/preloaded/src/erlang.erl
@@ -0,0 +1,683 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(erlang).
+
+-export([apply/2,apply/3,spawn/4,spawn_link/4,
+ spawn_monitor/1,spawn_monitor/3,
+ spawn_opt/2,spawn_opt/3,spawn_opt/4,spawn_opt/5,
+ disconnect_node/1]).
+-export([spawn/1, spawn_link/1, spawn/2, spawn_link/2]).
+-export([yield/0]).
+-export([crasher/6]).
+-export([fun_info/1]).
+-export([send_nosuspend/2, send_nosuspend/3]).
+-export([localtime_to_universaltime/1]).
+-export([suspend_process/1]).
+-export([min/2,max/2]).
+
+-export([dlink/1, dunlink/1, dsend/2, dsend/3, dgroup_leader/2,
+ dexit/2, dmonitor_node/3, dmonitor_p/2]).
+
+-export([delay_trap/2]).
+
+-export([set_cookie/2, get_cookie/0]).
+
+-export([nodes/0]).
+
+-export([concat_binary/1]).
+
+-export([list_to_integer/2,integer_to_list/2]).
+
+-export([flush_monitor_message/2]).
+
+-export([set_cpu_topology/1, format_cpu_topology/1]).
+
+-export([await_proc_exit/3]).
+
+-deprecated([hash/2]).
+
+-compile(nowarn_bif_clash).
+
+apply(Fun, Args) ->
+ apply(Fun, Args).
+
+apply(Mod, Name, Args) ->
+ apply(Mod, Name, Args).
+
+
+% Spawns with a fun
+spawn(F) when is_function(F) ->
+ spawn(erlang, apply, [F, []]);
+spawn({M,F}=MF) when is_atom(M), is_atom(F) ->
+ spawn(erlang, apply, [MF, []]);
+spawn(F) ->
+ erlang:error(badarg, [F]).
+
+spawn(N, F) when N =:= node() ->
+ spawn(F);
+spawn(N, F) when is_function(F) ->
+ spawn(N, erlang, apply, [F, []]);
+spawn(N, {M,F}=MF) when is_atom(M), is_atom(F) ->
+ spawn(N, erlang, apply, [MF, []]);
+spawn(N, F) ->
+ erlang:error(badarg, [N, F]).
+
+spawn_link(F) when is_function(F) ->
+ spawn_link(erlang, apply, [F, []]);
+spawn_link({M,F}=MF) when is_atom(M), is_atom(F) ->
+ spawn_link(erlang, apply, [MF, []]);
+spawn_link(F) ->
+ erlang:error(badarg, [F]).
+
+spawn_link(N, F) when N =:= node() ->
+ spawn_link(F);
+spawn_link(N, F) when is_function(F) ->
+ spawn_link(N, erlang, apply, [F, []]);
+spawn_link(N, {M,F}=MF) when is_atom(M), is_atom(F) ->
+ spawn_link(N, erlang, apply, [MF, []]);
+spawn_link(N, F) ->
+ erlang:error(badarg, [N, F]).
+
+%% Spawn and atomically set up a monitor.
+
+spawn_monitor(F) when is_function(F, 0) ->
+ erlang:spawn_opt({erlang,apply,[F,[]],[monitor]});
+spawn_monitor(F) ->
+ erlang:error(badarg, [F]).
+
+spawn_monitor(M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
+ erlang:spawn_opt({M,F,A,[monitor]});
+spawn_monitor(M, F, A) ->
+ erlang:error(badarg, [M,F,A]).
+
+spawn_opt(F, O) when is_function(F) ->
+ spawn_opt(erlang, apply, [F, []], O);
+spawn_opt({M,F}=MF, O) when is_atom(M), is_atom(F) ->
+ spawn_opt(erlang, apply, [MF, []], O);
+spawn_opt({M,F,A}, O) -> % For (undocumented) backward compatibility
+ spawn_opt(M, F, A, O);
+spawn_opt(F, O) ->
+ erlang:error(badarg, [F, O]).
+
+spawn_opt(N, F, O) when N =:= node() ->
+ spawn_opt(F, O);
+spawn_opt(N, F, O) when is_function(F) ->
+ spawn_opt(N, erlang, apply, [F, []], O);
+spawn_opt(N, {M,F}=MF, O) when is_atom(M), is_atom(F) ->
+ spawn_opt(N, erlang, apply, [MF, []], O);
+spawn_opt(N, F, O) ->
+ erlang:error(badarg, [N, F, O]).
+
+% Spawns with MFA
+
+spawn(N,M,F,A) when N =:= node(), is_atom(M), is_atom(F), is_list(A) ->
+ spawn(M,F,A);
+spawn(N,M,F,A) when is_atom(N), is_atom(M), is_atom(F) ->
+ case is_well_formed_list(A) of
+ true ->
+ ok;
+ false ->
+ erlang:error(badarg, [N, M, F, A])
+ end,
+ case catch gen_server:call({net_kernel,N},
+ {spawn,M,F,A,group_leader()},
+ infinity) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ Error ->
+ case remote_spawn_error(Error, {no_link, N, M, F, A, []}) of
+ {fault, Fault} ->
+ erlang:error(Fault, [N, M, F, A]);
+ Pid ->
+ Pid
+ end
+ end;
+spawn(N,M,F,A) ->
+ erlang:error(badarg, [N, M, F, A]).
+
+spawn_link(N,M,F,A) when N =:= node(), is_atom(M), is_atom(F), is_list(A) ->
+ spawn_link(M,F,A);
+spawn_link(N,M,F,A) when is_atom(N), is_atom(M), is_atom(F) ->
+ case is_well_formed_list(A) of
+ true ->
+ ok;
+ _ ->
+ erlang:error(badarg, [N, M, F, A])
+ end,
+ case catch gen_server:call({net_kernel,N},
+ {spawn_link,M,F,A,group_leader()},
+ infinity) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ Error ->
+ case remote_spawn_error(Error, {link, N, M, F, A, []}) of
+ {fault, Fault} ->
+ erlang:error(Fault, [N, M, F, A]);
+ Pid ->
+ Pid
+ end
+ end;
+spawn_link(N,M,F,A) ->
+ erlang:error(badarg, [N, M, F, A]).
+
+spawn_opt(M, F, A, Opts) ->
+ case catch erlang:spawn_opt({M,F,A,Opts}) of
+ {'EXIT',{Reason,_}} ->
+ erlang:error(Reason, [M,F,A,Opts]);
+ Res ->
+ Res
+ end.
+
+spawn_opt(N, M, F, A, O) when N =:= node(),
+ is_atom(M), is_atom(F), is_list(A),
+ is_list(O) ->
+ spawn_opt(M, F, A, O);
+spawn_opt(N, M, F, A, O) when is_atom(N), is_atom(M), is_atom(F) ->
+ case {is_well_formed_list(A), is_well_formed_list(O)} of
+ {true, true} ->
+ ok;
+ _ ->
+ erlang:error(badarg, [N, M, F, A, O])
+ end,
+ case lists:member(monitor, O) of
+ false -> ok;
+ true -> erlang:error(badarg, [N, M, F, A, O])
+ end,
+ {L,NO} = lists:foldl(fun (link, {_, NewOpts}) ->
+ {link, NewOpts};
+ (Opt, {LO, NewOpts}) ->
+ {LO, [Opt|NewOpts]}
+ end,
+ {no_link,[]},
+ O),
+ case catch gen_server:call({net_kernel,N},
+ {spawn_opt,M,F,A,NO,L,group_leader()},
+ infinity) of
+ Pid when is_pid(Pid) ->
+ Pid;
+ Error ->
+ case remote_spawn_error(Error, {L, N, M, F, A, NO}) of
+ {fault, Fault} ->
+ erlang:error(Fault, [N, M, F, A, O]);
+ Pid ->
+ Pid
+ end
+ end;
+spawn_opt(N,M,F,A,O) ->
+ erlang:error(badarg, [N,M,F,A,O]).
+
+remote_spawn_error({'EXIT', {{nodedown,N}, _}}, {L, N, M, F, A, O}) ->
+ {Opts, LL} = case L =:= link of
+ true ->
+ {[link|O], [link]};
+ false ->
+ {O, []}
+ end,
+ spawn_opt(erlang,crasher,[N,M,F,A,Opts,noconnection], LL);
+remote_spawn_error({'EXIT', {Reason, _}}, _) ->
+ {fault, Reason};
+remote_spawn_error({'EXIT', Reason}, _) ->
+ {fault, Reason};
+remote_spawn_error(Other, _) ->
+ {fault, Other}.
+
+is_well_formed_list([]) ->
+ true;
+is_well_formed_list([_|Rest]) ->
+ is_well_formed_list(Rest);
+is_well_formed_list(_) ->
+ false.
+
+crasher(Node,Mod,Fun,Args,[],Reason) ->
+ error_logger:warning_msg("** Can not start ~w:~w,~w on ~w **~n",
+ [Mod,Fun,Args,Node]),
+ exit(Reason);
+crasher(Node,Mod,Fun,Args,Opts,Reason) ->
+ error_logger:warning_msg("** Can not start ~w:~w,~w (~w) on ~w **~n",
+ [Mod,Fun,Args,Opts,Node]),
+ exit(Reason).
+
+yield() ->
+ erlang:yield().
+
+nodes() -> erlang:nodes(visible).
+
+disconnect_node(Node) -> net_kernel:disconnect(Node).
+
+fun_info(Fun) when is_function(Fun) ->
+ Keys = [type,env,arity,name,uniq,index,new_uniq,new_index,module,pid],
+ fun_info_1(Keys, Fun, []).
+
+fun_info_1([K|Ks], Fun, A) ->
+ case erlang:fun_info(Fun, K) of
+ {K,undefined} -> fun_info_1(Ks, Fun, A);
+ {K,_}=P -> fun_info_1(Ks, Fun, [P|A])
+ end;
+fun_info_1([], _, A) -> A.
+
+-type dst() :: pid() | port() | atom() | {atom(), node()}.
+
+-spec send_nosuspend(dst(), term()) -> boolean().
+send_nosuspend(Pid, Msg) ->
+ send_nosuspend(Pid, Msg, []).
+
+-spec send_nosuspend(dst(), term(), ['noconnect' | 'nosuspend']) -> boolean().
+send_nosuspend(Pid, Msg, Opts) ->
+ case erlang:send(Pid, Msg, [nosuspend|Opts]) of
+ ok -> true;
+ _ -> false
+ end.
+
+localtime_to_universaltime(Localtime) ->
+ erlang:localtime_to_universaltime(Localtime, undefined).
+
+suspend_process(P) ->
+ case catch erlang:suspend_process(P, []) of
+ {'EXIT', {Reason, _}} -> erlang:error(Reason, [P]);
+ {'EXIT', Reason} -> erlang:error(Reason, [P]);
+ Res -> Res
+ end.
+
+%%
+%% If the emulator wants to perform a distributed command and
+%% a connection is not established to the actual node the following
+%% functions is called in order to set up the connection and then
+%% reactivate the command.
+%%
+
+dlink(Pid) ->
+ case net_kernel:connect(node(Pid)) of
+ true -> link(Pid);
+ false -> erlang:dist_exit(self(), noconnection, Pid), true
+ end.
+
+%% Can this ever happen?
+dunlink(Pid) ->
+ case net_kernel:connect(node(Pid)) of
+ true -> unlink(Pid);
+ false -> true
+ end.
+
+dmonitor_node(Node, Flag, []) ->
+ case net_kernel:connect(Node) of
+ true -> erlang:monitor_node(Node, Flag, []);
+ false -> self() ! {nodedown, Node}, true
+ end;
+
+dmonitor_node(Node, Flag, Opts) ->
+ case lists:member(allow_passive_connect,Opts) of
+ true ->
+ case net_kernel:passive_cnct(Node) of
+ true -> erlang:monitor_node(Node, Flag, Opts);
+ false -> self() ! {nodedown, Node}, true
+ end;
+ _ ->
+ dmonitor_node(Node,Flag,[])
+ end.
+
+dgroup_leader(Leader, Pid) ->
+ case net_kernel:connect(node(Pid)) of
+ true -> group_leader(Leader, Pid);
+ false -> true %% bad arg ?
+ end.
+
+dexit(Pid, Reason) ->
+ case net_kernel:connect(node(Pid)) of
+ true -> exit(Pid, Reason);
+ false -> true
+ end.
+
+dsend(Pid, Msg) when is_pid(Pid) ->
+ case net_kernel:connect(node(Pid)) of
+ true -> erlang:send(Pid, Msg);
+ false -> Msg
+ end;
+dsend(Port, Msg) when is_port(Port) ->
+ case net_kernel:connect(node(Port)) of
+ true -> erlang:send(Port, Msg);
+ false -> Msg
+ end;
+dsend({Name, Node}, Msg) ->
+ case net_kernel:connect(Node) of
+ true -> erlang:send({Name,Node}, Msg);
+ false -> Msg;
+ ignored -> Msg % Not distributed.
+ end.
+
+dsend(Pid, Msg, Opts) when is_pid(Pid) ->
+ case net_kernel:connect(node(Pid)) of
+ true -> erlang:send(Pid, Msg, Opts);
+ false -> ok
+ end;
+dsend(Port, Msg, Opts) when is_port(Port) ->
+ case net_kernel:connect(node(Port)) of
+ true -> erlang:send(Port, Msg, Opts);
+ false -> ok
+ end;
+dsend({Name, Node}, Msg, Opts) ->
+ case net_kernel:connect(Node) of
+ true -> erlang:send({Name,Node}, Msg, Opts);
+ false -> ok;
+ ignored -> ok % Not distributed.
+ end.
+
+dmonitor_p(process, ProcSpec) ->
+ %% ProcSpec = pid() | {atom(),atom()}
+ %% ProcSpec CANNOT be an atom because a locally registered process
+ %% is never handled here.
+
+ Node = case ProcSpec of
+ {S,N} when is_atom(S), is_atom(N), N =/= node() -> N;
+ _ when is_pid(ProcSpec) -> node(ProcSpec)
+ end,
+ case net_kernel:connect(Node) of
+ true ->
+ erlang:monitor(process, ProcSpec);
+ false ->
+ Ref = make_ref(),
+ self() ! {'DOWN', Ref, process, ProcSpec, noconnection},
+ Ref
+ end.
+
+%%
+%% Trap function used when modified timing has been enabled.
+%%
+
+delay_trap(Result, 0) -> erlang:yield(), Result;
+delay_trap(Result, Timeout) -> receive after Timeout -> Result end.
+
+%%
+%% The business with different in and out cookies represented
+%% everywhere is discarded.
+%% A node has a cookie, connections/messages to that node use that cookie.
+%% Messages to us use our cookie. IF we change our cookie, other nodes
+%% have to reflect that, which we cannot forsee.
+%%
+set_cookie(Node, C) when Node =/= nonode@nohost, is_atom(Node) ->
+ Res = case C of
+ _ when is_atom(C) ->
+ auth:set_cookie(Node, C);
+ {CI,CO} when is_atom(CI), is_atom(CO) ->
+ auth:set_cookie(Node, {CI, CO});
+ _ ->
+ error
+ end,
+ case Res of
+ error -> exit(badarg);
+ Other -> Other
+ end.
+
+get_cookie() ->
+ auth:get_cookie().
+
+concat_binary(List) ->
+ list_to_binary(List).
+
+integer_to_list(I, 10) ->
+ erlang:integer_to_list(I);
+integer_to_list(I, Base)
+ when is_integer(I), is_integer(Base), Base >= 2, Base =< 1+$Z-$A+10 ->
+ if I < 0 ->
+ [$-|integer_to_list(-I, Base, [])];
+ true ->
+ integer_to_list(I, Base, [])
+ end;
+integer_to_list(I, Base) ->
+ erlang:error(badarg, [I, Base]).
+
+integer_to_list(I0, Base, R0) ->
+ D = I0 rem Base,
+ I1 = I0 div Base,
+ R1 = if D >= 10 ->
+ [D-10+$A|R0];
+ true ->
+ [D+$0|R0]
+ end,
+ if I1 =:= 0 ->
+ R1;
+ true ->
+ integer_to_list(I1, Base, R1)
+ end.
+
+
+
+list_to_integer(L, 10) ->
+ erlang:list_to_integer(L);
+list_to_integer(L, Base)
+ when is_list(L), is_integer(Base), Base >= 2, Base =< 1+$Z-$A+10 ->
+ case list_to_integer_sign(L, Base) of
+ I when is_integer(I) ->
+ I;
+ Fault ->
+ erlang:error(Fault, [L,Base])
+ end;
+list_to_integer(L, Base) ->
+ erlang:error(badarg, [L,Base]).
+
+list_to_integer_sign([$-|[_|_]=L], Base) ->
+ case list_to_integer(L, Base, 0) of
+ I when is_integer(I) ->
+ -I;
+ I ->
+ I
+ end;
+list_to_integer_sign([$+|[_|_]=L], Base) ->
+ list_to_integer(L, Base, 0);
+list_to_integer_sign([_|_]=L, Base) ->
+ list_to_integer(L, Base, 0);
+list_to_integer_sign(_, _) ->
+ badarg.
+
+list_to_integer([D|L], Base, I)
+ when is_integer(D), D >= $0, D =< $9, D < Base+$0 ->
+ list_to_integer(L, Base, I*Base + D-$0);
+list_to_integer([D|L], Base, I)
+ when is_integer(D), D >= $A, D < Base+$A-10 ->
+ list_to_integer(L, Base, I*Base + D-$A+10);
+list_to_integer([D|L], Base, I)
+ when is_integer(D), D >= $a, D < Base+$a-10 ->
+ list_to_integer(L, Base, I*Base + D-$a+10);
+list_to_integer([], _, I) ->
+ I;
+list_to_integer(_, _, _) ->
+ badarg.
+
+%% erlang:flush_monitor_message/2 is for internal use only!
+%%
+%% erlang:demonitor(Ref, [flush]) traps to
+%% erlang:flush_monitor_message(Ref, Res) when
+%% it needs to flush a monitor message.
+flush_monitor_message(Ref, Res) when is_reference(Ref), is_atom(Res) ->
+ receive {_, Ref, _, _, _} -> ok after 0 -> ok end,
+ Res.
+
+-record(cpu, {node = -1,
+ processor = -1,
+ processor_node = -1,
+ core = -1,
+ thread = -1,
+ logical = -1}).
+
+%% erlang:set_cpu_topology/1 is for internal use only!
+%%
+%% erlang:system_flag(cpu_topology, CpuTopology) traps to
+%% erlang:set_cpu_topology(CpuTopology).
+set_cpu_topology(CpuTopology) ->
+ try format_cpu_topology(erlang:system_flag(internal_cpu_topology,
+ cput_e2i(CpuTopology)))
+ catch
+ Class:Exception when Class =/= error; Exception =/= internal_error ->
+ erlang:error(badarg, [CpuTopology])
+ end.
+
+cput_e2i_clvl({logical, _}, _PLvl) ->
+ #cpu.logical;
+cput_e2i_clvl([E | _], PLvl) ->
+ case element(1, E) of
+ node -> case PLvl of
+ 0 -> #cpu.node;
+ #cpu.processor -> #cpu.processor_node
+ end;
+ processor -> case PLvl of
+ 0 -> #cpu.node;
+ #cpu.node -> #cpu.processor
+ end;
+ core -> #cpu.core;
+ thread -> #cpu.thread
+ end.
+
+cput_e2i(undefined) ->
+ undefined;
+cput_e2i(E) ->
+ rvrs(cput_e2i(E, -1, -1, #cpu{}, 0, cput_e2i_clvl(E, 0), [])).
+
+cput_e2i([], _NId, _PId, _IS, _PLvl, _Lvl, Res) ->
+ Res;
+cput_e2i([E|Es], NId0, PId, IS, PLvl, Lvl, Res0) ->
+ case cput_e2i(E, NId0, PId, IS, PLvl, Lvl, Res0) of
+ [] ->
+ cput_e2i(Es, NId0, PId, IS, PLvl, Lvl, Res0);
+ [#cpu{node = N,
+ processor = P,
+ processor_node = PN} = CPU|_] = Res1 ->
+ NId1 = case N > PN of
+ true -> N;
+ false -> PN
+ end,
+ cput_e2i(Es, NId1, P, CPU, PLvl, Lvl, Res1)
+ end;
+cput_e2i({Tag, [], TagList}, Nid, PId, CPU, PLvl, Lvl, Res) ->
+ %% Currently [] is the only valid InfoList
+ cput_e2i({Tag, TagList}, Nid, PId, CPU, PLvl, Lvl, Res);
+cput_e2i({node, NL}, Nid0, PId, _CPU, 0, #cpu.node, Res) ->
+ Nid1 = Nid0+1,
+ Lvl = cput_e2i_clvl(NL, #cpu.node),
+ cput_e2i(NL, Nid1, PId, #cpu{node = Nid1}, #cpu.node, Lvl, Res);
+cput_e2i({processor, PL}, Nid, PId0, _CPU, 0, #cpu.node, Res) ->
+ PId1 = PId0+1,
+ Lvl = cput_e2i_clvl(PL, #cpu.processor),
+ cput_e2i(PL, Nid, PId1, #cpu{processor = PId1}, #cpu.processor, Lvl, Res);
+cput_e2i({processor, PL}, Nid, PId0, CPU, PLvl, CLvl, Res)
+ when PLvl < #cpu.processor, CLvl =< #cpu.processor ->
+ PId1 = PId0+1,
+ Lvl = cput_e2i_clvl(PL, #cpu.processor),
+ cput_e2i(PL, Nid, PId1, CPU#cpu{processor = PId1,
+ processor_node = -1,
+ core = -1,
+ thread = -1}, #cpu.processor, Lvl, Res);
+cput_e2i({node, NL}, Nid0, PId, CPU, #cpu.processor, #cpu.processor_node,
+ Res) ->
+ Nid1 = Nid0+1,
+ Lvl = cput_e2i_clvl(NL, #cpu.processor_node),
+ cput_e2i(NL, Nid1, PId, CPU#cpu{processor_node = Nid1},
+ #cpu.processor_node, Lvl, Res);
+cput_e2i({core, CL}, Nid, PId, #cpu{core = C0} = CPU, PLvl, #cpu.core, Res)
+ when PLvl < #cpu.core ->
+ Lvl = cput_e2i_clvl(CL, #cpu.core),
+ cput_e2i(CL, Nid, PId, CPU#cpu{core = C0+1, thread = -1}, #cpu.core, Lvl,
+ Res);
+cput_e2i({thread, TL}, Nid, PId, #cpu{thread = T0} = CPU, PLvl, #cpu.thread,
+ Res) when PLvl < #cpu.thread ->
+ Lvl = cput_e2i_clvl(TL, #cpu.thread),
+ cput_e2i(TL, Nid, PId, CPU#cpu{thread = T0+1}, #cpu.thread, Lvl, Res);
+cput_e2i({logical, ID}, _Nid, PId, #cpu{processor=P, core=C, thread=T} = CPU,
+ PLvl, #cpu.logical, Res)
+ when PLvl < #cpu.logical, is_integer(ID), 0 =< ID, ID < 65536 ->
+ [CPU#cpu{processor = case P of -1 -> PId+1; _ -> P end,
+ core = case C of -1 -> 0; _ -> C end,
+ thread = case T of -1 -> 0; _ -> T end,
+ logical = ID} | Res].
+
+%% erlang:format_cpu_topology/1 is for internal use only!
+%%
+%% erlang:system_info(cpu_topology),
+%% and erlang:system_info({cpu_topology, Which}) traps to
+%% erlang:format_cpu_topology(InternalCpuTopology).
+format_cpu_topology(InternalCpuTopology) ->
+ try cput_i2e(InternalCpuTopology)
+ catch _ : _ -> erlang:error(internal_error, [InternalCpuTopology])
+ end.
+
+
+cput_i2e(undefined) -> undefined;
+cput_i2e(Is) -> cput_i2e(Is, true, #cpu.node, cput_i2e_tag_map()).
+
+cput_i2e([], _Frst, _Lvl, _TM) ->
+ [];
+cput_i2e([#cpu{logical = LID}| _], _Frst, Lvl, _TM) when Lvl == #cpu.logical ->
+ {logical, LID};
+cput_i2e([#cpu{} = I | Is], Frst, Lvl, TM) ->
+ cput_i2e(element(Lvl, I), Frst, Is, [I], Lvl, TM).
+
+cput_i2e(V, Frst, [I | Is], SameV, Lvl, TM) when V =:= element(Lvl, I) ->
+ cput_i2e(V, Frst, Is, [I | SameV], Lvl, TM);
+cput_i2e(-1, true, [], SameV, Lvl, TM) ->
+ cput_i2e(rvrs(SameV), true, Lvl+1, TM);
+cput_i2e(_V, true, [], SameV, Lvl, TM) when Lvl =/= #cpu.processor,
+ Lvl =/= #cpu.processor_node ->
+ cput_i2e(rvrs(SameV), true, Lvl+1, TM);
+cput_i2e(-1, _Frst, Is, SameV, #cpu.node, TM) ->
+ cput_i2e(rvrs(SameV), true, #cpu.processor, TM)
+ ++ cput_i2e(Is, false, #cpu.node, TM);
+cput_i2e(_V, _Frst, Is, SameV, Lvl, TM) ->
+ [{cput_i2e_tag(Lvl, TM), cput_i2e(rvrs(SameV), true, Lvl+1, TM)}
+ | cput_i2e(Is, false, Lvl, TM)].
+
+cput_i2e_tag_map() -> list_to_tuple([cpu | record_info(fields, cpu)]).
+
+cput_i2e_tag(Lvl, TM) ->
+ case element(Lvl, TM) of processor_node -> node; Other -> Other end.
+
+rvrs([_] = L) -> L;
+rvrs(Xs) -> rvrs(Xs, []).
+
+rvrs([],Ys) -> Ys;
+rvrs([X|Xs],Ys) -> rvrs(Xs, [X|Ys]).
+
+%% erlang:await_proc_exit/3 is for internal use only!
+%%
+%% BIFs that need to await a specific process exit before
+%% returning traps to erlang:await_proc_exit/3.
+%%
+%% NOTE: This function is tightly coupled to
+%% the implementation of the
+%% erts_bif_prep_await_proc_exit_*()
+%% functions in bif.c. Do not make
+%% any changes to it without reading
+%% the comment about them in bif.c!
+await_proc_exit(Proc, Op, Data) ->
+ Mon = erlang:monitor(process, Proc),
+ receive
+ {'DOWN', Mon, process, _Proc, Reason} ->
+ case Op of
+ apply ->
+ {M, F, A} = Data,
+ erlang:apply(M, F, A);
+ data ->
+ Data;
+ reason ->
+ Reason
+ end
+ end.
+
+min(A, B) when A > B -> B;
+min(A, _) -> A.
+
+max(A, B) when A < B -> B;
+max(A, _) -> A.
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
new file mode 100644
index 0000000000..c6f4c62f63
--- /dev/null
+++ b/erts/preloaded/src/init.erl
@@ -0,0 +1,1372 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%%
+%% New initial version of init.
+%% Booting from a script. The script is fetched either from
+%% a local file or distributed from another erlang node.
+%%
+%% Flags:
+%% -id Identity : identity of the system.
+%% -boot File : Absolute file name of the boot script.
+%% -boot_var Var Value
+%% : $Var in the boot script is expanded to
+%% Value.
+%% -loader LoaderMethod
+%% : efile, inet, ose_inet
+%% (Optional - default efile)
+%% -hosts [Node] : List of hosts from which we can boot.
+%% (Mandatory if -loader inet or ose_inet)
+%% -mode embedded : Load all modules at startup, no automatic loading
+%% -mode interactive : Auto load modules (default system behaviour).
+%% -path : Override path in bootfile.
+%% -pa Path+ : Add my own paths first.
+%% -pz Path+ : Add my own paths last.
+%% -run : Start own processes.
+%% -s : Start own processes.
+%%
+%% Experimental flags:
+%% -init_debug : Activate debug printouts in init
+%% -loader_debug : Activate debug printouts in erl_prim_loader
+%% -code_path_choice : strict | relaxed
+
+-module(init).
+
+-export([restart/0,reboot/0,stop/0,stop/1,
+ get_status/0,boot/1,get_arguments/0,get_plain_arguments/0,
+ get_argument/1,script_id/0]).
+
+% internal exports
+-export([fetch_loaded/0,ensure_loaded/1,make_permanent/2,
+ notify_when_started/1,wait_until_started/0,
+ objfile_extension/0, archive_extension/0,code_path_choice/0]).
+
+-include_lib("kernel/include/file.hrl").
+
+-type internal_status() :: 'starting' | 'started' | 'stopping'.
+
+-record(state, {flags = [],
+ args = [],
+ start = [],
+ kernel = [] :: [{atom(), pid()}],
+ bootpid :: pid(),
+ status = {starting, starting} :: {internal_status(), term()},
+ script_id = [],
+ loaded = [],
+ subscribed = []}).
+
+-define(ON_LOAD_HANDLER, init__boot__on_load_handler).
+
+debug(false, _) -> ok;
+debug(_, T) -> erlang:display(T).
+
+-spec get_arguments() -> [{atom(), [string()]}].
+get_arguments() ->
+ request(get_arguments).
+
+-spec get_plain_arguments() -> [string()].
+get_plain_arguments() ->
+ bs2ss(request(get_plain_arguments)).
+
+-spec get_argument(atom()) -> 'error' | {'ok', [[string()]]}.
+get_argument(Arg) ->
+ request({get_argument, Arg}).
+
+-spec script_id() -> term().
+script_id() ->
+ request(script_id).
+
+bs2as(L0) when is_list(L0) ->
+ map(fun b2a/1, L0);
+bs2as(L) ->
+ L.
+
+bs2ss(L0) when is_list(L0) ->
+ map(fun b2s/1, L0);
+bs2ss(L) ->
+ L.
+
+-spec get_status() -> {internal_status(), term()}.
+get_status() ->
+ request(get_status).
+
+-spec fetch_loaded() -> [atom()].
+fetch_loaded() ->
+ request(fetch_loaded).
+
+%% Handle dynamic code loading until the
+%% real code_server has been started.
+-spec ensure_loaded(atom()) -> 'not_allowed' | {'module', atom()}.
+ensure_loaded(Module) ->
+ request({ensure_loaded, Module}).
+
+make_permanent(Boot,Config) ->
+ request({make_permanent,Boot,Config}).
+
+-spec notify_when_started(pid()) -> 'ok' | 'started'.
+notify_when_started(Pid) ->
+ request({notify_when_started,Pid}).
+
+-spec wait_until_started() -> 'ok'.
+wait_until_started() ->
+ receive
+ {init,started} -> ok
+ end.
+
+request(Req) ->
+ init ! {self(),Req},
+ receive
+ {init,Rep} ->
+ Rep
+ end.
+
+-spec restart() -> 'ok'.
+restart() -> init ! {stop,restart}, ok.
+
+-spec reboot() -> 'ok'.
+reboot() -> init ! {stop,reboot}, ok.
+
+-spec stop() -> no_return().
+stop() -> init ! {stop,stop}, ok.
+
+-spec stop(non_neg_integer() | string()) -> no_return().
+stop(Status) -> init ! {stop,{stop,Status}}, ok.
+
+-spec boot([binary()]) -> no_return().
+boot(BootArgs) ->
+ register(init, self()),
+ process_flag(trap_exit, true),
+ start_on_load_handler_process(),
+ {Start0,Flags,Args} = parse_boot_args(BootArgs),
+ Start = map(fun prepare_run_args/1, Start0),
+ Flags0 = flags_to_atoms_again(Flags),
+ boot(Start,Flags0,Args).
+
+prepare_run_args({eval, [Expr]}) ->
+ {eval,Expr};
+prepare_run_args({_, L=[]}) ->
+ bs2as(L);
+prepare_run_args({_, L=[_]}) ->
+ bs2as(L);
+prepare_run_args({s, [M,F|Args]}) ->
+ [b2a(M), b2a(F) | bs2as(Args)];
+prepare_run_args({run, [M,F|Args]}) ->
+ [b2a(M), b2a(F) | bs2ss(Args)].
+
+b2a(Bin) when is_binary(Bin) ->
+ list_to_atom(binary_to_list(Bin));
+b2a(A) when is_atom(A) ->
+ A.
+
+b2s(Bin) when is_binary(Bin) ->
+ binary_to_list(Bin);
+b2s(L) when is_list(L) ->
+ L.
+
+map(_F, []) ->
+ [];
+map(F, [X|Rest]) ->
+ [F(X) | map(F, Rest)].
+
+flags_to_atoms_again([]) ->
+ [];
+flags_to_atoms_again([{F0,L0}|Rest]) ->
+ L = L0,
+ F = b2a(F0),
+ [{F,L}|flags_to_atoms_again(Rest)];
+flags_to_atoms_again([{F0}|Rest]) ->
+ F = b2a(F0),
+ [{F}|flags_to_atoms_again(Rest)].
+
+-spec code_path_choice() -> 'relaxed' | 'strict'.
+code_path_choice() ->
+ case get_argument(code_path_choice) of
+ {ok,[["strict"]]} ->
+ strict;
+ {ok,[["relaxed"]]} ->
+ relaxed;
+ _Else ->
+ relaxed
+ end.
+
+boot(Start,Flags,Args) ->
+ BootPid = do_boot(Flags,Start),
+ State = #state{flags = Flags,
+ args = Args,
+ start = Start,
+ bootpid = BootPid},
+ boot_loop(BootPid,State).
+
+%%% Convert a term to a printable string, if possible.
+to_string(X) when is_list(X) -> % assume string
+ F = flatten(X, []),
+ case printable_list(F) of
+ true -> F;
+ false -> ""
+ end;
+to_string(X) when is_atom(X) ->
+ atom_to_list(X);
+to_string(X) when is_pid(X) ->
+ pid_to_list(X);
+to_string(X) when is_float(X) ->
+ float_to_list(X);
+to_string(X) when is_integer(X) ->
+ integer_to_list(X);
+to_string(_X) ->
+ "". % can't do anything with it
+
+%% This is an incorrect and narrow definition of printable characters.
+%% The correct one is in io_lib:printable_list/1
+%%
+printable_list([H|T]) when is_integer(H), H >= 32, H =< 126 ->
+ printable_list(T);
+printable_list([$\n|T]) -> printable_list(T);
+printable_list([$\r|T]) -> printable_list(T);
+printable_list([$\t|T]) -> printable_list(T);
+printable_list([]) -> true;
+printable_list(_) -> false.
+
+flatten([H|T], Tail) when is_list(H) ->
+ flatten(H, flatten(T, Tail));
+flatten([H|T], Tail) ->
+ [H|flatten(T, Tail)];
+flatten([], Tail) ->
+ Tail.
+
+things_to_string([X|Rest]) ->
+ " (" ++ to_string(X) ++ ")" ++ things_to_string(Rest);
+things_to_string([]) ->
+ "".
+
+halt_string(String, List) ->
+ HaltString = String ++ things_to_string(List),
+ if
+ length(HaltString)<199 -> HaltString;
+ true -> first198(HaltString, 198)
+ end.
+
+first198([H|T], N) when N>0 ->
+ [H|first198(T, N-1)];
+first198(_, 0) ->
+ [].
+
+%% String = string()
+%% List = [string() | atom() | pid() | number()]
+%% Any other items in List, such as tuples, are ignored when creating
+%% the string used as argument to erlang:halt/1.
+crash(String, List) ->
+ halt(halt_string(String, List)).
+
+%% Status is {InternalStatus,ProvidedStatus}
+-spec boot_loop(pid(), #state{}) -> no_return().
+boot_loop(BootPid, State) ->
+ receive
+ {BootPid,loaded,ModLoaded} ->
+ Loaded = State#state.loaded,
+ boot_loop(BootPid,State#state{loaded = [ModLoaded|Loaded]});
+ {BootPid,started,KernelPid} ->
+ boot_loop(BootPid, new_kernelpid(KernelPid, BootPid, State));
+ {BootPid,progress,started} ->
+ {InS,_} = State#state.status,
+ notify(State#state.subscribed),
+ boot_loop(BootPid,State#state{status = {InS,started},
+ subscribed = []});
+ {BootPid,progress,NewStatus} ->
+ {InS,_} = State#state.status,
+ boot_loop(BootPid,State#state{status = {InS,NewStatus}});
+ {BootPid,{script_id,Id}} ->
+ boot_loop(BootPid,State#state{script_id = Id});
+ {'EXIT',BootPid,normal} ->
+ {_,PS} = State#state.status,
+ notify(State#state.subscribed),
+ loop(State#state{status = {started,PS},
+ subscribed = []});
+ {'EXIT',BootPid,Reason} ->
+ erlang:display({"init terminating in do_boot",Reason}),
+ crash("init terminating in do_boot", [Reason]);
+ {'EXIT',Pid,Reason} ->
+ Kernel = State#state.kernel,
+ terminate(Pid,Kernel,Reason), %% If Pid is a Kernel pid, halt()!
+ boot_loop(BootPid,State);
+ {stop,Reason} ->
+ stop(Reason,State);
+ {From,fetch_loaded} -> %% Fetch and reset initially loaded modules.
+ case whereis(?ON_LOAD_HANDLER) of
+ undefined ->
+ %% There is no on_load handler process,
+ %% probably because init:restart/0 has been
+ %% called and it is not the first time we
+ %% pass through here.
+ ok;
+ Pid when is_pid(Pid) ->
+ Pid ! run_on_load,
+ receive
+ {'EXIT',Pid,on_load_done} ->
+ ok;
+ {'EXIT',Pid,Res} ->
+ %% Failure to run an on_load handler.
+ %% This is fatal during start-up.
+ exit(Res)
+ end
+ end,
+ From ! {init,State#state.loaded},
+ garb_boot_loop(BootPid,State#state{loaded = []});
+ {From,{ensure_loaded,Module}} ->
+ {Res, Loaded} = ensure_loaded(Module, State#state.loaded),
+ From ! {init,Res},
+ boot_loop(BootPid,State#state{loaded = Loaded});
+ Msg ->
+ boot_loop(BootPid,handle_msg(Msg,State))
+ end.
+
+ensure_loaded(Module, Loaded) ->
+ File = concat([Module,objfile_extension()]),
+ case catch load_mod(Module,File) of
+ {ok, FullName} ->
+ {{module, Module}, [{Module, FullName}|Loaded]};
+ Res ->
+ {Res, Loaded}
+ end.
+
+%% Tell subscribed processes the system has started.
+notify(Pids) ->
+ lists:foreach(fun(Pid) -> Pid ! {init,started} end, Pids).
+
+%% Garbage collect all info about initially loaded modules.
+%% This information is temporary stored until the code_server
+%% is started.
+%% We force the garbage collection as the init process holds
+%% this information during the initialisation of the system and
+%% it will be automatically garbed much later (perhaps not at all
+%% if it is not accessed much).
+
+garb_boot_loop(BootPid,State) ->
+ garbage_collect(),
+ boot_loop(BootPid,State).
+
+new_kernelpid({Name,{ok,Pid}},BootPid,State) when is_pid(Pid) ->
+ link(Pid),
+ BootPid ! {self(),ok,Pid},
+ Kernel = State#state.kernel,
+ State#state{kernel = [{Name,Pid}|Kernel]};
+new_kernelpid({_Name,ignore},BootPid,State) ->
+ BootPid ! {self(),ignore},
+ State;
+new_kernelpid({Name,What},BootPid,State) ->
+ erlang:display({"could not start kernel pid",Name,What}),
+ clear_system(BootPid,State),
+ crash("could not start kernel pid", [Name, What]).
+
+%% Here is the main loop after the system has booted.
+
+loop(State) ->
+ receive
+ {'EXIT',Pid,Reason} ->
+ Kernel = State#state.kernel,
+ terminate(Pid,Kernel,Reason), %% If Pid is a Kernel pid, halt()!
+ loop(State);
+ {stop,Reason} ->
+ stop(Reason,State);
+ {From,fetch_loaded} -> %% The Loaded info is cleared in
+ Loaded = State#state.loaded, %% boot_loop but is handled here
+ From ! {init,Loaded}, %% anyway.
+ loop(State);
+ {From, {ensure_loaded, _}} ->
+ From ! {init, not_allowed},
+ loop(State);
+ Msg ->
+ loop(handle_msg(Msg,State))
+ end.
+
+handle_msg(Msg,State0) ->
+ case catch do_handle_msg(Msg,State0) of
+ {new_state,State} -> State;
+ _ -> State0
+ end.
+
+do_handle_msg(Msg,State) ->
+ #state{flags = Flags,
+ status = Status,
+ script_id = Sid,
+ args = Args,
+ subscribed = Subscribed} = State,
+ case Msg of
+ {From,get_plain_arguments} ->
+ From ! {init,Args};
+ {From,get_arguments} ->
+ From ! {init,get_arguments(Flags)};
+ {From,{get_argument,Arg}} ->
+ From ! {init,get_argument(Arg,Flags)};
+ {From,get_status} ->
+ From ! {init,Status};
+ {From,script_id} ->
+ From ! {init,Sid};
+ {From,{make_permanent,Boot,Config}} ->
+ {Res,State1} = make_permanent(Boot,Config,Flags,State),
+ From ! {init,Res},
+ {new_state,State1};
+ {From,{notify_when_started,Pid}} ->
+ case Status of
+ {InS,PS} when InS =:= started ; PS =:= started ->
+ From ! {init,started};
+ _ ->
+ From ! {init,ok},
+ {new_state,State#state{subscribed = [Pid|Subscribed]}}
+ end;
+ X ->
+ case whereis(user) of
+ undefined ->
+ catch error_logger ! {info, self(), {self(), X, []}};
+ User ->
+ User ! X,
+ ok
+ end
+ end.
+
+%%% -------------------------------------------------
+%%% A new release has been installed and made
+%%% permanent.
+%%% Both restart/0 and reboot/0 shall startup using
+%%% the new release. reboot/0 uses new boot script
+%%% and configuration file pointed out externally.
+%%% In the restart case we have to set new -boot and
+%%% -config arguments.
+%%% -------------------------------------------------
+
+make_permanent(Boot,Config,Flags0,State) ->
+ case set_flag('-boot',Boot,Flags0) of
+ {ok,Flags1} ->
+ case set_flag('-config',Config,Flags1) of
+ {ok,Flags} ->
+ {ok,State#state{flags = Flags}};
+ Error ->
+ {Error,State}
+ end;
+ Error ->
+ {Error,State}
+ end.
+
+set_flag(_Flag,false,Flags) ->
+ {ok,Flags};
+set_flag(Flag,Value,Flags) when is_list(Value) ->
+ case catch list_to_binary(Value) of
+ {'EXIT',_} ->
+ {error,badarg};
+ AValue ->
+ {ok,set_argument(Flags,Flag,AValue)}
+ end;
+set_flag(_,_,_) ->
+ {error,badarg}.
+
+%%% -------------------------------------------------
+%%% Stop the system.
+%%% Reason is: restart | reboot | stop
+%%% According to reason terminate emulator or restart
+%%% system using the same init process again.
+%%% -------------------------------------------------
+
+stop(Reason,State) ->
+ BootPid = State#state.bootpid,
+ {_,Progress} = State#state.status,
+ State1 = State#state{status = {stopping, Progress}},
+ clear_system(BootPid,State1),
+ do_stop(Reason,State1).
+
+do_stop(restart,#state{start = Start, flags = Flags, args = Args}) ->
+ boot(Start,Flags,Args);
+do_stop(reboot,_) ->
+ halt();
+do_stop(stop,State) ->
+ stop_heart(State),
+ halt();
+do_stop({stop,Status},State) ->
+ stop_heart(State),
+ halt(Status).
+
+clear_system(BootPid,State) ->
+ Heart = get_heart(State#state.kernel),
+ shutdown_pids(Heart,BootPid,State),
+ unload(Heart).
+
+stop_heart(State) ->
+ case get_heart(State#state.kernel) of
+ false ->
+ ok;
+ Pid ->
+ %% As heart survives a restart the Parent of heart is init.
+ BootPid = self(),
+ %% ignore timeout
+ shutdown_kernel_pid(Pid, BootPid, self(), State)
+ end.
+
+shutdown_pids(Heart,BootPid,State) ->
+ Timer = shutdown_timer(State#state.flags),
+ catch shutdown(State#state.kernel,BootPid,Timer,State),
+ kill_all_pids(Heart), % Even the shutdown timer.
+ kill_all_ports(Heart),
+ flush_timout(Timer).
+
+get_heart([{heart,Pid}|_Kernel]) -> Pid;
+get_heart([_|Kernel]) -> get_heart(Kernel);
+get_heart(_) -> false.
+
+
+shutdown([{heart,_Pid}|Kernel],BootPid,Timer,State) ->
+ shutdown(Kernel, BootPid, Timer, State);
+shutdown([{_Name,Pid}|Kernel],BootPid,Timer,State) ->
+ shutdown_kernel_pid(Pid, BootPid, Timer, State),
+ shutdown(Kernel,BootPid,Timer,State);
+shutdown(_,_,_,_) ->
+ true.
+
+
+%%
+%% A kernel pid must handle the special case message
+%% {'EXIT',Parent,Reason} and terminate upon it!
+%%
+shutdown_kernel_pid(Pid, BootPid, Timer, State) ->
+ Pid ! {'EXIT',BootPid,shutdown},
+ shutdown_loop(Pid, Timer, State, []).
+
+%%
+%% We have to handle init requests here in case a process
+%% performs such a request and cannot shutdown (deadlock).
+%% Keep all other EXIT messages in case it was another
+%% kernel process. Resend these messages and handle later.
+%%
+shutdown_loop(Pid,Timer,State,Exits) ->
+ receive
+ {'EXIT',Pid,_} ->
+ resend(reverse(Exits)),
+ ok;
+ {Timer,timeout} ->
+ erlang:display({init,shutdown_timeout}),
+ throw(timeout);
+ {stop,_} ->
+ shutdown_loop(Pid,Timer,State,Exits);
+ {From,fetch_loaded} ->
+ From ! {init,State#state.loaded},
+ shutdown_loop(Pid,Timer,State,Exits);
+ {'EXIT',OtherP,Reason} ->
+ shutdown_loop(Pid,Timer,State,
+ [{'EXIT',OtherP,Reason}|Exits]);
+ Msg ->
+ State1 = handle_msg(Msg,State),
+ shutdown_loop(Pid,Timer,State1,Exits)
+ end.
+
+resend([ExitMsg|Exits]) ->
+ self() ! ExitMsg,
+ resend(Exits);
+resend(_) ->
+ ok.
+
+%%
+%% Kill all existing pids in the system (except init and heart).
+kill_all_pids(Heart) ->
+ case get_pids(Heart) of
+ [] ->
+ ok;
+ Pids ->
+ kill_em(Pids),
+ kill_all_pids(Heart) % Continue until all are really killed.
+ end.
+
+%% All except zombies.
+alive_processes() ->
+ [P || P <- processes(), erlang:is_process_alive(P)].
+
+get_pids(Heart) ->
+ Pids = alive_processes(),
+ delete(Heart,self(),Pids).
+
+delete(Heart,Init,[Heart|Pids]) -> delete(Heart,Init,Pids);
+delete(Heart,Init,[Init|Pids]) -> delete(Heart,Init,Pids);
+delete(Heart,Init,[Pid|Pids]) -> [Pid|delete(Heart,Init,Pids)];
+delete(_,_,[]) -> [].
+
+kill_em([Pid|Pids]) ->
+ exit(Pid,kill),
+ kill_em(Pids);
+kill_em([]) ->
+ ok.
+
+%%
+%% Kill all existing ports in the system (except the heart port),
+%% i.e. ports still existing after all processes have been killed.
+%%
+%% System ports like the async driver port will nowadays be immortal;
+%% therefore, it is ok to send them exit signals...
+%%
+kill_all_ports(Heart) ->
+ kill_all_ports(Heart,erlang:ports()).
+
+kill_all_ports(Heart,[P|Ps]) ->
+ case erlang:port_info(P,connected) of
+ {connected,Heart} ->
+ kill_all_ports(Heart,Ps);
+ _ ->
+ exit(P,kill),
+ kill_all_ports(Heart,Ps)
+ end;
+kill_all_ports(_,_) ->
+ ok.
+
+unload(false) ->
+ do_unload(sub(erlang:pre_loaded(),erlang:loaded()));
+unload(_) ->
+ do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())).
+
+do_unload([M|Mods]) ->
+ catch erlang:purge_module(M),
+ catch erlang:delete_module(M),
+ catch erlang:purge_module(M),
+ do_unload(Mods);
+do_unload([]) ->
+ ok.
+
+sub([H|T],L) -> sub(T,del(H,L));
+sub([],L) -> L.
+
+del(Item, [Item|T]) -> T;
+del(Item, [H|T]) -> [H|del(Item, T)];
+del(_Item, []) -> [].
+
+%%% -------------------------------------------------
+%%% If the terminated Pid is one of the processes
+%%% added to the Kernel, take down the system brutally.
+%%% We are not sure that ANYTHING can work anymore,
+%%% i.e. halt the system.
+%%% Sleep awhile, it is thus possible for the
+%%% error_logger (if it is still alive) to write errors
+%%% using the simplest method.
+%%% -------------------------------------------------
+
+terminate(Pid,Kernel,Reason) ->
+ case kernel_pid(Pid,Kernel) of
+ {ok,Name} ->
+ sleep(500), %% Flush error printouts!
+ erlang:display({"Kernel pid terminated",Name,Reason}),
+ crash("Kernel pid terminated", [Name, Reason]);
+ _ ->
+ false
+ end.
+
+kernel_pid(Pid,[{Name,Pid}|_]) ->
+ {ok,Name};
+kernel_pid(Pid,[_|T]) ->
+ kernel_pid(Pid,T);
+kernel_pid(_,_) ->
+ false.
+
+sleep(T) -> receive after T -> ok end.
+
+%%% -------------------------------------------------
+%%% Start the loader.
+%%% The loader shall run for ever!
+%%% -------------------------------------------------
+
+start_prim_loader(Init,Id,Pgm,Nodes,Path,{Pa,Pz}) ->
+ case erl_prim_loader:start(Id,Pgm,Nodes) of
+ {ok,Pid} when Path =:= false ->
+ InitPath = append(Pa,["."|Pz]),
+ erl_prim_loader:set_path(InitPath),
+ add_to_kernel(Init,Pid),
+ Pid;
+ {ok,Pid} ->
+ erl_prim_loader:set_path(Path),
+ add_to_kernel(Init,Pid),
+ Pid;
+ {error,Reason} ->
+ erlang:display({"cannot start loader",Reason}),
+ exit(Reason)
+ end.
+
+add_to_kernel(Init,Pid) ->
+ Init ! {self(),started,{erl_prim_loader,{ok,Pid}}},
+ receive
+ {Init,ok,Pid} ->
+ unlink(Pid),
+ ok
+ end.
+
+prim_load_flags(Flags) ->
+ PortPgm = get_flag('-loader',Flags,<<"efile">>),
+ Hosts = get_flag_list('-hosts', Flags, []),
+ Id = get_flag('-id',Flags,none),
+ Path = get_flag_list('-path',Flags,false),
+ {PortPgm, Hosts, Id, Path}.
+
+%%% -------------------------------------------------
+%%% The boot process fetches a boot script and loads
+%%% all modules specified and starts spec. processes.
+%%% Processes specified with -s or -run are finally started.
+%%% -------------------------------------------------
+
+do_boot(Flags,Start) ->
+ Self = self(),
+ spawn_link(fun() -> do_boot(Self,Flags,Start) end).
+
+do_boot(Init,Flags,Start) ->
+ process_flag(trap_exit,true),
+ {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags),
+ Root = b2s(get_flag('-root',Flags)),
+ PathFls = path_flags(Flags),
+ Pgm = b2s(Pgm0),
+ _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes),
+ bs2ss(Path),PathFls),
+ BootFile = bootfile(Flags,Root),
+ BootList = get_boot(BootFile,Root),
+ LoadMode = b2a(get_flag('-mode',Flags,false)),
+ Deb = b2a(get_flag('-init_debug',Flags,false)),
+ BootVars = get_flag_args('-boot_var',Flags),
+ ParallelLoad =
+ (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0),
+
+ PathChoice = code_path_choice(),
+ eval_script(BootList,Init,PathFls,{Root,BootVars},Path,
+ {true,LoadMode,ParallelLoad},Deb,PathChoice),
+
+ %% To help identifying Purify windows that pop up,
+ %% print the node name into the Purify log.
+ (catch erlang:system_info({purify, "Node: " ++ atom_to_list(node())})),
+
+ start_em(Start).
+
+bootfile(Flags,Root) ->
+ b2s(get_flag('-boot',Flags,concat([Root,"/bin/start"]))).
+
+path_flags(Flags) ->
+ Pa = append(reverse(get_flag_args('-pa',Flags))),
+ Pz = append(get_flag_args('-pz',Flags)),
+ {bs2ss(Pa),bs2ss(Pz)}.
+
+get_boot(BootFile0,Root) ->
+ BootFile = concat([BootFile0,".boot"]),
+ case get_boot(BootFile) of
+ {ok, CmdList} ->
+ CmdList;
+ not_found -> %% Check for default.
+ BootF = concat([Root,"/bin/",BootFile]),
+ case get_boot(BootF) of
+ {ok, CmdList} ->
+ CmdList;
+ not_found ->
+ exit({'cannot get bootfile',list_to_atom(BootFile)});
+ _ ->
+ exit({'bootfile format error',list_to_atom(BootF)})
+ end;
+ _ ->
+ exit({'bootfile format error',list_to_atom(BootFile)})
+ end.
+
+get_boot(BootFile) ->
+ case erl_prim_loader:get_file(BootFile) of
+ {ok,Bin,_} ->
+ case binary_to_term(Bin) of
+ {script,Id,CmdList} when is_list(CmdList) ->
+ init ! {self(),{script_id,Id}}, % ;-)
+ {ok, CmdList};
+ _ ->
+ error
+ end;
+ _ ->
+ not_found
+ end.
+
+%%
+%% Eval a boot script.
+%% Load modules and start processes.
+%% If a start command does not spawn a new process the
+%% boot process hangs (we want to ensure syncronicity).
+%%
+
+eval_script([{progress,Info}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
+ debug(Deb,{progress,Info}),
+ init ! {self(),progress,Info},
+ eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
+eval_script([{preLoaded,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
+ eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
+eval_script([{path,Path}|CfgL],Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice) ->
+ RealPath0 = make_path(Pa, Pz, Path, Vars),
+ RealPath = patch_path(RealPath0, PathChoice),
+ erl_prim_loader:set_path(RealPath),
+ eval_script(CfgL,Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice);
+eval_script([{path,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
+ %% Ignore, use the command line -path flag.
+ eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
+eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,embedded,Par},Deb,PathChoice) ->
+ eval_script(CfgL,Init,PathFs,Vars,P,{true,embedded,Par},Deb,PathChoice);
+eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,E,Par},Deb,PathChoice) ->
+ eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice);
+eval_script([{primLoad,Mods}|CfgL],Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice)
+ when is_list(Mods) ->
+ if
+ Par =:= true ->
+ par_load_modules(Mods,Init);
+ true ->
+ load_modules(Mods)
+ end,
+ eval_script(CfgL,Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice);
+eval_script([{primLoad,_Mods}|CfgL],Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice) ->
+ %% Do not load now, code_server does that dynamically!
+ eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice);
+eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|CfgL],Init,
+ PathFs,Vars,P,Ph,Deb,PathChoice) ->
+ debug(Deb,{start,Server}),
+ start_in_kernel(Server,Mod,Fun,Args,Init),
+ eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
+eval_script([{apply,{Mod,Fun,Args}}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) ->
+ debug(Deb,{apply,{Mod,Fun,Args}}),
+ apply(Mod,Fun,Args),
+ eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice);
+eval_script([],_,_,_,_,_,_,_) ->
+ ok;
+eval_script(What,_,_,_,_,_,_,_) ->
+ exit({'unexpected command in bootfile',What}).
+
+load_modules([Mod|Mods]) ->
+ File = concat([Mod,objfile_extension()]),
+ {ok,Full} = load_mod(Mod,File),
+ init ! {self(),loaded,{Mod,Full}}, %% Tell init about loaded module
+ load_modules(Mods);
+load_modules([]) ->
+ ok.
+
+%%% An optimization: erl_prim_loader gets the chance of loading many
+%%% files in parallel, using threads. This will reduce the seek times,
+%%% and loaded code can be processed while other threads are waiting
+%%% for the disk. The optimization is not tried unless the loader is
+%%% "efile" and there is a non-empty pool of threads.
+%%%
+%%% Many threads are needed to get a good result, so it would be
+%%% beneficial to load several applications in parallel. However,
+%%% measurements show that the file system handles one directory at a
+%%% time, regardless if parallel threads are created for files on
+%%% several directories (a guess: writing the meta information when
+%%% the file was last read ('mtime'), forces the file system to sync
+%%% between directories).
+
+par_load_modules(Mods,Init) ->
+ Ext = objfile_extension(),
+ ModFiles = [{Mod,concat([Mod,Ext])} || Mod <- Mods,
+ not erlang:module_loaded(Mod)],
+ Self = self(),
+ Fun = fun(Mod, BinCode, FullName) ->
+ case catch load_mod_code(Mod, BinCode, FullName) of
+ {ok, _} ->
+ Init ! {Self,loaded,{Mod,FullName}},
+ ok;
+ _EXIT ->
+ {error, Mod}
+ end
+ end,
+ case erl_prim_loader:get_files(ModFiles, Fun) of
+ ok ->
+ ok;
+ {error,Mod} ->
+ exit({'cannot load',Mod,get_files})
+ end.
+
+make_path(Pa, Pz, Path, Vars) ->
+ append([Pa,append([fix_path(Path,Vars),Pz])]).
+
+%% For all Paths starting with $ROOT add rootdir and for those
+%% starting with $xxx/, expand $xxx to the value supplied with -boot_var!
+%% If $xxx cannot be expanded this process terminates.
+
+fix_path([Path|Ps], Vars) when is_atom(Path) ->
+ [add_var(atom_to_list(Path), Vars)|fix_path(Ps, Vars)];
+fix_path([Path|Ps], Vars) ->
+ [add_var(Path, Vars)|fix_path(Ps, Vars)];
+fix_path(_, _) ->
+ [].
+
+add_var("$ROOT/" ++ Path, {Root,_}) ->
+ concat([Root, "/", Path]);
+add_var([$$|Path0], {_,VarList}) ->
+ {Var,Path} = extract_var(Path0,[]),
+ Value = b2s(get_var_value(list_to_binary(Var),VarList)),
+ concat([Value, "/", Path]);
+add_var(Path, _) ->
+ Path.
+
+extract_var([$/|Path],Var) -> {reverse(Var),Path};
+extract_var([H|T],Var) -> extract_var(T,[H|Var]);
+extract_var([],Var) -> {reverse(Var),[]}.
+
+%% get_var_value(Var, [Vars]) where Vars == [atom()]
+get_var_value(Var,[Vars|VarList]) ->
+ case get_var_val(Var,Vars) of
+ {ok, Value} ->
+ Value;
+ _ ->
+ get_var_value(Var,VarList)
+ end;
+get_var_value(Var,[]) ->
+ exit(list_to_atom(concat(["cannot expand \$", Var, " in bootfile"]))).
+
+get_var_val(Var,[Var,Value|_]) -> {ok, Value};
+get_var_val(Var,[_,_|Vars]) -> get_var_val(Var,Vars);
+get_var_val(_,_) -> false.
+
+patch_path(Dirs, strict) ->
+ Dirs;
+patch_path(Dirs, relaxed) ->
+ ArchiveExt = archive_extension(),
+ [patch_dir(Dir, ArchiveExt) || Dir <- Dirs].
+
+patch_dir(Orig, ArchiveExt) ->
+ case funny_split(Orig, $/) of
+ ["nibe", RevApp, RevArchive | RevTop] ->
+ App = reverse(RevApp),
+ case funny_splitwith(RevArchive, $.) of
+ {Ext, Base} when Ext =:= ArchiveExt, Base =:= App ->
+ %% Orig archive
+ Top = reverse([reverse(C) || C <- RevTop]),
+ Dir = join(Top ++ [App, "ebin"], "/"),
+ Archive = Orig;
+ _ ->
+ %% Orig directory
+ Top = reverse([reverse(C) || C <- [RevArchive | RevTop]]),
+ Archive = join(Top ++ [App ++ ArchiveExt, App, "ebin"], "/"),
+ Dir = Orig
+ end,
+ %% First try dir, second try archive and at last use orig if both fails
+ case erl_prim_loader:read_file_info(Dir) of
+ {ok, #file_info{type = directory}} ->
+ Dir;
+ _ ->
+ case erl_prim_loader:read_file_info(Archive) of
+ {ok, #file_info{type = directory}} ->
+ Archive;
+ _ ->
+ Orig
+ end
+ end;
+ _ ->
+ Orig
+ end.
+
+%% Returns all lists in reverse order
+funny_split(List, Sep) ->
+ funny_split(List, Sep, [], []).
+
+funny_split([Sep | Tail], Sep, Path, Paths) ->
+ funny_split(Tail, Sep, [], [Path | Paths]);
+funny_split([Head | Tail], Sep, Path, Paths) ->
+ funny_split(Tail, Sep, [Head | Path], Paths);
+funny_split([], _Sep, Path, Paths) ->
+ [Path | Paths].
+
+%% Returns {BeforeSep, AfterSep} where BeforeSep is in reverse order
+funny_splitwith(List, Sep) ->
+ funny_splitwith(List, Sep, [], List).
+
+funny_splitwith([Sep | Tail], Sep, Acc, _Orig) ->
+ {Acc, Tail};
+funny_splitwith([Head | Tail], Sep, Acc, Orig) ->
+ funny_splitwith(Tail, Sep, [Head | Acc], Orig);
+funny_splitwith([], _Sep, _Acc, Orig) ->
+ {[], Orig}.
+
+-spec join([string()], string()) -> string().
+join([H1, H2 | T], S) ->
+ H1 ++ S ++ join([H2 | T], S);
+join([H], _) ->
+ H.
+
+%% Servers that are located in the init kernel are linked
+%% and supervised by init.
+
+start_in_kernel(Server,Mod,Fun,Args,Init) ->
+ Res = apply(Mod,Fun,Args),
+ Init ! {self(),started,{Server,Res}},
+ receive
+ {Init,ok,Pid} ->
+ unlink(Pid), %% Just for sure...
+ ok;
+ {Init,ignore} ->
+ ignore
+ end.
+
+%% Do start all processes specified at command line using -s!
+%% Use apply here instead of spawn to ensure syncronicity for
+%% those servers that wish to have it so.
+%% Disadvantage: anything started with -s that does not
+%% eventually spawn will hang the startup routine.
+
+%% We also handle -eval here. The argument is an arbitrary
+%% expression that should be parsed and evaluated.
+
+start_em([S|Tail]) ->
+ case whereis(user) of
+ undefined ->
+ ok;
+ P when is_pid(P) -> %Let's set the group_leader()
+ erlang:group_leader(P, self())
+ end,
+ start_it(S),
+ start_em(Tail);
+start_em([]) -> ok.
+
+start_it([]) ->
+ ok;
+start_it({eval,Bin}) ->
+ Str = binary_to_list(Bin),
+ {ok,Ts,_} = erl_scan:string(Str),
+ Ts1 = case reverse(Ts) of
+ [{dot,_}|_] -> Ts;
+ TsR -> reverse([{dot,1} | TsR])
+ end,
+ {ok,Expr} = erl_parse:parse_exprs(Ts1),
+ erl_eval:exprs(Expr, []),
+ ok;
+start_it([_|_]=MFA) ->
+ Ref = make_ref(),
+ case catch {Ref,case MFA of
+ [M] -> M:start();
+ [M,F] -> M:F();
+ [M,F|Args] -> M:F(Args) % Args is a list
+ end} of
+ {Ref,R} ->
+ R;
+ {'EXIT',Reason} ->
+ exit(Reason);
+ Other ->
+ throw(Other)
+ end.
+
+%%
+%% Fetch a module and load it into the system.
+%%
+load_mod(Mod, File) ->
+ case erlang:module_loaded(Mod) of
+ false ->
+ case erl_prim_loader:get_file(File) of
+ {ok,BinCode,FullName} ->
+ load_mod_code(Mod, BinCode, FullName);
+ _ ->
+ exit({'cannot load',Mod,get_file})
+ end;
+ _ -> % Already loaded.
+ {ok,File}
+ end.
+
+load_mod_code(Mod, BinCode, FullName) ->
+ case erlang:module_loaded(Mod) of
+ false ->
+ case erlang:load_module(Mod, BinCode) of
+ {module,Mod} -> {ok,FullName};
+ {error,on_load} ->
+ ?ON_LOAD_HANDLER ! {loaded,Mod},
+ {ok,FullName};
+ Other ->
+ exit({'cannot load',Mod,Other})
+ end;
+ _ -> % Already loaded.
+ {ok,FullName}
+ end.
+
+%% --------------------------------------------------------
+%% If -shutdown_time is specified at the command line
+%% this timer will inform the init process that it has to
+%% force processes to terminate. It cannot be handled
+%% softly any longer.
+%% --------------------------------------------------------
+
+shutdown_timer(Flags) ->
+ case get_flag('-shutdown_time',Flags,infinity) of
+ infinity ->
+ self();
+ Time ->
+ case catch list_to_integer(binary_to_list(Time)) of
+ T when is_integer(T) ->
+ Pid = spawn(fun() -> timer(T) end),
+ receive
+ {Pid, started} ->
+ Pid
+ end;
+ _ ->
+ self()
+ end
+ end.
+
+flush_timout(Pid) ->
+ receive
+ {Pid, timeout} -> true
+ after 0 -> true
+ end.
+
+timer(T) ->
+ init ! {self(), started},
+ receive
+ after T ->
+ init ! {self(), timeout}
+ end.
+
+%% --------------------------------------------------------
+%% Parse the command line arguments and extract things to start, flags
+%% and other arguments. We keep the relative of the groups.
+%% --------------------------------------------------------
+
+parse_boot_args(Args) ->
+ parse_boot_args(Args, [], [], []).
+
+parse_boot_args([B|Bs], Ss, Fs, As) ->
+ case check(B) of
+ start_extra_arg ->
+ {reverse(Ss),reverse(Fs),lists:reverse(As, Bs)}; % BIF
+ start_arg ->
+ {S,Rest} = get_args(Bs, []),
+ parse_boot_args(Rest, [{s, S}|Ss], Fs, As);
+ start_arg2 ->
+ {S,Rest} = get_args(Bs, []),
+ parse_boot_args(Rest, [{run, S}|Ss], Fs, As);
+ eval_arg ->
+ {Expr,Rest} = get_args(Bs, []),
+ parse_boot_args(Rest, [{eval, Expr}|Ss], Fs, As);
+ flag ->
+ {F,Rest} = get_args(Bs, []),
+ Fl = case F of
+ [] -> [B];
+ FF -> [B,FF]
+ end,
+ parse_boot_args(Rest, Ss,
+ [list_to_tuple(Fl)|Fs], As);
+ arg ->
+ parse_boot_args(Bs, Ss, Fs, [B|As]);
+ end_args ->
+ parse_boot_args(Bs, Ss, Fs, As)
+ end;
+parse_boot_args([], Start, Flags, Args) ->
+ {reverse(Start),reverse(Flags),reverse(Args)}.
+
+check(<<"-extra">>) -> start_extra_arg;
+check(<<"-s">>) -> start_arg;
+check(<<"-run">>) -> start_arg2;
+check(<<"-eval">>) -> eval_arg;
+check(<<"--">>) -> end_args;
+check(X) when is_binary(X) ->
+ case binary_to_list(X) of
+ [$-|_Rest] -> flag;
+ _Chars -> arg %Even empty atoms
+ end;
+check(_X) -> arg. %This should never occur
+
+get_args([B|Bs], As) ->
+ case check(B) of
+ start_extra_arg -> {reverse(As), [B|Bs]};
+ start_arg -> {reverse(As), [B|Bs]};
+ start_arg2 -> {reverse(As), [B|Bs]};
+ eval_arg -> {reverse(As), [B|Bs]};
+ end_args -> {reverse(As), Bs};
+ flag -> {reverse(As), [B|Bs]};
+ arg ->
+ get_args(Bs, [B|As])
+ end;
+get_args([], As) -> {reverse(As),[]}.
+
+%%
+%% Internal get_flag function, with default value.
+%% Return: true if flag given without args
+%% atom() if a single arg was given.
+%% list(atom()) if several args were given.
+%%
+get_flag(F,Flags,Default) ->
+ case catch get_flag(F,Flags) of
+ {'EXIT',_} ->
+ Default;
+ Value ->
+ Value
+ end.
+
+get_flag(F,Flags) ->
+ case search(F,Flags) of
+ {value,{F,[V]}} ->
+ V;
+ {value,{F,V}} ->
+ V;
+ {value,{F}} -> % Flag given!
+ true;
+ _ ->
+ exit(list_to_atom(concat(["no ",F," flag"])))
+ end.
+
+%%
+%% Internal get_flag function, with default value.
+%% Return: list(atom())
+%%
+get_flag_list(F,Flags,Default) ->
+ case catch get_flag_list(F,Flags) of
+ {'EXIT',_} ->
+ Default;
+ Value ->
+ Value
+ end.
+
+get_flag_list(F,Flags) ->
+ case search(F,Flags) of
+ {value,{F,V}} ->
+ V;
+ _ ->
+ exit(list_to_atom(concat(["no ",F," flag"])))
+ end.
+
+%%
+%% Internal get_flag function.
+%% Fetch all occurrences of flag.
+%% Return: [Args,Args,...] where Args ::= list(atom())
+%%
+get_flag_args(F,Flags) -> get_flag_args(F,Flags,[]).
+
+get_flag_args(F,[{F,V}|Flags],Acc) when is_list(V) ->
+ get_flag_args(F,Flags,[V|Acc]);
+get_flag_args(F,[{F,V}|Flags],Acc) ->
+ get_flag_args(F,Flags,[[V]|Acc]);
+get_flag_args(F,[_|Flags],Acc) ->
+ get_flag_args(F,Flags,Acc);
+get_flag_args(_,[],Acc) ->
+ reverse(Acc).
+
+get_arguments([{F,V}|Flags]) ->
+ [$-|Fl] = atom_to_list(F),
+ [{list_to_atom(Fl),to_strings(V)}|get_arguments(Flags)];
+get_arguments([{F}|Flags]) ->
+ [$-|Fl] = atom_to_list(F),
+ [{list_to_atom(Fl),[]}|get_arguments(Flags)];
+get_arguments([]) ->
+ [].
+
+to_strings([H|T]) when is_atom(H) -> [atom_to_list(H)|to_strings(T)];
+to_strings([H|T]) when is_binary(H) -> [binary_to_list(H)|to_strings(T)];
+to_strings([]) -> [].
+
+get_argument(Arg,Flags) ->
+ Args = get_arguments(Flags),
+ case get_argument1(Arg,Args) of
+ [] ->
+ error;
+ Value ->
+ {ok,Value}
+ end.
+
+get_argument1(Arg,[{Arg,V}|Args]) ->
+ [V|get_argument1(Arg,Args)];
+get_argument1(Arg,[_|Args]) ->
+ get_argument1(Arg,Args);
+get_argument1(_,[]) ->
+ [].
+
+set_argument([{Flag,_}|Flags],Flag,Value) ->
+ [{Flag,[Value]}|Flags];
+set_argument([{Flag}|Flags],Flag,Value) ->
+ [{Flag,[Value]}|Flags];
+set_argument([Item|Flags],Flag,Value) ->
+ [Item|set_argument(Flags,Flag,Value)];
+set_argument([],Flag,Value) ->
+ [{Flag,[Value]}].
+
+concat([A|T]) when is_atom(A) ->
+ atom_to_list(A) ++ concat(T);
+concat([C|T]) when is_integer(C), 0 =< C, C =< 255 ->
+ [C|concat(T)];
+concat([Bin|T]) when is_binary(Bin) ->
+ binary_to_list(Bin) ++ concat(T);
+concat([S|T]) ->
+ S ++ concat(T);
+concat([]) ->
+ [].
+
+append(L, Z) -> L ++ Z.
+
+append([E]) -> E;
+append([H|T]) ->
+ H ++ append(T);
+append([]) -> [].
+
+reverse([] = L) ->
+ L;
+reverse([_] = L) ->
+ L;
+reverse([A, B]) ->
+ [B, A];
+reverse([A, B | L]) ->
+ lists:reverse(L, [B, A]). % BIF
+
+search(Key, [H|_T]) when is_tuple(H), element(1, H) =:= Key ->
+ {value, H};
+search(Key, [_|T]) ->
+ search(Key, T);
+search(_Key, []) ->
+ false.
+
+-spec objfile_extension() -> nonempty_string().
+objfile_extension() ->
+ ".beam".
+%% case erlang:system_info(machine) of
+%% "JAM" -> ".jam";
+%% "VEE" -> ".vee";
+%% "BEAM" -> ".beam"
+%% end.
+
+-spec archive_extension() -> nonempty_string().
+archive_extension() ->
+ ".ez".
+
+%%%
+%%% Support for handling of on_load functions.
+%%%
+
+start_on_load_handler_process() ->
+ register(?ON_LOAD_HANDLER,
+ spawn_link(fun on_load_handler_init/0)).
+
+on_load_handler_init() ->
+ on_load_loop([]).
+
+on_load_loop(Mods) ->
+ receive
+ {loaded,Mod} ->
+ on_load_loop([Mod|Mods]);
+ run_on_load ->
+ run_on_load_handlers(Mods),
+ exit(on_load_done)
+ end.
+
+run_on_load_handlers([M|Ms]) ->
+ Fun = fun() ->
+ Res = erlang:call_on_load_function(M),
+ exit(Res)
+ end,
+ {Pid,Ref} = spawn_monitor(Fun),
+ receive
+ {'DOWN',Ref,process,Pid,OnLoadRes} ->
+ Keep = if
+ is_boolean(OnLoadRes) -> OnLoadRes;
+ true -> false
+ end,
+ erlang:finish_after_on_load(M, Keep),
+ case Keep of
+ false ->
+ exit({on_load_function_failed,M});
+ true ->
+ run_on_load_handlers(Ms)
+ end
+ end;
+run_on_load_handlers([]) -> ok.
diff --git a/erts/preloaded/src/otp_ring0.erl b/erts/preloaded/src/otp_ring0.erl
new file mode 100644
index 0000000000..3b0d562d1f
--- /dev/null
+++ b/erts/preloaded/src/otp_ring0.erl
@@ -0,0 +1,35 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(otp_ring0).
+
+%% Purpose : Start up of erlang system.
+
+-export([start/2]).
+
+start(_Env, Argv) ->
+ run(init, boot, Argv).
+
+run(M, F, A) ->
+ case erlang:function_exported(M, F, 1) of
+ false ->
+ erlang:display({fatal,error,module,M,"does not export",F,"/1"}),
+ halt(1);
+ true ->
+ M:F(A)
+ end.
diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl
new file mode 100644
index 0000000000..43e6f6cd88
--- /dev/null
+++ b/erts/preloaded/src/prim_file.erl
@@ -0,0 +1,1168 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(prim_file).
+
+%% Interface module to the file driver.
+
+
+
+%%% Interface towards a single file's contents. Uses ?FD_DRV.
+
+%% Generic file contents operations
+-export([open/2, close/1, sync/1, position/2, truncate/1,
+ write/2, pwrite/2, pwrite/3, read/2, read_line/1, pread/2, pread/3, copy/3]).
+
+%% Specialized file operations
+-export([open/1, open/3]).
+-export([read_file/1, read_file/2, write_file/2]).
+-export([ipread_s32bu_p32bu/3]).
+
+
+
+%%% Interface towards file system and metadata. Uses ?DRV.
+
+%% Takes an optional port (opens a ?DRV port per default) as first argument.
+-export([get_cwd/0, get_cwd/1, get_cwd/2,
+ set_cwd/1, set_cwd/2,
+ delete/1, delete/2,
+ rename/2, rename/3,
+ make_dir/1, make_dir/2,
+ del_dir/1, del_dir/2,
+ read_file_info/1, read_file_info/2,
+ altname/1, altname/2,
+ write_file_info/2, write_file_info/3,
+ make_link/2, make_link/3,
+ make_symlink/2, make_symlink/3,
+ read_link/1, read_link/2,
+ read_link_info/1, read_link_info/2,
+ list_dir/1, list_dir/2]).
+%% How to start and stop the ?DRV port.
+-export([start/0, stop/1]).
+
+%% Debug exports
+-export([open_int/4, open_mode/1, open_mode/4]).
+
+%%%-----------------------------------------------------------------
+%%% Includes and defines
+
+-include("file.hrl").
+
+-define(DRV, efile).
+-define(FD_DRV, efile).
+
+-define(LARGEFILESIZE, (1 bsl 63)).
+
+%% Driver commands
+-define(FILE_OPEN, 1).
+-define(FILE_READ, 2).
+-define(FILE_LSEEK, 3).
+-define(FILE_WRITE, 4).
+-define(FILE_FSTAT, 5).
+-define(FILE_PWD, 6).
+-define(FILE_READDIR, 7).
+-define(FILE_CHDIR, 8).
+-define(FILE_FSYNC, 9).
+-define(FILE_MKDIR, 10).
+-define(FILE_DELETE, 11).
+-define(FILE_RENAME, 12).
+-define(FILE_RMDIR, 13).
+-define(FILE_TRUNCATE, 14).
+-define(FILE_READ_FILE, 15).
+-define(FILE_WRITE_INFO, 16).
+-define(FILE_LSTAT, 19).
+-define(FILE_READLINK, 20).
+-define(FILE_LINK, 21).
+-define(FILE_SYMLINK, 22).
+-define(FILE_CLOSE, 23).
+-define(FILE_PWRITEV, 24).
+-define(FILE_PREADV, 25).
+-define(FILE_SETOPT, 26).
+-define(FILE_IPREAD, 27).
+-define(FILE_ALTNAME, 28).
+-define(FILE_READ_LINE, 29).
+
+%% Driver responses
+-define(FILE_RESP_OK, 0).
+-define(FILE_RESP_ERROR, 1).
+-define(FILE_RESP_DATA, 2).
+-define(FILE_RESP_NUMBER, 3).
+-define(FILE_RESP_INFO, 4).
+-define(FILE_RESP_NUMERR, 5).
+-define(FILE_RESP_LDATA, 6).
+-define(FILE_RESP_N2DATA, 7).
+-define(FILE_RESP_EOF, 8).
+
+%% Open modes for the driver's open function.
+-define(EFILE_MODE_READ, 1).
+-define(EFILE_MODE_WRITE, 2).
+-define(EFILE_MODE_READ_WRITE, 3).
+-define(EFILE_MODE_APPEND, 4).
+-define(EFILE_COMPRESSED, 8).
+
+%% Use this mask to get just the mode bits to be passed to the driver.
+-define(EFILE_MODE_MASK, 15).
+
+%% Seek modes for the driver's seek function.
+-define(EFILE_SEEK_SET, 0).
+-define(EFILE_SEEK_CUR, 1).
+-define(EFILE_SEEK_END, 2).
+
+%% Options
+-define(FILE_OPT_DELAYED_WRITE, 0).
+-define(FILE_OPT_READ_AHEAD, 1).
+
+%% IPREAD variants
+-define(IPREAD_S32BU_P32BU, 0).
+
+
+
+%%%-----------------------------------------------------------------
+%%% Functions operating on a file through a handle. ?FD_DRV.
+%%%
+%%% Generic file contents operations.
+%%%
+%%% Supposed to be called by applications through module file.
+
+
+%% Opens a file using the driver port Port. Returns {error, Reason}
+%% | {ok, FileDescriptor}
+open(Port, File, ModeList) when is_port(Port),
+ is_list(File),
+ is_list(ModeList) ->
+ case open_mode(ModeList) of
+ {Mode, _Portopts, _Setopts} ->
+ open_int(Port, File, Mode, []);
+ Reason ->
+ {error, Reason}
+ end;
+open(_,_,_) ->
+ {error, badarg}.
+
+%% Opens a file. Returns {error, Reason} | {ok, FileDescriptor}.
+open(File, ModeList) when is_list(File), is_list(ModeList) ->
+ case open_mode(ModeList) of
+ {Mode, Portopts, Setopts} ->
+ open_int({?FD_DRV, Portopts}, File, Mode, Setopts);
+ Reason ->
+ {error, Reason}
+ end;
+open(_, _) ->
+ {error, badarg}.
+
+%% Opens a port that can be used for open/3 or read_file/2.
+%% Returns {ok, Port} | {error, Reason}.
+open(Portopts) when is_list(Portopts) ->
+ case drv_open(?FD_DRV, Portopts) of
+ {error, _} = Error ->
+ Error;
+ Other ->
+ Other
+ end;
+open(_) ->
+ {error, badarg}.
+
+open_int({Driver, Portopts}, File, Mode, Setopts) ->
+ case drv_open(Driver, Portopts) of
+ {ok, Port} ->
+ open_int(Port, File, Mode, Setopts);
+ {error, _} = Error ->
+ Error
+ end;
+open_int(Port, File, Mode, Setopts) ->
+ M = Mode band ?EFILE_MODE_MASK,
+ case drv_command(Port, [<<?FILE_OPEN, M:32>>, File, 0]) of
+ {ok, Number} ->
+ open_int_setopts(Port, Number, Setopts);
+ Error ->
+ drv_close(Port),
+ Error
+ end.
+
+open_int_setopts(Port, Number, []) ->
+ {ok, #file_descriptor{module = ?MODULE, data = {Port, Number}}};
+open_int_setopts(Port, Number, [Cmd | Tail]) ->
+ case drv_command(Port, Cmd) of
+ ok ->
+ open_int_setopts(Port, Number, Tail);
+ Error ->
+ drv_close(Port),
+ Error
+ end.
+
+
+
+%% Returns ok.
+
+close(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
+ case drv_command(Port, <<?FILE_CLOSE>>) of
+ ok ->
+ drv_close(Port);
+ Error ->
+ Error
+ end;
+%% Closes a port opened with open/1.
+close(Port) when is_port(Port) ->
+ drv_close(Port).
+
+
+
+%% Returns {error, Reason} | ok.
+write(#file_descriptor{module = ?MODULE, data = {Port, _}}, Bytes) ->
+ case drv_command(Port, [?FILE_WRITE,Bytes]) of
+ {ok, _Size} ->
+ ok;
+ Error ->
+ Error
+ end.
+
+%% Returns ok | {error, {WrittenCount, Reason}}
+pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, L)
+ when is_list(L) ->
+ pwrite_int(Port, L, 0, [], []).
+
+pwrite_int(_, [], 0, [], []) ->
+ ok;
+pwrite_int(Port, [], N, Spec, Data) ->
+ Header = list_to_binary([<<?FILE_PWRITEV, N:32>> | reverse(Spec)]),
+ case drv_command_raw(Port, [Header | reverse(Data)]) of
+ {ok, _Size} ->
+ ok;
+ Error ->
+ Error
+ end;
+pwrite_int(Port, [{Offs, Bytes} | T], N, Spec, Data)
+ when is_integer(Offs) ->
+ if
+ -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE ->
+ pwrite_int(Port, T, N, Spec, Data, Offs, Bytes);
+ true ->
+ {error, einval}
+ end;
+pwrite_int(_, [_|_], _N, _Spec, _Data) ->
+ {error, badarg}.
+
+pwrite_int(Port, T, N, Spec, Data, Offs, Bin)
+ when is_binary(Bin) ->
+ Size = byte_size(Bin),
+ pwrite_int(Port, T, N+1,
+ [<<Offs:64/signed, Size:64>> | Spec],
+ [Bin | Data]);
+pwrite_int(Port, T, N, Spec, Data, Offs, Bytes) ->
+ try list_to_binary(Bytes) of
+ Bin ->
+ pwrite_int(Port, T, N, Spec, Data, Offs, Bin)
+ catch
+ error:Reason ->
+ {error, Reason}
+ end.
+
+
+
+%% Returns {error, Reason} | ok.
+pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Bytes)
+ when is_integer(Offs) ->
+ if
+ -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE ->
+ case pwrite_int(Port, [], 0, [], [], Offs, Bytes) of
+ {error, {_, Reason}} ->
+ {error, Reason};
+ Result ->
+ Result
+ end;
+ true ->
+ {error, einval}
+ end;
+pwrite(#file_descriptor{module = ?MODULE}, _, _) ->
+ {error, badarg}.
+
+
+
+%% Returns {error, Reason} | ok.
+sync(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
+ drv_command(Port, [?FILE_FSYNC]).
+
+%% Returns {ok, Data} | eof | {error, Reason}.
+read_line(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
+ case drv_command(Port, <<?FILE_READ_LINE>>) of
+ {ok, {0, _Data}} ->
+ eof;
+ {ok, {_Size, Data}} ->
+ {ok, Data};
+ {error, enomem} ->
+ erlang:garbage_collect(),
+ case drv_command(Port, <<?FILE_READ_LINE>>) of
+ {ok, {0, _Data}} ->
+ eof;
+ {ok, {_Size, Data}} ->
+ {ok, Data};
+ Other ->
+ Other
+ end;
+ Error ->
+ Error
+ end.
+
+%% Returns {ok, Data} | eof | {error, Reason}.
+read(#file_descriptor{module = ?MODULE, data = {Port, _}}, Size)
+ when is_integer(Size), 0 =< Size ->
+ if
+ Size < ?LARGEFILESIZE ->
+ case drv_command(Port, <<?FILE_READ, Size:64>>) of
+ {ok, {0, _Data}} when Size =/= 0 ->
+ eof;
+ {ok, {_Size, Data}} ->
+ {ok, Data};
+ {error, enomem} ->
+ %% Garbage collecting here might help if
+ %% the current processes has some old binaries left.
+ erlang:garbage_collect(),
+ case drv_command(Port, <<?FILE_READ, Size:64>>) of
+ {ok, {0, _Data}} when Size =/= 0 ->
+ eof;
+ {ok, {_Size, Data}} ->
+ {ok, Data};
+ Other ->
+ Other
+ end;
+ Error ->
+ Error
+ end;
+ true ->
+ {error, einval}
+ end.
+
+%% Returns {ok, [Data|eof, ...]} | {error, Reason}
+pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, L)
+ when is_list(L) ->
+ pread_int(Port, L, 0, []).
+
+pread_int(_, [], 0, []) ->
+ {ok, []};
+pread_int(Port, [], N, Spec) ->
+ drv_command(Port, [<<?FILE_PREADV, 0:32, N:32>> | reverse(Spec)]);
+pread_int(Port, [{Offs, Size} | T], N, Spec)
+ when is_integer(Offs), is_integer(Size), 0 =< Size ->
+ if
+ -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE,
+ Size < ?LARGEFILESIZE ->
+ pread_int(Port, T, N+1, [<<Offs:64/signed, Size:64>> | Spec]);
+ true ->
+ {error, einval}
+ end;
+pread_int(_, [_|_], _N, _Spec) ->
+ {error, badarg}.
+
+
+
+%% Returns {ok, Data} | eof | {error, Reason}.
+pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Size)
+ when is_integer(Offs), is_integer(Size), 0 =< Size ->
+ if
+ -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE,
+ Size < ?LARGEFILESIZE ->
+ case drv_command(Port,
+ <<?FILE_PREADV, 0:32, 1:32,
+ Offs:64/signed, Size:64>>) of
+ {ok, [eof]} ->
+ eof;
+ {ok, [Data]} ->
+ {ok, Data};
+ Error ->
+ Error
+ end;
+ true ->
+ {error, einval}
+ end;
+pread(#file_descriptor{module = ?MODULE, data = {_, _}}, _, _) ->
+ {error, badarg}.
+
+
+
+%% Returns {ok, Position} | {error, Reason}.
+position(#file_descriptor{module = ?MODULE, data = {Port, _}}, At) ->
+ case lseek_position(At) of
+ {Offs, Whence}
+ when -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE ->
+ drv_command(Port, <<?FILE_LSEEK, Offs:64/signed, Whence:32>>);
+ {_, _} ->
+ {error, einval};
+ Reason ->
+ {error, Reason}
+ end.
+
+%% Returns {error, Reaseon} | ok.
+truncate(#file_descriptor{module = ?MODULE, data = {Port, _}}) ->
+ drv_command(Port, <<?FILE_TRUNCATE>>).
+
+
+
+%% Returns {error, Reason} | {ok, BytesCopied}
+copy(#file_descriptor{module = ?MODULE} = Source,
+ #file_descriptor{module = ?MODULE} = Dest,
+ Length)
+ when is_integer(Length), Length >= 0;
+ is_atom(Length) ->
+ %% XXX Should be moved down to the driver for optimization.
+ file:copy_opened(Source, Dest, Length).
+
+
+
+ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE,
+ data = {_, _}} = Handle,
+ Offs,
+ Infinity) when is_atom(Infinity) ->
+ ipread_s32bu_p32bu(Handle, Offs, (1 bsl 31)-1);
+ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {Port, _}},
+ Offs,
+ MaxSize)
+ when is_integer(Offs), is_integer(MaxSize) ->
+ if
+ -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE,
+ 0 =< MaxSize, MaxSize < (1 bsl 31) ->
+ drv_command(Port, <<?FILE_IPREAD, ?IPREAD_S32BU_P32BU,
+ Offs:64, MaxSize:32>>);
+ true ->
+ {error, einval}
+ end;
+ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {_, _}},
+ _Offs,
+ _MaxSize) ->
+ {error, badarg}.
+
+
+
+%% Returns {ok, Contents} | {error, Reason}
+read_file(File) ->
+ case drv_open(?FD_DRV, [binary]) of
+ {ok, Port} ->
+ Result = read_file(Port, File),
+ close(Port),
+ Result;
+ {error, _} = Error ->
+ Error
+ end.
+
+%% Takes a Port opened with open/1.
+read_file(Port, File) when is_port(Port) ->
+ Cmd = [?FILE_READ_FILE | File],
+ case drv_command(Port, Cmd) of
+ {error, enomem} ->
+ %% It could possibly help to do a
+ %% garbage collection here,
+ %% if the file server has some references
+ %% to binaries read earlier.
+ erlang:garbage_collect(),
+ drv_command(Port, Cmd);
+ Result ->
+ Result
+ end.
+
+
+
+%% Returns {error, Reason} | ok.
+write_file(File, Bin) ->
+ case open(File, [binary, write]) of
+ {ok, Handle} ->
+ Result = write(Handle, Bin),
+ close(Handle),
+ Result;
+ Error ->
+ Error
+ end.
+
+
+
+%%%-----------------------------------------------------------------
+%%% Functions operating on files without handle to the file. ?DRV.
+%%%
+%%% Supposed to be called by applications through module file.
+
+
+
+%% Returns {ok, Port}, the Port should be used as first argument in all
+%% the following functions. Returns {error, Reason} upon failure.
+start() ->
+ try erlang:open_port({spawn, atom_to_list(?DRV)}, []) of
+ Port ->
+ {ok, Port}
+ catch
+ error:Reason ->
+ {error, Reason}
+ end.
+
+stop(Port) when is_port(Port) ->
+ try erlang:port_close(Port) of
+ _ ->
+ ok
+ catch
+ _:_ ->
+ ok
+ end.
+
+
+
+%%% The following functions take an optional Port as first argument.
+%%% If the port is not supplied, a temporary one is opened and then
+%%% closed after the request has been performed.
+
+
+
+%% get_cwd/{0,1,2}
+
+get_cwd() ->
+ get_cwd_int(0).
+
+get_cwd(Port) when is_port(Port) ->
+ get_cwd_int(Port, 0);
+get_cwd([]) ->
+ get_cwd_int(0);
+get_cwd([Letter, $: | _]) when $a =< Letter, Letter =< $z ->
+ get_cwd_int(Letter - $a + 1);
+get_cwd([Letter, $: | _]) when $A =< Letter, Letter =< $Z ->
+ get_cwd_int(Letter - $A + 1);
+get_cwd([_|_]) ->
+ {error, einval};
+get_cwd(_) ->
+ {error, badarg}.
+
+get_cwd(Port, []) when is_port(Port) ->
+ get_cwd_int(Port, 0);
+get_cwd(Port, [Letter, $: | _])
+ when is_port(Port), $a =< Letter, Letter =< $z ->
+ get_cwd_int(Port, Letter - $a + 1);
+get_cwd(Port, [Letter, $: | _])
+ when is_port(Port), $A =< Letter, Letter =< $Z ->
+ get_cwd_int(Port, Letter - $A + 1);
+get_cwd(Port, [_|_]) when is_port(Port) ->
+ {error, einval};
+get_cwd(_, _) ->
+ {error, badarg}.
+
+get_cwd_int(Drive) ->
+ get_cwd_int({?DRV, []}, Drive).
+
+get_cwd_int(Port, Drive) ->
+ drv_command(Port, <<?FILE_PWD, Drive>>).
+
+
+
+%% set_cwd/{1,2}
+
+set_cwd(Dir) ->
+ set_cwd_int({?DRV, []}, Dir).
+
+set_cwd(Port, Dir) when is_port(Port) ->
+ set_cwd_int(Port, Dir).
+
+set_cwd_int(Port, Dir0) ->
+ Dir =
+ (catch
+ case os:type() of
+ vxworks ->
+ %% chdir on vxworks doesn't support
+ %% relative paths
+ %% must call get_cwd from here and use
+ %% absname/2, since
+ %% absname/1 uses file:get_cwd ...
+ case get_cwd_int(Port, 0) of
+ {ok, AbsPath} ->
+ filename:absname(Dir0, AbsPath);
+ _Badcwd ->
+ Dir0
+ end;
+ _Else ->
+ Dir0
+ end),
+ %% Dir is now either a string or an EXIT tuple.
+ %% An EXIT tuple will fail in the following catch.
+ drv_command(Port, [?FILE_CHDIR, Dir, 0]).
+
+
+
+%% delete/{1,2}
+
+delete(File) ->
+ delete_int({?DRV, []}, File).
+
+delete(Port, File) when is_port(Port) ->
+ delete_int(Port, File).
+
+delete_int(Port, File) ->
+ drv_command(Port, [?FILE_DELETE, File, 0]).
+
+
+
+%% rename/{2,3}
+
+rename(From, To) ->
+ rename_int({?DRV, []}, From, To).
+
+rename(Port, From, To) when is_port(Port) ->
+ rename_int(Port, From, To).
+
+rename_int(Port, From, To) ->
+ drv_command(Port, [?FILE_RENAME, From, 0, To, 0]).
+
+
+
+%% make_dir/{1,2}
+
+make_dir(Dir) ->
+ make_dir_int({?DRV, []}, Dir).
+
+make_dir(Port, Dir) when is_port(Port) ->
+ make_dir_int(Port, Dir).
+
+make_dir_int(Port, Dir) ->
+ drv_command(Port, [?FILE_MKDIR, Dir, 0]).
+
+
+
+%% del_dir/{1,2}
+
+del_dir(Dir) ->
+ del_dir_int({?DRV, []}, Dir).
+
+del_dir(Port, Dir) when is_port(Port) ->
+ del_dir_int(Port, Dir).
+
+del_dir_int(Port, Dir) ->
+ drv_command(Port, [?FILE_RMDIR, Dir, 0]).
+
+
+
+%% read_file_info/{1,2}
+
+read_file_info(File) ->
+ read_file_info_int({?DRV, []}, File).
+
+read_file_info(Port, File) when is_port(Port) ->
+ read_file_info_int(Port, File).
+
+read_file_info_int(Port, File) ->
+ drv_command(Port, [?FILE_FSTAT, File, 0]).
+
+%% altname/{1,2}
+
+altname(File) ->
+ altname_int({?DRV, []}, File).
+
+altname(Port, File) when is_port(Port) ->
+ altname_int(Port, File).
+
+altname_int(Port, File) ->
+ drv_command(Port, [?FILE_ALTNAME, File, 0]).
+
+
+%% write_file_info/{2,3}
+
+write_file_info(File, Info) ->
+ write_file_info_int({?DRV, []}, File, Info).
+
+write_file_info(Port, File, Info) when is_port(Port) ->
+ write_file_info_int(Port, File, Info).
+
+write_file_info_int(Port,
+ File,
+ #file_info{mode=Mode,
+ uid=Uid,
+ gid=Gid,
+ atime=Atime0,
+ mtime=Mtime0,
+ ctime=Ctime}) ->
+ {Atime, Mtime} =
+ case {Atime0, Mtime0} of
+ {undefined, Mtime0} -> {erlang:localtime(), Mtime0};
+ {Atime0, undefined} -> {Atime0, Atime0};
+ Complete -> Complete
+ end,
+ drv_command(Port, [?FILE_WRITE_INFO,
+ int_to_bytes(Mode),
+ int_to_bytes(Uid),
+ int_to_bytes(Gid),
+ date_to_bytes(Atime),
+ date_to_bytes(Mtime),
+ date_to_bytes(Ctime),
+ File, 0]).
+
+
+
+%% make_link/{2,3}
+
+make_link(Old, New) ->
+ make_link_int({?DRV, []}, Old, New).
+
+make_link(Port, Old, New) when is_port(Port) ->
+ make_link_int(Port, Old, New).
+
+make_link_int(Port, Old, New) ->
+ drv_command(Port, [?FILE_LINK, Old, 0, New, 0]).
+
+
+
+%% make_symlink/{2,3}
+
+make_symlink(Old, New) ->
+ make_symlink_int({?DRV, []}, Old, New).
+
+make_symlink(Port, Old, New) when is_port(Port) ->
+ make_symlink_int(Port, Old, New).
+
+make_symlink_int(Port, Old, New) ->
+ drv_command(Port, [?FILE_SYMLINK, Old, 0, New, 0]).
+
+
+
+%% read_link/{2,3}
+
+read_link(Link) ->
+ read_link_int({?DRV, []}, Link).
+
+read_link(Port, Link) when is_port(Port) ->
+ read_link_int(Port, Link).
+
+read_link_int(Port, Link) ->
+ drv_command(Port, [?FILE_READLINK, Link, 0]).
+
+
+
+%% read_link_info/{2,3}
+
+read_link_info(Link) ->
+ read_link_info_int({?DRV, []}, Link).
+
+read_link_info(Port, Link) when is_port(Port) ->
+ read_link_info_int(Port, Link).
+
+read_link_info_int(Port, Link) ->
+ drv_command(Port, [?FILE_LSTAT, Link, 0]).
+
+
+
+%% list_dir/{1,2}
+
+list_dir(Dir) ->
+ list_dir_int({?DRV, []}, Dir).
+
+list_dir(Port, Dir) when is_port(Port) ->
+ list_dir_int(Port, Dir).
+
+list_dir_int(Port, Dir) ->
+ drv_command(Port, [?FILE_READDIR, Dir, 0], []).
+
+
+
+%%%-----------------------------------------------------------------
+%%% Functions to communicate with the driver
+
+
+
+%% Opens a driver port and converts any problems into {error, emfile}.
+%% Returns {ok, Port} when succesful.
+
+drv_open(Driver, Portopts) ->
+ try erlang:open_port({spawn, Driver}, Portopts) of
+ Port ->
+ {ok, Port}
+ catch
+ error:Reason ->
+ {error,Reason}
+ end.
+
+
+
+%% Closes a port in a safe way. Returns ok.
+
+drv_close(Port) ->
+ try erlang:port_close(Port) catch error:_ -> ok end,
+ receive %% Ugly workaround in case the caller==owner traps exits
+ {'EXIT', Port, _Reason} ->
+ ok
+ after 0 ->
+ ok
+ end.
+
+
+
+%% Issues a command to a port and gets the response.
+%% If Port is {Driver, Portopts} a port is first opened and
+%% then closed after the result has been received.
+%% Returns {ok, Result} or {error, Reason}.
+
+drv_command_raw(Port, Command) ->
+ drv_command(Port, Command, false, undefined).
+
+drv_command(Port, Command) ->
+ drv_command(Port, Command, undefined).
+
+drv_command(Port, Command, R) when is_binary(Command) ->
+ drv_command(Port, Command, true, R);
+drv_command(Port, Command, R) ->
+ try erlang:iolist_to_binary(Command) of
+ Bin ->
+ drv_command(Port, Bin, true, R)
+ catch
+ error:Reason ->
+ {error, Reason}
+ end.
+
+drv_command(Port, Command, Validated, R) when is_port(Port) ->
+ try erlang:port_command(Port, Command) of
+ true ->
+ drv_get_response(Port, R)
+ catch
+ %% If the Command is valid, knowing that the port is a port,
+ %% a badarg error must mean it is a dead port, that is:
+ %% a currently invalid filehandle, -> einval, not badarg.
+ error:badarg when Validated ->
+ {error, einval};
+ error:badarg ->
+ try erlang:iolist_size(Command) of
+ _ -> % Valid
+ {error, einval}
+ catch
+ error:_ ->
+ {error, badarg}
+ end;
+ error:Reason ->
+ {error, Reason}
+ end;
+drv_command({Driver, Portopts}, Command, Validated, R) ->
+ case drv_open(Driver, Portopts) of
+ {ok, Port} ->
+ Result = drv_command(Port, Command, Validated, R),
+ drv_close(Port),
+ Result;
+ Error ->
+ Error
+ end.
+
+
+
+%% Receives the response from a driver port.
+%% Returns: {ok, ListOrBinary}|{error, Reason}
+
+drv_get_response(Port, R) when is_list(R) ->
+ case drv_get_response(Port) of
+ ok ->
+ {ok, R};
+ {ok, Name} ->
+ drv_get_response(Port, [Name|R]);
+ Error ->
+ Error
+ end;
+drv_get_response(Port, _) ->
+ drv_get_response(Port).
+
+drv_get_response(Port) ->
+ erlang:bump_reductions(100),
+ receive
+ {Port, {data, [Response|Rest] = Data}} ->
+ try translate_response(Response, Rest)
+ catch
+ error:Reason ->
+ {error, {bad_response_from_port, Data,
+ {Reason, erlang:get_stacktrace()}}}
+ end;
+ {'EXIT', Port, Reason} ->
+ {error, {port_died, Reason}}
+ end.
+
+
+%%%-----------------------------------------------------------------
+%%% Utility functions.
+
+
+
+%% Converts a list of mode atoms into an mode word for the driver.
+%% Returns {Mode, Portopts, Setopts} where Portopts is a list of
+%% options for erlang:open_port/2 and Setopts is a list of
+%% setopt commands to send to the port, or error Reason upon failure.
+
+open_mode(List) when is_list(List) ->
+ case open_mode(List, 0, [], []) of
+ {Mode, Portopts, Setopts} when Mode band
+ (?EFILE_MODE_READ bor ?EFILE_MODE_WRITE)
+ =:= 0 ->
+ {Mode bor ?EFILE_MODE_READ, Portopts, Setopts};
+ Other ->
+ Other
+ end.
+
+open_mode([raw|Rest], Mode, Portopts, Setopts) ->
+ open_mode(Rest, Mode, Portopts, Setopts);
+open_mode([read|Rest], Mode, Portopts, Setopts) ->
+ open_mode(Rest, Mode bor ?EFILE_MODE_READ, Portopts, Setopts);
+open_mode([write|Rest], Mode, Portopts, Setopts) ->
+ open_mode(Rest, Mode bor ?EFILE_MODE_WRITE, Portopts, Setopts);
+open_mode([binary|Rest], Mode, Portopts, Setopts) ->
+ open_mode(Rest, Mode, [binary | Portopts], Setopts);
+open_mode([compressed|Rest], Mode, Portopts, Setopts) ->
+ open_mode(Rest, Mode bor ?EFILE_COMPRESSED, Portopts, Setopts);
+open_mode([append|Rest], Mode, Portopts, Setopts) ->
+ open_mode(Rest, Mode bor ?EFILE_MODE_APPEND bor ?EFILE_MODE_WRITE,
+ Portopts, Setopts);
+open_mode([delayed_write|Rest], Mode, Portopts, Setopts) ->
+ open_mode([{delayed_write, 64*1024, 2000}|Rest], Mode,
+ Portopts, Setopts);
+open_mode([{delayed_write, Size, Delay}|Rest], Mode, Portopts, Setopts)
+ when is_integer(Size), 0 =< Size, is_integer(Delay), 0 =< Delay ->
+ if
+ Size < ?LARGEFILESIZE, Delay < 1 bsl 64 ->
+ open_mode(Rest, Mode, Portopts,
+ [<<?FILE_SETOPT, ?FILE_OPT_DELAYED_WRITE,
+ Size:64, Delay:64>>
+ | Setopts]);
+ true ->
+ einval
+ end;
+open_mode([read_ahead|Rest], Mode, Portopts, Setopts) ->
+ open_mode([{read_ahead, 64*1024}|Rest], Mode, Portopts, Setopts);
+open_mode([{read_ahead, Size}|Rest], Mode, Portopts, Setopts)
+ when is_integer(Size), 0 =< Size ->
+ if
+ Size < ?LARGEFILESIZE ->
+ open_mode(Rest, Mode, Portopts,
+ [<<?FILE_SETOPT, ?FILE_OPT_READ_AHEAD,
+ Size:64>> | Setopts]);
+ true ->
+ einval
+ end;
+open_mode([], Mode, Portopts, Setopts) ->
+ {Mode, reverse(Portopts), reverse(Setopts)};
+open_mode(_, _Mode, _Portopts, _Setopts) ->
+ badarg.
+
+
+
+%% Converts a position tuple {bof, X} | {cur, X} | {eof, X} into
+%% {Offset, OriginCode} for the driver.
+%% Returns badarg upon failure.
+
+lseek_position(Pos)
+ when is_integer(Pos) ->
+ lseek_position({bof, Pos});
+lseek_position(bof) ->
+ lseek_position({bof, 0});
+lseek_position(cur) ->
+ lseek_position({cur, 0});
+lseek_position(eof) ->
+ lseek_position({eof, 0});
+lseek_position({bof, Offset})
+ when is_integer(Offset) ->
+ {Offset, ?EFILE_SEEK_SET};
+lseek_position({cur, Offset})
+ when is_integer(Offset) ->
+ {Offset, ?EFILE_SEEK_CUR};
+lseek_position({eof, Offset})
+ when is_integer(Offset) ->
+ {Offset, ?EFILE_SEEK_END};
+lseek_position(_) ->
+ badarg.
+
+
+
+%% Translates the response from the driver into
+%% {ok, Result} or {error, Reason}.
+
+translate_response(?FILE_RESP_OK, []) ->
+ ok;
+translate_response(?FILE_RESP_OK, Data) ->
+ {ok, Data};
+translate_response(?FILE_RESP_ERROR, List) when is_list(List) ->
+ {error, list_to_atom(List)};
+translate_response(?FILE_RESP_NUMBER, List) ->
+ {N, []} = get_uint64(List),
+ {ok, N};
+translate_response(?FILE_RESP_DATA, List) ->
+ {N, Data} = get_uint64(List),
+ {ok, {N, Data}};
+translate_response(?FILE_RESP_INFO, List) when is_list(List) ->
+ {ok, transform_info_ints(get_uint32s(List))};
+translate_response(?FILE_RESP_NUMERR, L0) ->
+ {N, L1} = get_uint64(L0),
+ {error, {N, list_to_atom(L1)}};
+translate_response(?FILE_RESP_LDATA, List) ->
+ {ok, transform_ldata(List)};
+translate_response(?FILE_RESP_N2DATA,
+ <<Offset:64, 0:64, Size:64>>) ->
+ {ok, {Size, Offset, eof}};
+translate_response(?FILE_RESP_N2DATA,
+ [<<Offset:64, 0:64, Size:64>> | <<>>]) ->
+ {ok, {Size, Offset, eof}};
+translate_response(?FILE_RESP_N2DATA = X,
+ [<<_:64, 0:64, _:64>> | _] = Data) ->
+ {error, {bad_response_from_port, [X | Data]}};
+translate_response(?FILE_RESP_N2DATA = X,
+ [<<_:64, _:64, _:64>> | <<>>] = Data) ->
+ {error, {bad_response_from_port, [X | Data]}};
+translate_response(?FILE_RESP_N2DATA,
+ [<<Offset:64, _ReadSize:64, Size:64>> | D]) ->
+ {ok, {Size, Offset, D}};
+translate_response(?FILE_RESP_N2DATA = X, L0) when is_list(L0) ->
+ {Offset, L1} = get_uint64(L0),
+ {ReadSize, L2} = get_uint64(L1),
+ {Size, L3} = get_uint64(L2),
+ case {ReadSize, L3} of
+ {0, []} ->
+ {ok, {Size, Offset, eof}};
+ {0, _} ->
+ {error, {bad_response_from_port, [X | L0]}};
+ {_, []} ->
+ {error, {bad_response_from_port, [X | L0]}};
+ _ ->
+ {ok, {Size, Offset, L3}}
+ end;
+translate_response(?FILE_RESP_EOF, []) ->
+ eof;
+translate_response(X, Data) ->
+ {error, {bad_response_from_port, [X | Data]}}.
+
+transform_info_ints(Ints) ->
+ [HighSize, LowSize, Type|Tail0] = Ints,
+ Size = HighSize * 16#100000000 + LowSize,
+ [Ay, Am, Ad, Ah, Ami, As|Tail1] = Tail0,
+ [My, Mm, Md, Mh, Mmi, Ms|Tail2] = Tail1,
+ [Cy, Cm, Cd, Ch, Cmi, Cs|Tail3] = Tail2,
+ [Mode, Links, Major, Minor, Inode, Uid, Gid, Access] = Tail3,
+ #file_info {
+ size = Size,
+ type = file_type(Type),
+ access = file_access(Access),
+ atime = {{Ay, Am, Ad}, {Ah, Ami, As}},
+ mtime = {{My, Mm, Md}, {Mh, Mmi, Ms}},
+ ctime = {{Cy, Cm, Cd}, {Ch, Cmi, Cs}},
+ mode = Mode,
+ links = Links,
+ major_device = Major,
+ minor_device = Minor,
+ inode = Inode,
+ uid = Uid,
+ gid = Gid}.
+
+file_type(1) -> device;
+file_type(2) -> directory;
+file_type(3) -> regular;
+file_type(4) -> symlink;
+file_type(_) -> other.
+
+file_access(0) -> none;
+file_access(1) -> write;
+file_access(2) -> read;
+file_access(3) -> read_write.
+
+int_to_bytes(Int) when is_integer(Int) ->
+ <<Int:32>>;
+int_to_bytes(undefined) ->
+ <<-1:32>>.
+
+date_to_bytes(undefined) ->
+ <<-1:32, -1:32, -1:32, -1:32, -1:32, -1:32>>;
+date_to_bytes({{Y, Mon, D}, {H, Min, S}}) ->
+ <<Y:32, Mon:32, D:32, H:32, Min:32, S:32>>.
+
+% uint64([[X1, X2, X3, X4] = Y1 | [X5, X6, X7, X8] = Y2]) ->
+% (uint32(Y1) bsl 32) bor uint32(Y2).
+
+% uint64(X1, X2, X3, X4, X5, X6, X7, X8) ->
+% (uint32(X1, X2, X3, X4) bsl 32) bor uint32(X5, X6, X7, X8).
+
+% uint32([X1,X2,X3,X4]) ->
+% (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.
+
+uint32(X1,X2,X3,X4) ->
+ (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.
+
+get_uint64(L0) ->
+ {X1, L1} = get_uint32(L0),
+ {X2, L2} = get_uint32(L1),
+ {(X1 bsl 32) bor X2, L2}.
+
+get_uint32([X1,X2,X3,X4|List]) ->
+ {(((((X1 bsl 8) bor X2) bsl 8) bor X3) bsl 8) bor X4, List}.
+
+get_uint32s([X1,X2,X3,X4|Tail]) ->
+ [uint32(X1,X2,X3,X4) | get_uint32s(Tail)];
+get_uint32s([]) -> [].
+
+
+
+%% Binary mode
+transform_ldata(<<0:32, 0:32>>) ->
+ [];
+transform_ldata([<<0:32, N:32, Sizes/binary>> | Datas]) ->
+ transform_ldata(N, Sizes, Datas, []);
+%% List mode
+transform_ldata([_,_,_,_,_,_,_,_|_] = L0) ->
+ {0, L1} = get_uint32(L0),
+ {N, L2} = get_uint32(L1),
+ transform_ldata(N, L2, []).
+
+%% List mode
+transform_ldata(0, List, Sizes) ->
+ transform_ldata(0, List, reverse(Sizes), []);
+transform_ldata(N, L0, Sizes) ->
+ {Size, L1} = get_uint64(L0),
+ transform_ldata(N-1, L1, [Size | Sizes]).
+
+%% Binary mode
+transform_ldata(1, <<0:64>>, <<>>, R) ->
+ reverse(R, [eof]);
+transform_ldata(1, <<Size:64>>, Data, R)
+ when byte_size(Data) =:= Size ->
+ reverse(R, [Data]);
+transform_ldata(N, <<0:64, Sizes/binary>>, [<<>> | Datas], R) ->
+ transform_ldata(N-1, Sizes, Datas, [eof | R]);
+transform_ldata(N, <<Size:64, Sizes/binary>>, [Data | Datas], R)
+ when byte_size(Data) =:= Size ->
+ transform_ldata(N-1, Sizes, Datas, [Data | R]);
+%% List mode
+transform_ldata(0, [], [], R) ->
+ reverse(R);
+transform_ldata(0, List, [0 | Sizes], R) ->
+ transform_ldata(0, List, Sizes, [eof | R]);
+transform_ldata(0, List, [Size | Sizes], R) ->
+ {Front, Rear} = lists_split(List, Size),
+ transform_ldata(0, Rear, Sizes, [Front | R]).
+
+
+
+lists_split(List, 0) when is_list(List) ->
+ {[], List};
+lists_split(List, N) when is_list(List), is_integer(N), N < 0 ->
+ erlang:error(badarg, [List, N]);
+lists_split(List, N) when is_list(List), is_integer(N) ->
+ case lists_split(List, N, []) of
+ premature_end_of_list ->
+ erlang:error(badarg, [List, N]);
+ Result ->
+ Result
+ end.
+
+lists_split(List, 0, Rev) ->
+ {reverse(Rev), List};
+lists_split([], _, _) ->
+ premature_end_of_list;
+lists_split([Hd | Tl], N, Rev) ->
+ lists_split(Tl, N-1, [Hd | Rev]).
+
+%% We KNOW that lists:reverse/2 is a BIF.
+
+reverse(X) -> lists:reverse(X, []).
+reverse(L, T) -> lists:reverse(L, T).
diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl
new file mode 100644
index 0000000000..0feb591efb
--- /dev/null
+++ b/erts/preloaded/src/prim_inet.erl
@@ -0,0 +1,1962 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% The SCTP protocol was added 2006
+%% by Leonid Timochouk <[email protected]>
+%% and Serge Aleynikov <[email protected]>
+%% at IDT Corp. Adapted by the OTP team at Ericsson AB.
+%%
+-module(prim_inet).
+
+%% Primitive inet_drv interface
+
+-export([open/1, open/2, fdopen/2, fdopen/3, close/1]).
+-export([bind/3, listen/1, listen/2]).
+-export([connect/3, connect/4, async_connect/4]).
+-export([accept/1, accept/2, async_accept/2]).
+-export([shutdown/2]).
+-export([send/2, send/3, sendto/4, sendmsg/3]).
+-export([recv/2, recv/3, async_recv/3]).
+-export([unrecv/2]).
+-export([recvfrom/2, recvfrom/3]).
+-export([setopt/3, setopts/2, getopt/2, getopts/2, is_sockopt_val/2]).
+-export([chgopt/3, chgopts/2]).
+-export([getstat/2, getfd/1, getindex/1, getstatus/1, gettype/1,
+ getiflist/1, ifget/3, ifset/3,
+ gethostname/1]).
+-export([getservbyname/3, getservbyport/3]).
+-export([peername/1, setpeername/2]).
+-export([sockname/1, setsockname/2]).
+-export([attach/1, detach/1]).
+
+-include("inet_sctp.hrl").
+-include("inet_int.hrl").
+
+%-define(DEBUG, 1).
+-ifdef(DEBUG).
+-define(DBG_FORMAT(Format, Args), (io:format((Format), (Args)))).
+-else.
+-define(DBG_FORMAT(Format, Args), ok).
+-endif.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% OPEN(tcp | udp | sctp, inet | inet6) ->
+%% {ok, insock()} |
+%% {error, Reason}
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+open(Protocol) -> open1(Protocol, ?INET_AF_INET).
+
+open(Protocol, inet) -> open1(Protocol, ?INET_AF_INET);
+open(Protocol, inet6) -> open1(Protocol, ?INET_AF_INET6);
+open(_, _) -> {error, einval}.
+
+fdopen(Protocol, Fd) -> fdopen1(Protocol, ?INET_AF_INET, Fd).
+
+fdopen(Protocol, Fd, inet) -> fdopen1(Protocol, ?INET_AF_INET, Fd);
+fdopen(Protocol, Fd, inet6) -> fdopen1(Protocol, ?INET_AF_INET6, Fd);
+fdopen(_, _, _) -> {error, einval}.
+
+open1(Protocol, Family) ->
+ case open0(Protocol) of
+ {ok, S} ->
+ case ctl_cmd(S, ?INET_REQ_OPEN, [Family]) of
+ {ok, _} ->
+ {ok,S};
+ Error ->
+ close(S), Error
+ end;
+ Error -> Error
+ end.
+
+fdopen1(Protocol, Family, Fd) when is_integer(Fd) ->
+ case open0(Protocol) of
+ {ok, S} ->
+ case ctl_cmd(S,?INET_REQ_FDOPEN,[Family,?int32(Fd)]) of
+ {ok, _} -> {ok,S};
+ Error -> close(S), Error
+ end;
+ Error -> Error
+ end.
+
+open0(Protocol) ->
+ try erlang:open_port({spawn_driver,protocol2drv(Protocol)}, [binary]) of
+ Port -> {ok,Port}
+ catch
+ error:Reason -> {error,Reason}
+ end.
+
+protocol2drv(tcp) -> "tcp_inet";
+protocol2drv(udp) -> "udp_inet";
+protocol2drv(sctp) -> "sctp_inet";
+protocol2drv(_) ->
+ erlang:error(eprotonosupport).
+
+drv2protocol("tcp_inet") -> tcp;
+drv2protocol("udp_inet") -> udp;
+drv2protocol("sctp_inet") -> sctp;
+drv2protocol(_) -> undefined.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Shutdown(insock(), atom()) -> ok
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% TODO: shutdown equivalent for SCTP
+%%
+shutdown(S, read) when is_port(S) ->
+ shutdown_2(S, 0);
+shutdown(S, write) when is_port(S) ->
+ shutdown_1(S, 1);
+shutdown(S, read_write) when is_port(S) ->
+ shutdown_1(S, 2).
+
+shutdown_1(S, How) ->
+ case subscribe(S, [subs_empty_out_q]) of
+ {ok,[{subs_empty_out_q,N}]} when N > 0 ->
+ shutdown_pend_loop(S, N); %% wait for pending output to be sent
+ _Other -> ok
+ end,
+ shutdown_2(S, How).
+
+shutdown_2(S, How) ->
+ case ctl_cmd(S, ?TCP_REQ_SHUTDOWN, [How]) of
+ {ok, []} -> ok;
+ Error -> Error
+ end.
+
+shutdown_pend_loop(S, N0) ->
+ receive
+ {empty_out_q,S} -> ok
+ after ?INET_CLOSE_TIMEOUT ->
+ case getstat(S, [send_pend]) of
+ {ok,[{send_pend,N0}]} -> ok;
+ {ok,[{send_pend,N}]} -> shutdown_pend_loop(S, N);
+ _ -> ok
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% CLOSE(insock()) -> ok
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+close(S) when is_port(S) ->
+ unlink(S), %% avoid getting {'EXIT', S, Reason}
+ case subscribe(S, [subs_empty_out_q]) of
+ {ok, [{subs_empty_out_q,N}]} when N > 0 ->
+ close_pend_loop(S, N); %% wait for pending output to be sent
+ _ ->
+ catch erlang:port_close(S),
+ ok
+ end.
+
+close_pend_loop(S, N) ->
+ receive
+ {empty_out_q,S} ->
+ catch erlang:port_close(S), ok
+ after ?INET_CLOSE_TIMEOUT ->
+ case getstat(S, [send_pend]) of
+ {ok, [{send_pend,N1}]} ->
+ if N1 =:= N -> catch erlang:port_close(S), ok;
+ true -> close_pend_loop(S, N1)
+ end;
+ _ ->
+ catch erlang:port_close(S), ok
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% BIND(insock(), IP, Port) -> {ok, integer()} | {error, Reason}
+%%
+%% bind the insock() to the interface address given by IP and Port
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+bind(S,IP,Port) when is_port(S), is_integer(Port), Port >= 0, Port =< 65535 ->
+ case ctl_cmd(S,?INET_REQ_BIND,[?int16(Port),ip_to_bytes(IP)]) of
+ {ok, [P1,P0]} -> {ok, ?u16(P1, P0)};
+ Error -> Error
+ end;
+
+%% Multi-homed "bind": sctp_bindx(). The Op is 'add' or 'remove'.
+%% If no addrs are specified, it just does nothing.
+%% Function returns {ok, S} on success, unlike TCP/UDP "bind":
+bind(S, Op, Addrs) when is_port(S), is_list(Addrs) ->
+ case Op of
+ add ->
+ bindx(S, 1, Addrs);
+ remove ->
+ bindx(S, 0, Addrs);
+ _ -> {error, einval}
+ end;
+bind(_, _, _) -> {error, einval}.
+
+bindx(S, AddFlag, Addrs) ->
+ case getprotocol(S) of
+ sctp ->
+ %% Really multi-homed "bindx". Stringified args:
+ %% [AddFlag, (Port, IP)+]:
+ Args = ?int8(AddFlag) ++
+ lists:concat([?int16(Port)++ip_to_bytes(IP) ||
+ {IP, Port} <- Addrs]),
+ case ctl_cmd(S, ?SCTP_REQ_BINDX, Args) of
+ {ok,_} -> {ok, S};
+ Error -> Error
+ end;
+ _ -> {error, einval}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% CONNECT(insock(), IP, Port [,Timeout]) -> ok | {error, Reason}
+%%
+%% connect the insock() to the address given by IP and Port
+%% if timeout is given:
+%% timeout < 0 -> infinity
+%% 0 -> immediate connect (mostly works for loopback)
+%% > 0 -> wait for timout ms if not connected then
+%% return {error, timeout}
+%%
+%% ASYNC_CONNECT(insock(), IP, Port, Timeout) -> {ok, S, Ref} | {error, Reason}
+%%
+%% a {inet_async,S,Ref,Status} will be sent on socket condition
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% For TCP, UDP or SCTP sockets.
+%%
+connect(S, IP, Port) -> connect0(S, IP, Port, -1).
+
+connect(S, IP, Port, infinity) -> connect0(S, IP, Port, -1);
+connect(S, IP, Port, Time) -> connect0(S, IP, Port, Time).
+
+connect0(S, IP, Port, Time) when is_port(S), Port > 0, Port =< 65535,
+ is_integer(Time) ->
+ case async_connect(S, IP, Port, Time) of
+ {ok, S, Ref} ->
+ receive
+ {inet_async, S, Ref, Status} ->
+ Status
+ end;
+ Error -> Error
+ end.
+
+async_connect(S, IP, Port, Time) ->
+ case ctl_cmd(S, ?INET_REQ_CONNECT,
+ [enc_time(Time),?int16(Port),ip_to_bytes(IP)]) of
+ {ok, [R1,R0]} -> {ok, S, ?u16(R1,R0)};
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% ACCEPT(insock() [,Timeout] ) -> {ok,insock()} | {error, Reason}
+%%
+%% accept incoming connection on listen socket
+%% if timeout is given:
+%% timeout < 0 -> infinity
+%% 0 -> immediate accept (poll)
+%% > 0 -> wait for timout ms for accept if no accept then
+%% return {error, timeout}
+%%
+%% ASYNC_ACCEPT(insock(), Timeout)
+%%
+%% async accept. return {ok,S,Ref} or {error, Reason}
+%% the owner of socket S will receive an {inet_async,S,Ref,Status} on
+%% socket condition
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% For TCP sockets only.
+%%
+accept(L) -> accept0(L, -1).
+
+accept(L, infinity) -> accept0(L, -1);
+accept(L, Time) -> accept0(L, Time).
+
+accept0(L, Time) when is_port(L), is_integer(Time) ->
+ case async_accept(L, Time) of
+ {ok, Ref} ->
+ receive
+ {inet_async, L, Ref, {ok,S}} ->
+ accept_opts(L, S);
+ {inet_async, L, Ref, Error} ->
+ Error
+ end;
+ Error -> Error
+ end.
+
+%% setup options from listen socket on the connected socket
+accept_opts(L, S) ->
+ case getopts(L, [active, nodelay, keepalive, delay_send, priority, tos]) of
+ {ok, Opts} ->
+ case setopts(S, Opts) of
+ ok -> {ok, S};
+ Error -> close(S), Error
+ end;
+ Error ->
+ close(S), Error
+ end.
+
+async_accept(L, Time) ->
+ case ctl_cmd(L,?TCP_REQ_ACCEPT, [enc_time(Time)]) of
+ {ok, [R1,R0]} -> {ok, ?u16(R1,R0)};
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% LISTEN(insock() [,Backlog]) -> ok | {error, Reason}
+%%
+%% set listen mode on socket
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% For TCP or SCTP sockets. For SCTP, Boolean backlog value (enable/disable
+%% listening) is also accepted:
+
+listen(S) -> listen(S, ?LISTEN_BACKLOG).
+
+listen(S, BackLog) when is_port(S), is_integer(BackLog) ->
+ case ctl_cmd(S, ?TCP_REQ_LISTEN, [?int16(BackLog)]) of
+ {ok, _} -> ok;
+ Error -> Error
+ end;
+listen(S, Flag) when is_port(S), is_boolean(Flag) ->
+ case ctl_cmd(S, ?SCTP_REQ_LISTEN, enc_value(set, bool8, Flag)) of
+ {ok,_} -> ok;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% SEND(insock(), Data) -> ok | {error, Reason}
+%%
+%% send Data on the socket (io-list)
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% This is a generic "port_command" interface used by TCP, UDP, SCTP, depending
+%% on the driver it is mapped to, and the "Data". It actually sends out data,--
+%% NOT delegating this task to any back-end. For SCTP, this function MUST NOT
+%% be called directly -- use "sendmsg" instead:
+%%
+send(S, Data, OptList) when is_port(S), is_list(OptList) ->
+ ?DBG_FORMAT("prim_inet:send(~p, ~p)~n", [S,Data]),
+ try erlang:port_command(S, Data, OptList) of
+ false -> % Port busy and nosuspend option passed
+ ?DBG_FORMAT("prim_inet:send() -> {error,busy}~n", []),
+ {error,busy};
+ true ->
+ receive
+ {inet_reply,S,Status} ->
+ ?DBG_FORMAT("prim_inet:send() -> ~p~n", [Status]),
+ Status
+ end
+ catch
+ error:_Error ->
+ ?DBG_FORMAT("prim_inet:send() -> {error,einval}~n", []),
+ {error,einval}
+ end.
+
+send(S, Data) ->
+ send(S, Data, []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% SENDTO(insock(), IP, Port, Data) -> ok | {error, Reason}
+%%
+%% send Datagram to the IP at port (Should add sync send!)
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% "sendto" is for UDP. IP and Port are set by the caller to 0 if the socket
+%% is known to be connected.
+
+sendto(S, IP, Port, Data) when is_port(S), Port >= 0, Port =< 65535 ->
+ ?DBG_FORMAT("prim_inet:sendto(~p, ~p, ~p, ~p)~n", [S,IP,Port,Data]),
+ try erlang:port_command(S, [?int16(Port),ip_to_bytes(IP),Data]) of
+ true ->
+ receive
+ {inet_reply,S,Reply} ->
+ ?DBG_FORMAT("prim_inet:send() -> ~p~n", [Reply]),
+ Reply
+ end
+ catch
+ error:_ ->
+ ?DBG_FORMAT("prim_inet:send() -> {error,einval}~n", []),
+ {error,einval}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% SENDMSG(insock(), IP, Port, InitMsg, Data) or
+%% SENDMSG(insock(), SndRcvInfo, Data) -> ok | {error, Reason}
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% SCTP: Sending data over an existing association: no need for a destination
+%% addr; uses SndRcvInfo:
+%%
+sendmsg(S, #sctp_sndrcvinfo{}=SRI, Data) when is_port(S) ->
+ Type = type_opt(set, sctp_default_send_param),
+ try type_value(set, Type, SRI) of
+ true ->
+ send(S, [enc_value(set, Type, SRI)|Data]);
+ false -> {error,einval}
+ catch
+ Reason -> {error,Reason}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% RECV(insock(), Length, [Timeout]) -> {ok,Data} | {error, Reason}
+%%
+%% receive Length data bytes from a socket
+%% if 0 is given then a Data packet is requested (see setopt (packet))
+%% N read N bytes
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% "recv" is for TCP:
+
+recv(S, Length) -> recv0(S, Length, -1).
+
+recv(S, Length, infinity) -> recv0(S, Length,-1);
+
+recv(S, Length, Time) when is_integer(Time) -> recv0(S, Length, Time).
+
+recv0(S, Length, Time) when is_port(S), is_integer(Length), Length >= 0 ->
+ case async_recv(S, Length, Time) of
+ {ok, Ref} ->
+ receive
+ {inet_async, S, Ref, Status} -> Status;
+ {'EXIT', S, _Reason} ->
+ {error, closed}
+ end;
+ Error -> Error
+ end.
+
+
+async_recv(S, Length, Time) ->
+ case ctl_cmd(S, ?TCP_REQ_RECV, [enc_time(Time), ?int32(Length)]) of
+ {ok,[R1,R0]} -> {ok, ?u16(R1,R0)};
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% RECVFROM(insock(), Lenth [Timeout]) -> {ok,{IP,Port,Data}} | {error, Reason}
+%% For SCTP: -> {ok,{IP,Port,[AncData],Data}}
+%% | {error, Reason}
+%% receive Length data bytes from a datagram socket sent from IP at Port
+%% if 0 is given then a Data packet is requested (see setopt (packet))
+%% N read N bytes
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% "recvfrom" is for both UDP and SCTP.
+%% NB: "Length" is actually ignored for these protocols, since they are msg-
+%% oriented: preserved here only for API compatibility.
+%%
+recvfrom(S, Length) ->
+ recvfrom0(S, Length, -1).
+
+recvfrom(S, Length, infinity) ->
+ recvfrom0(S, Length, -1);
+recvfrom(S, Length, Time) when is_integer(Time), Time < 16#ffffffff ->
+ recvfrom0(S, Length, Time);
+recvfrom(_, _, _) -> {error,einval}.
+
+recvfrom0(S, Length, Time)
+ when is_port(S), is_integer(Length), Length >= 0, Length =< 16#ffffffff ->
+ case ctl_cmd(S, ?PACKET_REQ_RECV,[enc_time(Time),?int32(Length)]) of
+ {ok,[R1,R0]} ->
+ Ref = ?u16(R1,R0),
+ receive
+ % Success, UDP:
+ {inet_async, S, Ref, {ok, [F,P1,P0 | AddrData]}} ->
+ {IP,Data} = get_ip(F, AddrData),
+ {ok, {IP, ?u16(P1,P0), Data}};
+
+ % Success, SCTP:
+ {inet_async, S, Ref, {ok, {[F,P1,P0 | Addr], AncData, DE}}} ->
+ {IP, _} = get_ip(F, Addr),
+ {ok, {IP, ?u16(P1,P0), AncData, DE}};
+
+ % Back-end error:
+ {inet_async, S, Ref, Error={error, _}} ->
+ Error
+ end;
+ Error ->
+ Error % Front-end error
+ end;
+recvfrom0(_, _, _) -> {error,einval}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% PEERNAME(insock()) -> {ok, {IP, Port}} | {error, Reason}
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+peername(S) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_PEER, []) of
+ {ok, [F, P1,P0 | Addr]} ->
+ {IP, _} = get_ip(F, Addr),
+ {ok, { IP, ?u16(P1, P0) }};
+ Error -> Error
+ end.
+
+setpeername(S, {IP,Port}) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_SETPEER, [?int16(Port),ip_to_bytes(IP)]) of
+ {ok,[]} -> ok;
+ Error -> Error
+ end;
+setpeername(S, undefined) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_SETPEER, []) of
+ {ok,[]} -> ok;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% SOCKNAME(insock()) -> {ok, {IP, Port}} | {error, Reason}
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+sockname(S) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_NAME, []) of
+ {ok, [F, P1, P0 | Addr]} ->
+ {IP, _} = get_ip(F, Addr),
+ {ok, { IP, ?u16(P1, P0) }};
+ Error -> Error
+ end.
+
+setsockname(S, {IP,Port}) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_SETNAME, [?int16(Port),ip_to_bytes(IP)]) of
+ {ok,[]} -> ok;
+ Error -> Error
+ end;
+setsockname(S, undefined) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_SETNAME, []) of
+ {ok,[]} -> ok;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% SETOPT(insock(), Opt, Value) -> ok | {error, Reason}
+%% SETOPTS(insock(), [{Opt,Value}]) -> ok | {error, Reason}
+%%
+%% set socket, ip and driver option
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+setopt(S, Opt, Value) when is_port(S) ->
+ setopts(S, [{Opt,Value}]).
+
+setopts(S, Opts) when is_port(S) ->
+ case encode_opt_val(Opts) of
+ {ok, Buf} ->
+ case ctl_cmd(S, ?INET_REQ_SETOPTS, Buf) of
+ {ok, _} -> ok;
+ Error -> Error
+ end;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETOPT(insock(), Opt) -> {ok,Value} | {error, Reason}
+%% GETOPTS(insock(), [Opt]) -> {ok, [{Opt,Value}]} | {error, Reason}
+%% get socket, ip and driver option
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+getopt(S, Opt) when is_port(S), is_atom(Opt) ->
+ case getopts(S, [Opt]) of
+ {ok,[{_,Value}]} -> {ok, Value};
+ Error -> Error
+ end.
+
+getopts(S, Opts) when is_port(S), is_list(Opts) ->
+ case encode_opts(Opts) of
+ {ok,Buf} ->
+ case ctl_cmd(S, ?INET_REQ_GETOPTS, Buf) of
+ {ok,Rep} ->
+ %% Non-SCTP: "Rep" contains the encoded option vals:
+ decode_opt_val(Rep);
+ {error,sctp_reply} ->
+ %% SCTP: Need to receive the full value:
+ receive
+ {inet_reply,S,Res} -> Res
+ end;
+ Error -> Error
+ end;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% CHGOPT(insock(), Opt) -> {ok,Value} | {error, Reason}
+%% CHGOPTS(insock(), [Opt]) -> {ok, [{Opt,Value}]} | {error, Reason}
+%% change socket, ip and driver option
+%%
+%% Same as setopts except for record value options where undefined
+%% fields are read with getopts before setting.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+chgopt(S, Opt, Value) when is_port(S) ->
+ chgopts(S, [{Opt,Value}]).
+
+chgopts(S, Opts) when is_port(S), is_list(Opts) ->
+ case inet:getopts(S, need_template(Opts)) of
+ {ok,Templates} ->
+ try merge_options(Opts, Templates) of
+ NewOpts ->
+ setopts(S, NewOpts)
+ catch
+ Reason -> {error,Reason}
+ end;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% IFLIST(insock()) -> {ok,IfNameList} | {error, Reason}
+%%
+%% get interface name list
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+getiflist(S) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_GETIFLIST, []) of
+ {ok, Data} -> {ok, build_iflist(Data)};
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% ifget(insock(), IFOpts) -> {ok,IfNameList} | {error, Reason}
+%%
+%% get interface name list
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ifget(S, Name, Opts) ->
+ case encode_ifname(Name) of
+ {ok, Buf1} ->
+ case encode_ifopts(Opts,[]) of
+ {ok, Buf2} ->
+ case ctl_cmd(S, ?INET_REQ_IFGET, [Buf1,Buf2]) of
+ {ok, Data} -> decode_ifopts(Data,[]);
+ Error -> Error
+ end;
+ Error -> Error
+ end;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% ifset(insock(), Name, IFOptVals) -> {ok,IfNameList} | {error, Reason}
+%%
+%% set interface parameters
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ifset(S, Name, Opts) ->
+ case encode_ifname(Name) of
+ {ok, Buf1} ->
+ case encode_ifopt_val(Opts,[]) of
+ {ok, Buf2} ->
+ case ctl_cmd(S, ?INET_REQ_IFSET, [Buf1,Buf2]) of
+ {ok, _} -> ok;
+ Error -> Error
+ end;
+ Error -> Error
+ end;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% subscribe(insock(), SubsList) -> {ok,StatReply} | {error, Reason}
+%%
+%% Subscribe on socket events (from driver)
+%%
+%% Available event subscriptions:
+%% subs_empty_out_q: StatReply = [{subs_empty_out_q, N}], where N
+%% is current queue length. When the queue becomes empty
+%% a {empty_out_q, insock()} message will be sent to
+%% subscribing process and the subscription will be
+%% removed. If N = 0, the queue is empty and no
+%% subscription is made.
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+subscribe(S, Sub) when is_port(S), is_list(Sub) ->
+ case encode_subs(Sub) of
+ {ok, Bytes} ->
+ case ctl_cmd(S, ?INET_REQ_SUBSCRIBE, Bytes) of
+ {ok, Data} -> decode_subs(Data);
+ Error -> Error
+ end;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETSTAT(insock(), StatList) -> {ok,StatReply} | {error, Reason}
+%%
+%% get socket statistics (from driver)
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+getstat(S, Stats) when is_port(S), is_list(Stats) ->
+ case encode_stats(Stats) of
+ {ok, Bytes} ->
+ case ctl_cmd(S, ?INET_REQ_GETSTAT, Bytes) of
+ {ok, Data} -> decode_stats(Data);
+ Error -> Error
+ end;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETFD(insock()) -> {ok,integer()} | {error, Reason}
+%%
+%% get internal file descriptor
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+getfd(S) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_GETFD, []) of
+ {ok, [S3,S2,S1,S0]} -> {ok, ?u32(S3,S2,S1,S0)};
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETIX(insock()) -> {ok,integer()} | {error, Reason}
+%%
+%% get internal socket index
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+getindex(S) when is_port(S) ->
+ %% NOT USED ANY MORE
+ {error, einval}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETTYPE(insock()) -> {ok,{Family,Type}} | {error, Reason}
+%%
+%% get family/type of a socket
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+gettype(S) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_GETTYPE, []) of
+ {ok, [F3,F2,F1,F0,T3,T2,T1,T0]} ->
+ Family = case ?u32(F3,F2,F1,F0) of
+ ?INET_AF_INET -> inet;
+ ?INET_AF_INET6 -> inet6;
+ _ -> undefined
+ end,
+ Type = case ?u32(T3,T2,T1,T0) of
+ ?INET_TYPE_STREAM -> stream;
+ ?INET_TYPE_DGRAM -> dgram;
+ ?INET_TYPE_SEQPACKET -> seqpacket;
+ _ -> undefined
+ end,
+ {ok, {Family, Type}};
+ Error -> Error
+ end.
+
+getprotocol(S) when is_port(S) ->
+ {name,Drv} = erlang:port_info(S, name),
+ drv2protocol(Drv).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% IS_SCTP(insock()) -> true | false
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% is_sctp(S) when is_port(S) ->
+%% case gettype(S) of
+%% {ok, {_, seqpacket}} -> true;
+%% _ -> false
+%% end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETSTATUS(insock()) -> {ok,Status} | {error, Reason}
+%%
+%% get socket status
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+getstatus(S) when is_port(S) ->
+ case ctl_cmd(S, ?INET_REQ_GETSTATUS, []) of
+ {ok, [S3,S2,S1,S0]} ->
+ {ok, dec_status(?u32(S3,S2,S1,S0))};
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETHOSTNAME(insock()) -> {ok,HostName} | {error, Reason}
+%%
+%% get host name
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+gethostname(S) when is_port(S) ->
+ ctl_cmd(S, ?INET_REQ_GETHOSTNAME, []).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETSERVBYNAME(insock(),Name,Proto) -> {ok,Port} | {error, Reason}
+%%
+%% get service port
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+getservbyname(S,Name,Proto) when is_port(S), is_atom(Name), is_atom(Proto) ->
+ getservbyname1(S, atom_to_list(Name), atom_to_list(Proto));
+getservbyname(S,Name,Proto) when is_port(S), is_atom(Name), is_list(Proto) ->
+ getservbyname1(S, atom_to_list(Name), Proto);
+getservbyname(S,Name,Proto) when is_port(S), is_list(Name), is_atom(Proto) ->
+ getservbyname1(S, Name, atom_to_list(Proto));
+getservbyname(S,Name,Proto) when is_port(S), is_list(Name), is_list(Proto) ->
+ getservbyname1(S, Name, Proto);
+getservbyname(_,_, _) ->
+ {error, einval}.
+
+getservbyname1(S,Name,Proto) ->
+ L1 = length(Name),
+ L2 = length(Proto),
+ if L1 > 255 -> {error, einval};
+ L2 > 255 -> {error, einval};
+ true ->
+ case ctl_cmd(S, ?INET_REQ_GETSERVBYNAME, [L1,Name,L2,Proto]) of
+ {ok, [P1,P0]} ->
+ {ok, ?u16(P1,P0)};
+ Error ->
+ Error
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% GETSERVBYPORT(insock(),Port,Proto) -> {ok,Port} | {error, Reason}
+%%
+%% get service port from portnumber and protocol
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+getservbyport(S,Port,Proto) when is_port(S), is_atom(Proto) ->
+ getservbyport1(S, Port, atom_to_list(Proto));
+getservbyport(S,Port,Proto) when is_port(S), is_list(Proto) ->
+ getservbyport1(S, Port, Proto);
+getservbyport(_, _, _) ->
+ {error, einval}.
+
+getservbyport1(S,Port,Proto) ->
+ L = length(Proto),
+ if Port < 0 -> {error, einval};
+ Port > 16#ffff -> {error, einval};
+ L > 255 -> {error, einval};
+ true ->
+ case ctl_cmd(S, ?INET_REQ_GETSERVBYPORT, [?int16(Port),L,Proto]) of
+ {ok, Name} -> {ok, Name};
+ Error -> Error
+ end
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% UNRECV(insock(), data) -> ok | {error, Reason}
+%%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+unrecv(S, Data) ->
+ case ctl_cmd(S, ?TCP_REQ_UNRECV, Data) of
+ {ok, _} -> ok;
+ Error -> Error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% DETACH(insock()) -> ok
+%%
+%% unlink from a socket
+%%
+%% ATTACH(insock()) -> ok | {error, Reason}
+%%
+%% link and connect to a socket
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+detach(S) when is_port(S) ->
+ unlink(S),
+ ok.
+
+attach(S) when is_port(S) ->
+ try erlang:port_connect(S, self()) of
+ true -> link(S), ok
+ catch
+ error:Reason -> {error,Reason}
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% INTERNAL FUNCTIONS
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+is_sockopt_val(Opt, Val) ->
+ Type = type_opt(set, Opt),
+ try type_value(set, Type, Val)
+ catch
+ _ -> false
+ end.
+
+%%
+%% Socket options processing: Encoding option NAMES:
+%%
+enc_opt(reuseaddr) -> ?INET_OPT_REUSEADDR;
+enc_opt(keepalive) -> ?INET_OPT_KEEPALIVE;
+enc_opt(dontroute) -> ?INET_OPT_DONTROUTE;
+enc_opt(linger) -> ?INET_OPT_LINGER;
+enc_opt(broadcast) -> ?INET_OPT_BROADCAST;
+enc_opt(sndbuf) -> ?INET_OPT_SNDBUF;
+enc_opt(recbuf) -> ?INET_OPT_RCVBUF;
+enc_opt(priority) -> ?INET_OPT_PRIORITY;
+enc_opt(tos) -> ?INET_OPT_TOS;
+enc_opt(nodelay) -> ?TCP_OPT_NODELAY;
+enc_opt(multicast_if) -> ?UDP_OPT_MULTICAST_IF;
+enc_opt(multicast_ttl) -> ?UDP_OPT_MULTICAST_TTL;
+enc_opt(multicast_loop) -> ?UDP_OPT_MULTICAST_LOOP;
+enc_opt(add_membership) -> ?UDP_OPT_ADD_MEMBERSHIP;
+enc_opt(drop_membership) -> ?UDP_OPT_DROP_MEMBERSHIP;
+enc_opt(buffer) -> ?INET_LOPT_BUFFER;
+enc_opt(header) -> ?INET_LOPT_HEADER;
+enc_opt(active) -> ?INET_LOPT_ACTIVE;
+enc_opt(packet) -> ?INET_LOPT_PACKET;
+enc_opt(mode) -> ?INET_LOPT_MODE;
+enc_opt(deliver) -> ?INET_LOPT_DELIVER;
+enc_opt(exit_on_close) -> ?INET_LOPT_EXITONCLOSE;
+enc_opt(high_watermark) -> ?INET_LOPT_TCP_HIWTRMRK;
+enc_opt(low_watermark) -> ?INET_LOPT_TCP_LOWTRMRK;
+enc_opt(bit8) -> ?INET_LOPT_BIT8;
+enc_opt(send_timeout) -> ?INET_LOPT_TCP_SEND_TIMEOUT;
+enc_opt(send_timeout_close) -> ?INET_LOPT_TCP_SEND_TIMEOUT_CLOSE;
+enc_opt(delay_send) -> ?INET_LOPT_TCP_DELAY_SEND;
+enc_opt(packet_size) -> ?INET_LOPT_PACKET_SIZE;
+enc_opt(read_packets) -> ?INET_LOPT_READ_PACKETS;
+enc_opt(raw) -> ?INET_OPT_RAW;
+% Names of SCTP opts:
+enc_opt(sctp_rtoinfo) -> ?SCTP_OPT_RTOINFO;
+enc_opt(sctp_associnfo) -> ?SCTP_OPT_ASSOCINFO;
+enc_opt(sctp_initmsg) -> ?SCTP_OPT_INITMSG;
+enc_opt(sctp_autoclose) -> ?SCTP_OPT_AUTOCLOSE;
+enc_opt(sctp_nodelay) -> ?SCTP_OPT_NODELAY;
+enc_opt(sctp_disable_fragments) -> ?SCTP_OPT_DISABLE_FRAGMENTS;
+enc_opt(sctp_i_want_mapped_v4_addr)-> ?SCTP_OPT_I_WANT_MAPPED_V4_ADDR;
+enc_opt(sctp_maxseg) -> ?SCTP_OPT_MAXSEG;
+enc_opt(sctp_set_peer_primary_addr)-> ?SCTP_OPT_SET_PEER_PRIMARY_ADDR;
+enc_opt(sctp_primary_addr) -> ?SCTP_OPT_PRIMARY_ADDR;
+enc_opt(sctp_adaptation_layer) -> ?SCTP_OPT_ADAPTATION_LAYER;
+enc_opt(sctp_peer_addr_params) -> ?SCTP_OPT_PEER_ADDR_PARAMS;
+enc_opt(sctp_default_send_param) -> ?SCTP_OPT_DEFAULT_SEND_PARAM;
+enc_opt(sctp_events) -> ?SCTP_OPT_EVENTS;
+enc_opt(sctp_delayed_ack_time) -> ?SCTP_OPT_DELAYED_ACK_TIME;
+enc_opt(sctp_status) -> ?SCTP_OPT_STATUS;
+enc_opt(sctp_get_peer_addr_info) -> ?SCTP_OPT_GET_PEER_ADDR_INFO.
+%%
+
+%%
+%% Decoding option NAMES:
+%%
+dec_opt(?INET_OPT_REUSEADDR) -> reuseaddr;
+dec_opt(?INET_OPT_KEEPALIVE) -> keepalive;
+dec_opt(?INET_OPT_DONTROUTE) -> dontroute;
+dec_opt(?INET_OPT_LINGER) -> linger;
+dec_opt(?INET_OPT_BROADCAST) -> broadcast;
+dec_opt(?INET_OPT_SNDBUF) -> sndbuf;
+dec_opt(?INET_OPT_RCVBUF) -> recbuf;
+dec_opt(?INET_OPT_PRIORITY) -> priority;
+dec_opt(?INET_OPT_TOS) -> tos;
+dec_opt(?TCP_OPT_NODELAY) -> nodelay;
+dec_opt(?UDP_OPT_MULTICAST_IF) -> multicast_if;
+dec_opt(?UDP_OPT_MULTICAST_TTL) -> multicast_ttl;
+dec_opt(?UDP_OPT_MULTICAST_LOOP) -> multicast_loop;
+dec_opt(?UDP_OPT_ADD_MEMBERSHIP) -> add_membership;
+dec_opt(?UDP_OPT_DROP_MEMBERSHIP) -> drop_membership;
+dec_opt(?INET_LOPT_BUFFER) -> buffer;
+dec_opt(?INET_LOPT_HEADER) -> header;
+dec_opt(?INET_LOPT_ACTIVE) -> active;
+dec_opt(?INET_LOPT_PACKET) -> packet;
+dec_opt(?INET_LOPT_MODE) -> mode;
+dec_opt(?INET_LOPT_DELIVER) -> deliver;
+dec_opt(?INET_LOPT_EXITONCLOSE) -> exit_on_close;
+dec_opt(?INET_LOPT_TCP_HIWTRMRK) -> high_watermark;
+dec_opt(?INET_LOPT_TCP_LOWTRMRK) -> low_watermark;
+dec_opt(?INET_LOPT_BIT8) -> bit8;
+dec_opt(?INET_LOPT_TCP_SEND_TIMEOUT) -> send_timeout;
+dec_opt(?INET_LOPT_TCP_SEND_TIMEOUT_CLOSE) -> send_timeout_close;
+dec_opt(?INET_LOPT_TCP_DELAY_SEND) -> delay_send;
+dec_opt(?INET_LOPT_PACKET_SIZE) -> packet_size;
+dec_opt(?INET_LOPT_READ_PACKETS) -> read_packets;
+dec_opt(?INET_OPT_RAW) -> raw;
+dec_opt(I) when is_integer(I) -> undefined.
+
+
+
+%% Metatypes:
+%% [] Value must be 'undefined' or nonexistent
+%% for setopts and getopts.
+%% [Type] Value required for setopts and getopts,
+%% will be encoded for both.
+%% [Type,Default] Default used if value is 'undefined'.
+%% [[Type,Default]] A combination of the two above.
+%% Type Value must be 'undefined' or nonexistent for getops,
+%% required for setopts.
+%%
+%% The use of [] and [[Type,Default]] is commented out in enc_value/2
+%% and type_value/2 below since they are only used in record fields.
+%% And record fields does not call enc_value/2 nor type_value/2.
+%% Anyone introducing these metatypes otherwhere will have to activate
+%% those clauses in enc_value/2 and type_value/2. You have been warned!
+
+type_opt(get, raw) -> [{[int],[int],[binary_or_uint]}];
+type_opt(_, raw) -> {int,int,binary};
+%% NB: "sctp_status" and "sctp_get_peer_addr_info" are read-only options,
+%% so they should not be NOT encoded for use with "setopt".
+type_opt(get, sctp_status) ->
+ [{record,#sctp_status{
+ assoc_id = [sctp_assoc_id],
+ _ = []}}];
+type_opt(get, sctp_get_peer_addr_info) ->
+ [{record,#sctp_paddrinfo{
+ assoc_id = [[sctp_assoc_id,0]],
+ address = [[addr,{any,0}]],
+ _ = []}}];
+type_opt(_, Opt) ->
+ type_opt_1(Opt).
+
+%% Types of option values, by option name:
+%%
+type_opt_1(reuseaddr) -> bool;
+type_opt_1(keepalive) -> bool;
+type_opt_1(dontroute) -> bool;
+type_opt_1(linger) -> {bool,int};
+type_opt_1(broadcast) -> bool;
+type_opt_1(sndbuf) -> int;
+type_opt_1(recbuf) -> int;
+type_opt_1(priority) -> int;
+type_opt_1(tos) -> int;
+type_opt_1(nodelay) -> bool;
+%% multicast
+type_opt_1(multicast_ttl) -> int;
+type_opt_1(multicast_loop) -> bool;
+type_opt_1(multicast_if) -> ip;
+type_opt_1(add_membership) -> {ip,ip};
+type_opt_1(drop_membership) -> {ip,ip};
+%% driver options
+type_opt_1(header) -> uint;
+type_opt_1(buffer) -> int;
+type_opt_1(active) ->
+ {enum,[{false, ?INET_PASSIVE},
+ {true, ?INET_ACTIVE},
+ {once, ?INET_ONCE}]};
+type_opt_1(packet) ->
+ {enum,[{0, ?TCP_PB_RAW},
+ {1, ?TCP_PB_1},
+ {2, ?TCP_PB_2},
+ {4, ?TCP_PB_4},
+ {raw,?TCP_PB_RAW},
+ {sunrm, ?TCP_PB_RM},
+ {asn1, ?TCP_PB_ASN1},
+ {cdr, ?TCP_PB_CDR},
+ {fcgi, ?TCP_PB_FCGI},
+ {line, ?TCP_PB_LINE_LF},
+ {tpkt, ?TCP_PB_TPKT},
+ {http, ?TCP_PB_HTTP},
+ {httph,?TCP_PB_HTTPH},
+ {http_bin, ?TCP_PB_HTTP_BIN},
+ {httph_bin,?TCP_PB_HTTPH_BIN},
+ {ssl, ?TCP_PB_SSL_TLS}, % obsolete
+ {ssl_tls, ?TCP_PB_SSL_TLS}]};
+type_opt_1(mode) ->
+ {enum,[{list, ?INET_MODE_LIST},
+ {binary, ?INET_MODE_BINARY}]};
+type_opt_1(deliver) ->
+ {enum,[{port, ?INET_DELIVER_PORT},
+ {term, ?INET_DELIVER_TERM}]};
+type_opt_1(exit_on_close) -> bool;
+type_opt_1(low_watermark) -> int;
+type_opt_1(high_watermark) -> int;
+type_opt_1(bit8) ->
+ {enum,[{clear, ?INET_BIT8_CLEAR},
+ {set, ?INET_BIT8_SET},
+ {on, ?INET_BIT8_ON},
+ {off, ?INET_BIT8_OFF}]};
+type_opt_1(send_timeout) -> time;
+type_opt_1(send_timeout_close) -> bool;
+type_opt_1(delay_send) -> bool;
+type_opt_1(packet_size) -> uint;
+type_opt_1(read_packets) -> uint;
+%%
+%% SCTP options (to be set). If the type is a record type, the corresponding
+%% record signature is returned, otherwise, an "elementary" type tag
+%% is returned:
+%%
+%% for SCTP_OPT_RTOINFO
+type_opt_1(sctp_rtoinfo) ->
+ [{record,#sctp_rtoinfo{
+ assoc_id = [[sctp_assoc_id,0]],
+ initial = [uint32,0],
+ max = [uint32,0],
+ min = [uint32,0]}}];
+%% for SCTP_OPT_ASSOCINFO
+type_opt_1(sctp_associnfo) ->
+ [{record,#sctp_assocparams{
+ assoc_id = [[sctp_assoc_id,0]],
+ asocmaxrxt = [uint16,0],
+ number_peer_destinations = [uint16,0],
+ peer_rwnd = [uint32,0],
+ local_rwnd = [uint32,0],
+ cookie_life = [uint32,0]}}];
+%% for SCTP_OPT_INITMSG and SCTP_TAG_SEND_ANC_INITMSG (send*)
+type_opt_1(sctp_initmsg) ->
+ [{record,#sctp_initmsg{
+ num_ostreams = [uint16,0],
+ max_instreams = [uint16,0],
+ max_attempts = [uint16,0],
+ max_init_timeo = [uint16,0]}}];
+%%
+type_opt_1(sctp_nodelay) -> bool;
+type_opt_1(sctp_autoclose) -> uint;
+type_opt_1(sctp_disable_fragments) -> bool;
+type_opt_1(sctp_i_want_mapped_v4_addr) -> bool;
+type_opt_1(sctp_maxseg) -> uint;
+%% for SCTP_OPT_PRIMARY_ADDR
+type_opt_1(sctp_primary_addr) ->
+ [{record,#sctp_prim{
+ assoc_id = [sctp_assoc_id],
+ addr = addr}}];
+%% for SCTP_OPT_SET_PEER_PRIMARY_ADDR
+type_opt_1(sctp_set_peer_primary_addr) ->
+ [{record,#sctp_setpeerprim{
+ assoc_id = [sctp_assoc_id],
+ addr = addr}}];
+%% for SCTP_OPT_ADAPTATION_LAYER
+type_opt_1(sctp_adaptation_layer) ->
+ [{record,#sctp_setadaptation{
+ adaptation_ind = [uint32,0]}}];
+%% for SCTP_OPT_PEER_ADDR_PARAMS
+type_opt_1(sctp_peer_addr_params) ->
+ [{record,#sctp_paddrparams{
+ assoc_id = [[sctp_assoc_id,0]],
+ address = [[addr,{any,0}]],
+ hbinterval = [uint32,0],
+ pathmaxrxt = [uint16,0],
+ pathmtu = [uint32,0],
+ sackdelay = [uint32,0],
+ flags =
+ [{bitenumlist,
+ [{hb_enable, ?SCTP_FLAG_HB_ENABLE},
+ {hb_disable, ?SCTP_FLAG_HB_DISABLE},
+ {hb_demand, ?SCTP_FLAG_HB_DEMAND},
+ {pmtud_enable, ?SCTP_FLAG_PMTUD_ENABLE},
+ {pmtud_disable, ?SCTP_FLAG_PMTUD_DISABLE},
+ {sackdelay_enable, ?SCTP_FLAG_SACKDELAY_ENABLE},
+ {sackdelay_disable, ?SCTP_FLAG_SACKDELAY_DISABLE}],
+ uint32},[]]}}];
+%% for SCTP_OPT_DEFAULT_SEND_PARAM and SCTP_TAG_SEND_ANC_PARAMS (on send*)
+type_opt_1(sctp_default_send_param) ->
+ [{record,#sctp_sndrcvinfo{
+ stream = [uint16,0],
+ ssn = [],
+ flags =
+ [{bitenumlist,
+ [{unordered, ?SCTP_FLAG_UNORDERED},
+ {addr_over, ?SCTP_FLAG_ADDR_OVER},
+ {abort, ?SCTP_FLAG_ABORT},
+ {eof, ?SCTP_FLAG_EOF}],
+ uint16},[]],
+ ppid = [uint32,0],
+ context = [uint32,0],
+ timetolive = [uint32,0],
+ tsn = [],
+ cumtsn = [],
+ assoc_id = [sctp_assoc_id,0]}}];
+%% for SCTP_OPT_EVENTS
+type_opt_1(sctp_events) ->
+ [{record,#sctp_event_subscribe{
+ data_io_event = [bool8,true],
+ association_event = [bool8,true],
+ address_event = [bool8,true],
+ send_failure_event = [bool8,true],
+ peer_error_event = [bool8,true],
+ shutdown_event = [bool8,true],
+ partial_delivery_event = [bool8,true],
+ adaptation_layer_event = [bool8,false],
+ authentication_event = [bool8,false]}}];
+%% for SCTP_OPT_DELAYED_ACK_TIME
+type_opt_1(sctp_delayed_ack_time) ->
+ [{record,#sctp_assoc_value{
+ assoc_id = [[sctp_assoc_id,0]],
+ assoc_value = [uint32,0]}}];
+%%
+type_opt_1(undefined) -> undefined;
+type_opt_1(O) when is_atom(O) -> undefined.
+
+
+
+%% Get. No supplied value.
+type_value(get, undefined) -> false; % Undefined type
+%% These two clauses can not happen since they are only used
+%% in record fields - from record fields they must have a
+%% value though it might be 'undefined', so record fields
+%% calls type_value/3, not type_value/2.
+%% type_value(get, []) -> true; % Ignored
+%% type_value(get, [[Type,Default]]) -> % Required field, default value
+%% type_value(get, Type, Default);
+type_value(get, [{record,Types}]) -> % Implied default value for record
+ type_value_record(get, Types,
+ erlang:make_tuple(tuple_size(Types), undefined), 2);
+type_value(get, [_]) -> false; % Required value missing
+type_value(get, _) -> true. % Field is supposed to be undefined
+
+%% Get and set. Value supplied.
+type_value(_, undefined, _) -> false; % Undefined type
+type_value(_, [], undefined) -> true; % Ignored
+type_value(_, [], _) -> false; % Value should not be supplied
+type_value(Q, [Type], Value) -> % Required field, proceed
+ type_value_default(Q, Type, Value);
+type_value(set, Type, Value) -> % Required for setopts
+ type_value_default(set, Type, Value);
+type_value(_, _, undefined) -> true; % Value should be undefined for
+type_value(_, _, _) -> false. % other than setopts.
+
+type_value_default(Q, [Type,Default], undefined) ->
+ type_value_1(Q, Type, Default);
+type_value_default(Q, [Type,_], Value) ->
+ type_value_1(Q, Type, Value);
+type_value_default(Q, Type, Value) ->
+ type_value_1(Q, Type, Value).
+
+type_value_1(Q, {record,Types}, undefined) ->
+ type_value_record(Q, Types,
+ erlang:make_tuple(tuple_size(Types), undefined), 2);
+type_value_1(Q, {record,Types}, Values)
+ when tuple_size(Types) =:= tuple_size(Values) ->
+ type_value_record(Q, Types, Values, 2);
+type_value_1(Q, Types, Values)
+ when tuple_size(Types) =:= tuple_size(Values) ->
+ type_value_tuple(Q, Types, Values, 1);
+type_value_1(_, Type, Value) ->
+ type_value_2(Type, Value).
+
+type_value_tuple(Q, Types, Values, N)
+ when is_integer(N), N =< tuple_size(Types) ->
+ type_value(Q, element(N, Types), element(N, Values))
+ andalso type_value_tuple(Q, Types, Values, N+1);
+type_value_tuple(_, _, _, _) -> true.
+
+type_value_record(Q, Types, Values, N)
+ when is_integer(N), N =< tuple_size(Types) ->
+ case type_value(Q, element(N, Types), element(N, Values)) of
+ true -> type_value_record(Q, Types, Values, N+1);
+ false ->
+ erlang:throw({type,{record,Q,Types,Values,N}})
+ end;
+type_value_record(_, _, _, _) -> true.
+
+%% Simple run-time type-checking of (option) values: type -vs- value:
+%% NB: the LHS is the TYPE, not the option name!
+%%
+%% Returns true | false | throw(ErrorReason) only for record types
+%%
+type_value_2(undefined, _) -> false;
+%%
+type_value_2(bool, true) -> true;
+type_value_2(bool, false) -> true;
+type_value_2(bool8, true) -> true;
+type_value_2(bool8, false) -> true;
+type_value_2(int, X) when is_integer(X) -> true;
+type_value_2(uint, X) when is_integer(X), X >= 0 -> true;
+type_value_2(uint32, X) when X band 16#ffffffff =:= X -> true;
+type_value_2(uint24, X) when X band 16#ffffff =:= X -> true;
+type_value_2(uint16, X) when X band 16#ffff =:= X -> true;
+type_value_2(uint8, X) when X band 16#ff =:= X -> true;
+type_value_2(time, infinity) -> true;
+type_value_2(time, X) when is_integer(X), X >= 0 -> true;
+type_value_2(ip,{A,B,C,D}) when ?ip(A,B,C,D) -> true;
+type_value_2(addr, {any,Port}) ->
+ type_value_2(uint16, Port);
+type_value_2(addr, {loopback,Port}) ->
+ type_value_2(uint16, Port);
+type_value_2(addr, {{A,B,C,D},Port}) when ?ip(A,B,C,D) ->
+ type_value_2(uint16, Port);
+type_value_2(addr, {{A,B,C,D,E,F,G,H},Port}) when ?ip6(A,B,C,D,E,F,G,H) ->
+ type_value_2(uint16, Port);
+type_value_2(ether,[X1,X2,X3,X4,X5,X6])
+ when ?ether(X1,X2,X3,X4,X5,X6) -> true;
+type_value_2({enum,List}, Enum) ->
+ case enum_val(Enum, List) of
+ {value,_} -> true;
+ false -> false
+ end;
+type_value_2({bitenumlist,List}, EnumList) ->
+ case enum_vals(EnumList, List) of
+ Ls when is_list(Ls) -> true;
+ false -> false
+ end;
+type_value_2({bitenumlist,List,_}, EnumList) ->
+ case enum_vals(EnumList, List) of
+ Ls when is_list(Ls) -> true;
+ false -> false
+ end;
+type_value_2(binary,Bin) when is_binary(Bin) -> true;
+type_value_2(binary_or_uint,Bin) when is_binary(Bin) -> true;
+type_value_2(binary_or_uint,Int) when is_integer(Int), Int >= 0 -> true;
+%% Type-checking of SCTP options
+type_value_2(sctp_assoc_id, X)
+ when X band 16#ffffffff =:= X -> true;
+type_value_2(_, _) -> false.
+
+
+
+%% Get. No supplied value.
+%%
+%% These two clauses can not happen since they are only used
+%% in record fields - from record fields they must have a
+%% value though it might be 'undefined', so record fields
+%% calls enc_value/3, not enc_value/2.
+%% enc_value(get, []) -> []; % Ignored
+%% enc_value(get, [[Type,Default]]) -> % Required field, default value
+%% enc_value(get, Type, Default);
+enc_value(get, [{record,Types}]) -> % Implied default value for record
+ enc_value_tuple(get, Types,
+ erlang:make_tuple(tuple_size(Types), undefined), 2);
+enc_value(get, _) -> [].
+
+%% Get and set
+enc_value(_, [], _) -> []; % Ignored
+enc_value(Q, [Type], Value) -> % Required field, proceed
+ enc_value_default(Q, Type, Value);
+enc_value(set, Type, Value) -> % Required for setopts
+ enc_value_default(set, Type, Value);
+enc_value(_, _, _) -> []. % Not encoded for other than setopts
+
+enc_value_default(Q, [Type,Default], undefined) ->
+ enc_value_1(Q, Type, Default);
+enc_value_default(Q, [Type,_], Value) ->
+ enc_value_1(Q, Type, Value);
+enc_value_default(Q, Type, Value) ->
+ enc_value_1(Q, Type, Value).
+
+enc_value_1(Q, {record,Types}, undefined) ->
+ enc_value_tuple(Q, Types,
+ erlang:make_tuple(tuple_size(Types), undefined), 2);
+enc_value_1(Q, {record,Types}, Values)
+ when tuple_size(Types) =:= tuple_size(Values) ->
+ enc_value_tuple(Q, Types, Values, 2);
+enc_value_1(Q, Types, Values) when tuple_size(Types) =:= tuple_size(Values) ->
+ enc_value_tuple(Q, Types, Values, 1);
+enc_value_1(_, Type, Value) ->
+ enc_value_2(Type, Value).
+
+enc_value_tuple(Q, Types, Values, N)
+ when is_integer(N), N =< tuple_size(Types) ->
+ [enc_value(Q, element(N, Types), element(N, Values))
+ |enc_value_tuple(Q, Types, Values, N+1)];
+enc_value_tuple(_, _, _, _) -> [].
+
+%%
+%% Encoding of option VALUES:
+%%
+enc_value_2(bool, true) -> [0,0,0,1];
+enc_value_2(bool, false) -> [0,0,0,0];
+enc_value_2(bool8, true) -> [1];
+enc_value_2(bool8, false) -> [0];
+enc_value_2(int, Val) -> ?int32(Val);
+enc_value_2(uint, Val) -> ?int32(Val);
+enc_value_2(uint32, Val) -> ?int32(Val);
+enc_value_2(uint24, Val) -> ?int24(Val);
+enc_value_2(uint16, Val) -> ?int16(Val);
+enc_value_2(uint8, Val) -> ?int8(Val);
+enc_value_2(time, infinity) -> ?int32(-1);
+enc_value_2(time, Val) -> ?int32(Val);
+enc_value_2(ip,{A,B,C,D}) -> [A,B,C,D];
+enc_value_2(ip, any) -> [0,0,0,0];
+enc_value_2(ip, loopback) -> [127,0,0,1];
+enc_value_2(addr, {any,Port}) ->
+ [?INET_AF_ANY|?int16(Port)];
+enc_value_2(addr, {loopback,Port}) ->
+ [?INET_AF_LOOPBACK|?int16(Port)];
+enc_value_2(addr, {IP,Port}) ->
+ case tuple_size(IP) of
+ 4 ->
+ [?INET_AF_INET,?int16(Port)|ip4_to_bytes(IP)];
+ 8 ->
+ [?INET_AF_INET6,?int16(Port)|ip6_to_bytes(IP)]
+ end;
+enc_value_2(ether, [X1,X2,X3,X4,X5,X6]) -> [X1,X2,X3,X4,X5,X6];
+enc_value_2(sctp_assoc_id, Val) -> ?int32(Val);
+%% enc_value_2(sctp_assoc_id, Bin) -> [byte_size(Bin),Bin];
+enc_value_2({enum,List}, Enum) ->
+ {value,Val} = enum_val(Enum, List),
+ ?int32(Val);
+enc_value_2({bitenumlist,List}, EnumList) ->
+ Vs = enum_vals(EnumList, List),
+ Val = borlist(Vs, 0),
+ ?int32(Val);
+enc_value_2({bitenumlist,List,Type}, EnumList) ->
+ Vs = enum_vals(EnumList, List),
+ Value = borlist(Vs, 0),
+ enc_value_2(Type, Value);
+enc_value_2(binary,Bin) -> [?int32(byte_size(Bin)),Bin];
+enc_value_2(binary_or_uint,Datum) when is_binary(Datum) ->
+ [1,enc_value_2(binary, Datum)];
+enc_value_2(binary_or_uint,Datum) when is_integer(Datum) ->
+ [0,enc_value_2(uint, Datum)].
+
+
+
+%%
+%% Decoding of option VALUES receved from "getopt":
+%% NOT required for SCTP, as it always returns ready terms, not lists:
+%%
+dec_value(bool, [0,0,0,0|T]) -> {false,T};
+dec_value(bool, [_,_,_,_|T]) -> {true,T};
+%% Currently not used i.e only used by SCTP that does not dec_value/2
+%% dec_value(bool8, [0|T]) -> {false,T};
+%% dec_value(bool8, [_|T]) -> {true,T};
+dec_value(int, [X3,X2,X1,X0|T]) -> {?i32(X3,X2,X1,X0),T};
+dec_value(uint, [X3,X2,X1,X0|T]) -> {?u32(X3,X2,X1,X0),T};
+%% Currently not used i.e only used by SCTP that does not dec_value/2
+%% dec_value(uint32, [X3,X2,X1,X0|T]) -> {?u32(X3,X2,X1,X0),T};
+%% dec_value(uint24, [X2,X1,X0|T]) -> {?u24(X2,X1,X0),T};
+%% dec_value(uint16, [X1,X0|T]) -> {?u16(X1,X0),T};
+%% dec_value(uint8, [X0|T]) -> {?u8(X0),T};
+dec_value(time, [X3,X2,X1,X0|T]) ->
+ case ?i32(X3,X2,X1,X0) of
+ -1 -> {infinity, T};
+ Val -> {Val, T}
+ end;
+dec_value(ip, [A,B,C,D|T]) -> {{A,B,C,D}, T};
+dec_value(ether,[X1,X2,X3,X4,X5,X6|T]) -> {[X1,X2,X3,X4,X5,X6],T};
+dec_value({enum,List}, [X3,X2,X1,X0|T]) ->
+ Val = ?i32(X3,X2,X1,X0),
+ case enum_name(Val, List) of
+ {name, Enum} -> {Enum, T};
+ _ -> {undefined, T}
+ end;
+dec_value({bitenumlist,List}, [X3,X2,X1,X0|T]) ->
+ Val = ?i32(X3,X2,X1,X0),
+ {enum_names(Val, List), T};
+%% Currently not used i.e only used by SCTP that does not dec_value/2
+%% dec_value({bitenumlist,List,Type}, T0) ->
+%% {Val,T} = dec_value(Type, T0),
+%% {enum_names(Val, List), T};
+dec_value(binary,[L0,L1,L2,L3|List]) ->
+ Len = ?i32(L0,L1,L2,L3),
+ {X,T}=lists:split(Len,List),
+ {list_to_binary(X),T};
+dec_value(Types, List) when is_tuple(Types) ->
+ {L,T} = dec_value_tuple(Types, List, 1, []),
+ {list_to_tuple(L),T};
+dec_value(Type, Val) ->
+ erlang:error({decode,Type,Val}).
+%% dec_value(_, B) ->
+%% {undefined, B}.
+
+dec_value_tuple(Types, List, N, Acc)
+ when is_integer(N), N =< tuple_size(Types) ->
+ {Term,Tail} = dec_value(element(N, Types), List),
+ dec_value_tuple(Types, Tail, N+1, [Term|Acc]);
+dec_value_tuple(_, List, _, Acc) ->
+ {lists:reverse(Acc),List}.
+
+borlist([V|Vs], Value) ->
+ borlist(Vs, V bor Value);
+borlist([], Value) -> Value.
+
+
+enum_vals([Enum|Es], List) ->
+ case enum_val(Enum, List) of
+ false -> false;
+ {value,Value} -> [Value | enum_vals(Es, List)]
+ end;
+enum_vals([], _) -> [].
+
+enum_names(Val, [{Enum,BitVal} |List]) ->
+ if Val band BitVal =:= BitVal ->
+ [Enum | enum_names(Val, List)];
+ true ->
+ enum_names(Val, List)
+ end;
+enum_names(_, []) -> [].
+
+enum_val(Enum, [{Enum,Value}|_]) -> {value,Value};
+enum_val(Enum, [_|List]) -> enum_val(Enum, List);
+enum_val(_, []) -> false.
+
+enum_name(Val, [{Enum,Val}|_]) -> {name,Enum};
+enum_name(Val, [_|List]) -> enum_name(Val, List);
+enum_name(_, []) -> false.
+
+
+
+%% Encoding for setopts
+%%
+%% encode opt/val REVERSED since options are stored in reverse order
+%% i.e. the recent options first (we must process old -> new)
+encode_opt_val(Opts) ->
+ try
+ enc_opt_val(Opts, [])
+ catch
+ Reason -> {error,Reason}
+ end.
+
+enc_opt_val([{active,once}|Opts], Acc) ->
+ %% Specially optimized because {active,once} will be used for
+ %% every packet, not only once when initializing the socket.
+ %% Measurements show that this optimization is worthwhile.
+ enc_opt_val(Opts, [<<?INET_LOPT_ACTIVE:8,?INET_ONCE:32>>|Acc]);
+enc_opt_val([{raw,P,O,B}|Opts], Acc) ->
+ enc_opt_val(Opts, Acc, raw, {P,O,B});
+enc_opt_val([{Opt,Val}|Opts], Acc) ->
+ enc_opt_val(Opts, Acc, Opt, Val);
+enc_opt_val([binary|Opts], Acc) ->
+ enc_opt_val(Opts, Acc, mode, binary);
+enc_opt_val([list|Opts], Acc) ->
+ enc_opt_val(Opts, Acc, mode, list);
+enc_opt_val([_|_], _) -> {error,einval};
+enc_opt_val([], Acc) -> {ok,Acc}.
+
+enc_opt_val(Opts, Acc, Opt, Val) when is_atom(Opt) ->
+ Type = type_opt(set, Opt),
+ case type_value(set, Type, Val) of
+ true ->
+ enc_opt_val(Opts, [enc_opt(Opt),enc_value(set, Type, Val)|Acc]);
+ false -> {error,einval}
+ end;
+enc_opt_val(_, _, _, _) -> {error,einval}.
+
+
+
+%% Encoding for getopts
+%%
+%% "encode_opts" is for "getopt" only, not setopt". But it uses "enc_opt" which
+%% is common for "getopt" and "setopt":
+encode_opts(Opts) ->
+ try enc_opts(Opts) of
+ Buf -> {ok,Buf}
+ catch
+ Error -> {error,Error}
+ end.
+
+% Raw options are a special case, they need to be rewritten to be properly
+% handled and the types need checking even when querying.
+enc_opts([{raw,P,O,S}|Opts]) ->
+ enc_opts(Opts, raw, {P,O,S});
+enc_opts([{Opt,Val}|Opts]) ->
+ enc_opts(Opts, Opt, Val);
+enc_opts([Opt|Opts]) ->
+ enc_opts(Opts, Opt);
+enc_opts([]) -> [].
+
+enc_opts(Opts, Opt) when is_atom(Opt) ->
+ Type = type_opt(get, Opt),
+ case type_value(get, Type) of
+ true ->
+ [enc_opt(Opt),enc_value(get, Type)|enc_opts(Opts)];
+ false ->
+ throw(einval)
+ end;
+enc_opts(_, _) ->
+ throw(einval).
+
+enc_opts(Opts, Opt, Val) when is_atom(Opt) ->
+ Type = type_opt(get, Opt),
+ case type_value(get, Type, Val) of
+ true ->
+ [enc_opt(Opt),enc_value(get, Type, Val)|enc_opts(Opts)];
+ false ->
+ throw(einval)
+ end;
+enc_opts(_, _, _) ->
+ throw(einval).
+
+
+
+%% Decoding of raw list data options
+%%
+decode_opt_val(Buf) ->
+ try dec_opt_val(Buf) of
+ Result -> {ok,Result}
+ catch
+ Error -> {error,Error}
+ end.
+
+dec_opt_val([B|Buf]=BBuf) ->
+ case dec_opt(B) of
+ undefined ->
+ erlang:error({decode,BBuf});
+ Opt ->
+ Type = type_opt(dec, Opt),
+ dec_opt_val(Buf, Opt, Type)
+ end;
+dec_opt_val([]) -> [].
+
+dec_opt_val(Buf, raw, Type) ->
+ {{P,O,B},T} = dec_value(Type, Buf),
+ [{raw,P,O,B}|dec_opt_val(T)];
+dec_opt_val(Buf, Opt, Type) ->
+ {Val,T} = dec_value(Type, Buf),
+ [{Opt,Val}|dec_opt_val(T)].
+
+
+
+%% Pre-processing of options for chgopts
+%%
+%% Return list of option requests for getopts
+%% for all options that containing 'undefined' record fields.
+%%
+need_template([{Opt,undefined}=OV|Opts]) when is_atom(Opt) ->
+ [OV|need_template(Opts)];
+need_template([{Opt,Val}|Opts]) when is_atom(Opt) ->
+ case need_template(Val, 2) of
+ true ->
+ [{Opt,undefined}|need_template(Opts)];
+ false ->
+ need_template(Opts)
+ end;
+need_template([_|Opts]) ->
+ need_template(Opts);
+need_template([]) -> [].
+%%
+need_template(T, N) when is_integer(N), N =< tuple_size(T) ->
+ case element(N, T) of
+ undefined -> true;
+ _ ->
+ need_template(T, N+1)
+ end;
+need_template(_, _) -> false.
+
+%% Replace 'undefined' record fields in option values with values
+%% from template records.
+%%
+merge_options([{Opt,undefined}|Opts], [{Opt,_}=T|Templates]) ->
+ [T|merge_options(Opts, Templates)];
+merge_options([{Opt,Val}|Opts], [{Opt,Template}|Templates])
+ when is_atom(Opt), tuple_size(Val) >= 2 ->
+ Key = element(1, Val),
+ Size = tuple_size(Val),
+ if Size =:= tuple_size(Template), Key =:= element(1, Template) ->
+ %% is_record(Template, Key)
+ [{Opt,list_to_tuple([Key|merge_fields(Val, Template, 2)])}
+ |merge_options(Opts, Templates)];
+ true ->
+ throw({merge,Val,Template})
+ end;
+merge_options([OptVal|Opts], Templates) ->
+ [OptVal|merge_options(Opts, Templates)];
+merge_options([], []) -> [];
+merge_options(Opts, Templates) ->
+ throw({merge,Opts,Templates}).
+
+merge_fields(Opt, Template, N) when is_integer(N), N =< tuple_size(Opt) ->
+ case element(N, Opt) of
+ undefined ->
+ [element(N, Template)|merge_fields(Opt, Template, N+1)];
+ Val ->
+ [Val|merge_fields(Opt, Template, N+1)]
+ end;
+merge_fields(_, _, _) -> [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% handle interface options
+%%
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+type_ifopt(addr) -> ip;
+type_ifopt(broadaddr) -> ip;
+type_ifopt(dstaddr) -> ip;
+type_ifopt(mtu) -> int;
+type_ifopt(netmask) -> ip;
+type_ifopt(flags) ->
+ {bitenumlist,
+ [{up, ?INET_IFF_UP},
+ {down, ?INET_IFF_DOWN},
+ {broadcast, ?INET_IFF_BROADCAST},
+ {no_broadcast, ?INET_IFF_NBROADCAST},
+ {loopback, ?INET_IFF_LOOPBACK},
+ {pointtopoint, ?INET_IFF_POINTTOPOINT},
+ {no_pointtopoint, ?INET_IFF_NPOINTTOPOINT},
+ {running, ?INET_IFF_RUNNING},
+ {multicast, ?INET_IFF_MULTICAST}]};
+type_ifopt(hwaddr) -> ether;
+type_ifopt(Opt) when is_atom(Opt) -> undefined.
+
+enc_ifopt(addr) -> ?INET_IFOPT_ADDR;
+enc_ifopt(broadaddr) -> ?INET_IFOPT_BROADADDR;
+enc_ifopt(dstaddr) -> ?INET_IFOPT_DSTADDR;
+enc_ifopt(mtu) -> ?INET_IFOPT_MTU;
+enc_ifopt(netmask) -> ?INET_IFOPT_NETMASK;
+enc_ifopt(flags) -> ?INET_IFOPT_FLAGS;
+enc_ifopt(hwaddr) -> ?INET_IFOPT_HWADDR;
+enc_ifopt(Opt) when is_atom(Opt) -> -1.
+
+dec_ifopt(?INET_IFOPT_ADDR) -> addr;
+dec_ifopt(?INET_IFOPT_BROADADDR) -> broadaddr;
+dec_ifopt(?INET_IFOPT_DSTADDR) -> dstaddr;
+dec_ifopt(?INET_IFOPT_MTU) -> mtu;
+dec_ifopt(?INET_IFOPT_NETMASK) -> netmask;
+dec_ifopt(?INET_IFOPT_FLAGS) -> flags;
+dec_ifopt(?INET_IFOPT_HWADDR) -> hwaddr;
+dec_ifopt(I) when is_integer(I) -> undefined.
+
+%% decode if options returns a reversed list
+decode_ifopts([B | Buf], Acc) ->
+ case dec_ifopt(B) of
+ undefined ->
+ {error, einval};
+ Opt ->
+ {Val,T} = dec_value(type_ifopt(Opt), Buf),
+ decode_ifopts(T, [{Opt,Val} | Acc])
+ end;
+decode_ifopts(_,Acc) -> {ok,Acc}.
+
+
+%% encode if options return a reverse list
+encode_ifopts([Opt|Opts], Acc) ->
+ case enc_ifopt(Opt) of
+ -1 -> {error,einval};
+ B -> encode_ifopts(Opts,[B|Acc])
+ end;
+encode_ifopts([],Acc) -> {ok,Acc}.
+
+
+%% encode if options return a reverse list
+encode_ifopt_val([{Opt,Val}|Opts], Buf) ->
+ Type = type_ifopt(Opt),
+ try type_value(set, Type, Val) of
+ true ->
+ encode_ifopt_val(Opts,
+ [Buf,enc_ifopt(Opt),enc_value(set, Type, Val)]);
+ false -> {error,einval}
+ catch
+ Reason -> {error,Reason}
+ end;
+encode_ifopt_val([], Buf) -> {ok,Buf}.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% handle subscribe options
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+encode_subs(L) ->
+ try enc_subs(L) of
+ Result -> {ok,Result}
+ catch
+ Error -> {error,Error}
+ end.
+
+enc_subs([H|T]) ->
+ case H of
+ subs_empty_out_q -> [?INET_SUBS_EMPTY_OUT_Q|enc_subs(T)]%;
+ %%Dialyzer _ -> throw(einval)
+ end;
+enc_subs([]) -> [].
+
+
+decode_subs(Bytes) ->
+ try dec_subs(Bytes) of
+ Result -> {ok,Result}
+ catch
+ Error -> {error,Error}
+ end.
+
+dec_subs([X,X3,X2,X1,X0|R]) ->
+ Val = ?u32(X3,X2,X1,X0),
+ case X of
+ ?INET_SUBS_EMPTY_OUT_Q -> [{subs_empty_out_q,Val}|dec_subs(R)];
+ _ -> throw(einval)
+ end;
+dec_subs([]) -> [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% handle statictics options
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+encode_stats(L) ->
+ try enc_stats(L) of
+ Result -> {ok,Result}
+ catch
+ Error -> {error,Error}
+ end.
+
+enc_stats([H|T]) ->
+ case H of
+ recv_cnt -> [?INET_STAT_RECV_CNT |enc_stats(T)];
+ recv_max -> [?INET_STAT_RECV_MAX |enc_stats(T)];
+ recv_avg -> [?INET_STAT_RECV_AVG |enc_stats(T)];
+ recv_dvi -> [?INET_STAT_RECV_DVI |enc_stats(T)];
+ send_cnt -> [?INET_STAT_SEND_CNT |enc_stats(T)];
+ send_max -> [?INET_STAT_SEND_MAX |enc_stats(T)];
+ send_avg -> [?INET_STAT_SEND_AVG |enc_stats(T)];
+ send_pend -> [?INET_STAT_SEND_PEND|enc_stats(T)];
+ send_oct -> [?INET_STAT_SEND_OCT |enc_stats(T)];
+ recv_oct -> [?INET_STAT_RECV_OCT |enc_stats(T)];
+ _ -> throw(einval)
+ end;
+enc_stats([]) -> [].
+
+
+decode_stats(Bytes) ->
+ try dec_stats(Bytes) of
+ Result -> {ok,Result}
+ catch
+ Error -> {error,Error}
+ end.
+
+
+dec_stats([?INET_STAT_SEND_OCT,X7,X6,X5,X4,X3,X2,X1,X0|R]) ->
+ Val = ?u64(X7,X6,X5,X4,X3,X2,X1,X0),
+ [{send_oct, Val}|dec_stats(R)];
+dec_stats([?INET_STAT_RECV_OCT,X7,X6,X5,X4,X3,X2,X1,X0|R]) ->
+ Val = ?u64(X7,X6,X5,X4,X3,X2,X1,X0),
+ [{recv_oct, Val}|dec_stats(R)];
+dec_stats([X,X3,X2,X1,X0|R]) ->
+ Val = ?u32(X3,X2,X1,X0),
+ case X of
+ ?INET_STAT_RECV_CNT -> [{recv_cnt,Val} |dec_stats(R)];
+ ?INET_STAT_RECV_MAX -> [{recv_max,Val} |dec_stats(R)];
+ ?INET_STAT_RECV_AVG -> [{recv_avg,Val} |dec_stats(R)];
+ ?INET_STAT_RECV_DVI -> [{recv_dvi,Val} |dec_stats(R)];
+ ?INET_STAT_SEND_CNT -> [{send_cnt,Val} |dec_stats(R)];
+ ?INET_STAT_SEND_MAX -> [{send_max,Val} |dec_stats(R)];
+ ?INET_STAT_SEND_AVG -> [{send_avg,Val} |dec_stats(R)];
+ ?INET_STAT_SEND_PEND -> [{send_pend,Val}|dec_stats(R)];
+ _ -> throw(einval)
+ end;
+dec_stats([]) -> [].
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% handle status options
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+dec_status(Flags) ->
+ enum_names(Flags,
+ [
+ {busy, ?INET_F_BUSY},
+ %% {listening, ?INET_F_LST}, NOT USED ANY MORE
+ {accepting, ?INET_F_ACC},
+ {connecting, ?INET_F_CON},
+ {listen, ?INET_F_LISTEN},
+ {connected, ?INET_F_ACTIVE},
+ {bound, ?INET_F_BOUND},
+ {open, ?INET_F_OPEN}
+ ]).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% UTILS
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+enc_time(Time) when Time < 0 -> [255,255,255,255];
+enc_time(Time) -> ?int32(Time).
+
+encode_ifname(Name) when is_atom(Name) -> encode_ifname(atom_to_list(Name));
+encode_ifname(Name) ->
+ N = length(Name),
+ if N > 255 -> {error, einval};
+ true -> {ok,[N | Name]}
+ end.
+
+build_iflist(Cs) ->
+ build_iflist(Cs, [], []).
+
+%% Turn a NULL separated list of chars into a list of strings, removing
+%% duplicates.
+build_iflist([0|L], Acc, [H|T]) ->
+ case rev(Acc) of
+ H -> build_iflist(L, [], [H|T]);
+ N -> build_iflist(L, [], [N,H|T])
+ end;
+build_iflist([0|L], Acc, []) ->
+ build_iflist(L, [], [rev(Acc)]);
+build_iflist([C|L], Acc, List) ->
+ build_iflist(L, [C|Acc], List);
+build_iflist([], [], List) ->
+ rev(List);
+build_iflist([], Acc, List) ->
+ build_iflist([0], Acc, List).
+
+rev(L) -> rev(L,[]).
+rev([C|L],Acc) -> rev(L,[C|Acc]);
+rev([],Acc) -> Acc.
+
+ip_to_bytes(IP) when tuple_size(IP) =:= 4 -> ip4_to_bytes(IP);
+ip_to_bytes(IP) when tuple_size(IP) =:= 8 -> ip6_to_bytes(IP).
+
+ip4_to_bytes({A,B,C,D}) ->
+ [A band 16#ff, B band 16#ff, C band 16#ff, D band 16#ff].
+
+ip6_to_bytes({A,B,C,D,E,F,G,H}) ->
+ [?int16(A), ?int16(B), ?int16(C), ?int16(D),
+ ?int16(E), ?int16(F), ?int16(G), ?int16(H)].
+
+get_ip(?INET_AF_INET, Addr) -> get_ip4(Addr);
+get_ip(?INET_AF_INET6, Addr) -> get_ip6(Addr).
+
+get_ip4([A,B,C,D | T]) -> {{A,B,C,D},T}.
+
+get_ip6([X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16 | T]) ->
+ { { ?u16(X1,X2),?u16(X3,X4),?u16(X5,X6),?u16(X7,X8),
+ ?u16(X9,X10),?u16(X11,X12),?u16(X13,X14),?u16(X15,X16)}, T}.
+
+
+%% Control command
+ctl_cmd(Port, Cmd, Args) ->
+ ?DBG_FORMAT("prim_inet:ctl_cmd(~p, ~p, ~p)~n", [Port,Cmd,Args]),
+ Result =
+ try erlang:port_control(Port, Cmd, Args) of
+ [?INET_REP_OK|Reply] -> {ok,Reply};
+ [?INET_REP_SCTP] -> {error,sctp_reply};
+ [?INET_REP_ERROR|Err] -> {error,list_to_atom(Err)}
+ catch
+ error:_ -> {error,einval}
+ end,
+ ?DBG_FORMAT("prim_inet:ctl_cmd() -> ~p~n", [Result]),
+ Result.
diff --git a/erts/preloaded/src/prim_zip.erl b/erts/preloaded/src/prim_zip.erl
new file mode 100644
index 0000000000..17ef8c6c43
--- /dev/null
+++ b/erts/preloaded/src/prim_zip.erl
@@ -0,0 +1,604 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% zip functions that are used by code_server
+
+-module(prim_zip).
+
+%% unzipping piecemal
+-export([
+ open/1,
+ open/3,
+ foldl/3,
+ close/1
+ ]).
+
+%% Internal function. Exported to avoid dialyzer warnings
+-export([splitter/3]).
+
+%% includes
+-include_lib("kernel/include/file.hrl"). % #file_info
+-include_lib("stdlib/include/zip.hrl"). % #zip_file, #zip_comment
+-include("zip_internal.hrl"). % #cd_file_header etc
+
+%% max bytes read from files and archives (and fed to zlib)
+-define(READ_BLOCK_SIZE, 16*1024).
+
+%% for debugging, to turn off catch
+-define(CATCH, catch).
+
+-record(primzip_file,
+ {name,
+ get_info,
+ get_bin}).
+
+-record(primzip,
+ {files = [] :: [#primzip_file{}],
+ zlib, % handle to the zlib port from zlib:open
+ input, % fun/2 for file/memory input
+ in}). % input (file handle or binary)
+
+filter_fun() ->
+ Continue = true,
+ Include = true,
+ fun({_Name, _GetInfoFun, _GetBinFun}, Acc) ->
+ {Continue, Include, Acc}
+ end.
+
+%% Open a zip archive
+open(F) ->
+ open(filter_fun(), undefined, F).
+
+open(FilterFun, FilterAcc, F) ->
+ case ?CATCH do_open(FilterFun, FilterAcc, F) of
+ {ok, PrimZip, Acc} ->
+ {ok, PrimZip, Acc};
+ Error ->
+ {error, Error}
+ end.
+
+do_open(FilterFun, FilterAcc, F) ->
+ Input = get_zip_input(F),
+ In0 = Input({open, F, [read, binary, raw]}, []),
+ Z = zlib:open(),
+ PrimZip = #primzip{files = [], zlib = Z, in = In0, input = Input},
+ {PrimZip2, FilterAcc2} = get_central_dir(PrimZip, FilterFun, FilterAcc),
+ {ok, PrimZip2, FilterAcc2}.
+
+%% iterate over all files in a zip archive
+foldl(FilterFun, FilterAcc, #primzip{files = Files} = PrimZip) ->
+ case ?CATCH do_foldl(FilterFun, FilterAcc, Files, [], PrimZip, PrimZip) of
+ {ok, FilterAcc2, PrimZip2} -> {ok, PrimZip2, FilterAcc2};
+ Error -> {error, Error}
+ end;
+foldl(_, _, _) ->
+ {error, einval}.
+
+do_foldl(FilterFun, FilterAcc, [PF | Tail], Acc0, PrimZip, PrimZipOrig) ->
+ #primzip_file{name = F, get_info = GetInfo, get_bin = GetBin} = PF,
+ case FilterFun({F, GetInfo, GetBin}, FilterAcc) of
+ {Continue, Include, FilterAcc2} ->
+ Acc1 =
+ case Include of
+ false -> Acc0;
+ true -> [PF | Acc0];
+ {true, Nick} -> [PF#primzip_file{name = Nick} | Acc0]
+ end,
+ case Continue of
+ true ->
+ do_foldl(FilterFun, FilterAcc2, Tail, Acc1, PrimZip, PrimZipOrig);
+ false ->
+ {ok, FilterAcc2, PrimZipOrig}
+ end;
+ FilterRes ->
+ throw({illegal_filter, FilterRes})
+ end;
+do_foldl(_FilterFun, FilterAcc, [], Acc, PrimZip, _PrimZipOrig) ->
+ {ok, FilterAcc, PrimZip#primzip{files = reverse(Acc)}}.
+
+%% close a zip archive
+close(#primzip{in = In0, input = Input, zlib = Z}) ->
+ Input(close, In0),
+ zlib:close(Z);
+close(_) ->
+ {error, einval}.
+
+get_zip_input({F, B}) when is_binary(B), is_list(F) ->
+ fun binary_io/2;
+get_zip_input(F) when is_list(F) ->
+ fun prim_file_io/2.
+
+%% get a file from the archive
+get_z_file(F, Offset, ChunkSize, #primzip{zlib = Z, in = In0, input = Input}) ->
+ case Input({pread, Offset, ChunkSize}, In0) of
+ {<<?LOCAL_FILE_MAGIC:32/little,
+ BLH:(?LOCAL_FILE_HEADER_SZ-4)/binary, _/binary>> = B, _In1} ->
+ #local_file_header{gp_flag = GPFlag,
+ file_name_length = FNLen,
+ extra_field_length = EFLen,
+ comp_method = CompMethod} =
+ local_file_header_from_bin(BLH, F),
+ DataOffs = ?LOCAL_FILE_HEADER_SZ + FNLen + EFLen
+ + offset_over_z_data_descriptor(GPFlag),
+ case B of
+ <<_:DataOffs/binary, Data/binary>> ->
+ Out = get_z_all(CompMethod, Data, Z, F),
+ %%{Out, CRC} = get_z_all(CompMethod, Data, Z, F),
+ %%CRC == CRC32 orelse throw({bad_crc, F}),
+ Out;
+ _ ->
+ throw({bad_local_file_offset, F})
+ end;
+ _ ->
+ throw({bad_local_file_header, F})
+ end.
+
+%% flag for zlib
+-define(MAX_WBITS, 15).
+
+%% get compressed or stored data
+get_z_all(?DEFLATED, Compressed, Z, _F) ->
+ ok = zlib:inflateInit(Z, -?MAX_WBITS),
+ Uncompressed = zlib:inflate(Z, Compressed),
+ %%_CRC = zlib:crc32(Z),
+ ?CATCH zlib:inflateEnd(Z),
+ erlang:iolist_to_binary(Uncompressed); % {erlang:iolist_to_binary(Uncompressed), CRC}
+get_z_all(?STORED, Stored, _Z, _F) ->
+ %%CRC0 = zlib:crc32(Z, <<>>),
+ %%CRC1 = zlib:crc32(Z, CRC0, Stored),
+ Stored; % {Stored, CRC1};
+get_z_all(CompMethod, _, _, F) ->
+ throw({unsupported_compression, F, CompMethod}).
+
+%% skip data descriptor if any
+offset_over_z_data_descriptor(GPFlag) when GPFlag band 8 =:= 8 ->
+ 12;
+offset_over_z_data_descriptor(_GPFlag) ->
+ 0.
+
+%% get the central directory from the archive
+get_central_dir(#primzip{in = In0, input = Input} = PrimZip, FilterFun, FilterAcc) ->
+ {B, In1} = get_end_of_central_dir(In0, ?END_OF_CENTRAL_DIR_SZ, Input),
+ {EOCD, _BComment} = eocd_and_comment_from_bin(B),
+ {BCD, In2} = Input({pread, EOCD#eocd.offset, EOCD#eocd.size}, In1),
+ N = EOCD#eocd.entries,
+ EndOffset = EOCD#eocd.offset,
+ PrimZip2 = PrimZip#primzip{in = In2},
+ if
+ N =:= 0 ->
+ {PrimZip2, FilterAcc};
+ true ->
+ {F, Offset, CFH, BCDRest} = get_file_header(BCD),
+ get_cd_loop(N, BCDRest, [], PrimZip2, F, Offset, CFH, EndOffset, FilterFun, FilterAcc, PrimZip)
+ end.
+
+get_cd_loop(N, BCD, Acc0, PrimZip, FileName, Offset, CFH, EndOffset, FilterFun, FilterAcc, PrimZipOrig) ->
+ {NextF, NextOffset, NextCFH, BCDRest, Size} =
+ if
+ N =:= 1 ->
+ {undefined, undefined, undefined, undefined, EndOffset - Offset};
+ true ->
+ {NextF0, NextOffset0, NextCFH0, BCDRest0} = get_file_header(BCD),
+ {NextF0, NextOffset0, NextCFH0, BCDRest0, NextOffset0 - Offset}
+ end,
+ %% erlang:display({FileName, N, Offset, Size, NextPF}),
+ GetInfo = fun() -> cd_file_header_to_file_info(FileName, CFH, <<>>) end,
+ GetBin = fun() -> get_z_file(FileName, Offset, Size, PrimZip) end,
+ PF = #primzip_file{name = FileName, get_info = GetInfo, get_bin = GetBin},
+ case FilterFun({FileName, GetInfo, GetBin}, FilterAcc) of
+ {Continue, Include, FilterAcc2} ->
+ Acc1 =
+ case Include of
+ false -> Acc0;
+ true -> [PF | Acc0];
+ {true, Nick} -> [PF#primzip_file{name = Nick} | Acc0]
+ end,
+ case Continue of
+ true when N > 1 ->
+ get_cd_loop(N-1, BCDRest, Acc1, PrimZip, NextF, NextOffset, NextCFH, EndOffset, FilterFun, FilterAcc2, PrimZipOrig);
+ true ->
+ PrimZip2 = PrimZip#primzip{files = reverse(Acc1)},
+ {PrimZip2, FilterAcc2};
+ false ->
+ {PrimZipOrig, FilterAcc2}
+ end;
+ FilterRes ->
+ throw({illegal_filter, FilterRes})
+ end.
+
+get_file_header(BCD) ->
+ BCFH =
+ case BCD of
+ <<?CENTRAL_FILE_MAGIC:32/little,
+ B:(?CENTRAL_FILE_HEADER_SZ-4)/binary,
+ _/binary>> ->
+ B;
+ _ ->
+ throw(bad_central_directory)
+ end,
+ CFH = cd_file_header_from_bin(BCFH),
+ FileNameLen = CFH#cd_file_header.file_name_length,
+ ExtraLen = CFH#cd_file_header.extra_field_length,
+ CommentLen = CFH#cd_file_header.file_comment_length,
+ ToGet = FileNameLen + ExtraLen + CommentLen,
+ {B2, BCDRest} =
+ case BCD of
+ <<_:?CENTRAL_FILE_HEADER_SZ/binary,
+ G:ToGet/binary,
+ Rest/binary>> ->
+ {G, Rest};
+ _ ->
+ throw(bad_central_directory)
+ end,
+ FileName = get_filename_from_b2(B2, FileNameLen, ExtraLen, CommentLen),
+ Offset = CFH#cd_file_header.local_header_offset,
+ {FileName, Offset, CFH, BCDRest}.
+
+get_filename_from_b2(B, FileNameLen, ExtraLen, CommentLen) ->
+ case B of
+ <<BFileName:FileNameLen/binary,
+ _BExtra:ExtraLen/binary,
+ _BComment:CommentLen/binary>> ->
+ binary_to_list(BFileName);
+ _ ->
+ throw(bad_central_directory)
+ end.
+
+%% get end record, containing the offset to the central directory
+%% the end record is always at the end of the file BUT alas it is
+%% of variable size (yes that's dumb!)
+get_end_of_central_dir(_In, Sz, _Input) when Sz > 16#ffff ->
+ throw(bad_eocd);
+get_end_of_central_dir(In0, Sz, Input) ->
+ In1 = Input({seek, eof, -Sz}, In0),
+ {B, In2} = Input({read, Sz}, In1),
+ case find_eocd_header(B) of
+ none ->
+ get_end_of_central_dir(In2, Sz+Sz, Input);
+ Header ->
+ {Header, In2}
+ end.
+
+%% find the end record by matching for it
+find_eocd_header(<<?END_OF_CENTRAL_DIR_MAGIC:32/little, Rest/binary>>) ->
+ Rest;
+find_eocd_header(<<_:8, Rest/binary>>)
+ when byte_size(Rest) > ?END_OF_CENTRAL_DIR_SZ-4 ->
+ find_eocd_header(Rest);
+find_eocd_header(_) ->
+ none.
+
+%% io objects
+prim_file_io({file_info, F}, _) ->
+ case prim_file:read_file_info(F) of
+ {ok, Info} -> Info;
+ {error, E} -> throw(E)
+ end;
+prim_file_io({open, FN, Opts}, _) ->
+ case ?CATCH prim_file:open(FN, Opts++[binary]) of
+ {ok, H} ->
+ H;
+ {error, E} ->
+ throw(E)
+ end;
+prim_file_io({read, N}, H) ->
+ case prim_file:read(H, N) of
+ {ok, B} -> {B, H};
+ eof -> {eof, H};
+ {error, E} -> throw(E)
+ end;
+prim_file_io({pread, Pos, N}, H) ->
+ case prim_file:pread(H, Pos, N) of
+ {ok, B} -> {B, H};
+ eof -> {eof, H};
+ {error, E} -> throw(E)
+ end;
+prim_file_io({seek, S, Pos}, H) ->
+ case prim_file:position(H, {S, Pos}) of
+ {ok, _NewPos} -> H;
+ {error, Error} -> throw(Error)
+ end;
+prim_file_io({write, Data}, H) ->
+ case prim_file:write(H, Data) of
+ ok -> H;
+ {error, Error} -> throw(Error)
+ end;
+prim_file_io({pwrite, Pos, Data}, H) ->
+ case prim_file:pwrite(H, Pos, Data) of
+ ok -> H;
+ {error, Error} -> throw(Error)
+ end;
+prim_file_io({close, FN}, H) ->
+ case prim_file:close(H) of
+ ok -> FN;
+ {error, Error} -> throw(Error)
+ end;
+prim_file_io(close, H) ->
+ prim_file_io({close, ok}, H);
+prim_file_io({set_file_info, F, FI}, H) ->
+ case prim_file:write_file_info(F, FI) of
+ ok -> H;
+ {error, Error} -> throw(Error)
+ end.
+
+binary_io({pread, NewPos, N}, {OldPos, B}) ->
+ case B of
+ <<_:NewPos/binary, Read:N/binary, _Rest/binary>> ->
+ {Read, {NewPos+N, B}};
+ _ ->
+ {eof, {OldPos, B}}
+ end;
+binary_io({read, N}, {Pos, B}) when Pos >= byte_size(B) ->
+ {eof, {Pos+N, B}};
+binary_io({read, N}, {Pos, B}) when Pos + N > byte_size(B) ->
+ case B of
+ <<_:Pos/binary, Read/binary>> ->
+ {Read, {byte_size(B), B}};
+ _ ->
+ {eof, {Pos, B}}
+ end;
+binary_io({read, N}, {Pos, B}) ->
+ case B of
+ <<_:Pos/binary, Read:N/binary, _/binary>> ->
+ {Read, {Pos+N, B}};
+ _ ->
+ {eof, {Pos, B}}
+ end;
+binary_io({seek, bof, Pos}, {_OldPos, B}) ->
+ {Pos, B};
+binary_io({seek, cur, Pos}, {OldPos, B}) ->
+ {OldPos + Pos, B};
+binary_io({seek, eof, Pos}, {_OldPos, B}) ->
+ {byte_size(B) + Pos, B};
+binary_io({file_info, {_Filename, B}}, A) ->
+ binary_io({file_info, B}, A);
+binary_io({file_info, B}, _) ->
+ {Type, Size} =
+ if
+ is_binary(B) -> {regular, byte_size(B)};
+ B =:= directory -> {directory, 0}
+ end,
+ Now = calendar:local_time(),
+ #file_info{size = Size, type = Type, access = read_write,
+ atime = Now, mtime = Now, ctime = Now,
+ mode = 0, links = 1, major_device = 0,
+ minor_device = 0, inode = 0, uid = 0, gid = 0};
+binary_io({pwrite, Pos, Data}, {OldPos, B}) ->
+ {OldPos, pwrite_binary(B, Pos, Data)};
+binary_io({write, Data}, {Pos, B}) ->
+ {Pos + erlang:iolist_size(Data), pwrite_binary(B, Pos, Data)};
+binary_io({open, {_Filename, B}, _Opts}, _) ->
+ {0, B};
+binary_io({open, B, _Opts}, _) when is_binary(B) ->
+ {0, B};
+binary_io({open, Filename, _Opts}, _) when is_list(Filename) ->
+ {0, <<>>};
+binary_io(close, {_Pos, B}) ->
+ B;
+binary_io({close, FN}, {_Pos, B}) ->
+ {FN, B}.
+
+%% ZIP header manipulations
+eocd_and_comment_from_bin(<<DiskNum:16/little,
+ StartDiskNum:16/little,
+ EntriesOnDisk:16/little,
+ Entries:16/little,
+ Size:32/little,
+ Offset:32/little,
+ ZipCommentLength:16/little,
+ Comment:ZipCommentLength/binary>>) ->
+ {#eocd{disk_num = DiskNum,
+ start_disk_num = StartDiskNum,
+ entries_on_disk = EntriesOnDisk,
+ entries = Entries,
+ size = Size,
+ offset = Offset,
+ zip_comment_length = ZipCommentLength},
+ Comment};
+eocd_and_comment_from_bin(_) ->
+ throw(bad_eocd).
+
+%% make a file_info from a central directory header
+cd_file_header_to_file_info(FileName,
+ #cd_file_header{uncomp_size = UncompSize,
+ last_mod_time = ModTime,
+ last_mod_date = ModDate},
+ ExtraField) when is_binary(ExtraField) ->
+ T = dos_date_time_to_datetime(ModDate, ModTime),
+ Type =
+ case last(FileName) of
+ $/ -> directory;
+ _ -> regular
+ end,
+ FI = #file_info{size = UncompSize,
+ type = Type,
+ access = read_write,
+ atime = T,
+ mtime = T,
+ ctime = T,
+ mode = 8#066,
+ links = 1,
+ major_device = 0,
+ minor_device = 0,
+ inode = 0,
+ uid = 0,
+ gid = 0},
+ add_extra_info(FI, ExtraField).
+
+%% add extra info to file (some day when we implement it)
+%% add_extra_info(FI, <<?EXTENDED_TIMESTAMP_TAG:16/little, _Rest/binary>>) ->
+%% FI; % not yet supported, some other day...
+%% add_extra_info(FI, <<?UNIX_EXTRA_FIELD_TAG:16/little, Rest/binary>>) ->
+%% _UnixExtra = unix_extra_field_and_var_from_bin(Rest),
+%% FI; % not yet supported, and not widely used
+add_extra_info(FI, _) ->
+ FI.
+%%
+%% unix_extra_field_and_var_from_bin(<<TSize:16/little,
+%% ATime:32/little,
+%% MTime:32/little,
+%% UID:16/little,
+%% GID:16/little,
+%% Var:TSize/binary>>) ->
+%% {#unix_extra_field{atime = ATime,
+%% mtime = MTime,
+%% uid = UID,
+%% gid = GID},
+%% Var};
+%% unix_extra_field_and_var_from_bin(_) ->
+%% throw(bad_unix_extra_field).
+
+%% convert between erlang datetime and the MSDOS date and time
+%% that's stored in the zip archive
+%% MSDOS Time MSDOS Date
+%% bit 0 - 4 5 - 10 11 - 15 16 - 20 21 - 24 25 - 31
+%% value second minute hour day (1 - 31) month (1 - 12) years from 1980
+dos_date_time_to_datetime(DosDate, DosTime) ->
+ <<Hour:5, Min:6, Sec:5>> = <<DosTime:16>>,
+ <<YearFrom1980:7, Month:4, Day:5>> = <<DosDate:16>>,
+ {{YearFrom1980+1980, Month, Day},
+ {Hour, Min, Sec}}.
+
+cd_file_header_from_bin(<<VersionMadeBy:16/little,
+ VersionNeeded:16/little,
+ GPFlag:16/little,
+ CompMethod:16/little,
+ LastModTime:16/little,
+ LastModDate:16/little,
+ CRC32:32/little,
+ CompSize:32/little,
+ UncompSize:32/little,
+ FileNameLength:16/little,
+ ExtraFieldLength:16/little,
+ FileCommentLength:16/little,
+ DiskNumStart:16/little,
+ InternalAttr:16/little,
+ ExternalAttr:32/little,
+ LocalHeaderOffset:32/little>>) ->
+ #cd_file_header{version_made_by = VersionMadeBy,
+ version_needed = VersionNeeded,
+ gp_flag = GPFlag,
+ comp_method = CompMethod,
+ last_mod_time = LastModTime,
+ last_mod_date = LastModDate,
+ crc32 = CRC32,
+ comp_size = CompSize,
+ uncomp_size = UncompSize,
+ file_name_length = FileNameLength,
+ extra_field_length = ExtraFieldLength,
+ file_comment_length = FileCommentLength,
+ disk_num_start = DiskNumStart,
+ internal_attr = InternalAttr,
+ external_attr = ExternalAttr,
+ local_header_offset = LocalHeaderOffset};
+cd_file_header_from_bin(_) ->
+ throw(bad_cd_file_header).
+
+local_file_header_from_bin(<<VersionNeeded:16/little,
+ GPFlag:16/little,
+ CompMethod:16/little,
+ LastModTime:16/little,
+ LastModDate:16/little,
+ CRC32:32/little,
+ CompSize:32/little,
+ UncompSize:32/little,
+ FileNameLength:16/little,
+ ExtraFieldLength:16/little>>,
+ _F) ->
+ #local_file_header{version_needed = VersionNeeded,
+ gp_flag = GPFlag,
+ comp_method = CompMethod,
+ last_mod_time = LastModTime,
+ last_mod_date = LastModDate,
+ crc32 = CRC32,
+ comp_size = CompSize,
+ uncomp_size = UncompSize,
+ file_name_length = FileNameLength,
+ extra_field_length = ExtraFieldLength};
+local_file_header_from_bin(_, F) ->
+ throw({bad_local_file_header, F}).
+
+%% A pwrite-like function for iolists (used by memory-option)
+
+split_iolist(B, Pos) when is_binary(B) ->
+ split_binary(B, Pos);
+split_iolist(L, Pos) when is_list(L) ->
+ splitter([], L, Pos).
+
+splitter(Left, Right, 0) ->
+ {Left, Right};
+splitter(<<>>, Right, RelPos) ->
+ split_iolist(Right, RelPos);
+splitter(Left, [A | Right], RelPos) when is_list(A) or is_binary(A) ->
+ Sz = erlang:iolist_size(A),
+ case Sz > RelPos of
+ true ->
+ {Leftx, Rightx} = split_iolist(A, RelPos),
+ {[Left | Leftx], [Rightx, Right]};
+ _ ->
+ splitter([Left | A], Right, RelPos - Sz)
+ end;
+splitter(Left, [A | Right], RelPos) when is_integer(A) ->
+ splitter([Left, A], Right, RelPos - 1);
+splitter(Left, Right, RelPos) when is_binary(Right) ->
+ splitter(Left, [Right], RelPos).
+
+skip_iolist(B, Pos) when is_binary(B) ->
+ case B of
+ <<_:Pos/binary, Bin/binary>> -> Bin;
+ _ -> <<>>
+ end;
+skip_iolist(L, Pos) when is_list(L) ->
+ skipper(L, Pos).
+
+skipper(Right, 0) ->
+ Right;
+skipper([A | Right], RelPos) when is_list(A) or is_binary(A) ->
+ Sz = erlang:iolist_size(A),
+ case Sz > RelPos of
+ true ->
+ Rightx = skip_iolist(A, RelPos),
+ [Rightx, Right];
+ _ ->
+ skip_iolist(Right, RelPos - Sz)
+ end;
+skipper([A | Right], RelPos) when is_integer(A) ->
+ skip_iolist(Right, RelPos - 1).
+
+pwrite_iolist(Iolist, Pos, Bin) ->
+ {Left, Right} = split_iolist(Iolist, Pos),
+ Sz = erlang:iolist_size(Bin),
+ R = skip_iolist(Right, Sz),
+ [Left, Bin | R].
+
+pwrite_binary(B, Pos, Bin) ->
+ erlang:iolist_to_binary(pwrite_iolist(B, Pos, Bin)).
+
+reverse(X) ->
+ reverse(X, []).
+
+reverse([H|T], Y) ->
+ reverse(T, [H|Y]);
+reverse([], X) ->
+ X.
+
+last([E|Es]) -> last(E, Es).
+
+last(_, [E|Es]) -> last(E, Es);
+last(E, []) -> E.
diff --git a/erts/preloaded/src/zip_internal.hrl b/erts/preloaded/src/zip_internal.hrl
new file mode 100644
index 0000000000..a8f7b1f1b7
--- /dev/null
+++ b/erts/preloaded/src/zip_internal.hrl
@@ -0,0 +1,103 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%% ZIP-file format records and defines
+
+%% compression methods
+-define(STORED, 0).
+-define(UNCOMPRESSED, 0).
+-define(SHRUNK, 1).
+-define(REDUCED_1, 2).
+-define(REDUCED_2, 3).
+-define(REDUCED_3, 4).
+-define(REDUCED_4, 5).
+-define(IMPLODED, 6).
+-define(TOKENIZED, 7).
+-define(DEFLATED, 8).
+-define(DEFLATED_64, 9).
+-define(PKWARE_IMPLODED, 10).
+-define(PKWARE_RESERVED, 11).
+-define(BZIP2_COMPRESSED, 12).
+
+%% zip-file records
+-define(LOCAL_FILE_MAGIC,16#04034b50).
+-define(LOCAL_FILE_HEADER_SZ,(4+2+2+2+2+2+4+4+4+2+2)).
+-define(LOCAL_FILE_HEADER_CRC32_OFFSET, 4+2+2+2+2+2).
+-record(local_file_header, {version_needed,
+ gp_flag,
+ comp_method,
+ last_mod_time,
+ last_mod_date,
+ crc32,
+ comp_size,
+ uncomp_size,
+ file_name_length,
+ extra_field_length}).
+
+-define(CENTRAL_FILE_HEADER_SZ,(4+2+2+2+2+2+2+4+4+4+2+2+2+2+2+4+4)).
+
+-define(CENTRAL_DIR_MAGIC, 16#06054b50).
+-define(CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)).
+-define(CENTRAL_DIR_DIGITAL_SIG_MAGIC, 16#05054b50).
+-define(CENTRAL_DIR_DIGITAL_SIG_SZ, (4+2)).
+
+-define(CENTRAL_FILE_MAGIC, 16#02014b50).
+
+-record(cd_file_header, {version_made_by,
+ version_needed,
+ gp_flag,
+ comp_method,
+ last_mod_time,
+ last_mod_date,
+ crc32,
+ comp_size,
+ uncomp_size,
+ file_name_length,
+ extra_field_length,
+ file_comment_length,
+ disk_num_start,
+ internal_attr,
+ external_attr,
+ local_header_offset}).
+
+%% Unix extra fields (not yet supported)
+-define(UNIX_EXTRA_FIELD_TAG, 16#000d).
+-record(unix_extra_field, {atime,
+ mtime,
+ uid,
+ gid}).
+
+%% extended timestamps (not yet supported)
+-define(EXTENDED_TIMESTAMP_TAG, 16#5455).
+-record(extended_timestamp, {mtime,
+ atime,
+ ctime}).
+
+-define(END_OF_CENTRAL_DIR_MAGIC, 16#06054b50).
+-define(END_OF_CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)).
+
+-record(eocd, {disk_num,
+ start_disk_num,
+ entries_on_disk,
+ entries,
+ size,
+ offset,
+ zip_comment_length}).
+
+
diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl
new file mode 100644
index 0000000000..21971a75cf
--- /dev/null
+++ b/erts/preloaded/src/zlib.erl
@@ -0,0 +1,421 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(zlib).
+
+-export([open/0,close/1,deflateInit/1,deflateInit/2,deflateInit/6,
+ deflateSetDictionary/2,deflateReset/1,deflateParams/3,
+ deflate/2,deflate/3,deflateEnd/1,
+ inflateInit/1,inflateInit/2,inflateSetDictionary/2,
+ inflateSync/1,inflateReset/1,inflate/2,inflateEnd/1,
+ setBufSize/2,getBufSize/1,
+ crc32/1,crc32/2,crc32/3,adler32/2,adler32/3,getQSize/1,
+ crc32_combine/4,adler32_combine/4,
+ compress/1,uncompress/1,zip/1,unzip/1,
+ gzip/1,gunzip/1]).
+
+%% flush argument encoding
+-define(Z_NO_FLUSH, 0).
+-define(Z_SYNC_FLUSH, 2).
+-define(Z_FULL_FLUSH, 3).
+-define(Z_FINISH, 4).
+
+%% compression level
+-define(Z_NO_COMPRESSION, 0).
+-define(Z_BEST_SPEED, 1).
+-define(Z_BEST_COMPRESSION, 9).
+-define(Z_DEFAULT_COMPRESSION, (-1)).
+
+%% compresssion strategy
+-define(Z_FILTERED, 1).
+-define(Z_HUFFMAN_ONLY, 2).
+-define(Z_DEFAULT_STRATEGY, 0).
+
+%% deflate compression method
+-define(Z_DEFLATED, 8).
+
+-define(Z_NULL, 0).
+
+-define(MAX_WBITS, 15).
+
+%% gzip defs (rfc 1952)
+
+-define(ID1, 16#1f).
+-define(ID2, 16#8b).
+
+-define(FTEXT, 16#01).
+-define(FHCRC, 16#02).
+-define(FEXTRA, 16#04).
+-define(FNAME, 16#08).
+-define(FCOMMENT, 16#10).
+-define(RESERVED, 16#E0).
+
+-define(OS_MDDOS, 0).
+-define(OS_AMIGA, 1).
+-define(OS_OPENVMS, 2).
+-define(OS_UNIX, 3).
+-define(OS_VMCMS, 4).
+-define(OS_ATARI, 5).
+-define(OS_OS2, 6).
+-define(OS_MAC, 7).
+-define(OS_ZSYS, 8).
+-define(OS_CPM, 9).
+-define(OS_TOP20, 10).
+-define(OS_NTFS, 11).
+-define(OS_QDOS, 12).
+-define(OS_ACORN, 13).
+-define(OS_UNKNOWN,255).
+
+-define(DEFLATE_INIT, 1).
+-define(DEFLATE_INIT2, 2).
+-define(DEFLATE_SETDICT, 3).
+-define(DEFLATE_RESET, 4).
+-define(DEFLATE_END, 5).
+-define(DEFLATE_PARAMS, 6).
+-define(DEFLATE, 7).
+
+-define(INFLATE_INIT, 8).
+-define(INFLATE_INIT2, 9).
+-define(INFLATE_SETDICT, 10).
+-define(INFLATE_SYNC, 11).
+-define(INFLATE_RESET, 12).
+-define(INFLATE_END, 13).
+-define(INFLATE, 14).
+
+-define(CRC32_0, 15).
+-define(CRC32_1, 16).
+-define(CRC32_2, 17).
+
+-define(SET_BUFSZ, 18).
+-define(GET_BUFSZ, 19).
+-define(GET_QSIZE, 20).
+
+-define(ADLER32_1, 21).
+-define(ADLER32_2, 22).
+
+-define(CRC32_COMBINE, 23).
+-define(ADLER32_COMBINE, 24).
+
+%%------------------------------------------------------------------------
+
+%% Main data types of the file
+-type(iodata() :: iolist() | binary()). %XXX To be removed in R13B.
+-type zstream() :: port().
+
+%% Auxiliary data types of the file
+-type zlevel() :: 'none' | 'default' | 'best_compression' | 'best_speed'
+ | 0..9.
+-type zmethod() :: 'deflated'.
+-type zwindowbits() :: -15..-9 | 9..47.
+-type zmemlevel() :: 1..9.
+-type zstrategy() :: 'default' | 'filtered' | 'huffman_only'.
+-type zflush() :: 'none' | 'sync' | 'full' | 'finish'.
+
+%%------------------------------------------------------------------------
+
+%% open a z_stream
+-spec open() -> zstream().
+open() ->
+ open_port({spawn, "zlib_drv"}, [binary]).
+
+%% close and release z_stream
+-spec close(zstream()) -> 'ok'.
+close(Z) ->
+ try
+ true = port_close(Z),
+ receive %In case the caller is the owner and traps exits
+ {'EXIT',Z,_} -> ok
+ after 0 -> ok
+ end
+ catch _:_ -> erlang:error(badarg)
+ end.
+
+-spec deflateInit(zstream()) -> 'ok'.
+deflateInit(Z) ->
+ call(Z, ?DEFLATE_INIT, <<?Z_DEFAULT_COMPRESSION:32>>).
+
+-spec deflateInit(zstream(), zlevel()) -> 'ok'.
+deflateInit(Z, Level) ->
+ call(Z, ?DEFLATE_INIT, <<(arg_level(Level)):32>>).
+
+-spec deflateInit(zstream(), zlevel(), zmethod(),
+ zwindowbits(), zmemlevel(), zstrategy()) -> 'ok'.
+deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) ->
+ call(Z, ?DEFLATE_INIT2, <<(arg_level(Level)):32,
+ (arg_method(Method)):32,
+ (arg_bitsz(WindowBits)):32,
+ (arg_mem(MemLevel)):32,
+ (arg_strategy(Strategy)):32>>).
+
+-spec deflateSetDictionary(zstream(), binary()) -> integer().
+deflateSetDictionary(Z, Dictionary) ->
+ call(Z, ?DEFLATE_SETDICT, Dictionary).
+
+-spec deflateReset(zstream()) -> 'ok'.
+deflateReset(Z) ->
+ call(Z, ?DEFLATE_RESET, []).
+
+-spec deflateParams(zstream(), zlevel(), zstrategy()) -> 'ok'.
+deflateParams(Z, Level, Strategy) ->
+ call(Z, ?DEFLATE_PARAMS, <<(arg_level(Level)):32,
+ (arg_strategy(Strategy)):32>>).
+
+-spec deflate(zstream(), iodata()) -> iolist().
+deflate(Z, Data) ->
+ deflate(Z, Data, none).
+
+-spec deflate(zstream(), iodata(), zflush()) -> iolist().
+deflate(Z, Data, Flush) ->
+ try port_command(Z, Data) of
+ true ->
+ call(Z, ?DEFLATE, <<(arg_flush(Flush)):32>>),
+ collect(Z)
+ catch
+ error:_Err ->
+ flush(Z),
+ erlang:error(badarg)
+ end.
+
+-spec deflateEnd(zstream()) -> 'ok'.
+deflateEnd(Z) ->
+ call(Z, ?DEFLATE_END, []).
+
+-spec inflateInit(zstream()) -> 'ok'.
+inflateInit(Z) ->
+ call(Z, ?INFLATE_INIT, []).
+
+-spec inflateInit(zstream(), zwindowbits()) -> 'ok'.
+inflateInit(Z, WindowBits) ->
+ call(Z, ?INFLATE_INIT2, <<(arg_bitsz(WindowBits)):32>>).
+
+-spec inflateSetDictionary(zstream(), binary()) -> 'ok'.
+inflateSetDictionary(Z, Dictionary) ->
+ call(Z, ?INFLATE_SETDICT, Dictionary).
+
+-spec inflateSync(zstream()) -> 'ok'.
+inflateSync(Z) ->
+ call(Z, ?INFLATE_SYNC, []).
+
+-spec inflateReset(zstream()) -> 'ok'.
+inflateReset(Z) ->
+ call(Z, ?INFLATE_RESET, []).
+
+-spec inflate(zstream(), iodata()) -> iolist().
+inflate(Z, Data) ->
+ try port_command(Z, Data) of
+ true ->
+ call(Z, ?INFLATE, <<?Z_NO_FLUSH:32>>),
+ collect(Z)
+ catch
+ error:_Err ->
+ flush(Z),
+ erlang:error(badarg)
+ end.
+
+-spec inflateEnd(zstream()) -> 'ok'.
+inflateEnd(Z) ->
+ call(Z, ?INFLATE_END, []).
+
+-spec setBufSize(zstream(), non_neg_integer()) -> 'ok'.
+setBufSize(Z, Size) ->
+ call(Z, ?SET_BUFSZ, <<Size:32>>).
+
+-spec getBufSize(zstream()) -> non_neg_integer().
+getBufSize(Z) ->
+ call(Z, ?GET_BUFSZ, []).
+
+-spec crc32(zstream()) -> integer().
+crc32(Z) ->
+ call(Z, ?CRC32_0, []).
+
+-spec crc32(zstream(), binary()) -> integer().
+crc32(Z, Binary) ->
+ call(Z, ?CRC32_1, Binary).
+
+-spec crc32(zstream(), integer(), binary()) -> integer().
+crc32(Z, CRC, Binary) when is_binary(Binary), is_integer(CRC) ->
+ call(Z, ?CRC32_2, <<CRC:32, Binary/binary>>);
+crc32(_Z, _CRC, _Binary) ->
+ erlang:error(badarg).
+
+-spec adler32(zstream(), binary()) -> integer().
+adler32(Z, Binary) ->
+ call(Z, ?ADLER32_1, Binary).
+
+-spec adler32(zstream(), integer(), binary()) -> integer().
+adler32(Z, Adler, Binary) when is_binary(Binary), is_integer(Adler) ->
+ call(Z, ?ADLER32_2, <<Adler:32, Binary/binary>>);
+adler32(_Z, _Adler, _Binary) ->
+ erlang:error(badarg).
+
+-spec crc32_combine(zstream(), integer(), integer(), integer()) -> integer().
+crc32_combine(Z, CRC1, CRC2, Len2)
+ when is_integer(CRC1), is_integer(CRC2), is_integer(Len2) ->
+ call(Z, ?CRC32_COMBINE, <<CRC1:32, CRC2:32, Len2:32>>);
+crc32_combine(_Z, _CRC1, _CRC2, _Len2) ->
+ erlang:error(badarg).
+
+-spec adler32_combine(zstream(), integer(), integer(), integer()) -> integer().
+adler32_combine(Z, Adler1, Adler2, Len2)
+ when is_integer(Adler1), is_integer(Adler2), is_integer(Len2) ->
+ call(Z, ?ADLER32_COMBINE, <<Adler1:32, Adler2:32, Len2:32>>);
+adler32_combine(_Z, _Adler1, _Adler2, _Len2) ->
+ erlang:error(badarg).
+
+-spec getQSize(zstream()) -> non_neg_integer().
+getQSize(Z) ->
+ call(Z, ?GET_QSIZE, []).
+
+%% compress/uncompress zlib with header
+-spec compress(binary()) -> binary().
+compress(Binary) ->
+ Z = open(),
+ deflateInit(Z, default),
+ Bs = deflate(Z, Binary,finish),
+ deflateEnd(Z),
+ close(Z),
+ list_to_binary(Bs).
+
+-spec uncompress(binary()) -> binary().
+uncompress(Binary) when byte_size(Binary) >= 8 ->
+ Z = open(),
+ inflateInit(Z),
+ Bs = inflate(Z, Binary),
+ inflateEnd(Z),
+ close(Z),
+ list_to_binary(Bs);
+uncompress(Binary) when is_binary(Binary) -> erlang:error(data_error);
+uncompress(_) -> erlang:error(badarg).
+
+%% unzip/zip zlib without header (zip members)
+-spec zip(binary()) -> binary().
+zip(Binary) ->
+ Z = open(),
+ deflateInit(Z, default, deflated, -?MAX_WBITS, 8, default),
+ Bs = deflate(Z, Binary, finish),
+ deflateEnd(Z),
+ close(Z),
+ list_to_binary(Bs).
+
+-spec unzip(binary()) -> binary().
+unzip(Binary) ->
+ Z = open(),
+ inflateInit(Z, -?MAX_WBITS),
+ Bs = inflate(Z, Binary),
+ inflateEnd(Z),
+ close(Z),
+ list_to_binary(Bs).
+
+-spec gzip(iodata()) -> binary().
+gzip(Data) when is_binary(Data); is_list(Data) ->
+ Z = open(),
+ deflateInit(Z, default, deflated, 16+?MAX_WBITS, 8, default),
+ Bs = deflate(Z, Data, finish),
+ deflateEnd(Z),
+ close(Z),
+ iolist_to_binary(Bs);
+gzip(_) -> erlang:error(badarg).
+
+-spec gunzip(iodata()) -> binary().
+gunzip(Data) when is_binary(Data); is_list(Data) ->
+ Z = open(),
+ inflateInit(Z, 16+?MAX_WBITS),
+ Bs = inflate(Z, Data),
+ inflateEnd(Z),
+ close(Z),
+ iolist_to_binary(Bs);
+gunzip(_) -> erlang:error(badarg).
+
+-spec collect(zstream()) -> iolist().
+collect(Z) ->
+ collect(Z, []).
+
+-spec collect(zstream(), iolist()) -> iolist().
+collect(Z, Acc) ->
+ receive
+ {Z, {data, Bin}} ->
+ collect(Z, [Bin|Acc])
+ after 0 ->
+ reverse(Acc)
+ end.
+
+-spec flush(zstream()) -> 'ok'.
+flush(Z) ->
+ receive
+ {Z, {data,_}} ->
+ flush(Z)
+ after 0 ->
+ ok
+ end.
+
+arg_flush(none) -> ?Z_NO_FLUSH;
+%% ?Z_PARTIAL_FLUSH is deprecated in zlib -- deliberately not included.
+arg_flush(sync) -> ?Z_SYNC_FLUSH;
+arg_flush(full) -> ?Z_FULL_FLUSH;
+arg_flush(finish) -> ?Z_FINISH;
+arg_flush(_) -> erlang:error(badarg).
+
+arg_level(none) -> ?Z_NO_COMPRESSION;
+arg_level(best_speed) -> ?Z_BEST_SPEED;
+arg_level(best_compression) -> ?Z_BEST_COMPRESSION;
+arg_level(default) -> ?Z_DEFAULT_COMPRESSION;
+arg_level(Level) when is_integer(Level), Level >= 0, Level =< 9 -> Level;
+arg_level(_) -> erlang:error(badarg).
+
+arg_strategy(filtered) -> ?Z_FILTERED;
+arg_strategy(huffman_only) -> ?Z_HUFFMAN_ONLY;
+arg_strategy(default) -> ?Z_DEFAULT_STRATEGY;
+arg_strategy(_) -> erlang:error(badarg).
+
+arg_method(deflated) -> ?Z_DEFLATED;
+arg_method(_) -> erlang:error(badarg).
+
+-spec arg_bitsz(zwindowbits()) -> zwindowbits().
+arg_bitsz(Bits) when is_integer(Bits) andalso
+ ((8 < Bits andalso Bits < 48) orelse
+ (-15 =< Bits andalso Bits < -8)) ->
+ Bits;
+arg_bitsz(_) -> erlang:error(badarg).
+
+-spec arg_mem(zmemlevel()) -> zmemlevel().
+arg_mem(Level) when is_integer(Level), 1 =< Level, Level =< 9 -> Level;
+arg_mem(_) -> erlang:error(badarg).
+
+call(Z, Cmd, Arg) ->
+ try port_control(Z, Cmd, Arg) of
+ [0|Res] -> list_to_atom(Res);
+ [1|Res] ->
+ flush(Z),
+ erlang:error(list_to_atom(Res));
+ [2,A,B,C,D] ->
+ (A bsl 24)+(B bsl 16)+(C bsl 8)+D;
+ [3,A,B,C,D] ->
+ erlang:error({need_dictionary,(A bsl 24)+(B bsl 16)+(C bsl 8)+D})
+ catch
+ error:badarg -> %% Rethrow loses port_control from stacktrace.
+ erlang:error(badarg)
+ end.
+
+reverse(X) ->
+ reverse(X, []).
+
+reverse([H|T], Y) ->
+ reverse(T, [H|Y]);
+reverse([], X) ->
+ X.