Merge branch 'siri/erl_prim_loader/archive-scripts/OTP-10071' into maint

* siri/erl_prim_loader/archive-scripts/OTP-10071:
  Bugfix escript_SUITE:archive_script_file_access
  Update preloaded
  Fix flattening of paths in erl_prim_loader

4 files changed, 137 insertions, 71 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
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/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),