erl_tar: Resolve directory traversal vulnerability for symlinks

2 files changed, 73 insertions, 6 deletions

diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index 7064fcacfa..74fc51ee35 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -1611,7 +1611,8 @@ write_extracted_element(#tar_header{name=Name0}=Header, Bin, Opts) ->
                 create_extracted_dir(Name1, Opts);
             symlink ->
                 read_verbose(Opts, "x ~ts~n", [Name0]),
-                create_symlink(Name1, Header#tar_header.linkname, Opts);
+                LinkName = safe_link_name(Header, Opts),
+                create_symlink(Name1, LinkName, Opts);
             Device when Device =:= char orelse Device =:= block ->
                 %% char/block devices will be created as empty files
                 %% and then have their major/minor device set later
@@ -1639,6 +1640,52 @@ make_safe_path(Path, #read_opts{cwd=Cwd}) ->
             filename:absname(SafePath, Cwd)
     end.
 
+safe_link_name(#tar_header{linkname=Path}, #read_opts{cwd=Cwd}) ->
+    case safe_relative_path_links(Path, Cwd) of
+        unsafe ->
+            throw({error,{Path,unsafe_symlink}});
+        SafePath ->
+            SafePath
+    end.
+
+safe_relative_path_links(Path, Cwd) ->
+    case filename:pathtype(Path) of
+        relative -> safe_relative_path_links(filename:split(Path), Cwd, [], "");
+        _ -> unsafe
+    end.
+
+safe_relative_path_links([Segment|Segments], Cwd, PrevSegments, Acc) ->
+    AccSegment = join(Acc, Segment),
+    case lists:member(AccSegment, PrevSegments) of
+        true ->
+            unsafe;
+        false ->
+            case file:read_link(join(Cwd, AccSegment)) of
+                {ok, LinkPath} ->
+                    case filename:pathtype(LinkPath) of
+                        relative ->
+                            safe_relative_path_links(filename:split(LinkPath) ++ Segments,
+                                                     Cwd, [AccSegment|PrevSegments], Acc);
+                        _ ->
+                            unsafe
+                    end;
+
+                {error, _} ->
+                    case filename:safe_relative_path(join(Acc, Segment)) of
+                        unsafe ->
+                            unsafe;
+                        NewAcc ->
+                            safe_relative_path_links(Segments, Cwd,
+                                                     [AccSegment|PrevSegments], NewAcc)
+                    end
+            end
+    end;
+safe_relative_path_links([], _Cwd, _PrevSegments, Acc) ->
+    Acc.
+
+join([], Path) -> Path;
+join(Left, Right) -> filename:join(Left, Right).
+
 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 32a33283d1..fb2b7dc45d 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -578,19 +578,22 @@ extract_from_open_file(Config) when is_list(Config) ->
 symlinks(Config) when is_list(Config) ->
     PrivDir = proplists:get_value(priv_dir, Config),
     Dir = filename:join(PrivDir, "symlinks"),
+    VulnerableDir = filename:join(PrivDir, "vulnerable_symlinks"),
     ok = file:make_dir(Dir),
+    ok = file:make_dir(VulnerableDir),
     ABadSymlink = filename:join(Dir, "bad_symlink"),
-    PointsTo = "/a/definitely/non_existing/path",
-    Res = case make_symlink("/a/definitely/non_existing/path", ABadSymlink) of
+    PointsTo = "a/definitely/non_existing/path",
+    Res = case make_symlink("a/definitely/non_existing/path", ABadSymlink) of
 	      {error, enotsup} ->
 		  {skip, "Symbolic links not supported on this platform"};
 	      ok ->
 		  symlinks(Dir, "bad_symlink", PointsTo),
-		  long_symlink(Dir)
+		  long_symlink(Dir),
+                  symlink_vulnerability(VulnerableDir)
 	  end,
 
     %% Clean up.
-    delete_files([Dir]),
+    delete_files([Dir,VulnerableDir]),
     verify_ports(Config),
     Res.
 
@@ -678,7 +681,7 @@ long_symlink(Dir) ->
     ok = file:set_cwd(Dir),
 
     AFile = "long_symlink",
-    RequiresPAX = "/tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed",
+    RequiresPAX = "tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed",
     ok = file:make_symlink(RequiresPAX, AFile),
     ok = erl_tar:create(Tar, [AFile], [verbose]),
     false = is_ustar(Tar),
@@ -690,6 +693,23 @@ long_symlink(Dir) ->
     {ok, RequiresPAX} = file:read_link(AFile),
     ok.
 
+symlink_vulnerability(Dir) ->
+    ok = file:set_cwd(Dir),
+    ok = file:make_dir("tar"),
+    ok = file:set_cwd("tar"),
+    ok = file:make_symlink("..", "link"),
+    ok = file:write_file("../file", <<>>),
+    ok = erl_tar:create("../my.tar", ["link","link/file"]),
+    ok = erl_tar:tt("../my.tar"),
+
+    ok = file:set_cwd(Dir),
+    delete_files(["file","tar"]),
+    ok = file:make_dir("tar"),
+    ok = file:set_cwd("tar"),
+    {error,{"..",unsafe_symlink}} = erl_tar:extract("../my.tar"),
+
+    ok.
+
 init(Config) when is_list(Config) ->
     PrivDir = proplists:get_value(priv_dir, Config),
     ok = file:set_cwd(PrivDir),