diff --git a/bin/tar.ml b/bin/tar.ml index 609fd05..680fd84 100644 --- a/bin/tar.ml +++ b/bin/tar.ml @@ -5,6 +5,7 @@ type metadata = Unix.LargeFile.stats type header = { full_path : string; offset : int64; + hard_link : bool; linked_path : string; (* Meaningless unless a hard or soft link *) md : metadata; } @@ -12,6 +13,8 @@ type header = { type entry = | File of int64 * metadata + | Symlink of string * metadata + | Hardlink of string | InferredDirectory of entry NameMap.t * metadata | Directory of entry NameMap.t * metadata @@ -34,7 +37,7 @@ let default_file_metadata : metadata = { st_ino = 1; st_kind = Unix.S_REG; st_perm = 7 * 64 + 7 * 8 + 7; - st_nlink = 0; + st_nlink = 1; st_uid = 0; st_gid = 0; st_rdev = 0; @@ -74,6 +77,7 @@ let add_direct name node = function | _ -> Printf.printf "whatever the fuck %s" name; Directory (NameMap.empty, empty_dir_metadata) + let find_or_infer_dir name = function | InferredDirectory (children, _) | Directory (children, _) -> @@ -82,7 +86,6 @@ let find_or_infer_dir name = function | Some x -> x) | _ -> failwith "findorinfer" -(* entry -> string list -> entry -> entry*) let rec add_deep node = function | (last :: [], dir) -> add_direct last node dir @@ -90,10 +93,21 @@ let rec add_deep node = function add_direct one (add_deep node (rest, (find_or_infer_dir one dir))) dir | _ -> failwith "heh" +let inc_nlink path tree = + add_deep + (match find path tree with + | Some (File (o, md)) -> File (o, {md with st_nlink = md.st_nlink + 1}) + | Some (Directory (o, md)) -> Directory (o, {md with st_nlink = md.st_nlink + 1}) + | _ -> failwith "can't increase hardlink count...") + (clean_path path, tree) + + +let read_path buf o c = + List.hd (String.split_on_char (Char.chr 0) (Bytes.sub_string buf o c)) (* Assume we have a block, extract data from it into a header object *) let read_header offset (block : bytes) : header = - let name = List.hd (String.split_on_char (Char.chr 0) (Bytes.sub_string block 0 100)) in + let name = read_path block 0 100 in let mode = Octal.to_int (Bytes.sub_string block 100 8) in let uid = Octal.to_int (Bytes.sub_string block 108 8) in let gid = Octal.to_int (Bytes.sub_string block 116 8) in @@ -101,7 +115,7 @@ let read_header offset (block : bytes) : header = let time = Octal.to_int (Bytes.sub_string block 136 12) in (* tODO: checksum, link *) let type_flag = Bytes.get block 156 in - let linked_path = Bytes.sub_string block 157 100 in + let linked_path = read_path block 157 100 in let ustar_used = String.equal "ustar" (Bytes.sub_string block 257 5) in (*let () = assert ustar_used in*) let prefix = List.hd (String.split_on_char (Char.chr 0) (Bytes.sub_string block 345 155)) in @@ -110,6 +124,7 @@ let read_header offset (block : bytes) : header = default_file_metadata with st_ino = (Int64.to_int offset) + 1; st_kind = (match type_flag with + | '2' -> Unix.S_LNK | '5' -> Unix.S_DIR | _ -> Unix.S_REG); st_perm = mode; @@ -121,6 +136,7 @@ let read_header offset (block : bytes) : header = { full_path = path; md = md; + hard_link = (type_flag == '1'); offset = offset; linked_path = linked_path; } @@ -150,13 +166,23 @@ let rec read_headers offset ch = else h :: (read_headers (next_header_pos h) ch) let make_node h = + if h.hard_link then + Hardlink (h.linked_path) + else match h.md.st_kind with | Unix.S_DIR -> Directory (NameMap.empty, h.md) - | Unix.S_REG -> File (h.offset, h.md) + | Unix.S_REG -> + File (h.offset, h.md) + | Unix.S_LNK -> Symlink (h.linked_path, h.md) | _ -> failwith "other kinds of files not yet implemented" let add_node dir h = - add_deep (make_node h) ((clean_path h.full_path), dir) + let node = make_node h in + let root = + (match node with + | Hardlink (path) -> (inc_nlink path dir) + | _ -> dir) in + add_deep (make_node h) ((clean_path h.full_path), root) let build_tree headers = let root = Directory (NameMap.empty, empty_dir_metadata) in @@ -175,6 +201,10 @@ let rec print_tree path = function | Directory (children, _) -> Printf.printf "dir: %s/\n" path; NameMap.iter (fun s d -> print_tree (Printf.sprintf "%s/%s" path s) d) children + | Symlink (s, _) -> + Printf.printf "link '%s' -> '%s'" path s + | Hardlink (s) -> + Printf.printf "hardlink '%s' -> '%s'" path s (* Now that we know everything about a file, we need to be able to actually read it *) let read_file f ch off count =