aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/kernel/test/prim_file_SUITE.erl47
-rw-r--r--lib/sasl/test/systools_SUITE.erl16
-rw-r--r--lib/stdlib/doc/src/erl_tar.xml4
-rw-r--r--lib/stdlib/src/erl_tar.erl59
-rw-r--r--lib/stdlib/test/tar_SUITE.erl37
-rw-r--r--lib/tools/src/lcnt.erl39
-rw-r--r--lib/tools/test/xref_SUITE.erl8
7 files changed, 164 insertions, 46 deletions
diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl
index 8be94f1e57..0c84a7d1cc 100644
--- a/lib/kernel/test/prim_file_SUITE.erl
+++ b/lib/kernel/test/prim_file_SUITE.erl
@@ -19,8 +19,8 @@
%%
-module(prim_file_SUITE).
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- read_write_file/1]).
+ init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2,
+ read_write_file/1, free_memory/0]).
-export([cur_dir_0a/1, cur_dir_0b/1,
cur_dir_1a/1, cur_dir_1b/1,
make_del_dir_a/1, make_del_dir_b/1,
@@ -115,6 +115,18 @@ groups() ->
[make_link_a, make_link_b, read_link_info_for_non_link,
symlinks_a, symlinks_b, list_dir_error]}].
+init_per_testcase(large_write, Config) ->
+ {ok, Started} = application:ensure_all_started(os_mon),
+ [{started, Started}|Config];
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(large_write, Config) ->
+ [application:stop(App) || App <- lists:reverse(proplists:get_value(started, Config))],
+ ok;
+end_per_testcase(_, _Config) ->
+ ok.
+
init_per_group(_GroupName, Config) ->
Config.
@@ -2022,11 +2034,13 @@ run_large_file_test(Config, Run, Name) ->
{{unix,sunos},OsVersion} when OsVersion < {5,5,1} ->
{skip,"Only supported on Win32, Unix or SunOS >= 5.5.1"};
{{unix,_},_} ->
- N = unix_free(proplists:get_value(priv_dir, Config)),
- io:format("Free disk: ~w KByte~n", [N]),
- if N < 5 bsl 20 ->
+ DiscFree = unix_free(proplists:get_value(priv_dir, Config)),
+ MemFree = free_memory(),
+ io:format("Free disk: ~w KByte~n", [DiscFree]),
+ io:format("Free mem: ~w MByte~n", [MemFree]),
+ if DiscFree < 5 bsl 20; MemFree < 5 bsl 10 ->
%% Less than 5 GByte free
- {skip,"Less than 5 GByte free disk"};
+ {skip,"Less than 5 GByte free disk/mem"};
true ->
do_run_large_file_test(Config, Run, Name)
end;
@@ -2079,6 +2093,27 @@ zip_data([], Bs) ->
zip_data(As, []) ->
As.
+%% Stolen from emulator -> alloc_SUITE
+free_memory() ->
+ %% Free memory in MB.
+ try
+ SMD = memsup:get_system_memory_data(),
+ {value, {free_memory, Free}} = lists:keysearch(free_memory, 1, SMD),
+ TotFree = (Free +
+ case lists:keysearch(cached_memory, 1, SMD) of
+ {value, {cached_memory, Cached}} -> Cached;
+ false -> 0
+ end +
+ case lists:keysearch(buffered_memory, 1, SMD) of
+ {value, {buffered_memory, Buffed}} -> Buffed;
+ false -> 0
+ end),
+ TotFree div (1024*1024)
+ catch
+ error : undef ->
+ ct:fail({"os_mon not built"})
+ end.
+
%%%-----------------------------------------------------------------
%%% Utilities
rm_rf(Mod,Dir) ->
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/src/lcnt.erl b/lib/tools/src/lcnt.erl
index 22db947e7a..864d62f6c5 100644
--- a/lib/tools/src/lcnt.erl
+++ b/lib/tools/src/lcnt.erl
@@ -698,19 +698,47 @@ stats2record([{{File,Line},{Tries,Colls,{S,Ns,N}}}|Stats]) ->
nt = N} | stats2record(Stats)];
stats2record([]) -> [].
+
clean_id_creation(Id) when is_pid(Id) ->
Bin = term_to_binary(Id),
- <<H:3/binary, L:16, Node:L/binary, Ids:8/binary, _Creation/binary>> = Bin,
- Bin2 = list_to_binary([H, bytes16(L), Node, Ids, 0]),
+ <<H:3/binary, Rest/binary>> = Bin,
+ <<131, PidTag, AtomTag>> = H,
+ LL = atomlen_bits(AtomTag),
+ CL = creation_bits(PidTag),
+ <<L:LL, Node:L/binary, Ids:8/binary, _Creation/binary>> = Rest,
+ Bin2 = list_to_binary([H, <<L:LL>>, Node, Ids, <<0:CL>>]),
binary_to_term(Bin2);
clean_id_creation(Id) when is_port(Id) ->
Bin = term_to_binary(Id),
- <<H:3/binary, L:16, Node:L/binary, Ids:4/binary, _Creation/binary>> = Bin,
- Bin2 = list_to_binary([H, bytes16(L), Node, Ids, 0]),
+ <<H:3/binary, Rest/binary>> = Bin,
+ <<131, PortTag, AtomTag>> = H,
+ LL = atomlen_bits(AtomTag),
+ CL = creation_bits(PortTag),
+ <<L:LL, Node:L/binary, Ids:4/binary, _Creation/binary>> = Rest,
+ Bin2 = list_to_binary([H, <<L:LL>>, Node, Ids, <<0:CL>>]),
binary_to_term(Bin2);
clean_id_creation(Id) ->
Id.
+-define(PID_EXT, $g).
+-define(NEW_PID_EXT, $X).
+-define(PORT_EXT, $f).
+-define(NEW_PORT_EXT, $Y).
+-define(ATOM_EXT, $d).
+-define(SMALL_ATOM_EXT, $s).
+-define(ATOM_UTF8_EXT, $v).
+-define(SMALL_ATOM_UTF8_EXT, $w).
+
+atomlen_bits(?ATOM_EXT) -> 16;
+atomlen_bits(?SMALL_ATOM_EXT) -> 8;
+atomlen_bits(?ATOM_UTF8_EXT) -> 16;
+atomlen_bits(?SMALL_ATOM_UTF8_EXT) -> 8.
+
+creation_bits(?PID_EXT) -> 8;
+creation_bits(?NEW_PID_EXT) -> 32;
+creation_bits(?PORT_EXT) -> 8;
+creation_bits(?NEW_PORT_EXT) -> 32.
+
%% serializer
state_default(Field) -> proplists:get_value(Field, state2list(#state{})).
@@ -932,9 +960,6 @@ strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2
strings([{left, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""]));
strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])).
--define(SMALL_ATOM_UTF8_EXT, $w).
--define(ATOM_UTF8_EXT, $v).
--define(ATOM_EXT, $d).
term2string({M,F,A}) when is_atom(M), is_atom(F), is_integer(A) -> term2string("~p:~p/~p", [M,F,A]);
term2string(Term) when is_port(Term) ->
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].
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-10 22:25:07 +0000