1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(tar_SUITE).
21
22-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
23	 init_per_group/2, end_per_group/2,
24         init_per_testcase/2,
25         borderline/1, atomic/1, long_names/1,
26	 create_long_names/1, bad_tar/1, errors/1, extract_from_binary/1,
27	 extract_from_binary_compressed/1, extract_filtered/1,
28	 extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1,
29	 memory/1,unicode/1,read_other_implementations/1,
30         sparse/1, init/1, leading_slash/1, dotdot/1,
31         roundtrip_metadata/1, apply_file_info_opts/1,
32         incompatible_options/1]).
33
34-include_lib("common_test/include/ct.hrl").
35-include_lib("kernel/include/file.hrl").
36
37suite() -> [{ct_hooks,[ts_install_cth]}].
38
39all() ->
40    [borderline, atomic, long_names, create_long_names,
41     bad_tar, errors, extract_from_binary,
42     extract_from_binary_compressed, extract_from_open_file,
43     extract_filtered,
44     symlinks, open_add_close, cooked_compressed, memory, unicode,
45     read_other_implementations,
46     sparse,init,leading_slash,dotdot,roundtrip_metadata,
47     apply_file_info_opts,incompatible_options].
48
49groups() ->
50    [].
51
52init_per_suite(Config) ->
53    Config.
54
55end_per_suite(_Config) ->
56    ok.
57
58init_per_group(_GroupName, Config) ->
59    Config.
60
61end_per_group(_GroupName, Config) ->
62    Config.
63
64init_per_testcase(_Case, Config) ->
65    Ports = ordsets:from_list(erlang:ports()),
66    [{ports,Ports}|Config].
67
68%% Test creating, listing and extracting one file from an archive,
69%% multiple times with different file sizes.  Also check that the file
70%% attributes of the extracted file has survived.
71borderline(Config) when is_list(Config) ->
72
73    %% Note: We cannot use absolute paths, because the pathnames will be
74    %% too long for the limit allowed in tar files (100 characters).
75    %% Therefore, strip off the current working directory from the front
76    %% of the private directory path.
77
78    {ok, Cwd} = file:get_cwd(),
79    RootDir = proplists:get_value(priv_dir, Config),
80    TempDir = remove_prefix(Cwd++"/", filename:join(RootDir, "borderline")),
81    ok = file:make_dir(TempDir),
82
83    Record = 512,
84    Block = 20 * Record,
85
86    lists:foreach(fun(Size) -> borderline_test(Size, TempDir) end,
87		  [0, 1, 10, 13, 127, 333, Record-1, Record, Record+1,
88		   Block-2*Record-1, Block-2*Record, Block-2*Record+1,
89		   Block-Record-1, Block-Record, Block-Record+1,
90		   Block-1, Block, Block+1,
91		   Block+Record-1, Block+Record, Block+Record+1]),
92
93    %% Clean up.
94    delete_files([TempDir]),
95
96    verify_ports(Config).
97
98borderline_test(Size, TempDir) ->
99    io:format("Testing size ~p", [Size]),
100    borderline_test(Size, TempDir, true),
101    borderline_test(Size, TempDir, false),
102    ok.
103
104borderline_test(Size, TempDir, IsUstar) ->
105    Prefix = case IsUstar of
106                 true ->
107                     "file_";
108                 false ->
109                     lists:duplicate(100, $f) ++ "ile_"
110             end,
111    SizeList = integer_to_list(Size),
112    Archive = filename:join(TempDir, "ar_"++ SizeList ++".tar"),
113    Name = filename:join(TempDir, Prefix++SizeList),
114
115    %% Create a file and archive it.
116    X0 = erlang:monotonic_time(),
117    ok = file:write_file(Name, random_byte_list(X0, Size)),
118    ok = erl_tar:create(Archive, [Name]),
119    ok = file:delete(Name),
120
121    %% Verify listing and extracting.
122    IsUstar = is_ustar(Archive),
123    {ok, [Name]} = erl_tar:table(Archive),
124    ok = erl_tar:extract(Archive, [verbose]),
125
126    %% Verify contents of extracted file.
127    {ok, Bin} = file:read_file(Name),
128    true = match_byte_list(X0, binary_to_list(Bin)),
129
130    %% Verify that Unix tar can read it.
131    case IsUstar of
132        true ->
133            tar_tf(Archive, Name);
134        false ->
135            ok
136    end,
137
138    ok.
139
140tar_tf(Archive, Name) ->
141    case os:type() of
142	{unix, _} ->
143	    tar_tf1(Archive, Name);
144	_ ->
145	    ok
146    end.
147
148tar_tf1(Archive, Name) ->
149    Expect = Name ++ "\n",
150    cmd_expect("tar tf " ++ Archive, Expect).
151
152%% We can't use os:cmd/1, because Unix 'tar tf Name' on Solaris never
153%% terminates when given an archive of a size it doesn't like.
154
155cmd_expect(Cmd, Expect) ->
156    Port = open_port({spawn, make_cmd(Cmd)}, [stream, in, eof]),
157    get_data(Port, Expect).
158
159get_data(Port, Expect) ->
160    receive
161	{Port, {data, Bytes}} ->
162	    get_data(Port, match_output(Bytes, Expect, Port));
163	{Port, eof} ->
164	    Port ! {self(), close},
165	    receive
166		{Port, closed} ->
167		    true
168	    end,
169	    receive
170		{'EXIT',  Port,  _} ->
171		    ok
172	    after 1 ->				% force context switch
173		    ok
174	    end,
175	    match_output(eof, Expect, Port)
176    end.
177
178match_output([C|Output], [C|Expect], Port) ->
179    match_output(Output, Expect, Port);
180match_output([_|_], [_|_], Port) ->
181    kill_port_and_fail(Port, badmatch);
182match_output([X|Output], [], Port) ->
183    kill_port_and_fail(Port, {too_much_data, [X|Output]});
184match_output([], Expect, _Port) ->
185    Expect;
186match_output(eof, [], _Port) ->
187    [];
188match_output(eof, _Expect, Port) ->
189    kill_port_and_fail(Port, unexpected_end_of_input).
190
191kill_port_and_fail(Port, Reason) ->
192    unlink(Port),
193    exit(Port, die),
194    ct:fail(Reason).
195
196make_cmd(Cmd) ->
197    case os:type() of
198	{win32, _} -> lists:concat(["cmd /c",  Cmd]);
199	{unix, _}  -> lists:concat(["sh -c '",  Cmd,  "'"])
200    end.
201
202%% Verifies a random byte list.
203
204match_byte_list(X0, [Byte|Rest]) ->
205    X = next_random(X0),
206    case (X bsr 26) band 16#ff of
207	Byte -> match_byte_list(X, Rest);
208	_ -> false
209    end;
210match_byte_list(_, []) ->
211    true.
212
213%% Generates a random byte list.
214
215random_byte_list(X0, Count) ->
216    random_byte_list(X0, Count, []).
217
218random_byte_list(X0, Count, Result) when Count > 0->
219    X = next_random(X0),
220    random_byte_list(X, Count-1, [(X bsr 26) band 16#ff|Result]);
221random_byte_list(_X, 0, Result) ->
222    lists:reverse(Result).
223
224%% This RNG is from line 21 on page 102 in Knuth: The Art of Computer Programming,
225%% Volume II, Seminumerical Algorithms.
226
227next_random(X) ->
228    (X*17059465+1) band 16#fffffffff.
229
230%% Test the 'atomic' operations: create/extract/table, on compressed
231%% and uncompressed archives.
232%% Also test the 'cooked' option.
233atomic(Config) when is_list(Config) ->
234    ok = file:set_cwd(proplists:get_value(priv_dir, Config)),
235    DataFiles = data_files(),
236    Names = [Name || {Name,_,_} <- DataFiles],
237    io:format("Names: ~p", [Names]),
238
239    %% Create an uncompressed archive.  The compressed flag should still be
240    %% allowed when listing contents or extracting.
241
242    Tar1 = "uncompressed.tar",
243    erl_tar:create(Tar1, Names, []),
244    {ok, Names} = erl_tar:table(Tar1, []),
245    {ok, Names} = erl_tar:table(Tar1, [compressed]),
246    {ok, Names} = erl_tar:table(Tar1, [cooked]),
247    {ok, Names} = erl_tar:table(Tar1, [compressed,cooked]),
248
249    %% Create a compressed archive.
250
251    Tar2 = "compressed.tar",
252    erl_tar:create(Tar2, Names, [compressed]),
253    {ok, Names} = erl_tar:table(Tar2, [compressed]),
254    {error, Reason} = erl_tar:table(Tar2, []),
255    {ok, Names} = erl_tar:table(Tar2, [compressed,cooked]),
256    {error, Reason} = erl_tar:table(Tar2, [cooked]),
257    ok = io:format("No compressed option: ~p, ~s",
258		   [Reason, erl_tar:format_error(Reason)]),
259
260    %% Same test again, but this time created with 'cooked'
261
262    Tar3 = "uncompressed_cooked.tar",
263    erl_tar:create(Tar3, Names, [cooked]),
264    {ok, Names} = erl_tar:table(Tar3, []),
265    {ok, Names} = erl_tar:table(Tar3, [compressed]),
266    {ok, Names} = erl_tar:table(Tar3, [cooked]),
267    {ok, Names} = erl_tar:table(Tar3, [compressed,cooked]),
268
269    Tar4 = "compressed_cooked.tar",
270    erl_tar:create(Tar4, Names, [compressed,cooked]),
271    {ok, Names} = erl_tar:table(Tar4, [compressed]),
272    {error, Reason} = erl_tar:table(Tar4, []),
273    {ok, Names} = erl_tar:table(Tar4, [compressed,cooked]),
274    {error, Reason} = erl_tar:table(Tar4, [cooked]),
275    ok = io:format("No compressed option: ~p, ~s",
276		   [Reason, erl_tar:format_error(Reason)]),
277
278    %% Clean up.
279    delete_files([Tar1,Tar2,Tar3,Tar4|Names]),
280
281    verify_ports(Config).
282
283%% Returns a sequence of characters.
284
285char_seq(N, First) ->
286    char_seq(N, First, []).
287
288char_seq(0, _, Result) ->
289    Result;
290char_seq(N, C, Result) when C < 127 ->
291    char_seq(N-1, C+1, [C|Result]);
292char_seq(N, _, Result) ->
293    char_seq(N, $!, Result).
294
295data_files() ->
296    Files = [{"first_file", 1555, $a},
297	     {"small_file", 7, $d},
298	     {"big_file", 23875, $e},
299	     {"last_file", 7500, $g}],
300    create_files(Files),
301    Files.
302
303create_files([{Name, Size, First}|Rest]) ->
304    ok = file:write_file(Name, char_seq(Size, First)),
305    create_files(Rest);
306create_files([]) ->
307    ok.
308
309%% Test to extract an Unix tar file containing filenames longer than
310%% 100 characters and empty directories.
311long_names(Config) when is_list(Config) ->
312    DataDir = proplists:get_value(data_dir, Config),
313    Long = filename:join(DataDir, "long_names.tar"),
314    run_in_short_tempdir(Config,
315			 fun() -> do_long_names(Long) end),
316    verify_ports(Config).
317
318
319do_long_names(Long) ->
320    %% Try table/2 and extract/2.
321    case erl_tar:table(Long, [verbose]) of
322	{ok,List} when is_list(List) ->
323	    io:format("~p\n", [List])
324    end,
325
326    {ok,Cwd} = file:get_cwd(),
327    ok = erl_tar:extract(Long),
328    Base = filename:join([Cwd, "original_software", "written_by",
329			  "a_bunch_of_hackers",
330			  "spending_all_their_nights",
331			  "still", "not_long_enough",
332			  "but_soon_it_will_be"]),
333
334    %% Verify that the empty directory was created.
335    EmptyDir = filename:join(Base, "empty_directory"),
336    {ok, #file_info{type=directory}} = file:read_file_info(EmptyDir),
337
338    %% Verify that the files were created.
339    {ok,First} = file:read_file(filename:join(Base, "first_file")),
340    {ok,Second} = file:read_file(filename:join(Base, "second_file")),
341    "Here"++_ = binary_to_list(First),
342    "And"++_ = binary_to_list(Second),
343
344    ok.
345
346%% Creates a tar file from a deep directory structure (filenames are
347%% longer than 100 characters).
348create_long_names(Config) when is_list(Config) ->
349    run_in_short_tempdir(Config, fun create_long_names/0),
350    verify_ports(Config).
351
352create_long_names() ->
353    {ok,Dir} = file:get_cwd(),
354    Dirs = ["aslfjkshjkhliuf",
355	    "asdhjfehnbfsky",
356	    "sahajfskdfhsz",
357	    "asldfkdlfy4y8rchg",
358	    "f7nafhjgffagkhsfkhsjk",
359	    "dfjasldkfjsdkfjashbv"],
360
361    DeepDir = make_dirs(Dirs, []),
362    AFile = filename:join(DeepDir, "a_file"),
363    Hello = "hello, world\n",
364    ok = file:write_file(AFile, Hello),
365    TarName = filename:join(Dir,  "my_tar_with_long_names.tar"),
366    ok = erl_tar:create(TarName, [AFile]),
367
368    %% Print contents.
369    ok = erl_tar:tt(TarName),
370
371    %% Extract and verify.
372    true = is_ustar(TarName),
373    ExtractDir = "extract_dir",
374    ok = file:make_dir(ExtractDir),
375    ok = erl_tar:extract(TarName, [{cwd,ExtractDir}]),
376    {ok, Bin} = file:read_file(filename:join(ExtractDir, AFile)),
377    Hello = binary_to_list(Bin),
378
379    ok.
380
381make_dirs([Dir|Rest], []) ->
382    ok = file:make_dir(Dir),
383    make_dirs(Rest, Dir);
384make_dirs([Dir|Rest], Parent) ->
385    Name = filename:join(Parent, Dir),
386    ok = file:make_dir(Name),
387    make_dirs(Rest, Name);
388make_dirs([], Dir) ->
389    Dir.
390
391%% Try erl_tar:table/2 and erl_tar:extract/2 on some corrupted tar files.
392bad_tar(Config) when is_list(Config) ->
393    try_bad("bad_checksum", bad_header, Config),
394    try_bad("bad_octal",    invalid_tar_checksum, Config),
395    try_bad("bad_too_short",    eof, Config),
396    try_bad("bad_even_shorter", eof, Config),
397    verify_ports(Config).
398
399try_bad(Name0, Reason, Config) ->
400    %% Intentionally no macros here.
401
402    DataDir = proplists:get_value(data_dir, Config),
403    PrivDir = proplists:get_value(priv_dir, Config),
404    Name = Name0 ++ ".tar",
405    io:format("~nTrying ~s", [Name]),
406    Full = filename:join(DataDir, Name),
407    Dest = filename:join(PrivDir, Name0),
408    Opts = [verbose, {cwd, Dest}],
409    Expected = {error, Reason},
410    io:fwrite("Expected: ~p\n", [Expected]),
411    case {erl_tar:table(Full, Opts), erl_tar:extract(Full, Opts)} of
412	{Expected, Expected} ->
413	    io:format("Result: ~p", [Expected]),
414	    case catch erl_tar:format_error(Reason) of
415		{'EXIT', CrashReason} ->
416		    ct:fail({format_error, crashed, CrashReason});
417		String when is_list(String) ->
418		    io:format("format_error(~p) -> ~s", [Reason, String]);
419		Other ->
420		    ct:fail({format_error, returned, Other})
421	    end;
422	{Other1, Other2} ->
423	    io:format("table/2 returned ~p", [Other1]),
424	    io:format("extract/2 returned ~p", [Other2]),
425	    ct:fail({bad_return_value, Other1, Other2})
426    end.
427
428%% Tests that some common errors return correct error codes
429%% and that format_error/1 handles them correctly.
430errors(Config) when is_list(Config) ->
431    PrivDir = proplists:get_value(priv_dir, Config),
432
433    %% Give the tar file the same name as a directory.
434    BadTar = filename:join(PrivDir, "bad_tarfile.tar"),
435    ok = file:make_dir(BadTar),
436    try_error(erl_tar, create, [BadTar, []], {BadTar, eisdir}),
437
438    %% Try including non-existent files in the tar file.
439    NonExistent = "non_existent_file",
440    GoodTar = filename:join(PrivDir, "a_good_tarfile.tar"),
441    try_error(erl_tar, create, [GoodTar, [NonExistent]],
442	      {NonExistent, enoent}),
443
444    %% Clean up.
445    delete_files([GoodTar,BadTar]),
446
447    verify_ports(Config).
448
449try_error(M, F, A, Error) ->
450    io:format("Trying ~p:~p(~p)", [M, F, A]),
451    case catch apply(M, F, A) of
452	{'EXIT', Reason} ->
453	    exit(Reason);
454	ok ->
455	    ct:fail(unexpected_success);
456	{error, Error} ->
457	    case catch erl_tar:format_error(Error) of
458		{'EXIT', FReason} ->
459		    ct:fail({format_error, crashed, FReason});
460		String when is_list(String) ->
461		    io:format("format_error(~p) -> ~s", [Error, String]);
462		Other ->
463		    ct:fail({format_error, returned, Other})
464	    end;
465	Other ->
466	    ct:fail({expected, {error, Error}, actual, Other})
467    end.
468
469%% remove_prefix(Prefix, List) -> ListWithoutPrefix.
470
471remove_prefix([C|Rest1], [C|Rest2]) ->
472    remove_prefix(Rest1, Rest2);
473remove_prefix(_, Result) ->
474    Result.
475
476%% Test extracting a tar archive from a binary.
477extract_from_binary(Config) when is_list(Config) ->
478    DataDir = proplists:get_value(data_dir, Config),
479    PrivDir = proplists:get_value(priv_dir, Config),
480    Long = filename:join(DataDir, "no_fancy_stuff.tar"),
481    ExtractDir = filename:join(PrivDir, "extract_from_binary"),
482    ok = file:make_dir(ExtractDir),
483
484    %% Read a tar file into a binary and extract from the binary.
485    {ok, Bin} = file:read_file(Long),
486    ok = erl_tar:extract({binary, Bin}, [{cwd,ExtractDir}]),
487
488    %% Verify.
489    Dir = filename:join(ExtractDir, "no_fancy_stuff"),
490    true = filelib:is_dir(Dir),
491    true = filelib:is_file(filename:join(Dir, "a_dir_list")),
492    true = filelib:is_file(filename:join(Dir, "EPLICENCE")),
493
494    %% Clean up.
495    delete_files([ExtractDir]),
496
497    verify_ports(Config).
498
499extract_from_binary_compressed(Config) when is_list(Config) ->
500    %% Test extracting a compressed tar archive from a binary.
501    DataDir = proplists:get_value(data_dir, Config),
502    PrivDir = proplists:get_value(priv_dir, Config),
503    Name = filename:join(DataDir, "cooked_tar_problem.tar.gz"),
504    ExtractDir = filename:join(PrivDir, "extract_from_binary_compressed"),
505    ok = file:make_dir(ExtractDir),
506    {ok,Bin} = file:read_file(Name),
507
508    %% Try taking contents.
509    {ok,Files} = erl_tar:table({binary,Bin}, [compressed]),
510    io:format("~p\n", [Files]),
511    19 = length(Files),
512
513    %% Try taking contents when already uncompressed.
514    {ok,Files} = erl_tar:table({binary,zlib:gunzip(Bin)}, [compressed]),
515    io:format("~p\n", [Files]),
516    19 = length(Files),
517
518    %% Trying extracting from a binary.
519    ok = erl_tar:extract({binary,Bin}, [compressed,{cwd,ExtractDir}]),
520    {ok,List} = file:list_dir(filename:join(ExtractDir, "ddll_SUITE_data")),
521    io:format("~p\n", [List]),
522    19 = length(List),
523
524    %% Clean up while at the same time testing that all file
525    %% were extracted as expected.
526    lists:foreach(fun(N) ->
527			  File = filename:join(ExtractDir, N),
528			  io:format("Deleting: ~p\n", [File]),
529			  ok = file:delete(File)
530		  end, Files),
531
532    %% Clean up the rest.
533    delete_files([ExtractDir]),
534
535    verify_ports(Config).
536
537%% Test extracting a tar archive from a binary.
538extract_filtered(Config) when is_list(Config) ->
539    DataDir = proplists:get_value(data_dir, Config),
540    PrivDir = proplists:get_value(priv_dir, Config),
541    Long = filename:join(DataDir, "no_fancy_stuff.tar"),
542    ExtractDir = filename:join(PrivDir, "extract_from_binary"),
543    ok = file:make_dir(ExtractDir),
544
545    ok = erl_tar:extract(Long, [{cwd,ExtractDir},{files,["no_fancy_stuff/EPLICENCE"]}]),
546
547    %% Verify.
548    Dir = filename:join(ExtractDir, "no_fancy_stuff"),
549    true = filelib:is_dir(Dir),
550    false = filelib:is_file(filename:join(Dir, "a_dir_list")),
551    true = filelib:is_file(filename:join(Dir, "EPLICENCE")),
552
553    %% Clean up.
554    delete_files([ExtractDir]),
555
556    verify_ports(Config).
557
558%% Test extracting a tar archive from an open file.
559extract_from_open_file(Config) when is_list(Config) ->
560    DataDir = proplists:get_value(data_dir, Config),
561    PrivDir = proplists:get_value(priv_dir, Config),
562    Long = filename:join(DataDir, "no_fancy_stuff.tar"),
563    ExtractDir = filename:join(PrivDir, "extract_from_open_file"),
564    ok = file:make_dir(ExtractDir),
565
566    {ok, File} = file:open(Long, [read]),
567    ok = erl_tar:extract({file, File}, [{cwd,ExtractDir}]),
568
569    %% Verify.
570    Dir = filename:join(ExtractDir, "no_fancy_stuff"),
571    true = filelib:is_dir(Dir),
572    true = filelib:is_file(filename:join(Dir, "a_dir_list")),
573    true = filelib:is_file(filename:join(Dir, "EPLICENCE")),
574
575    %% Close open file.
576    ok = file:close(File),
577
578    %% Clean up.
579    delete_files([ExtractDir]),
580
581    verify_ports(Config).
582
583%% Make sure incompatible options are rejected when opening archives with file
584%% descriptors.
585incompatible_options(Config) when is_list(Config) ->
586    DataDir = proplists:get_value(data_dir, Config),
587    Long = filename:join(DataDir, "no_fancy_stuff.tar"),
588
589    {ok, File} = file:open(Long, [read]),
590    Handle = {file, File},
591
592    {error, {Handle, {incompatible_option, compressed}}}
593        = erl_tar:open(Handle, [read, compressed]),
594    {error, {Handle, {incompatible_option, cooked}}}
595        = erl_tar:open(Handle, [read, cooked]),
596
597    {error, {Handle, {incompatible_option, compressed}}}
598        = erl_tar:extract(Handle, [compressed]),
599    {error, {Handle, {incompatible_option, cooked}}}
600        = erl_tar:extract(Handle, [cooked]),
601
602    ok = file:close(File),
603
604    verify_ports(Config).
605
606%% Test that archives containing symlinks can be created and extracted.
607symlinks(Config) when is_list(Config) ->
608    PrivDir = proplists:get_value(priv_dir, Config),
609    Dir = filename:join(PrivDir, "symlinks"),
610    VulnerableDir = filename:join(PrivDir, "vulnerable_symlinks"),
611    ok = file:make_dir(Dir),
612    ok = file:make_dir(VulnerableDir),
613    ABadSymlink = filename:join(Dir, "bad_symlink"),
614    PointsTo = "a/definitely/non_existing/path",
615    Res = case make_symlink("a/definitely/non_existing/path", ABadSymlink) of
616	      {error, enotsup} ->
617		  {skip, "Symbolic links not supported on this platform"};
618	      ok ->
619		  symlinks(Dir, "bad_symlink", PointsTo),
620		  long_symlink(Dir),
621                  symlink_vulnerability(VulnerableDir)
622	  end,
623
624    %% Clean up.
625    delete_files([Dir,VulnerableDir]),
626    verify_ports(Config),
627    Res.
628
629make_symlink(Path, Link) ->
630    case os:type() of
631	{win32,_} ->
632	    %% Symlinks on Windows have two problems:
633	    %%   1) file:read_link_info/1 cannot read out the target
634	    %%      of the symlink if the target does not exist.
635	    %%      That is possible (but not easy) to fix in the
636	    %%      efile driver.
637	    %%
638	    %%   2) Symlinks to files and directories are different
639	    %%      creatures. If the target is not existing, the
640	    %%      symlink will be created to be of the file-pointing
641	    %%      type. That can be partially worked around in erl_tar
642	    %%      by creating all symlinks when the end of the tar
643	    %%      file has been reached.
644	    %%
645	    %% But for now, pretend that there are no symlinks on
646	    %% Windows.
647	    {error, enotsup};
648	_ ->
649	    file:make_symlink(Path, Link)
650    end.
651
652symlinks(Dir, BadSymlink, PointsTo) ->
653    Tar = filename:join(Dir, "symlink.tar"),
654    DerefTar = filename:join(Dir, "dereference.tar"),
655
656    %% Create the archive.
657
658    ok = file:set_cwd(Dir),
659    GoodSymlink = "good_symlink",
660    AFile = "a_good_file",
661    ALine = "A line of text for a file.",
662    ok = file:write_file(AFile, ALine),
663    ok = file:make_symlink(AFile, GoodSymlink),
664    ok = erl_tar:create(Tar, [BadSymlink, GoodSymlink, AFile], [verbose]),
665    true = is_ustar(Tar),
666
667    %% List contents of tar file.
668
669    ok = erl_tar:tt(Tar),
670
671    %% Also create another archive with the dereference flag.
672
673    ok = erl_tar:create(DerefTar, [AFile, GoodSymlink], [dereference, verbose]),
674    true = is_ustar(DerefTar),
675
676    %% Extract files to a new directory.
677
678    NewDir = filename:join(Dir, "extracted"),
679    ok = file:make_dir(NewDir),
680    ok = erl_tar:extract(Tar, [{cwd, NewDir}, verbose]),
681
682    %% Verify that the files are there.
683
684    ok = file:set_cwd(NewDir),
685    {ok, #file_info{type=symlink}} = file:read_link_info(BadSymlink),
686    {ok, PointsTo} = file:read_link(BadSymlink),
687    {ok, #file_info{type=symlink}} = file:read_link_info(GoodSymlink),
688    {ok, AFile} = file:read_link(GoodSymlink),
689    Expected = list_to_binary(ALine),
690    {ok, Expected} = file:read_file(GoodSymlink),
691
692    %% Extract the "dereferenced archive"  to a new directory.
693
694    NewDirDeref = filename:join(Dir, "extracted_deref"),
695    ok = file:make_dir(NewDirDeref),
696    ok = erl_tar:extract(DerefTar, [{cwd, NewDirDeref}, verbose]),
697
698    %% Verify that the files are there.
699
700    ok = file:set_cwd(NewDirDeref),
701    {ok, #file_info{type=regular}} = file:read_link_info(GoodSymlink),
702    {ok, #file_info{type=regular}} = file:read_link_info(AFile),
703    {ok, Expected} = file:read_file(GoodSymlink),
704    {ok, Expected} = file:read_file(AFile),
705
706    ok.
707
708long_symlink(Dir) ->
709    Tar = filename:join(Dir, "long_symlink.tar"),
710    ok = file:set_cwd(Dir),
711
712    AFile = "long_symlink",
713    RequiresPAX = "tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed",
714    ok = file:make_symlink(RequiresPAX, AFile),
715    ok = erl_tar:create(Tar, [AFile], [verbose]),
716    false = is_ustar(Tar),
717    NewDir = filename:join(Dir, "extracted"),
718    _ = file:make_dir(NewDir),
719    ok = erl_tar:extract(Tar, [{cwd, NewDir}, verbose]),
720    ok = file:set_cwd(NewDir),
721    {ok, #file_info{type=symlink}} = file:read_link_info(AFile),
722    {ok, RequiresPAX} = file:read_link(AFile),
723    ok.
724
725symlink_vulnerability(Dir) ->
726    ok = file:set_cwd(Dir),
727    ok = file:make_dir("tar"),
728    ok = file:set_cwd("tar"),
729    ok = file:make_symlink("..", "link"),
730    ok = file:write_file("../file", <<>>),
731    ok = erl_tar:create("../my.tar", ["link","link/file"]),
732    ok = erl_tar:tt("../my.tar"),
733
734    ok = file:set_cwd(Dir),
735    delete_files(["file","tar"]),
736    ok = file:make_dir("tar"),
737    ok = file:set_cwd("tar"),
738    {error,{"..",unsafe_symlink}} = erl_tar:extract("../my.tar"),
739
740    ok.
741
742init(Config) when is_list(Config) ->
743    PrivDir = proplists:get_value(priv_dir, Config),
744    ok = file:set_cwd(PrivDir),
745    Dir = filename:join(PrivDir, "init"),
746    ok = file:make_dir(Dir),
747
748    [{FileOne,_,_}|_] = oac_files(),
749    TarOne = filename:join(Dir, "archive1.tar"),
750    {ok,Fd} = file:open(TarOne, [write]),
751
752    %% If the arity of the fun is wrong, badarg should be returned
753    {error, badarg} = erl_tar:init(Fd, write, fun file_op_bad/1),
754
755    %% Otherwise we should be good to go
756    {ok, Tar} = erl_tar:init(Fd, write, fun file_op/2),
757    ok = erl_tar:add(Tar, FileOne, []),
758    ok = erl_tar:close(Tar),
759    {ok, [FileOne]} = erl_tar:table(TarOne),
760
761    verify_ports(Config).
762
763file_op_bad(_) ->
764    throw({error, should_never_be_called}).
765
766file_op(write, {Fd, Data}) ->
767    file:write(Fd, Data);
768file_op(position, {Fd, Pos}) ->
769    file:position(Fd, Pos);
770file_op(read2, {Fd, Size}) ->
771    file:read(Fd, Size);
772file_op(close, Fd) ->
773    file:close(Fd).
774
775open_add_close(Config) when is_list(Config) ->
776    PrivDir = proplists:get_value(priv_dir, Config),
777    ok = file:set_cwd(PrivDir),
778    Dir = filename:join(PrivDir, "open_add_close"),
779    ok = file:make_dir(Dir),
780
781    [{FileOne,_,_},{FileTwo,_,_},{FileThree,_,_}] = oac_files(),
782    ADir = "empty_dir",
783    AnotherDir = "another_dir",
784    SomeContent = filename:join(AnotherDir, "some_content"),
785    ok = file:make_dir(ADir),
786    ok = file:make_dir(AnotherDir),
787    ok = file:make_dir(SomeContent),
788
789    TarOne = filename:join(Dir, "archive1.tar"),
790    {ok,AD} = erl_tar:open(TarOne, [write]),
791    ok = erl_tar:add(AD, FileOne, []),
792
793    %% Add with {NameInArchive,Name}
794    ok = erl_tar:add(AD, {"second file", FileTwo}, []),
795
796    %% Add with {binary, Bin}
797    {ok,FileThreeBin} = file:read_file(FileThree),
798    ok = erl_tar:add(AD, {FileThree, FileThreeBin}, [verbose]),
799
800    %% Add with Name
801    ok = erl_tar:add(AD, FileThree, "chunked", [{chunks,11411},verbose]),
802    ok = erl_tar:add(AD, ADir, [verbose]),
803    ok = erl_tar:add(AD, AnotherDir, [verbose]),
804    ok = erl_tar:close(AD),
805    true = is_ustar(TarOne),
806
807    ok = erl_tar:t(TarOne),
808    ok = erl_tar:tt(TarOne),
809
810    Expected = {ok,[FileOne,"second file",FileThree,"chunked",ADir,SomeContent]},
811    Expected = erl_tar:table(TarOne),
812
813    delete_files(["oac_file","oac_small","oac_big",Dir,AnotherDir,ADir]),
814
815    verify_ports(Config).
816
817oac_files() ->
818    Files = [{"oac_file", 1459, $x},
819	     {"oac_small", 99, $w},
820	     {"oac_big", 33896, $A}],
821    create_files(Files),
822    Files.
823
824cooked_compressed(Config) when is_list(Config) ->
825    %% Test that a compressed archive can be read in cooked mode.
826    DataDir = proplists:get_value(data_dir, Config),
827    PrivDir = proplists:get_value(priv_dir, Config),
828    Name = filename:join(DataDir, "cooked_tar_problem.tar.gz"),
829
830    %% Try table/2 and extract/2.
831    {ok,List} = erl_tar:table(Name, [cooked,compressed]),
832    io:format("~p\n", [List]),
833    19 = length(List),
834    ok = erl_tar:extract(Name, [cooked,compressed,{cwd,PrivDir}]),
835
836    %% Clean up while at the same time testing that all file
837    %% were extracted as expected.
838    lists:foreach(fun(N) ->
839			  File = filename:join(PrivDir, N),
840			  io:format("Deleting: ~p\n", [File]),
841			  ok = file:delete(File)
842		  end, List),
843
844    %% Clean up.
845    delete_files([filename:join(PrivDir, "ddll_SUITE_data")]),
846
847    verify_ports(Config).
848
849%% Test that an archive can be created directly from binaries and
850%% that an archive can be extracted into binaries.
851memory(Config) when is_list(Config) ->
852    DataDir = proplists:get_value(data_dir, Config),
853
854    FileBins = [{"bar/fum", <<"BARFUM">>},{"foo", <<"FOO">>}],
855    Name1 = filename:join(DataDir, "memory.tar"),
856    ok = erl_tar:create(Name1, FileBins, [write,verbose]),
857    {ok,Extracted1} = erl_tar:extract(Name1, [memory,verbose]),
858    FileBins1 = lists:sort(Extracted1),
859
860    io:format("FileBins: ~p\n", [FileBins]),
861    io:format("FileBins1: ~p\n", [FileBins1]),
862    FileBins = FileBins1,
863
864    Name2 = filename:join(DataDir, "memory2.tar"),
865    {ok,Fd} = erl_tar:open(Name2, [write]),
866    [ok,ok] = [erl_tar:add(Fd, B, N, [write,verbose]) || {N,B} <- FileBins],
867    ok = erl_tar:close(Fd),
868    {ok,Extracted2} = erl_tar:extract(Name2, [memory,verbose]),
869    FileBins2 = lists:sort(Extracted2),
870    io:format("FileBins2: ~p\n", [FileBins2]),
871    FileBins = FileBins2,
872
873    %% Clean up.
874    ok = delete_files([Name1,Name2]),
875
876    verify_ports(Config).
877
878read_other_implementations(Config) when is_list(Config) ->
879    DataDir = proplists:get_value(data_dir, Config),
880    Files = ["v7.tar", "gnu.tar", "bsd.tar",
881             "star.tar", "pax_mtime.tar"],
882    do_read_other_implementations(Files, DataDir),
883    verify_ports(Config).
884
885do_read_other_implementations([], _DataDir) ->
886    ok;
887do_read_other_implementations([File|Rest], DataDir) ->
888    io:format("~nTrying ~s", [File]),
889    Full = filename:join(DataDir, File),
890    {ok, _} = erl_tar:table(Full),
891    {ok, _} = erl_tar:extract(Full, [memory]),
892    do_read_other_implementations(Rest, DataDir).
893
894
895%% Test handling of sparse files
896sparse(Config) when is_list(Config) ->
897    DataDir = proplists:get_value(data_dir, Config),
898    PrivDir = proplists:get_value(priv_dir, Config),
899    Sparse01Empty = "sparse01_empty.tar",
900    Sparse01 = "sparse01.tar",
901    Sparse10Empty = "sparse10_empty.tar",
902    Sparse10 = "sparse10.tar",
903    do_sparse([Sparse01Empty, Sparse01, Sparse10Empty, Sparse10], DataDir, PrivDir),
904    verify_ports(Config).
905
906do_sparse([], _DataDir, _PrivDir) ->
907    ok;
908do_sparse([Name|Rest], DataDir, PrivDir) ->
909    io:format("~nTrying sparse file ~s", [Name]),
910    Full = filename:join(DataDir, Name),
911    {ok, [_]} = erl_tar:table(Full),
912    {ok, _} = erl_tar:extract(Full, [memory]),
913    do_sparse(Rest, DataDir, PrivDir).
914
915%% Test filenames with characters outside the US ASCII range.
916unicode(Config) when is_list(Config) ->
917    run_unicode_node(Config, "+fnu"),
918    case has_transparent_naming() of
919	true ->
920	    run_unicode_node(Config, "+fnl");
921	false ->
922	    ok
923    end.
924
925run_unicode_node(Config, Option) ->
926    PrivDir = proplists:get_value(priv_dir, Config),
927    Pa = filename:dirname(code:which(?MODULE)),
928    Args = Option ++ " -pa "++Pa,
929    io:format("~s\n", [Args]),
930    Node = start_node(unicode, Args),
931    ok = rpc:call(Node, erlang, apply,
932		  [fun() -> do_unicode(PrivDir) end,[]]),
933    true = test_server:stop_node(Node),
934    ok.
935
936has_transparent_naming() ->
937    case os:type() of
938	{unix,darwin} -> false;
939	{unix,_} -> true;
940	_ -> false
941    end.
942
943do_unicode(PrivDir) ->
944    ok = file:set_cwd(PrivDir),
945    ok = file:make_dir("unicöde"),
946
947    Names = lists:sort(unicode_create_files()),
948    Tar = "unicöde.tar",
949    ok = erl_tar:create(Tar, ["unicöde"], []),
950
951    %% Unicode filenames require PAX format.
952    false = is_ustar(Tar),
953    {ok,Names0} = erl_tar:table(Tar, []),
954    Names = lists:sort(Names0),
955    _ = [ok = file:delete(Name) || Name <- Names],
956    ok = erl_tar:extract(Tar),
957    _ = [{ok,_} = file:read_file(Name) || Name <- Names],
958    _ = [ok = file:delete(Name) || Name <- Names],
959    ok = file:del_dir("unicöde"),
960    ok.
961
962unicode_create_files() ->
963    FileA = "unicöde/smörgåsbord",
964    ok = file:write_file(FileA, "yum!\n"),
965    [FileA|case file:native_name_encoding() of
966	       utf8 ->
967		   FileB = "unicöde/Хороший файл!",
968		   ok = file:write_file(FileB, "But almost empty.\n"),
969		   [FileB];
970	       latin1 ->
971		   []
972	   end].
973
974leading_slash(Config) ->
975    PrivDir = proplists:get_value(priv_dir, Config),
976    Dir = filename:join(PrivDir, ?FUNCTION_NAME),
977    TarFile = filename:join(Dir, "leading_slash.tar"),
978    ok = filelib:ensure_dir(TarFile),
979    {ok,Fd} = erl_tar:open(TarFile, [write]),
980    TarMemberName = "e/d/c/b/a_member",
981    TarMemberNameAbs = "/" ++ TarMemberName,
982    Contents = <<"contents\n">>,
983    ok = erl_tar:add(Fd, Contents, TarMemberNameAbs, [verbose]),
984    ok = erl_tar:close(Fd),
985
986    ok = erl_tar:extract(TarFile, [{cwd,Dir}]),
987
988    {ok,Contents} = file:read_file(filename:join(Dir, TarMemberName)),
989    ok.
990
991dotdot(Config) ->
992    PrivDir = proplists:get_value(priv_dir, Config),
993    Dir = filename:join(PrivDir, ?FUNCTION_NAME),
994    ok = file:make_dir(Dir),
995    Tar = filename:join(Dir, "dotdot.tar"),
996    {ok,Fd} = erl_tar:open(Tar, [write]),
997    BeamFile = code:which(?MODULE),
998    ok = erl_tar:add(Fd, BeamFile, "a/./../../some_file", []),
999    ok = erl_tar:close(Fd),
1000
1001    {error,{_,unsafe_path=Error}} = erl_tar:extract(Tar, [{cwd,Dir}]),
1002    false = filelib:is_regular(filename:join(PrivDir, "some_file")),
1003    io:format("~s\n", [erl_tar:format_error(Error)]),
1004
1005    ok.
1006
1007roundtrip_metadata(Config) ->
1008    PrivDir = proplists:get_value(priv_dir, Config),
1009    Dir = filename:join(PrivDir, ?FUNCTION_NAME),
1010    ok = file:make_dir(Dir),
1011
1012    do_roundtrip_metadata(Dir, "name-does-not-matter"),
1013    ok.
1014
1015do_roundtrip_metadata(Dir, File) ->
1016    Tar = filename:join(Dir, atom_to_list(?FUNCTION_NAME)++".tar"),
1017    BeamFile = code:which(compile),
1018    {ok,Fd} = erl_tar:open(Tar, [write]),
1019    ok = erl_tar:add(Fd, BeamFile, File, []),
1020    ok = erl_tar:close(Fd),
1021
1022    ok = erl_tar:extract(Tar, [{cwd,Dir}]),
1023
1024    %% Make sure that size and modification times are the same
1025    %% on all platforms.
1026    {ok,OrigInfo} = file:read_file_info(BeamFile),
1027    ExtractedFile = filename:join(Dir, File),
1028    {ok,ExtractedInfo} = file:read_file_info(ExtractedFile),
1029    #file_info{size=Size,mtime=Mtime,type=regular} = OrigInfo,
1030    #file_info{size=Size,mtime=Mtime,type=regular} = ExtractedInfo,
1031
1032    %% On Unix platforms more fields are expected to be the same.
1033    case os:type() of
1034        {unix,_} ->
1035            #file_info{access=Access,mode=Mode} = OrigInfo,
1036            #file_info{access=Access,mode=Mode} = ExtractedInfo,
1037            ok;
1038        _ ->
1039            ok
1040    end.
1041
1042apply_file_info_opts(Config) when is_list(Config) ->
1043    ok = file:set_cwd(proplists:get_value(priv_dir, Config)),
1044
1045    ok = file:make_dir("empty_directory"),
1046    ok = file:write_file("file", "contents"),
1047
1048    Opts = [{atime, 0}, {mtime, 0}, {ctime, 0}, {uid, 0}, {gid, 0}],
1049    TarFile = "reproducible.tar",
1050    {ok, Tar} = erl_tar:open(TarFile, [write]),
1051    ok = erl_tar:add(Tar, "file", Opts),
1052    ok = erl_tar:add(Tar, "empty_directory", Opts),
1053    ok = erl_tar:add(Tar, <<"contents">>, "memory_file", Opts),
1054    erl_tar:close(Tar),
1055
1056    ok = file:make_dir("extracted"),
1057    erl_tar:extract(TarFile, [{cwd, "extracted"}]),
1058
1059    {ok, #file_info{mtime=0}} =
1060        file:read_file_info("extracted/empty_directory", [{time, posix}]),
1061    {ok, #file_info{mtime=0}} =
1062        file:read_file_info("extracted/file", [{time, posix}]),
1063    {ok, #file_info{mtime=0}} =
1064        file:read_file_info("extracted/memory_file", [{time, posix}]),
1065
1066    ok.
1067
1068%% Delete the given list of files.
1069delete_files([]) -> ok;
1070delete_files([Item|Rest]) ->
1071    case file:delete(Item) of
1072	ok ->
1073	    delete_files(Rest);
1074	{error,eperm} ->
1075	    file:change_mode(Item, 8#777),
1076	    delete_files(filelib:wildcard(filename:join(Item, "*"))),
1077	    file:del_dir(Item),
1078	    ok;
1079	{error,eacces} ->
1080	    %% We'll see about that!
1081	    file:change_mode(Item, 8#777),
1082	    case file:delete(Item) of
1083		ok -> ok;
1084		{error,_} ->
1085		    erlang:yield(),
1086		    file:change_mode(Item, 8#777),
1087		    file:delete(Item),
1088		    ok
1089	    end;
1090	{error,_} -> ok
1091    end,
1092    delete_files(Rest).
1093
1094%% Move to a temporary directory with as short name as possible and
1095%% execute Fun. Remove the directory and any files in it afterwards.
1096%% This is necessary because pathnames on Windows may be limited to
1097%% 260 characters.
1098run_in_short_tempdir(Config, Fun) ->
1099    {ok,Cwd} = file:get_cwd(),
1100    PrivDir0 = proplists:get_value(priv_dir, Config),
1101
1102    %% Normalize name to make sure that there is no slash at the end.
1103    PrivDir = filename:absname(PrivDir0),
1104
1105    %% We need a base directory with a much shorter pathname than
1106    %% priv_dir. We KNOW that priv_dir is located four levels below
1107    %% the directory that common_test puts the ct_run.* directories
1108    %% in. That fact is not documented, but a usually reliable source
1109    %% assured me that the directory structure is unlikely to change
1110    %% in future versions of common_test because of backwards
1111    %% compatibility (tools developed by users of common_test depend
1112    %% on the current directory layout).
1113    Base = lists:foldl(fun(_, D) ->
1114			       filename:dirname(D)
1115		       end, PrivDir, [1,2,3,4]),
1116
1117    Dir = make_temp_dir(Base, 0),
1118    ok = file:set_cwd(Dir),
1119    io:format("Running test in ~s\n", [Dir]),
1120    try
1121	Fun()
1122    after
1123	file:set_cwd(Cwd),
1124	delete_files([Dir])
1125    end.
1126
1127make_temp_dir(Base, I) ->
1128    Name = filename:join(Base, integer_to_list(I, 36)),
1129    case file:make_dir(Name) of
1130	ok -> Name;
1131	{error,eexist} -> make_temp_dir(Base, I+1)
1132    end.
1133
1134start_node(Name, Args) ->
1135    [_,Host] = string:tokens(atom_to_list(node()), "@"),
1136    ct:log("Trying to start ~w@~s~n", [Name,Host]),
1137    case test_server:start_node(Name, peer, [{args,Args}]) of
1138	{error,Reason} ->
1139	    ct:fail(Reason);
1140	{ok,Node} ->
1141	    ct:log("Node ~p started~n", [Node]),
1142	    Node
1143    end.
1144
1145%% Test that the given tar file is a plain USTAR archive,
1146%% without any PAX extensions.
1147is_ustar(File) ->
1148    {ok,Bin} = file:read_file(File),
1149    <<_:257/binary,"ustar",0,_/binary>> = Bin,
1150    <<_:156/binary,Type:8,_/binary>> = Bin,
1151    case Type of
1152        $x -> false;
1153        $g -> false;
1154        _ -> true
1155    end.
1156
1157
1158verify_ports(Config) ->
1159    PortsBefore = proplists:get_value(ports, Config),
1160    PortsAfter = ordsets:from_list(erlang:ports()),
1161    case ordsets:subtract(PortsAfter, PortsBefore) of
1162        [] ->
1163            ok;
1164        [_|_]=Rem ->
1165            error({leaked_ports,Rem})
1166    end.
1167