diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index d42964cd25f0..2f5b3accc3eb 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -37,8 +37,11 @@ basic_timestamp/1, extended_timestamp/1, uid_gid/1]). +-export([zip/5, unzip/3]). + -import(proplists,[get_value/2, get_value/3]). +-include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). -include_lib("stdlib/include/zip.hrl"). -include_lib("stdlib/include/assert.hrl"). @@ -60,7 +63,10 @@ groups() -> %% ezip - Use erlang zip on disk %% emzip - Use erlang zip in memory -define(ZIP_MODES,[zip, ezip, emzip]). +%% -define(ZIP_MODES,[emzip]). -define(UNZIP_MODES,[unzip, unezip, unemzip]). +%% How much memory the zip/unzip 64 testcases that zip/unzip from/to are expected to use +-define(EMZIP64_MEM_USAGE, (8 * (1 bsl 30))). zip_groups() -> @@ -83,12 +89,10 @@ z64(Mode) when is_atom(Mode) -> z64(Modes) when is_list(Modes) -> [z64(M) || M <- Modes]. -noz64(Z64Mode) -> - case string:split(atom_to_list(Z64Mode), "_") of - ["z64",Mode] -> - list_to_atom(Mode); - [_Mode] -> - Z64Mode +un_z64(Mode) -> + case atom_to_list(Mode) of + "z64_" ++ ModeString -> list_to_atom(ModeString); + _ -> Mode end. zip_testcases() -> @@ -99,54 +103,94 @@ zip64_testcases() -> zip64_central_directory]. init_per_suite(Config) -> - Config. + {ok, Started} = application:ensure_all_started(os_mon), + cleanup_priv_dir(Config), + [{started, Started} | Config]. -end_per_suite(_Config) -> +end_per_suite(Config) -> + [application:stop(App) || App <- lists:reverse(get_value(started, Config))], + cleanup_priv_dir(Config), ok. +cleanup_priv_dir(Config) -> + %% Cleanup potential files in priv_dir + Pdir = get_value(pdir, Config, get_value(priv_dir,Config)), + ct:log("Cleaning up ~s",[Pdir]), + [ case file:delete(File) of + {error, eperm} -> file:del_dir_r(File); + _ -> ok + end || File <- filelib:wildcard(filename:join(Pdir, "*"))]. + init_per_group(zip64_group, Config) -> PrivDir = get_value(priv_dir, Config), - OneMB = <<0:(8 bsl 20)>>, - Large4GB = filename:join(PrivDir, "large.txt"), - ok = file:write_file(Large4GB, lists:duplicate(4 bsl 10, OneMB)), - Medium4MB = filename:join(PrivDir, "medium.txt"), - ok = file:write_file(Medium4MB, lists:duplicate(4, OneMB)), - - [{large, Large4GB},{medium,Medium4MB}|Config]; + case {erlang:system_info(wordsize), disc_free(PrivDir), memsize()} of + {4, _, _} -> + {skip, "Zip64 tests only work on 64-bit systems"}; + {8, error, _} -> + {skip, "Failed to query disk space for priv_dir. " + "Is it on a remote file system?~n"}; + {8, N,M} when N >= 16 * (1 bsl 20), M >= ?EMZIP64_MEM_USAGE -> + ct:log("Free disk: ~w KByte~n", [N]), + ct:log("Free memory: ~w MByte~n", [M div (1 bsl 20)]), + OneMB = <<0:(8 bsl 20)>>, + Large4GB = filename:join(PrivDir, "large.txt"), + ok = file:write_file(Large4GB, lists:duplicate(4 bsl 10, OneMB)), + Medium4MB = filename:join(PrivDir, "medium.txt"), + ok = file:write_file(Medium4MB, lists:duplicate(4, OneMB)), + + [{large, Large4GB},{medium,Medium4MB}|Config]; + {8,N,M} -> + ct:log("Free disk: ~w KByte~n", [N]), + ct:log("Free memory: ~w MByte~n", [M div (1 bsl 20)]), + {skip,"Less than 16 GByte free disk or less then 8 GB free mem"} + end; init_per_group(Group, Config) -> case lists:member(Group, ?ZIP_MODES ++ ?UNZIP_MODES ++ z64(?ZIP_MODES ++ ?UNZIP_MODES)) of true -> case get_value(zip, Config) of undefined -> - [throw({skip, "zip does not support zip64"}) || - Group =:= zip andalso - get_value(large,Config) =/= undefined andalso - os:cmd("zip -v | grep ZIP64_SUPPORT") == ""], - ct:print("Zip: ~p", [Group]), - Pdir = filename:join(get_value(priv_dir, Config),Group), - ok = filelib:ensure_path(Pdir), - [{pdir, Pdir},{zip, noz64(Group)} | Config]; + case un_z64(Group) =/= zip orelse has_zip() of + true -> + Pdir = filename:join(get_value(priv_dir, Config),Group), + ok = filelib:ensure_path(Pdir), + [{pdir, Pdir},{zip, Group} | Config]; + false -> + {skip, "No zip program found"} + end; _Zip -> - ct:print("UnZip: ~p", [Group]), - Pdir = filename:join(get_value(pdir, Config),Group), - ok = filelib:ensure_path(Pdir), - [{pdir, Pdir},{unzip, noz64(Group)} | Config] + case un_z64(Group) =/= unzip orelse has_zip() of + true -> + Pdir = filename:join(get_value(pdir, Config),Group), + ok = filelib:ensure_path(Pdir), + [{pdir, Pdir},{unzip, Group} | Config]; + false -> + {skip, "No zip program found"} + end end; false -> Config end. end_per_group(_GroupName, Config) -> + cleanup_priv_dir(Config), Config. init_per_testcase(TC, Config) -> - PrivDir = filename:join(get_value(pdir, Config,get_value(priv_dir, Config)), TC), - ok = filelib:ensure_path(PrivDir), - [{pdir, PrivDir} | Config]. + UsesZip = un_z64(get_value(zip, Config)) =:= zip orelse un_z64(get_value(unzip, Config)) =:= unzip, + HasZip = has_zip(), + ct:log("Free memory: ~w MByte~n", [memsize() div (1 bsl 20)]), + if UsesZip andalso not HasZip -> + {skip, "No zip command found"}; + true -> + PrivDir = filename:join(get_value(pdir, Config,get_value(priv_dir, Config)), TC), + ok = filelib:ensure_path(PrivDir), + [{pdir, PrivDir} | Config] + end. + end_per_testcase(_TC, Config) -> - file:del_dir_r(get_value(pdir,Config)), + cleanup_priv_dir(Config), Config. %% Test creating, listing and extracting one file from an archive @@ -422,7 +466,7 @@ unzip_options(Config) when is_list(Config) -> lists:foreach(fun(F)-> {ok,B} = file:read_file(filename:join(DataDir, F)), {ok,B} = file:read_file(filename:join(Subdir, F)) end, FList2), - lists:foreach(fun(F)-> ok = file:delete(F) end, + lists:foreach(fun(F)-> 1 = delete_files([F]) end, RetList2), %% Clean up and verify no more files. @@ -757,6 +801,9 @@ unzip_from_binary(Config) when is_list(Config) -> {ok, QuoteData} = file:read_file(filename:join(DataDir, Quote)), {ok, QuoteData} = file:read_file(DestQuote), + %% Don't be in ExtractDir when we delete it + ok = file:set_cwd(PrivDir), + %% Clean up. delete_files([DestFilename, DestQuote, Archive, ExtractDir]), @@ -1112,7 +1159,7 @@ test_zip1() -> has_zip() andalso zip_is_unicode_aware(). has_zip() -> - os:find_executable("zip") =/= false. + os:find_executable("zip") =/= false andalso element(1, os:type()) =:= unix. zip_is_unicode_aware() -> S = os:cmd("zip -v | grep 'UNICODE_SUPPORT'"), @@ -1190,35 +1237,40 @@ mode(Config) -> file:write_file(Executable, "aaa"), {ok, ExecFI } = file:read_file_info(Executable), ok = file:write_file_info(Executable, ExecFI#file_info{ mode = 8#111 bor 8#400 }), + {ok, #file_info{ mode = OrigExecMode }} = file:read_file_info(Executable), Directory = filename:join(PrivDir,"dir"), ok = file:make_dir(Directory), {ok, DirFI } = file:read_file_info(Executable), ok = file:write_file_info(Directory, DirFI#file_info{ mode = 8#111 bor 8#400 }), + {ok, #file_info{ mode = OrigDirMode }} = file:read_file_info(Directory), ?assertMatch( {ok, Archive}, zip(Config, Archive, "-r", ["dir","exec"], [{cwd, PrivDir},{extra,[extended_timestamp]}])), + OrigExecMode777 = OrigExecMode band 8#777, + OrigDirMode777 = OrigDirMode band 8#777, + ?assertMatch( {ok, [#zip_comment{}, - #zip_file{ name = "dir/", info = #file_info{ mode = 8#111 bor 8#400}}, - #zip_file{ name = "exec", info = #file_info{ mode = 8#111 bor 8#400}} ]}, + #zip_file{ name = "dir/", info = #file_info{ mode = OrigDirMode777 }}, + #zip_file{ name = "exec", info = #file_info{ mode = OrigExecMode777 }} ]}, zip:list_dir(Archive)), ok = file:make_dir(ExtractDir), ?assertMatch( {ok, ["dir/","exec"]}, unzip(Config, Archive, [{cwd,ExtractDir}])), - case get_value(unzip, Config) =/= unemzip of + case un_z64(get_value(unzip, Config)) =/= unemzip of true -> {ok,#file_info{ mode = ExecMode }} = file:read_file_info(filename:join(ExtractDir,"exec")), - ?assertEqual(8#111 bor 8#400, ExecMode band 8#777), + ?assertEqual(ExecMode band 8#777, OrigExecMode777), {ok,#file_info{ mode = DirMode }} = file:read_file_info(filename:join(ExtractDir,"dir")), - ?assertEqual(8#111 bor 8#400, DirMode band 8#777); + ?assertEqual(DirMode band 8#777, OrigDirMode777); false -> %% emzip does not support mode ok @@ -1253,11 +1305,16 @@ zip64_central_headers(Config) -> %% %% The archive will be roughly 8 GBs large - ok = file:make_symlink("../../large.txt", filename:join(PrivDir, "uncomp.txt")), - ok = file:make_symlink("../../large.txt", filename:join(PrivDir, "uncomp.comp.zip")), - ok = file:make_symlink("../../medium.txt", filename:join(PrivDir, "offset.txt")), - ok = file:make_symlink("../../large.txt", filename:join(PrivDir, "uncomp.offset.txt")), - ok = file:make_symlink("../../large.txt", filename:join(PrivDir, "uncomp.comp.offset.zip")), + ok = file:make_link(filename:join(PrivDir, "../../large.txt"), + filename:join(PrivDir, "uncomp.txt")), + ok = file:make_link(filename:join(PrivDir, "../../large.txt"), + filename:join(PrivDir, "uncomp.comp.zip")), + ok = file:make_link(filename:join(PrivDir, "../../medium.txt"), + filename:join(PrivDir, "offset.txt")), + ok = file:make_link(filename:join(PrivDir, "../../large.txt"), + filename:join(PrivDir, "uncomp.offset.txt")), + ok = file:make_link(filename:join(PrivDir, "../../large.txt"), + filename:join(PrivDir, "uncomp.comp.offset.zip")), ?assertMatch( {ok, Archive}, zip(Config, Archive, "-1", @@ -1394,18 +1451,24 @@ basic_timestamp(Config) -> mtime = UnZMtime, ctime = UnZCtime }} = - file:read_file_info(filename:join(ExtractDir, "testfile.txt")), + file:read_file_info(filename:join(ExtractDir, "testfile.txt"),[raw]), ct:log("extract: ~p",[UnzipFI]), - case get_value(unzip, Config) =/= unemzip of - true -> + UnzipMode = un_z64(get_value(unzip, Config)), + + if UnzipMode =/= unemzip -> ?assertEqual(ZMtime, UnZMtime), - ?assertEqual(UnZAtime, UnZMtime), - ?assert(UnZMtime < UnZCtime); - false -> + %% When using unzip, the atime is sometimes set to ctime for unknown reasons... so we cannot test it + %% ?assertEqual(UnZAtime, UnZMtime), + ?assert(UnZAtime =:= UnZMtime orelse UnZAtime =:= UnZCtime), + + %% On windows the ctime and mtime are the same so + %% we cannot compare them. + [?assert(UnZMtime < UnZCtime) || os:type() =/= {win32,nt}]; + UnzipMode =:= unemzip -> %% emzip does not support timestamps ok end, @@ -1416,115 +1479,112 @@ basic_timestamp(Config) -> %% the atime and ctime when the file is added to the archive. extended_timestamp(Config) -> - case os:cmd("zip -v | grep USE_EF_UT_TIME") of - "" -> {skip, "zip does not support extended timestamps"}; - _ -> - PrivDir = get_value(pdir, Config), - Archive = filename:join(PrivDir, "archive.zip"), - ExtractDir = filename:join(PrivDir, "extract"), - Testfile = filename:join(PrivDir, "testfile.txt"), + PrivDir = get_value(pdir, Config), + Archive = filename:join(PrivDir, "archive.zip"), + ExtractDir = filename:join(PrivDir, "extract"), + Testfile = filename:join(PrivDir, "testfile.txt"), - ok = file:write_file(Testfile, "abc"), - {ok, OndiskFI = #file_info{ mtime = Mtime }} = - file:read_file_info(Testfile), + ok = file:write_file(Testfile, "abc"), + {ok, OndiskFI = #file_info{ mtime = Mtime }} = + file:read_file_info(Testfile), - %% Sleep a bit to let the timestamp progress - timer:sleep(1000), + %% Sleep a bit to let the timestamp progress + timer:sleep(1000), - ?assertMatch( - {ok, Archive}, - zip(Config, Archive, "", ["testfile.txt"], [{cwd, PrivDir}])), + ?assertMatch( + {ok, Archive}, + zip(Config, Archive, "", ["testfile.txt"], [{cwd, PrivDir}])), - %% list_dir only reads the central directory header and thus only - %% the mtime will be correct here - {ok, [#zip_comment{}, - #zip_file{ info = ZipFI = #file_info{ mtime = ZMtime}} ]} = - zip:list_dir(Archive), + %% list_dir only reads the central directory header and thus only + %% the mtime will be correct here + {ok, [#zip_comment{}, + #zip_file{ info = ZipFI = #file_info{ mtime = ZMtime}} ]} = + zip:list_dir(Archive), - ct:log("on disk: ~p",[OndiskFI]), - ct:log("in zip : ~p",[ZipFI]), - ct:log("zipinfo:~n~ts",[os:cmd("zipinfo -v "++Archive)]), + ct:log("on disk: ~p",[OndiskFI]), + ct:log("in zip : ~p",[ZipFI]), + ct:log("zipinfo:~n~ts",[os:cmd("zipinfo -v "++Archive)]), - ?assertEqual(Mtime, ZMtime), + ?assertEqual(Mtime, ZMtime), - %% Sleep a bit to let the timestamp progress - timer:sleep(1000), + %% Sleep a bit to let the timestamp progress + timer:sleep(1000), - ok = file:make_dir(ExtractDir), - ?assertMatch( - {ok, ["testfile.txt"]}, - unzip(Config, Archive, [{cwd,ExtractDir}])), + ok = file:make_dir(ExtractDir), + ?assertMatch( + {ok, ["testfile.txt"]}, + unzip(Config, Archive, [{cwd,ExtractDir}])), - {ok, UnzipFI = #file_info{ atime = UnZAtime, - mtime = UnZMtime, - ctime = UnZCtime - }} = - file:read_file_info(filename:join(ExtractDir, "testfile.txt")), + {ok, UnzipFI = #file_info{ atime = UnZAtime, + mtime = UnZMtime, + ctime = UnZCtime + }} = + file:read_file_info(filename:join(ExtractDir, "testfile.txt"),[raw]), - ct:log("extract: ~p",[UnzipFI]), + ct:log("extract: ~p",[UnzipFI]), - case get_value(unzip, Config) =/= unemzip of - true -> - ?assertEqual(ZMtime, UnZMtime), - ?assertEqual(UnZAtime, UnZMtime), + UnzipMode = un_z64(get_value(unzip, Config)), - ?assert(UnZMtime < UnZCtime); - false -> - %% emzip does not support timestamps - ok - end, + if UnzipMode =/= unemzip -> + ?assertEqual(ZMtime, UnZMtime), - ok - end. + %% When using unzip, the atime is sometimes set to ctime for unknown reasons... so we cannot test it + %% ?assertEqual(UnZAtime, UnZMtime), + ?assert(UnZAtime =:= UnZMtime orelse UnZAtime =:= UnZCtime), -uid_gid(Config) -> + %% On windows the ctime and mtime are the same so + %% we cannot compare them. + [?assert(UnZMtime < UnZCtime) || os:type() =/= {win32,nt}]; + UnzipMode =:= unemzip -> + %% emzip does not support timestamps + ok + end, - case os:cmd("zip -v | grep STORE_UNIX_UIDs_GIDs") of - "" -> {skip, "zip does not support uid/gids"}; - _ -> + ok. - PrivDir = get_value(pdir, Config), - ExtractDir = filename:join(PrivDir, "extract"), - Archive = filename:join(PrivDir, "archive.zip"), - Testfile = filename:join(PrivDir, "testfile.txt"), +uid_gid(Config) -> - ok = file:write_file(Testfile, "abc"), - {ok, OndiskFI = #file_info{ gid = GID, uid = UID }} = - file:read_file_info(Testfile), + PrivDir = get_value(pdir, Config), + ExtractDir = filename:join(PrivDir, "extract"), + Archive = filename:join(PrivDir, "archive.zip"), + Testfile = filename:join(PrivDir, "testfile.txt"), - ?assertMatch( - {ok, Archive}, - zip(Config, Archive, "", ["testfile.txt"], [{cwd, PrivDir}])), + ok = file:write_file(Testfile, "abc"), + {ok, OndiskFI = #file_info{ gid = GID, uid = UID }} = + file:read_file_info(Testfile), - {ok, [#zip_comment{}, - #zip_file{ info = ZipFI = #file_info{ gid = ZGID, uid = ZUID }} ]} = - zip:list_dir(Archive,[{extra, [uid_gid]}]), + ?assertMatch( + {ok, Archive}, + zip(Config, Archive, "", ["testfile.txt"], [{cwd, PrivDir}])), - ct:log("on disk: ~p",[OndiskFI]), - ct:log("in zip : ~p",[ZipFI]), + {ok, [#zip_comment{}, + #zip_file{ info = ZipFI = #file_info{ gid = ZGID, uid = ZUID }} ]} = + zip:list_dir(Archive,[{extra, [uid_gid]}]), - ?assertEqual(UID, ZUID), - ?assertEqual(GID, ZGID), + ct:log("on disk: ~p",[OndiskFI]), + ct:log("in zip : ~p",[ZipFI]), - ok = file:make_dir(ExtractDir), - ?assertMatch( - {ok, ["testfile.txt"]}, - unzip(Config, Archive, [{cwd, ExtractDir},{extra,[uid_gid]}])), + ?assertEqual(UID, ZUID), + ?assertEqual(GID, ZGID), - {ok,#file_info{ gid = ExZGID, uid = ExZUID }} = - file:read_file_info(filename:join(ExtractDir,"testfile.txt")), + ok = file:make_dir(ExtractDir), + ?assertMatch( + {ok, ["testfile.txt"]}, + unzip(Config, Archive, [{cwd, ExtractDir},{extra,[uid_gid]}])), - case get_value(unzip, Config) =/= unemzip of - true -> - ?assertEqual(UID, ExZUID), - ?assertEqual(GID, ExZGID); - _ -> - %% emzip does not support uid_gid - ok - end, + {ok,#file_info{ gid = ExZGID, uid = ExZUID }} = + file:read_file_info(filename:join(ExtractDir,"testfile.txt")), + case un_z64(get_value(unzip, Config)) =/= unemzip of + true -> + ?assertEqual(UID, ExZUID), + ?assertEqual(GID, ExZGID); + _ -> + %% emzip does not support uid_gid ok - end. + end, + + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Generic zip interface @@ -1532,52 +1592,84 @@ uid_gid(Config) -> zip(Config, Archive, ZipOpts, Filelist, Opts) when is_list(Config) -> zip(get_value(zip, Config), Archive, ZipOpts, Filelist, Opts); +zip(z64_zip, Archive, ZipOpts, Filelist, Opts) -> + zip(zip, Archive, ZipOpts, Filelist, Opts); zip(zip, Archive, ZipOpts, Filelist, Opts) -> cmd("cd "++get_value(cwd, Opts)++" && " "zip "++ZipOpts++" "++Archive++" "++lists:join($ ,Filelist)), {ok, Archive}; +zip(z64_ezip, Archive, _ZipOpts, Filelist, Opts) -> + zip(ezip, Archive, _ZipOpts, Filelist, Opts); zip(ezip, Archive, _ZipOpts, Filelist, Opts) -> ct:log("Creating zip:zip(~p,~n~p,~n~p)",[Archive, Filelist, Opts]), zip:zip(Archive, Filelist, Opts); +zip(z64_emzip, Archive, _ZipOpts, Filelist, Opts) -> + %% Run in peer node so that memory issues don't crash test node + {ok, Peer, Node} = ?CT_PEER(#{ args => emzip_peer_args() }), + try + erpc:call( + Node, + fun() -> + ?MODULE:zip(emzip, Archive, _ZipOpts, Filelist, Opts) + end) + after + catch peer:stop(Peer) + end; zip(emzip, Archive, _ZipOpts, Filelist, Opts) -> ct:log("Creating emzip ~ts",[Archive]), Cwd = get_value(cwd, Opts), + + + %% For this not to use a huge amount of memory we re-use + %% the binary for files that are the same size as those are the same file. + %% This cuts memory usage from ~16GB to ~4GB. + {Files,_Cache} = lists:mapfoldl( - fun F(Fn, Cache) -> - AbsFn = filename:join(Cwd, Fn), - {ok, Fi} = file:read_file_info(AbsFn), - {SubDirFiles, NewCache} = - if Fi#file_info.type == directory -> - {ok, Files} = file:list_dir(AbsFn), - lists:mapfoldl(F, Cache#{ Fn => <<>> }, - [filename:join(Fn, DirFn) || DirFn <- Files]); - Fi#file_info.type == regular -> - %% For this not to use a huge amount of memory we re-use - %% the binary for files that are links to the same file. - %% This cuts memory usage from ~16GB to ~4GB. - {[], - case file:read_link_all(AbsFn) of - {ok, LinkFn} -> - case maps:get(LinkFn, Cache, undefined) of - undefined -> - {ok, Data} = file:read_file(AbsFn), - Cache#{ LinkFn => Data, Fn => Data }; - Data -> - Cache#{ Fn => Data } - end; - {error, _} -> - {ok, Data} = file:read_file(AbsFn), - Cache#{ Fn => Data } - end} - end, - {[{Fn, maps:get(Fn, NewCache), Fi}|SubDirFiles], NewCache} - end, #{}, Filelist), + fun F(Fn, Cache) -> + AbsFn = filename:join(Cwd, Fn), + {ok, Fi} = file:read_file_info(AbsFn), + CacheKey = {Fi#file_info.type, Fi#file_info.size}, + {SubDirFiles, NewCache} = + if Fi#file_info.type == directory -> + {ok, Files} = file:list_dir(AbsFn), + lists:mapfoldl(F, Cache#{ CacheKey => <<>> }, + [filename:join(Fn, DirFn) || DirFn <- Files]); + Fi#file_info.type == regular -> + {[], + case maps:find(CacheKey, Cache) of + {ok, _} -> Cache; + error -> + {ok, Data} = read_file( + file:open(AbsFn, [read, raw, binary]), + Fi#file_info.size), + Cache#{ CacheKey => Data } + end} + end, + {[{Fn, maps:get(CacheKey, NewCache), Fi}|SubDirFiles], NewCache} + end, #{}, Filelist), zip:zip(Archive, lists:flatten(Files), proplists:delete(cwd,Opts)). +%% Special read_file that works on windows on > 4 GB files +read_file({ok, D}, Size) -> + Bin = iolist_to_binary(read_file(D, Size)), + erlang:garbage_collect(), %% Do a GC to get rid of all intermediate binaries + {ok, Bin}; +read_file({error, _} = E, _Size) -> + E; +read_file(eof = E, _Size) -> + E; +read_file(D, 0) -> + file:close(D), + []; +read_file(D, Size) -> + {ok, B} = file:read(D, min(1 bsl 30, Size)), + [B | read_file(D, Size - byte_size(B))]. unzip(Config, Archive, Opts) when is_list(Config) -> unzip(get_value(unzip, Config), Archive, Opts); +unzip(z64_unzip, Archive, Opts) -> + unzip(unzip, Archive, Opts); unzip(unzip, Archive, Opts) -> UidGid = [" -X " || lists:member(uid_gid, get_value(extra, Opts, []))], Files = lists:join($ , get_value(file_list, Opts, [])), @@ -1591,15 +1683,30 @@ unzip(unzip, Archive, Opts) -> {match,Match} -> Match end end,string:split(Res,"\n",all)))}; +unzip(z64_unezip, Archive, Opts) -> + unzip(unezip, Archive, Opts); unzip(unezip, Archive, Opts) -> Cwd = get_value(cwd, Opts) ++ "/", {ok, Files} = zip:unzip(Archive, Opts), {ok, lists:sort([F -- Cwd || F <- Files])}; +unzip(z64_unemzip, Archive, Opts) -> + %% Run in peer node so that memory issues don't crash test node + {ok, Peer, Node} = ?CT_PEER(#{ args => emzip_peer_args() }), + try + erpc:call( + Node, + fun() -> + unzip(unemzip, Archive, Opts) + end) + after + catch peer:stop(Peer) + end; unzip(unemzip, Archive, Opts) -> Cwd = get_value(cwd, Opts) ++ "/", + {ok, Files} = zip:unzip(Archive, [memory | Opts]), {ok, lists:sort( - [begin + [begin case lists:last(F) of $/ -> filelib:ensure_path(F); @@ -1610,10 +1717,61 @@ unzip(unemzip, Archive, Opts) -> F -- Cwd end || {F, B} <- Files])}. +emzip_peer_args() -> + 8 = erlang:system_info(wordsize),%% Supercarrier only supported on 64-bit + ["+MMscs",integer_to_list(?EMZIP64_MEM_USAGE div (1024 * 1024))]. + cmp(Source, Target) -> - "" = cmd("cmp --silent "++Source++" "++Target++~s' || echo "files are different"'). + {ok, SrcInfo} = file:read_file_info(Source), + {ok, TgtInfo} = file:read_file_info(Target), + ?assertEqual(SrcInfo#file_info.size, TgtInfo#file_info.size), + ?assertEqual(SrcInfo#file_info.mode, TgtInfo#file_info.mode), + + {ok, Src} = file:open(Source, [read, binary]), + {ok, Tgt} = file:open(Target, [read, binary]), + + cmp(Src, Tgt, 0), + + file:close(Src), + file:close(Tgt). + +%% Check if first 100 MB are the same +cmp(Src, Tgt, Pos) when Pos < 100 bsl 20 -> + erlang:garbage_collect(), + case {file:read(Src, 20 bsl 20), file:read(Tgt, 20 bsl 20)} of + {{ok, Data}, {ok, Data}} -> + cmp(Src, Tgt, Pos + 20 bsl 20); + {E, E} -> + ok + end; +cmp(_Src, _Tgt, _) -> + ok. cmd(Cmd) -> Res = os:cmd(Cmd), ct:log("Cmd: ~ts~nRes: ~ts~n",[Cmd, Res]), Res. + +disc_free(Path) -> + Data = disksup:get_disk_data(), + + %% What partitions could Data be mounted on? + Partitions = + [D || {P, _Tot, _Perc}=D <- Data, + lists:prefix(filename:nativename(P), filename:nativename(Path))], + + %% Sorting in descending order places the partition with the most specific + %% path first. + case lists:sort(fun erlang:'>='/2, Partitions) of + [{_,Tot, Perc} | _] -> round(Tot * (1-(Perc/100))); + [] -> error + end. + +memsize() -> + case proplists:get_value(available_memory, memsup:get_system_memory_data()) of + undefined -> + {Tot,_Used,_} = memsup:get_memory_data(), + Tot; + Available -> + Available + end.