Merge branch 'bjorn/stdlib/erl_tar/OTP-14278'

* bjorn/stdlib/erl_tar/OTP-14278:
  erl_tar: Handle leading slashes and directory traversal attacks
  Don't create absolute path names in tar files

5 files changed, 91 insertions, 33 deletions

diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl
index 0c98232467..1a8bd3f607 100644
--- a/lib/sasl/test/systools_SUITE.erl
+++ b/lib/sasl/test/systools_SUITE.erl
@@ -87,25 +87,25 @@ end_per_group(_GroupName, Config) ->
 
 
 init_per_suite(Config) when is_list(Config) ->
+    %% To use in end_per_testcase
+    Path = code:get_path(),
+    {ok,Cwd} = file:get_cwd(),
+
     %% Make of copy of the data directory.
     DataDir = ?datadir,
     PrivDir = ?privdir,
     CopyDir = fname(PrivDir, "datacopy"),
+    ok = file:make_dir(CopyDir),
     TarFile = fname(PrivDir, "datacopy.tgz"),
-    {ok, Tar} = erl_tar:open(TarFile, [write, compressed]),
-    ok = erl_tar:add(Tar, DataDir, CopyDir, [compressed]),
-    ok = erl_tar:close(Tar),
-    ok = erl_tar:extract(TarFile, [compressed]),
+    ok = file:set_cwd(DataDir),
+    ok = erl_tar:create(TarFile, ["."], [compressed]),
+    ok = erl_tar:extract(TarFile, [compressed, {cwd,CopyDir}]),
     ok = file:delete(TarFile),
 
     %% Compile source files in the copy directory.
     Sources = filelib:wildcard(fname([CopyDir,'*','*','*','*','*.erl'])),
     lists:foreach(fun compile_source/1, Sources),
 
-    %% To use in end_per_testcase
-    Path = code:get_path(),
-    {ok,Cwd} = file:get_cwd(),
-
     [{copy_dir, CopyDir}, {cwd,Cwd}, {path,Path} | Config].
 
 compile_source(File) ->
diff --git a/lib/stdlib/doc/src/erl_tar.xml b/lib/stdlib/doc/src/erl_tar.xml
index f28d8b425b..fab7c832d5 100644
--- a/lib/stdlib/doc/src/erl_tar.xml
+++ b/lib/stdlib/doc/src/erl_tar.xml
@@ -292,6 +292,10 @@
           <c>Fd</c> is assumed to be a file descriptor returned from function
           <c>file:open/2</c>.</p>
         <p>Otherwise, <c>Name</c> is to be a filename.</p>
+	<note><p>Leading slashes in tar member names will be removed before
+	writing the file. That is, absolute paths will be turned into
+	relative paths. There will be an info message written to the error
+	logger when paths are changed in this way.</p></note>
       </desc>
     </func>
 
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index a54df939bf..168ea4002c 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -69,6 +69,8 @@ format_error(invalid_gnu_1_0_sparsemap) ->
     "Invalid GNU sparse map (version 1.0)";
 format_error({invalid_gnu_0_1_sparsemap, Format}) ->
     lists:flatten(io_lib:format("Invalid GNU sparse map (version ~s)", [Format]));
+format_error(unsafe_path) ->
+    "The path points above the current working directory";
 format_error({Name,Reason}) ->
     lists:flatten(io_lib:format("~ts: ~ts", [Name,format_error(Reason)]));
 format_error(Atom) when is_atom(Atom) ->
@@ -120,26 +122,38 @@ do_extract(Handle, Opts) when is_list(Opts) ->
 
 extract1(eof, Reader, _, Acc) when is_list(Acc) ->
     {ok, {ok, lists:reverse(Acc)}, Reader};
+extract1(eof, Reader, _, leading_slash) ->
+    error_logger:info_msg("erl_tar: removed leading '/' from member names\n"),
+    {ok, ok, Reader};
 extract1(eof, Reader, _, Acc) ->
     {ok, Acc, Reader};
