erl_tar.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 921 行 · 第 1/2 页

	{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,
	    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, File, #read_opts{verbose=true}, Result) 
                                      when is_record(Header, tar_header) ->
    #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(Header, File, _, Result) when is_record(Header, tar_header) ->
    Name = Header#tar_header.name,
    skip(File, Header#tar_header.size),
    {ok, [Name|Result]}.

extract1(eof, _, _, []) -> ok;
extract1(Header, File, Opts, Result) ->
    Name = Header#tar_header.name,
    ok = extract2(File, Header, Opts, check_extract(Name, Opts)),
    {ok, Result}.

extract2(File, Header, Opts, true) ->
    {ok, Bin} = get_element(File, Header),
    write_extracted_element(Header, Bin, Opts);
extract2(File, Header, _, false) ->
    skip(File, Header#tar_header.size).

%% 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 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 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, 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 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) ->
    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}.