diff options
Diffstat (limited to 'lib/stdlib/src/erl_tar.erl')
| -rw-r--r-- | lib/stdlib/src/erl_tar.erl | 959 |
1 files changed, 959 insertions, 0 deletions
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl new file mode 100644 index 0000000000..fd85c7aef5 --- /dev/null +++ b/lib/stdlib/src/erl_tar.erl @@ -0,0 +1,959 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(erl_tar). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Purpose: Unix tar (tape archive) utility. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-export([create/2, create/3, extract/1, extract/2, table/1, table/2, + open/2, close/1, add/3, add/4, + t/1, tt/1, format_error/1]). + +-include_lib("kernel/include/file.hrl"). + +-record(add_opts, + {read_info, % Fun to use for read file/link info. + verbose = false :: boolean()}). % Verbose on/off. + +%% Opens a tar archive. + +open(Name, Mode) -> + case open_mode(Mode) of + {ok, Access, Raw, Opts} -> + open1(Name, Access, Raw, Opts); + {error, Reason} -> + {error, {Name, Reason}} + end. + +open1({binary,Bin}, read, _Raw, Opts) -> + case file:open(Bin, [ram,binary,read]) of + {ok,File} -> + case Opts of + [compressed] -> ram_file:uncompress(File); + [] -> ok + end, + {ok,{read,File}}; + Error -> + Error + end; +open1({file, Fd}, read, _Raw, _Opts) -> + {ok, {read, Fd}}; +open1(Name, Access, Raw, Opts) -> + case file:open(Name, Raw ++ [binary, Access|Opts]) of + {ok, File} -> + {ok, {Access, File}}; + {error, Reason} -> + {error, {Name, Reason}} + end. + +%% Closes a tar archive. + +close({read, File}) -> + ok = file:close(File); +close({write, File}) -> + PadResult = pad_file(File), + ok = file:close(File), + PadResult; +close(_) -> + {error, einval}. + +%% Adds a file to a tape archive. + +add(File, Name, Options) -> + add(File, Name, Name, Options). + +add({write, File}, Name, NameInArchive, Options) -> + Opts = #add_opts{read_info=fun(F) -> file:read_link_info(F) end}, + add1(File, Name, NameInArchive, add_opts(Options, Opts)); +add({read, _File}, _, _, _) -> + {error, eacces}; +add(_, _, _, _) -> + {error, einval}. + +add_opts([dereference|T], Opts) -> + add_opts(T, Opts#add_opts{read_info=fun(F) -> file:read_file_info(F) end}); +add_opts([verbose|T], Opts) -> + add_opts(T, Opts#add_opts{verbose=true}); +add_opts([_|T], Opts) -> + add_opts(T, Opts); +add_opts([], Opts) -> + Opts. + +%% Creates a tar file Name containing the given files. + +create(Name, Filenames) -> + create(Name, Filenames, []). + +%% Creates a tar archive Name containing the given files. +%% Accepted options: verbose, compressed, cooked + +create(Name, FileList, Options) -> + Mode = lists:filter(fun(X) -> (X=:=compressed) or (X=:=cooked) + end, Options), + case open(Name, [write|Mode]) of + {ok, TarFile} -> + Add = fun({NmInA, NmOrBin}) -> + add(TarFile, NmOrBin, NmInA, Options); + (Nm) -> + add(TarFile, Nm, Nm, Options) + end, + Result = foreach_while_ok(Add, FileList), + case {Result, close(TarFile)} of + {ok, Res} -> Res; + {Res, _} -> Res + end; + Reason -> + Reason + end. + +%% Extracts all files from the tar file Name. + +extract(Name) -> + extract(Name, []). + +%% Extracts (all) files from the tar file Name. +%% Options accepted: keep_old_files, {files, ListOfFilesToExtract}, verbose, +%% {cwd, AbsoluteDirectory} + +extract(Name, Opts) -> + foldl_read(Name, fun extract1/4, ok, extract_opts(Opts)). + +%% Returns a list of names of the files in the tar file Name. +%% Options accepted: verbose + +table(Name) -> + table(Name, []). + +%% Returns a list of names of the files in the tar file Name. +%% Options accepted: compressed, verbose, cooked. + +table(Name, Opts) -> + foldl_read(Name, fun table1/4, [], table_opts(Opts)). + + +%% Comments for printing the contents of a tape archive, +%% meant to be invoked from the shell. + +t(Name) -> + case table(Name) of + {ok, List} -> + lists:foreach(fun(N) -> ok = io:format("~s\n", [N]) end, List); + Error -> + Error + end. + +tt(Name) -> + case table(Name, [verbose]) of + {ok, List} -> + lists:foreach(fun print_header/1, List); + Error -> + Error + end. + +print_header({Name, Type, Size, Mtime, Mode, Uid, Gid}) -> + io:format("~s~s ~4w/~-4w ~7w ~s ~s\n", + [type_to_string(Type), mode_to_string(Mode), + Uid, Gid, Size, time_to_string(Mtime), Name]). + +type_to_string(regular) -> "-"; +type_to_string(directory) -> "d"; +type_to_string(link) -> "l"; +type_to_string(symlink) -> "s"; +type_to_string(char) -> "c"; +type_to_string(block) -> "b"; +type_to_string(fifo) -> "f"; +type_to_string(_) -> "?". + +mode_to_string(Mode) -> + mode_to_string(Mode, "xwrxwrxwr", []). + +mode_to_string(Mode, [C|T], Acc) when Mode band 1 =:= 1 -> + mode_to_string(Mode bsr 1, T, [C|Acc]); +mode_to_string(Mode, [_|T], Acc) -> + mode_to_string(Mode bsr 1, T, [$-|Acc]); +mode_to_string(_, [], Acc) -> + Acc. + +time_to_string({{Y, Mon, Day}, {H, Min, _}}) -> + io_lib:format("~s ~2w ~s:~s ~w", [month(Mon), Day, two_d(H), two_d(Min), Y]). + +two_d(N) -> + tl(integer_to_list(N + 100)). + +month(1) -> "Jan"; +month(2) -> "Feb"; +month(3) -> "Mar"; +month(4) -> "Apr"; +month(5) -> "May"; +month(6) -> "Jun"; +month(7) -> "Jul"; +month(8) -> "Aug"; +month(9) -> "Sep"; +month(10) -> "Oct"; +month(11) -> "Nov"; +month(12) -> "Dec". + +%% Converts the short error reason to a descriptive string. + +format_error(bad_header) -> "Bad directory header"; +format_error(eof) -> "Unexpected end of file"; +format_error(symbolic_link_too_long) -> "Symbolic link too long"; +format_error({Name,Reason}) -> + lists:flatten(io_lib:format("~s: ~s", [Name,format_error(Reason)])); +format_error(Atom) when is_atom(Atom) -> + file:format_error(Atom); +format_error(Term) -> + lists:flatten(io_lib:format("~p", [Term])). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Useful definitions (also start of implementation). +%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Offset for fields in the tar header. +%% Note that these offsets are ZERO-based as in the POSIX standard +%% document, while binaries use ONE-base offset. Caveat Programmer. + +-define(th_name, 0). +-define(th_mode, 100). +-define(th_uid, 108). +-define(th_gid, 116). +-define(th_size, 124). +-define(th_mtime, 136). +-define(th_chksum, 148). +-define(th_typeflag, 156). +-define(th_linkname, 157). +-define(th_magic, 257). +-define(th_version, 263). +-define(th_prefix, 345). + +%% Length of these fields. + +-define(th_name_len, 100). +-define(th_mode_len, 8). +-define(th_uid_len, 8). +-define(th_gid_len, 8). +-define(th_size_len, 12). +-define(th_mtime_len, 12). +-define(th_chksum_len, 8). +-define(th_linkname_len, 100). +-define(th_magic_len, 6). +-define(th_version_len, 2). +-define(th_prefix_len, 167). + +-record(tar_header, + {name, % Name of file. + mode, % Mode bits. + uid, % User id. + gid, % Group id. + size, % Size of file + mtime, % Last modified (seconds since + % Jan 1, 1970). + chksum, % Checksum of header. + typeflag = [], % Type of file. + linkname = [], % Name of link. + filler = [], + prefix}). % Filename prefix. + +-define(record_size, 512). +-define(block_size, (512*20)). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Adding members to a tar archive. +%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +add1(TarFile, Bin, NameInArchive, Opts) when is_binary(Bin) -> + Now = calendar:now_to_local_time(now()), + Info = #file_info{size = byte_size(Bin), + type = regular, + access = read_write, + atime = Now, + mtime = Now, + ctime = Now, + mode = 8#100644, + links = 1, + major_device = 0, + minor_device = 0, + inode = 0, + uid = 0, + gid = 0}, + Header = create_header(NameInArchive, Info), + add1(TarFile, NameInArchive, Header, Bin, Opts); +add1(TarFile, Name, NameInArchive, Opts) -> + case read_file_and_info(Name, Opts) of + {ok, Bin, Info} when Info#file_info.type =:= regular -> + Header = create_header(NameInArchive, Info), + add1(TarFile, Name, Header, Bin, Opts); + {ok, PointsTo, Info} when Info#file_info.type =:= symlink -> + if + length(PointsTo) > 100 -> + {error,{PointsTo,symbolic_link_too_long}}; + true -> + Info2 = Info#file_info{size=0}, + Header = create_header(NameInArchive, Info2, PointsTo), + add1(TarFile, Name, Header, list_to_binary([]), Opts) + end; + {ok, _, Info} when Info#file_info.type =:= directory -> + add_directory(TarFile, Name, NameInArchive, Info, Opts); + {ok, _, #file_info{type=Type}} -> + {error, {bad_file_type, Name, Type}}; + {error, Reason} -> + {error, {Name, Reason}} + end. + +add1(Tar, Name, Header, Bin, Options) -> + add_verbose(Options, "a ~s~n", [Name]), + file:write(Tar, [Header, Bin, padding(byte_size(Bin), ?record_size)]). + +add_directory(TarFile, DirName, NameInArchive, Info, Options) -> + case file:list_dir(DirName) of + {ok, []} -> + add_verbose(Options, "a ~s~n", [DirName]), + Header = create_header(NameInArchive, Info), + file:write(TarFile, Header); + {ok, Files} -> + Add = fun (File) -> + add1(TarFile, + filename:join(DirName, File), + filename:join(NameInArchive, File), + Options) end, + foreach_while_ok(Add, Files); + {error, Reason} -> + {error, {DirName, Reason}} + end. + +%% Creates a header for file in a tar file. + +create_header(Name, Info) -> + create_header(Name, Info, []). +create_header(Name, #file_info {mode=Mode, uid=Uid, gid=Gid, + size=Size, mtime=Mtime0, type=Type}, Linkname) -> + Mtime = posix_time(erlang:localtime_to_universaltime(Mtime0)), + {Prefix,Suffix} = split_filename(Name), + H0 = [to_string(Suffix, 100), + to_octal(Mode, 8), + to_octal(Uid, 8), + to_octal(Gid, 8), + to_octal(Size, ?th_size_len), + to_octal(Mtime, ?th_mtime_len), + <<" ">>, + file_type(Type), + to_string(Linkname, ?th_linkname_len), + "ustar",0, + "00", + zeroes(?th_prefix-?th_version-?th_version_len), + to_string(Prefix, ?th_prefix_len)], + H = list_to_binary(H0), + 512 = byte_size(H), %Assertion. + ChksumString = to_octal(checksum(H), 6, [0,$\s]), + <<Before:?th_chksum/binary,_:?th_chksum_len/binary,After/binary>> = H, + [Before,ChksumString,After]. + +file_type(regular) -> $0; +file_type(symlink) -> $2; +file_type(directory) -> $5. + +to_octal(Int, Count) when Count > 1 -> + to_octal(Int, Count-1, [0]). + +to_octal(_, 0, Result) -> Result; +to_octal(Int, Count, Result) -> + to_octal(Int div 8, Count-1, [Int rem 8 + $0|Result]). + +to_string(Str0, Count) -> + Str = list_to_binary(Str0), + case byte_size(Str) of + Size when Size < Count -> + [Str|zeroes(Count-Size)]; + _ -> Str + end. + +%% Pads out end of file. + +pad_file(File) -> + {ok,Position} = file:position(File, {cur,0}), + %% There must be at least one empty record at the end of the file. + Zeros = zeroes(?block_size - (Position rem ?block_size)), + file:write(File, Zeros). + +split_filename(Name) when length(Name) =< ?th_name_len -> + {"", Name}; +split_filename(Name0) -> + split_filename(lists:reverse(filename:split(Name0)), [], [], 0). + +split_filename([Comp|Rest], Prefix, Suffix, Len) + when Len+length(Comp) < ?th_name_len -> + split_filename(Rest, Prefix, [Comp|Suffix], Len+length(Comp)+1); +split_filename([Comp|Rest], Prefix, Suffix, Len) -> + split_filename(Rest, [Comp|Prefix], Suffix, Len+length(Comp)+1); +split_filename([], Prefix, Suffix, _) -> + {filename:join(Prefix),filename:join(Suffix)}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Retrieving files from a tape archive. +%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Options used when reading a tar archive. + +-record(read_opts, + {cwd :: string(), % Current working directory. + keep_old_files = false :: boolean(), % Owerwrite or not. + files = all, % Set of files to extract + % (or all). + output = file :: 'file' | 'memory', + open_mode = [], % Open mode options. + verbose = false :: boolean()}). % Verbose on/off. + +extract_opts(List) -> + extract_opts(List, default_options()). + +table_opts(List) -> + read_opts(List, default_options()). + +default_options() -> + {ok, Cwd} = file:get_cwd(), + #read_opts{cwd=Cwd}. + +%% Parse options for extract. + +extract_opts([keep_old_files|Rest], Opts) -> + extract_opts(Rest, Opts#read_opts{keep_old_files=true}); +extract_opts([{cwd, Cwd}|Rest], Opts) -> + extract_opts(Rest, Opts#read_opts{cwd=Cwd}); +extract_opts([{files, Files}|Rest], Opts) -> + Set = ordsets:from_list(Files), + extract_opts(Rest, Opts#read_opts{files=Set}); +extract_opts([memory|Rest], Opts) -> + extract_opts(Rest, Opts#read_opts{output=memory}); +extract_opts([compressed|Rest], Opts=#read_opts{open_mode=OpenMode}) -> + extract_opts(Rest, Opts#read_opts{open_mode=[compressed|OpenMode]}); +extract_opts([cooked|Rest], Opts=#read_opts{open_mode=OpenMode}) -> + extract_opts(Rest, Opts#read_opts{open_mode=[cooked|OpenMode]}); +extract_opts([verbose|Rest], Opts) -> + extract_opts(Rest, Opts#read_opts{verbose=true}); +extract_opts([Other|Rest], Opts) -> + extract_opts(Rest, read_opts([Other], Opts)); +extract_opts([], Opts) -> + Opts. + +%% Common options for all read operations. + +read_opts([compressed|Rest], Opts=#read_opts{open_mode=OpenMode}) -> + read_opts(Rest, Opts#read_opts{open_mode=[compressed|OpenMode]}); +read_opts([cooked|Rest], Opts=#read_opts{open_mode=OpenMode}) -> + read_opts(Rest, Opts#read_opts{open_mode=[cooked|OpenMode]}); +read_opts([verbose|Rest], Opts) -> + read_opts(Rest, Opts#read_opts{verbose=true}); +read_opts([_|Rest], Opts) -> + read_opts(Rest, Opts); +read_opts([], Opts) -> + Opts. + +foldl_read(TarName, Fun, Accu, Opts) -> + case open(TarName, [read|Opts#read_opts.open_mode]) of + {ok, {read, File}} -> + Result = + case catch foldl_read1(Fun, Accu, File, Opts) of + {'EXIT', Reason} -> + exit(Reason); + {error, {Reason, Format, Args}} -> + read_verbose(Opts, Format, Args), + {error, Reason}; + {error, Reason} -> + {error, Reason}; + Ok -> + Ok + end, + ok = file:close(File), + Result; + Error -> + Error + end. + +foldl_read1(Fun, Accu0, File, Opts) -> + case get_header(File) of + eof -> + Fun(eof, File, Opts, Accu0); + Header -> + {ok, NewAccu} = Fun(Header, File, Opts, Accu0), + foldl_read1(Fun, NewAccu, File, Opts) + end. + +table1(eof, _, _, Result) -> + {ok, lists:reverse(Result)}; +table1(Header = #tar_header{}, File, #read_opts{verbose=true}, Result) -> + #tar_header{name=Name, size=Size, mtime=Mtime, typeflag=Type, + mode=Mode, uid=Uid, gid=Gid} = Header, + skip(File, Size), + {ok, [{Name, Type, Size, posix_to_erlang_time(Mtime), Mode, Uid, Gid}|Result]}; +table1(#tar_header{name=Name, size=Size}, File, _, Result) -> + skip(File, Size), + {ok, [Name|Result]}. + +extract1(eof, _, _, Acc) -> + if + is_list(Acc) -> + {ok, lists:reverse(Acc)}; + true -> + Acc + end; +extract1(Header, File, Opts, Acc) -> + Name = Header#tar_header.name, + case check_extract(Name, Opts) of + true -> + {ok, Bin} = get_element(File, Header), + case write_extracted_element(Header, Bin, Opts) of + ok -> + {ok, Acc}; + {ok, NameBin} when is_list(Acc) -> + {ok, [NameBin | Acc]}; + {ok, NameBin} when Acc =:= ok -> + {ok, [NameBin]} + end; + false -> + ok = skip(File, Header#tar_header.size), + {ok, Acc} + end. + +%% Checks if the file Name should be extracted. + +check_extract(_, #read_opts{files=all}) -> + true; +check_extract(Name, #read_opts{files=Files}) -> + ordsets:is_element(Name, Files). + +get_header(File) -> + case file:read(File, ?record_size) of + eof -> + throw({error,eof}); + {ok, Bin} when is_binary(Bin) -> + convert_header(Bin); + {ok, List} -> + convert_header(list_to_binary(List)); + {error, Reason} -> + throw({error, Reason}) + end. + +%% Converts the tar header to a record. + +convert_header(Bin) when byte_size(Bin) =:= ?record_size -> + case verify_checksum(Bin) of + ok -> + Hd = #tar_header{name=get_name(Bin), + mode=from_octal(Bin, ?th_mode, ?th_mode_len), + uid=from_octal(Bin, ?th_uid, ?th_uid_len), + gid=from_octal(Bin, ?th_gid, ?th_gid_len), + size=from_octal(Bin, ?th_size, ?th_size_len), + mtime=from_octal(Bin, ?th_mtime, ?th_mtime_len), + linkname=from_string(Bin, + ?th_linkname, ?th_linkname_len), + typeflag=typeflag(Bin)}, + convert_header1(Hd); + eof -> + eof + end; +convert_header(Bin) when byte_size(Bin) =:= 0 -> + eof; +convert_header(_Bin) -> + throw({error, eof}). + +%% Basic sanity. Better set the element size to zero here if the type +%% always is of zero length. + +convert_header1(H) when H#tar_header.typeflag =:= symlink, H#tar_header.size =/= 0 -> + convert_header1(H#tar_header{size=0}); +convert_header1(H) when H#tar_header.typeflag =:= directory, H#tar_header.size =/= 0 -> + convert_header1(H#tar_header{size=0}); +convert_header1(Header) -> + Header. + +typeflag(Bin) -> + [T] = binary_to_list(Bin, ?th_typeflag+1, ?th_typeflag+1), + case T of + 0 -> regular; + $0 -> regular; + $1 -> link; + $2 -> symlink; + $3 -> char; + $4 -> block; + $5 -> directory; + $6 -> fifo; + $7 -> regular; + _ -> unknown + end. + +%% Get the name of the file from the prefix and name fields of the +%% tar header. + +get_name(Bin) -> + Name = from_string(Bin, ?th_name, ?th_name_len), + case binary_to_list(Bin, ?th_prefix+1, ?th_prefix+1) of + [0] -> + Name; + [_] -> + Prefix = binary_to_list(Bin, ?th_prefix+1, byte_size(Bin)), + lists:reverse(remove_nulls(Prefix), [$/|Name]) + end. + +from_string(Bin, Pos, Len) -> + lists:reverse(remove_nulls(binary_to_list(Bin, Pos+1, Pos+Len))). + +%% Returns all characters up to (but not including) the first null +%% character, in REVERSE order. + +remove_nulls(List) -> + remove_nulls(List, []). + +remove_nulls([0|_], Result) -> + remove_nulls([], Result); +remove_nulls([C|Rest], Result) -> + remove_nulls(Rest, [C|Result]); +remove_nulls([], Result) -> + Result. + +from_octal(Bin, Pos, Len) -> + from_octal(binary_to_list(Bin, Pos+1, Pos+Len)). + +from_octal([$\s|Rest]) -> + from_octal(Rest); +from_octal([Digit|Rest]) when $0 =< Digit, Digit =< $7 -> + from_octal(Rest, Digit-$0); +from_octal(Bin) when is_binary(Bin) -> + from_octal(binary_to_list(Bin)); +from_octal(Other) -> + throw({error, {bad_header, "Bad octal number: ~p", [Other]}}). + +from_octal([Digit|Rest], Result) when $0 =< Digit, Digit =< $7 -> + from_octal(Rest, Result*8+Digit-$0); +from_octal([$\s|_], Result) -> + Result; +from_octal([0|_], Result) -> + Result; +from_octal(Other, _) -> + throw({error, {bad_header, "Bad contents in octal field: ~p", [Other]}}). + +%% Retrieves the next element from the archive. +%% Returns {ok, Bin} | eof | {error, Reason} + +get_element(File, #tar_header{size = 0}) -> + skip_to_next(File), + {ok,<<>>}; +get_element(File, #tar_header{size = Size}) -> + case file:read(File, Size) of + {ok,Bin}=Res when byte_size(Bin) =:= Size -> + skip_to_next(File), + Res; + {ok,List} when length(List) =:= Size -> + skip_to_next(File), + {ok,list_to_binary(List)}; + {ok,_} -> throw({error,eof}); + {error, Reason} -> throw({error, Reason}); + eof -> throw({error,eof}) + end. + +%% Verify the checksum in the header. First try an unsigned addition +%% of all bytes in the header (as it should be according to Posix). + +verify_checksum(Bin) -> + <<H1:?th_chksum/binary,CheckStr:?th_chksum_len/binary,H2/binary>> = Bin, + case checksum(H1) + checksum(H2) of + 0 -> eof; + Checksum0 -> + Csum = from_octal(CheckStr), + CsumInit = ?th_chksum_len * $\s, + case Checksum0 + CsumInit of + Csum -> ok; + Unsigned -> + verify_checksum(H1, H2, CsumInit, Csum, Unsigned) + end + end. + +%% The checksums didn't match. Now try a signed addition. + +verify_checksum(H1, H2, Csum, ShouldBe, Unsigned) -> + case signed_sum(binary_to_list(H1), signed_sum(binary_to_list(H2), Csum)) of + ShouldBe -> ok; + Signed -> + throw({error, + {bad_header, + "Incorrect directory checksum ~w (~w), should be ~w", + [Signed, Unsigned, ShouldBe]}}) + end. + +signed_sum([C|Rest], Sum) when C < 128 -> + signed_sum(Rest, Sum+C); +signed_sum([C|Rest], Sum) -> + signed_sum(Rest, Sum+C-256); +signed_sum([], Sum) -> Sum. + +write_extracted_element(Header, Bin, Opts) + when Opts#read_opts.output =:= memory -> + case Header#tar_header.typeflag of + regular -> + {ok, {Header#tar_header.name, Bin}}; + _ -> + ok + end; +write_extracted_element(Header, Bin, Opts) -> + Name = filename:absname(Header#tar_header.name, Opts#read_opts.cwd), + Created = + case Header#tar_header.typeflag of + regular -> + write_extracted_file(Name, Bin, Opts); + directory -> + create_extracted_dir(Name, Opts); + symlink -> + create_symlink(Name, Header, Opts); + Other -> % Ignore. + read_verbose(Opts, "x ~s - unsupported type ~p~n", + [Name, Other]), + not_written + end, + case Created of + ok -> set_extracted_file_info(Name, Header); + not_written -> ok + end. + +create_extracted_dir(Name, _Opts) -> + case file:make_dir(Name) of + ok -> ok; + {error,enotsup} -> not_written; + {error,eexist} -> not_written; + {error,enoent} -> make_dirs(Name, dir); + {error,Reason} -> throw({error, Reason}) + end. + +create_symlink(Name, #tar_header{linkname=Linkname}=Header, Opts) -> + case file:make_symlink(Linkname, Name) of + ok -> ok; + {error,enoent} -> + ok = make_dirs(Name, file), + create_symlink(Name, Header, Opts); + {error,eexist} -> not_written; + {error,enotsup} -> + read_verbose(Opts, "x ~s - symbolic links not supported~n", [Name]), + not_written; + {error,Reason} -> throw({error, Reason}) + end. + +write_extracted_file(Name, Bin, Opts) -> + Write = + case Opts#read_opts.keep_old_files of + true -> + case file:read_file_info(Name) of + {ok, _} -> false; + _ -> true + end; + false -> true + end, + case Write of + true -> + read_verbose(Opts, "x ~s~n", [Name]), + write_file(Name, Bin); + false -> + read_verbose(Opts, "x ~s - exists, not created~n", [Name]), + not_written + end. + +write_file(Name, Bin) -> + case file:write_file(Name, Bin) of + ok -> ok; + {error,enoent} -> + ok = make_dirs(Name, file), + write_file(Name, Bin); + {error,Reason} -> + throw({error, Reason}) + end. + +set_extracted_file_info(_, #tar_header{typeflag = symlink}) -> ok; +set_extracted_file_info(Name, #tar_header{mode=Mode, mtime=Mtime}) -> + Info = #file_info{mode=Mode, mtime=posix_to_erlang_time(Mtime)}, + file:write_file_info(Name, Info). + +%% Makes all directories leading up to the file. + +make_dirs(Name, Type) -> + make_dirs1(filename:split(Name), Type). + +make_dirs1([Dir, Next|Rest], Type) -> + case file:read_file_info(Dir) of + {ok, #file_info{type=directory}} -> + make_dirs1([filename:join(Dir, Next)|Rest], Type); + {ok, #file_info{}} -> + throw({error, enotdir}); + {error, _} -> + case file:make_dir(Dir) of + ok -> + make_dirs1([filename:join(Dir, Next)|Rest], Type); + {error, Reason} -> + throw({error, Reason}) + end + end; +make_dirs1([_], file) -> ok; +make_dirs1([Dir], dir) -> + file:make_dir(Dir); +make_dirs1([], _) -> + %% There must be something wrong here. The list was not supposed + %% to be empty. + throw({error, enoent}). + +%% Prints the message on if the verbose option is given (for reading). + +read_verbose(#read_opts{verbose=true}, Format, Args) -> + io:format(Format, Args), + io:nl(); +read_verbose(_, _, _) -> + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Utility functions. +%%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Returns the checksum of a binary. + +checksum(Bin) -> checksum(Bin, 0). + +checksum(<<A,B,C,D,E,F,G,H,T/binary>>, Sum) -> + checksum(T, Sum+A+B+C+D+E+F+G+H); +checksum(<<A,T/binary>>, Sum) -> + checksum(T, Sum+A); +checksum(<<>>, Sum) -> Sum. + +%% Returns a list of zeroes to pad out to the given block size. + +padding(Size, BlockSize) -> + zeroes(pad_size(Size, BlockSize)). + +pad_size(Size, BlockSize) -> + case Size rem BlockSize of + 0 -> 0; + Rem -> BlockSize-Rem + end. + +zeroes(0) -> []; +zeroes(1) -> [0]; +zeroes(2) -> [0,0]; +zeroes(Number) -> + Half = zeroes(Number div 2), + case Number rem 2 of + 0 -> [Half|Half]; + 1 -> [Half|[0|Half]] + end. + +%% Skips the given number of bytes rounded up to an even record. + +skip(File, Size) -> + %% Note: There is no point in handling failure to get the current position + %% in the file. If it doesn't work, something serious is wrong. + Amount = ((Size + ?record_size - 1) div ?record_size) * ?record_size, + {ok,_} = file:position(File, {cur, Amount}), + ok. + +%% Skips to the next record in the file. + +skip_to_next(File) -> + %% Note: There is no point in handling failure to get the current position + %% in the file. If it doesn't work, something serious is wrong. + {ok, Position} = file:position(File, {cur, 0}), + NewPosition = ((Position + ?record_size - 1) div ?record_size) * ?record_size, + {ok,NewPosition} = file:position(File, NewPosition), + ok. + +%% Prints the message on if the verbose option is given. + +add_verbose(#add_opts{verbose=true}, Format, Args) -> + io:format(Format, Args); +add_verbose(_, _, _) -> + ok. + +%% Converts a tuple containing the time to a Posix time (seconds +%% since Jan 1, 1970). + +posix_time(Time) -> + EpochStart = {{1970,1,1},{0,0,0}}, + {Days,{Hour,Min,Sec}} = calendar:time_difference(EpochStart, Time), + 86400*Days + 3600*Hour + 60*Min + Sec. + +posix_to_erlang_time(Sec) -> + OneMillion = 1000000, + Time = calendar:now_to_datetime({Sec div OneMillion, Sec rem OneMillion, 0}), + erlang:universaltime_to_localtime(Time). + +read_file_and_info(Name, Opts) -> + ReadInfo = Opts#add_opts.read_info, + case ReadInfo(Name) of + {ok,Info} when Info#file_info.type =:= regular -> + case file:read_file(Name) of + {ok,Bin} -> + {ok,Bin,Info}; + Error -> + Error + end; + {ok,Info} when Info#file_info.type =:= symlink -> + case file:read_link(Name) of + {ok,PointsTo} -> + {ok,PointsTo,Info}; + Error -> + Error + end; + {ok, Info} -> + {ok,[],Info}; + Error -> + Error + end. + +foreach_while_ok(Fun, [First|Rest]) -> + case Fun(First) of + ok -> foreach_while_ok(Fun, Rest); + Other -> Other + end; +foreach_while_ok(_, []) -> ok. + +open_mode(Mode) -> + open_mode(Mode, false, [raw], []). + +open_mode(read, _, Raw, _) -> + {ok, read, Raw, []}; +open_mode(write, _, Raw, _) -> + {ok, write, Raw, []}; +open_mode([read|Rest], false, Raw, Opts) -> + open_mode(Rest, read, Raw, Opts); +open_mode([write|Rest], false, Raw, Opts) -> + open_mode(Rest, write, Raw, Opts); +open_mode([compressed|Rest], Access, Raw, Opts) -> + open_mode(Rest, Access, Raw, [compressed|Opts]); +open_mode([cooked|Rest], Access, _Raw, Opts) -> + open_mode(Rest, Access, [], Opts); +open_mode([], Access, Raw, Opts) -> + {ok, Access, Raw, Opts}; +open_mode(_, _, _, _) -> + {error, einval}. |