-extract1(#tar_header{name=Name,size=Size}=Header, Reader, Opts, Acc) ->
+extract1(#tar_header{name=Name,size=Size}=Header, Reader0, Opts, Acc0) ->
     case check_extract(Name, Opts) of
         true ->
-            case do_read(Reader, Size) of
-                {ok, Bin, Reader2} ->
-                    case write_extracted_element(Header, Bin, Opts) of
-                        ok ->
-                            {ok, Acc, Reader2};
-                        {ok, NameBin} when is_list(Acc) ->
-                            {ok, [NameBin | Acc], Reader2};
-                        {error, _} = Err ->
-                            throw(Err)
-                    end;
+            case do_read(Reader0, Size) of
+                {ok, Bin, Reader1} ->
+                    Acc = extract2(Header, Bin, Opts, Acc0),
+                    {ok, Acc, Reader1};
                 {error, _} = Err ->
                     throw(Err)
             end;
         false ->
-            {ok, Acc, skip_file(Reader)}
+            {ok, Acc0, skip_file(Reader0)}
+    end.
+
+extract2(Header, Bin, Opts, Acc) ->
+    case write_extracted_element(Header, Bin, Opts) of
+        ok ->
+            case Header of
+                #tar_header{name="/"++_} ->
+                    leading_slash;
+                #tar_header{} ->
+                    Acc
+            end;
+        {ok, NameBin} when is_list(Acc) ->
+            [NameBin | Acc];
+        {error, _} = Err ->
+            throw(Err)
     end.
 
 %% Checks if the file Name should be extracted.
@@ -1052,14 +1066,11 @@ unpack_modern(Format, #header_v7{}=V7, Bin, #tar_header{}=Header0)
 
 
 safe_join_path([], Name) ->
-    strip_slashes(Name, both);
+    filename:join([Name]);
 safe_join_path(Prefix, []) ->
-    strip_slashes(Prefix, right);
+    filename:join([Prefix]);
 safe_join_path(Prefix, Name) ->
-    filename:join(strip_slashes(Prefix, right), strip_slashes(Name, both)).
-
-strip_slashes(Str, Direction) ->
-    string:strip(Str, Direction, $/).
+    filename:join(Prefix, Name).
 
 new_sparse_file_reader(Reader, Sparsemap, RealSize) ->
     true = validate_sparse_entries(Sparsemap, RealSize),
@@ -1557,7 +1568,7 @@ write_extracted_element(#tar_header{name=Name,typeflag=Type},
             ok
     end;
 write_extracted_element(#tar_header{name=Name0}=Header, Bin, Opts) ->
-    Name1 = filename:absname(Name0, Opts#read_opts.cwd),
+    Name1 = make_safe_path(Name0, Opts),
     Created =
         case typeflag(Header#tar_header.typeflag) of
             regular ->
@@ -1585,6 +1596,16 @@ write_extracted_element(#tar_header{name=Name0}=Header, Bin, Opts) ->
         not_written -> ok
     end.
 
+make_safe_path([$/|Path], Opts) ->
+    make_safe_path(Path, Opts);
+make_safe_path(Path, #read_opts{cwd=Cwd}) ->
+    case filename:safe_relative_path(Path) of
+        unsafe ->
+            throw({error,{Path,unsafe_path}});
+        SafePath ->
+            filename:absname(SafePath, Cwd)
+    end.
+
 create_regular(Name, NameInArchive, Bin, Opts) ->
     case write_extracted_file(Name, Bin, Opts) of
         not_written ->
diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl
index 2e1ae7bcff..76fa760fa8 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -27,7 +27,7 @@
 	 extract_from_binary_compressed/1, extract_filtered/1,
 	 extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1,
 	 memory/1,unicode/1,read_other_implementations/1,
-         sparse/1, init/1]).
+         sparse/1, init/1, leading_slash/1, dotdot/1]).
 
 -include_lib("common_test/include/ct.hrl").
 -include_lib("kernel/include/file.hrl").
@@ -41,7 +41,7 @@ all() ->
      extract_filtered,
      symlinks, open_add_close, cooked_compressed, memory, unicode,
      read_other_implementations,
-     sparse,init].
+     sparse,init,leading_slash,dotdot].
 
 groups() -> 
     [].
@@ -920,6 +920,39 @@ unicode_create_files() ->
 		   []
 	   end].
 
+leading_slash(Config) ->
+    PrivDir = proplists:get_value(priv_dir, Config),
+    Dir = filename:join(PrivDir, ?FUNCTION_NAME),
+    TarFile = filename:join(Dir, "leading_slash.tar"),
+    ok = filelib:ensure_dir(TarFile),
+    {ok,Fd} = erl_tar:open(TarFile, [write]),
+    TarMemberName = "e/d/c/b/a_member",
+    TarMemberNameAbs = "/" ++ TarMemberName,
+    Contents = <<"contents\n">>,
+    ok = erl_tar:add(Fd, Contents, TarMemberNameAbs, [verbose]),
+    ok = erl_tar:close(Fd),
+
+    ok = erl_tar:extract(TarFile, [{cwd,Dir}]),
+
+    {ok,Contents} = file:read_file(filename:join(Dir, TarMemberName)),
+    ok.
+
+dotdot(Config) ->
+    PrivDir = proplists:get_value(priv_dir, Config),
+    Dir = filename:join(PrivDir, ?FUNCTION_NAME),
+    ok = file:make_dir(Dir),
+    Tar = filename:join(Dir, "dotdot.tar"),
+    {ok,Fd} = erl_tar:open(Tar, [write]),
+    BeamFile = code:which(?MODULE),
+    ok = erl_tar:add(Fd, BeamFile, "a/./../../some_file", []),
+    ok = erl_tar:close(Fd),
+
+    {error,{_,unsafe_path=Error}} = erl_tar:extract(Tar, [{cwd,Dir}]),
+    false = filelib:is_regular(filename:join(PrivDir, "some_file")),
+    io:format("~s\n", [erl_tar:format_error(Error)]),
+
+    ok.
+
 %% Delete the given list of files.
 delete_files([]) -> ok;
 delete_files([Item|Rest]) ->
diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl
index f308ea1204..b8e7113595 100644
--- a/lib/tools/test/xref_SUITE.erl
+++ b/lib/tools/test/xref_SUITE.erl
@@ -89,11 +89,11 @@ init_per_suite(Conf) when is_list(Conf) ->
     DataDir = ?datadir,
     PrivDir = ?privdir,
     CopyDir = fname(PrivDir, "datacopy"),
+    ok = file:make_dir(CopyDir),
     TarFile = fname(PrivDir, "datacopy.tgz"),
-    {ok, Tar} = erl_tar:open(TarFile, [write, compressed]),
-    ok = erl_tar:add(Tar, DataDir, CopyDir, [compressed]),
-    ok = erl_tar:close(Tar),
-    ok = erl_tar:extract(TarFile, [compressed]),
+    ok = file:set_cwd(DataDir),
+    ok = erl_tar:create(TarFile, ["."], [compressed]),
+    ok = erl_tar:extract(TarFile, [compressed, {cwd,CopyDir}]),
     ok = file:delete(TarFile),
     [{copy_dir, CopyDir}|Conf].