%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1997-2013. 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([init/3, 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.
chunk_size = 0, % For file reading when sending to sftp. 0=do not chunk
verbose = false :: boolean()}). % Verbose on/off.
%% Opens a tar archive.
init(UsrHandle, AccessMode, Fun) when is_function(Fun,2) ->
{ok, {AccessMode,{tar_descriptor,UsrHandle,Fun}}}.
%%%================================================================
%%% The open function with friends is to keep the file and binary api of this module
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} ->
_ = [ram_file:uncompress(File) || Opts =:= [compressed]],
init(File,read,file_fun());
Error ->
Error
end;
open1({file, Fd}, read, _Raw, _Opts) ->
init(Fd, read, file_fun());
open1(Name, Access, Raw, Opts) ->
case file:open(Name, Raw ++ [binary, Access|Opts]) of
{ok, File} ->
init(File, Access, file_fun());
{error, Reason} ->
{error, {Name, Reason}}
end.
file_fun() ->
fun(write, {Fd,Data}) -> file:write(Fd, Data);
(position, {Fd,Pos}) -> file:position(Fd, Pos);
(read2, {Fd,Size}) -> file:read(Fd,Size);
(close, Fd) -> file:close(Fd)
end.
%%% End of file and binary api (except for open_mode/1 downwards
%%%================================================================
%% Closes a tar archive.
close({read, File}) ->
ok = do_close(File);
close({write, File}) ->
PadResult = pad_file(File),
ok = do_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([{chunks,N}|T], Opts) ->
add_opts(T, Opts#add_opts{chunk_size=N});
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("~ts\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("~ts: ~ts", [Name,format_error(Reason)]));
format_error(Atom) when is_atom(Atom) ->
file:format_error(Atom);
format_error(Term) ->
lists:flatten(io_lib:format("~tp", [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(erlang:timestamp()),
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, chunked, Options) ->
add_verbose(Options, "a ~ts [chunked ", [Name]),
try
ok = do_write(Tar, Header),
{ok,D} = file:open(Name, [read,binary]),
{ok,NumBytes} = add_read_write_chunks(D, Tar, Options#add_opts.chunk_size, 0, Options),
_ = file:close(D),
ok = do_write(Tar, padding(NumBytes,?record_size))
of
ok ->
add_verbose(Options, "~n", []),
ok
catch
error:{badmatch,{error,Error}} ->
add_verbose(Options, "~n", []),
{error,{Name,Error}}
end;
add1(Tar, Name, Header, Bin, Options) ->
add_verbose(Options, "a ~ts~n", [Name]),
do_write(Tar, [Header, Bin, padding(byte_size(Bin), ?record_size)]).
add_read_write_chunks(D, Tar, ChunkSize, SumNumBytes, Options) ->
case file:read(D, ChunkSize) of
{ok,Bin} ->
ok = do_write(Tar, Bin),
add_verbose(Options, ".", []),
add_read_write_chunks(D, Tar, ChunkSize, SumNumBytes+byte_size(Bin), Options);
eof ->
add_verbose(Options, "]", []),
{ok,SumNumBytes};
Other ->
Other
end.
add_directory(TarFile, DirName, NameInArchive, Info, Options) ->
case file:list_dir(DirName) of
{ok, []} ->
add_verbose(Options, "a ~ts~n", [DirName]),
Header = create_header(NameInArchive, Info),
do_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 = case file:native_name_encoding() of
utf8 ->
unicode:characters_to_binary(Str0);
latin1 ->
list_to_binary(Str0)
end,
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} = do_position(File, {cur,0}),
%% There must be at least two zero records at the end.
Fill = case ?block_size - (Position rem ?block_size) of
Fill0 when Fill0 < 2*?record_size ->
%% We need to another block here to ensure that there
%% are at least two zero records at the end.
Fill0 + ?block_size;
Fill0 ->
%% Large enough.
Fill0
end,
do_write(File, zeroes(Fill)).
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({AccessMode,TD={tar_descriptor,_UsrHandle,_AccessFun}}, Fun, Accu, Opts) ->
case AccessMode of
read ->
foldl_read0(TD, Fun, Accu, Opts);
_ ->
{error,{read_mode_expected,AccessMode}}
end;
foldl_read(TarName, Fun, Accu, Opts) ->
case open(TarName, [read|Opts#read_opts.open_mode]) of
{ok, {read, File}} ->
Result = foldl_read0(File, Fun, Accu, Opts),
ok = do_close(File),
Result;
Error ->
Error
end.
foldl_read0(File, Fun, Accu, Opts) ->
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.
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 do_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(Bin0) ->
List0 = get_name_raw(Bin0),
case file:native_name_encoding() of
utf8 ->
Bin = list_to_binary(List0),
case unicode:characters_to_list(Bin) of
{error,_,_} ->
List0;
List when is_list(List) ->
List
end;
latin1 ->
List0
end.
get_name_raw(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 do_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 ~ts - 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 ~ts - 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 ~ts~n", [Name]),
write_file(Name, Bin);
false ->
read_verbose(Opts, "x ~ts - 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, file) ->
filelib:ensure_dir(Name);
make_dirs(Name, dir) ->
filelib:ensure_dir(filename:join(Name,"*")).
%% 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,_} = do_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} = do_position(File, {cur, 0}),
NewPosition = ((Position + ?record_size - 1) div ?record_size) * ?record_size,
{ok,NewPosition} = do_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,
Opts#add_opts.chunk_size>0 ->
{ok,chunked,Info};
{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}.
%%%================================================================
do_write({tar_descriptor,UsrHandle,Fun}, Data) -> Fun(write,{UsrHandle,Data}).
do_position({tar_descriptor,UsrHandle,Fun}, Pos) -> Fun(position,{UsrHandle,Pos}).
do_read({tar_descriptor,UsrHandle,Fun}, Len) -> Fun(read2,{UsrHandle,Len}).
do_close({tar_descriptor,UsrHandle,Fun}) -> Fun(close,UsrHandle).
