aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/preloaded/ebin/erl_prim_loader.beambin54420 -> 55108 bytes
-rw-r--r--erts/preloaded/src/erl_prim_loader.erl110
-rw-r--r--lib/compiler/src/compile.erl18
-rw-r--r--lib/compiler/test/compile_SUITE.erl12
-rw-r--r--lib/stdlib/test/escript_SUITE.erl69
-rw-r--r--lib/stdlib/test/escript_SUITE_data/archive_script_file_access/archive_script_file_access.erl29
6 files changed, 159 insertions, 79 deletions
diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam
index 19a0693197..80fc79f396 100644
--- a/erts/preloaded/ebin/erl_prim_loader.beam
+++ b/erts/preloaded/ebin/erl_prim_loader.beam
Binary files differ
diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl
index cd5519f537..5ee3d03fef 100644
--- a/erts/preloaded/src/erl_prim_loader.erl
+++ b/erts/preloaded/src/erl_prim_loader.erl
@@ -836,7 +836,7 @@ prim_set_primary_archive(PS, ArchiveFile0, ArchiveBin,
when is_list(ArchiveFile0), is_binary(ArchiveBin) ->
%% Try the archive file
debug(PS, {set_primary_archive, ArchiveFile0, byte_size(ArchiveBin)}),
- ArchiveFile = absname(ArchiveFile0),
+ ArchiveFile = real_path(absname(ArchiveFile0)),
{Res3, PS3} =
case PS#prim_state.primary_archive of
undefined ->
@@ -1076,7 +1076,7 @@ open_archive(Archive, Acc, Fun) ->
%%
%% In the archive (zip) file, directory elements might or might not be
%% present. To ensure consistency, a directory element is added if it
-%% does not already exist (ensure_virual_dir/6). NOTE that there will
+%% does not already exist (ensure_virtual_dirs/6). NOTE that there will
%% be no such directory element for the top directory of the archive.
open_archive(Archive, FileInfo, Acc, Fun) ->
FakeFI = FileInfo#file_info{type = directory},
@@ -1243,6 +1243,17 @@ path_split([Head | Tail], Path, Paths) ->
path_split([], Path, Paths) ->
[Path | Paths].
+%% The opposite of path_split/1
+path_join(Paths) ->
+ path_join(Paths,[]).
+
+path_join([""],Acc) ->
+ Acc;
+path_join([Path],Acc) ->
+ reverse(Path) ++ Acc;
+path_join([Path|Paths],Acc) ->
+ path_join(Paths,"/" ++ reverse(Path) ++ Acc).
+
name_split(ArchiveFile, File0) ->
File = absname(File0),
do_name_split(ArchiveFile, File).
@@ -1267,7 +1278,7 @@ do_name_split(undefined, File) ->
end;
do_name_split(ArchiveFile, File) ->
%% Look first in primary archive
- case string_match(File, ArchiveFile, []) of
+ case string_match(real_path(File), ArchiveFile, []) of
no_match ->
%% Archive or plain file
do_name_split(undefined, File);
@@ -1333,26 +1344,24 @@ 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, []),
- Name3 =
- 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,
- path_flatten(Name3).
+ 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, $\: | _]) ->
@@ -1462,25 +1471,42 @@ normalize(Name, Acc) ->
%% Remove .. and . from the path, e.g.
%% /path/./to/this/../file -> /path/to/file
-path_flatten(Name) ->
- path_flatten(Name,[],[]).
-
-path_flatten([$/,$.,$.,$/|Rest],_RevLast,RevTop) ->
- path_flatten(Rest,[],RevTop);
-path_flatten([$/,$.,$/|Rest],RevLast,RevTop) ->
- path_flatten([$/|Rest],RevLast,RevTop);
-path_flatten([$/,$.,$.],_RevLast,RevTop) ->
- path_flatten([],[],RevTop);
-path_flatten([$/,$.],RevLast,RevTop) ->
- path_flatten([],RevLast,RevTop);
-path_flatten([$/],RevLast,RevTop) ->
- path_flatten([],RevLast,RevTop);
-path_flatten([$/|Rest],RevLast,RevTop) ->
- path_flatten(Rest,[],[$/|RevLast++RevTop]);
-path_flatten([Ch|Rest],RevLast,RevTop) ->
- path_flatten(Rest,[Ch|RevLast],RevTop);
-path_flatten([],RevLast,RevTop) ->
- reverse(RevLast++RevTop).
+%% This includes resolving symlinks.
+%%
+%% This is done to ensure that paths are totally normalized before
+%% comparing to find out if a file is inside the primary archive or
+%% not.
+real_path(Name) ->
+ real_path(Name,reverse(path_split(Name)),[],[]).
+
+real_path(_Name,[],Acc,_Links) ->
+ path_join(Acc);
+real_path(Name,["."|Paths],Acc,Links) ->
+ real_path(Name,Paths,Acc,Links);
+real_path(Name,[".."|Paths],[""]=Acc,Links) ->
+ %% /.. -> / (can't get higher than root)
+ real_path(Name,Paths,Acc,Links);
+real_path(Name,[".."|Paths],[Prev|Acc],Links) when Prev=/=".." ->
+ real_path(Name,Paths,Acc,Links);
+real_path(Name,[Path|Paths],Acc,Links) ->
+ This = [Path|Acc],
+ ThisFile = path_join(This),
+ case lists:member(ThisFile,Links) of
+ true -> % circular!!
+ Name;
+ false ->
+ case prim_file:read_link(ThisFile) of
+ {ok,Link} ->
+ case reverse(path_split(Link)) of
+ [""|_] = LinkPaths ->
+ real_path(Name,LinkPaths++Paths,[],[ThisFile|Links]);
+ LinkPaths ->
+ real_path(Name,LinkPaths++Paths,Acc,[ThisFile|Links])
+ end;
+ _ ->
+ real_path(Name,Paths,This,Links)
+ end
+ end.
load_prim_archive(ArchiveFile, ArchiveBin, #file_info{}=FileInfo) ->
Fun = fun({Components, _GI, _GB}, A) ->
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 7911f51a73..7365706b94 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -146,10 +146,17 @@ env_default_opts() ->
do_compile(Input, Opts0) ->
Opts = expand_opts(Opts0),
- Self = self(),
- Serv = spawn_link(fun() -> internal(Self, Input, Opts) end),
+ {Pid,Ref} =
+ spawn_monitor(fun() ->
+ exit(try
+ internal(Input, Opts)
+ catch
+ error:Reason ->
+ {error,Reason}
+ end)
+ end),
receive
- {Serv,Rep} -> Rep
+ {'DOWN',Ref,process,Pid,Rep} -> Rep
end.
expand_opts(Opts0) ->
@@ -242,11 +249,6 @@ format_error({module_name,Mod,Filename}) ->
errors=[],
warnings=[]}).
-internal(Master, Input, Opts) ->
- Master ! {self(), try internal(Input, Opts)
- catch error:Reason -> {error, Reason}
- end}.
-
internal({forms,Forms}, Opts0) ->
{_,Ps} = passes(forms, Opts0),
Source = proplists:get_value(source, Opts0, ""),
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 9dbfb5883b..da53a6ba9c 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -76,6 +76,9 @@ app_test(Config) when is_list(Config) ->
file_1(Config) when is_list(Config) ->
?line Dog = test_server:timetrap(test_server:minutes(5)),
+
+ process_flag(trap_exit, true),
+
?line {Simple, Target} = files(Config, "file_1"),
?line {ok, Cwd} = file:get_cwd(),
?line ok = file:set_cwd(filename:dirname(Target)),
@@ -102,6 +105,15 @@ file_1(Config) when is_list(Config) ->
%% Cleanup.
?line ok = file:delete(Target),
?line ok = file:del_dir(filename:dirname(Target)),
+
+ %% There should not be any messages in the messages.
+ receive
+ Any ->
+ ?t:fail({unexpected,Any})
+ after 10 ->
+ ok
+ end,
+
?line test_server:timetrap_cancel(Dog),
ok.
diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl
index 7b03fdafe3..38c085616d 100644
--- a/lib/stdlib/test/escript_SUITE.erl
+++ b/lib/stdlib/test/escript_SUITE.erl
@@ -469,22 +469,23 @@ archive_script(Config) when is_list(Config) ->
%% Test the correction of OTP-10071
%% The errors identified are
%%
-%% * If primary archive was named "xxx", then a file in the same
-%% directory named "xxxyyy" would be interpreted as a file named yyy
-%% inside the archive.
+%% a) If primary archive was named "xxx", then a file in the same
+%% directory named "xxxyyy" would be interpreted as a file named yyy
+%% inside the archive.
%%
-%% * erl_prim_loader did not correctly create and normalize absolute
-%% paths for primary archive and files inside it, so unless given
-%% with exact same path files inside the archive would not be
-%% found. E.g. if escript was started as ./xxx then "xxx/file" would
-%% not be found since erl_prim_loader would try to match
-%% /full/path/to/xxx with /full/path/to/./xxx. Same problem with
-%% ../
+%% b) erl_prim_loader did not correctly create and normalize absolute
+%% paths for primary archive and files inside it, so unless given
+%% with exact same path files inside the archive would not be
+%% found. E.g. if escript was started as ./xxx then "xxx/file"
+%% would not be found since erl_prim_loader would try to match
+%% /full/path/to/xxx with /full/path/to/./xxx. Same problem with
+%% ../. Also, the use of symlinks in the path to the archive would
+%% cause problems.
%%
-%% * Depending on how the primary archive was built,
-%% erl_prim_loader:list_dir/1 would sometimes return an empty string
-%% inside the file list. This was a virtual element representing the
-%% top directory of the archive. This shall not occur.
+%% c) Depending on how the primary archive was built,
+%% erl_prim_loader:list_dir/1 would sometimes return an empty string
+%% inside the file list. This was a virtual element representing the
+%% top directory of the archive. This shall not occur.
%%
archive_script_file_access(Config) when is_list(Config) ->
%% Copy the orig files to priv_dir
@@ -542,18 +543,22 @@ archive_script_file_access(Config) when is_list(Config) ->
ok = escript:create(Script1,[shebang,{emu_args,Flags},{archive,Bin1}]),
ok = file:change_mode(Script1,8#00744),
+ %% If supported, create a symlink to the script. This is used to
+ %% test error b) described above this test case.
+ SymlinkName1 = "symlink_to_"++ScriptName1,
+ Symlink1 = filename:join([PrivDir, SymlinkName1]),
+ file:make_symlink(ScriptName1,Symlink1), % will fail if not supported
+
%% Also add a dummy file in the same directory with the same name
%% as the script except is also has an extension. This used to
- %% cause erl_prim_loader to believe it was a file inside the
- %% script.
+ %% test error a) described above this test case.
ok = file:write_file(Script1 ++ ".extension",
<<"same name as script, but with extension">>),
%% Change to script's directory and run it as "./<script_name>"
ok = file:set_cwd(PrivDir),
- do_run(PrivDir, "./" ++ ScriptName1,
- [<<"file_access:[]\n",
- "ExitCode:0">>]),
+ run(PrivDir, "./" ++ ScriptName1 ++ " " ++ ScriptName1,
+ [<<"ExitCode:0">>]),
ok = file:set_cwd(TopDir),
@@ -574,18 +579,34 @@ archive_script_file_access(Config) when is_list(Config) ->
%% Also add a dummy file in the same directory with the same name
%% as the script except is also has an extension. This used to
- %% cause erl_prim_loader to believe it was a file inside the
- %% script.
+ %% test error a) described above this test case.
ok = file:write_file(Script2 ++ ".extension",
<<"same name as script, but with extension">>),
+ %% If supported, create a symlink to the script. This is used to
+ %% test error b) described above this test case.
+ SymlinkName2 = "symlink_to_"++ScriptName2,
+ Symlink2 = filename:join([PrivDir, SymlinkName2]),
+ file:make_symlink(ScriptName2,Symlink2), % will fail if not supported
+
%% Change to script's directory and run it as "./<script_name>"
ok = file:set_cwd(PrivDir),
- do_run(PrivDir, "./" ++ ScriptName2,
- [<<"file_access:[]\n",
- "ExitCode:0">>]),
+ run(PrivDir, "./" ++ ScriptName2 ++ " " ++ ScriptName2,
+ [<<"ExitCode:0">>]),
+
+ %% 3. If symlinks are supported, run one of the scripts via a symlink.
+ %%
+ %% This is in order to test error b) described above this test case.
+ case file:read_link(Symlink2) of
+ {ok,_} ->
+ run(PrivDir, "./" ++ SymlinkName2 ++ " " ++ ScriptName2,
+ [<<"ExitCode:0">>]);
+ _ -> % not supported
+ ok
+ end,
ok = file:set_cwd(OldDir).
+
compile_app(TopDir, AppName) ->
AppDir = filename:join([TopDir, AppName]),
SrcDir = filename:join([AppDir, "src"]),
diff --git a/lib/stdlib/test/escript_SUITE_data/archive_script_file_access/archive_script_file_access.erl b/lib/stdlib/test/escript_SUITE_data/archive_script_file_access/archive_script_file_access.erl
index 226a8675db..b03c8ba70d 100644
--- a/lib/stdlib/test/escript_SUITE_data/archive_script_file_access/archive_script_file_access.erl
+++ b/lib/stdlib/test/escript_SUITE_data/archive_script_file_access/archive_script_file_access.erl
@@ -23,12 +23,9 @@
-include_lib("kernel/include/file.hrl").
-main(MainArgs) ->
- io:format("file_access:~p\n", [MainArgs]),
- ArchiveFile = escript:script_name(),
+main([RelArchiveFile]) ->
- AbsArchiveFile = filename:absname(ArchiveFile),
- RelArchiveFile = filename:basename(ArchiveFile),
+ AbsArchiveFile = filename:absname(RelArchiveFile),
DotSlashArchiveFile = "./" ++ RelArchiveFile,
Beam = atom_to_list(?MODULE) ++ ".beam",
@@ -39,6 +36,10 @@ main(MainArgs) ->
AbsDir = filename:join(AbsArchiveFile,Dir),
RelDir = filename:join(RelArchiveFile,Dir),
DotSlashDir = filename:join(DotSlashArchiveFile,Dir),
+ SubDir = "subdir1",
+ AbsSubDir = filename:join(AbsDir,SubDir),
+ RelSubDir = filename:join(RelDir,SubDir),
+ DotSlashSubDir = filename:join(DotSlashDir,SubDir),
{ok,List1} = erl_prim_loader:list_dir(AbsArchiveFile),
{ok,List1} = erl_prim_loader:list_dir(RelArchiveFile),
@@ -48,8 +49,26 @@ main(MainArgs) ->
{ok,List1} = erl_prim_loader:list_dir(filename:join([AbsDir,".."])),
{ok,List1} = erl_prim_loader:list_dir(filename:join([RelDir,".."])),
{ok,List1} = erl_prim_loader:list_dir(filename:join([DotSlashDir,".."])),
+ {ok,List1} = erl_prim_loader:list_dir(filename:join([AbsSubDir,"..",".."])),
+ {ok,List1} = erl_prim_loader:list_dir(filename:join([RelSubDir,"..",".."])),
+ {ok,List1} = erl_prim_loader:list_dir(filename:join([DotSlashSubDir,"..",".."])),
false = lists:member([],List1),
+ %% If symlinks are supported on this platform...
+ RelSymlinkArchiveFile = "symlink_to_" ++ RelArchiveFile,
+ case file:read_link(RelSymlinkArchiveFile) of
+ {ok,_} ->
+ DotSlashSymlinkArchiveFile = "./" ++ RelSymlinkArchiveFile,
+ AbsSymlinkArchiveFile=filename:join(filename:dirname(AbsArchiveFile),
+ RelSymlinkArchiveFile),
+ {ok,List1} = erl_prim_loader:list_dir(AbsSymlinkArchiveFile),
+ {ok,List1} = erl_prim_loader:list_dir(RelSymlinkArchiveFile),
+ {ok,List1} = erl_prim_loader:list_dir(DotSlashSymlinkArchiveFile);
+ _ -> % not supported
+ ok
+ end,
+
+
{ok,List2} = erl_prim_loader:list_dir(AbsDir),
{ok,List2} = erl_prim_loader:list_dir(RelDir),
{ok,List2} = erl_prim_loader:list_dir(DotSlashDir),