この練習問題では一つ前の練習問題 2.16と再帰的なファイルのコピーについての練習問題 2.15 を組み合わせます。
すこし難しい部分は権限の管理です。アーカイブのディレクトリを書き込み権限で作成して全てのファイルを抽出し終わってから本来の権限に設定しなければいけません。
最初に補助関数 mkpath p m を書きます。この関数はパス p に含まれるディレクトリでまだ作成されていないものを、 m の権限で作成します。p の最後には余分な “/” が含まれていても構いません。
let warning mes = prerr_string mes;prerr_newline ();;
open Filename
let mkpath p perm =
let normal_path =
if basename p = "" then dirname p else p in
let path_to_dir = dirname normal_path in
let rec make p =
try ignore (stat p)
with Unix_error (ENOENT, _, _) ->
if p = current_dir_name then ()
else if p = parent_dir_name then
warning "Ill formed archive: path contains \"..\""
else begin
make (dirname p);
mkdir p perm
end in
make path_to_dir;;
2.15 節でファイルをコピーするときに利用したものと似たset_infos を定義します。
let set_infos header =
chmod header.name header.perm;
let mtime = float header.mtime in
utimes header.name mtime mtime;
begin match header.kind with
| LNK f -> ()
| _ -> chmod header.name header.perm
end;
try chown header.name header.uid header.gid
with Unix_error(EPERM,_,_) -> ();;
untar_file_collect_dirs は作成されるディレクトリを記録しながら一つのレコードをコピーします。
let verbose = ref true;;
let default_dir_perm = 0o777;;
let default_file_perm = 0o666;;
let protect f x g y = try f x; g y with z -> g y; raise z
let file_exists f = try ignore (stat f); true with _ -> false;;
let untar_file_collect_dirs file dirs =
let fh = file.header in
if !verbose then begin print_string fh.name; print_newline () end;
match fh.kind with
| CHR (_,_) | BLK(_,_) | FIFO ->
warning (fh.name ^ "Ignoring special files");
dirs
| DIR ->
mkpath fh.name default_dir_perm;
if file_exists fh.name then dirs
else begin mkdir fh.name default_dir_perm; fh :: dirs end
| x ->
mkpath fh.name default_dir_perm;
begin match x with
| REG | CONT ->
let flags = [ O_WRONLY; O_TRUNC; O_CREAT; ] in
let out = openfile fh.name flags default_file_perm in
protect (copy_file file) out close out
| LNK f ->
symlink f fh.name
| LINK f ->
begin
try if (stat fh.name).st_kind = S_REG then unlink fh.name
with Unix_error(_,_,_) -> ();
end;
Unix.link f fh.name;
| _ -> assert false
end;
set_infos fh;
dirs;;
メインプログラムは untar_file_collect_dirs を全てのレコードに適用し、最後にディレクトリのアクセス権限を修正するだけです。
let extract tarfile =
let fd = openfile tarfile [ O_RDONLY ] 0 in
let new_directories =
fold untar_file_collect_dirs [] fd in
List.iter set_infos new_directories;
close fd;;
let untar () =
let nargs = Array.length Sys.argv in
if nargs = 2 then extract Sys.argv.(1)
else prerr_endline ("Usage: " ^ Sys.argv.(0) ^ " <tarfile>");;
handle_unix_error untar ();;
* * *