From 4709e81b81cda56969d2885edc5126d632347845 Mon Sep 17 00:00:00 2001 From: haxala1r Date: Wed, 26 Nov 2025 21:12:08 +0300 Subject: [PATCH] Initial working commit --- .envrc | 1 + .gitignore | 4 ++ bin/dune | 5 ++ bin/main.ml | 46 +++++++++++++++ bin/octal.ml | 40 +++++++++++++ bin/tar.ml | 160 +++++++++++++++++++++++++++++++++++++++++++++++++++ dune-project | 14 +++++ fusetar.opam | 28 +++++++++ shell.nix | 14 +++++ 9 files changed, 312 insertions(+) create mode 100644 .envrc create mode 100644 .gitignore create mode 100644 bin/dune create mode 100644 bin/main.ml create mode 100644 bin/octal.ml create mode 100644 bin/tar.ml create mode 100644 dune-project create mode 100644 fusetar.opam create mode 100644 shell.nix diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..1d953f4 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use nix diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..820d271 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +asd.tar +mnt/ +*~ +_build/ \ No newline at end of file diff --git a/bin/dune b/bin/dune new file mode 100644 index 0000000..7f5b5d4 --- /dev/null +++ b/bin/dune @@ -0,0 +1,5 @@ +(executable + (public_name main) + (name main) + (modules main tar octal) + (libraries ocamlfuse)) diff --git a/bin/main.ml b/bin/main.ml new file mode 100644 index 0000000..8c36ef0 --- /dev/null +++ b/bin/main.ml @@ -0,0 +1,46 @@ + + +module Octal = Octal +module Tar = Tar + +let clean_path path = + let clean_split = List.filter (fun x -> (not (String.equal x "")) && (not (String.equal x "."))) in + clean_split (String.split_on_char '/' (String.trim path)) + + +let (root, tar_ch) = Tar.parse_tar "asd.tar" +let () = Tar.print_tree "" root + +let getattr path = + match Tar.find_from_split (clean_path path) root with + | None -> raise (Unix.Unix_error (Unix.ENOENT, "hi1", "hi1")) + | Some (File (_, md)) -> md + | Some (Directory (_, md)) -> md + +let readdir path _ = + match Tar.find_from_split (clean_path path) root with + | None -> raise (Unix.Unix_error (Unix.ENOENT, "234", "234")) + | Some (File (_, _)) -> raise (Unix.Unix_error (Unix.ENOENT, "345", "345")) + | Some (Directory (children, _)) -> + ["."; ".."] @ (List.map (fun (name, _) -> name) (Tar.NameMap.to_list children)) + +let read path buf offset amount = + match Tar.find_from_split (clean_path path) root with + | None -> raise (Unix.Unix_error (Unix.ENOENT, "read", path)) + | Some (File (fo, md)) -> + (let (file_buf,read) = (Tar.read_file (File (fo, md)) tar_ch offset amount) in + Bytes.iteri (fun i c -> Bigarray.Array1.set buf i c) file_buf; + read) + | _ -> raise (Unix.Unix_error (Unix.EISDIR, "read", path)) + +let _ = + let () = Printf.printf "hmmm?\n" in + let () = List.iter (fun x -> Printf.printf "%s\n" x) (readdir "bin" 5) in + let () = Out_channel.flush_all () in + Fuse.main Sys.argv + { + Fuse.default_operations with + getattr = getattr; + readdir = readdir; + read = read; + } diff --git a/bin/octal.ml b/bin/octal.ml new file mode 100644 index 0000000..e367516 --- /dev/null +++ b/bin/octal.ml @@ -0,0 +1,40 @@ + +let until_nul s = + match String.index_opt s '\x00' with + | None -> s + | Some i -> String.sub s 0 i + +module type IntType = sig + type t + val add : t -> t -> t + val sub : t -> t -> t + val mul : t -> t -> t + val of_int : int -> t + val to_int : t -> int +end + + +module IntForInt = struct + type t = int + let add = Int.add + let sub = Int.sub + let mul = Int.mul + let of_int x = x + let to_int x = x +end + +let octal_reader (type a) (module I : IntType with type t = a) sin : a = + let ( + ) = I.add in + let ( * ) = I.mul in + let ( - ) = I.sub in + let s = (until_nul sin) in + let l = List.init (String.length s) (String.get s) in + let rec aux a = function + | c :: rest -> + aux ((a * (I.of_int 8)) + (I.of_int (int_of_char c)) - (I.of_int (int_of_char '0'))) rest + | [] -> a + in aux (I.of_int 0) l + +(* lmao *) +let to_int = octal_reader (module IntForInt) +let to_int64 = octal_reader (module Int64) diff --git a/bin/tar.ml b/bin/tar.ml new file mode 100644 index 0000000..7b496cf --- /dev/null +++ b/bin/tar.ml @@ -0,0 +1,160 @@ + +module NameMap = Map.Make(String) + +type metadata = Unix.LargeFile.stats + + + +type entry = + | File of int64 * metadata + | Directory of entry NameMap.t * metadata + +let empty_dir_metadata : metadata = { + st_dev = 0; + st_ino = 1; + st_kind = Unix.S_DIR; + st_perm = 7 * 64 + 7 * 8 + 7; + st_nlink = 0; + st_uid = 0; + st_gid = 0; + st_rdev = 0; + st_size = Int64.of_int 0; + st_atime = 0.; + st_mtime = 0.; + st_ctime = 0.; + } +let default_file_metadata : metadata = { + st_dev = 0; + st_ino = 1; + st_kind = Unix.S_REG; + st_perm = 7 * 64 + 7 * 8 + 7; + st_nlink = 0; + st_uid = 0; + st_gid = 0; + st_rdev = 0; + st_size = Int64.of_int 0; + st_atime = 0.; + st_mtime = 0.; + st_ctime = 0.; + } + +let clean_path path = + let clean_split = List.filter (fun x -> (not (String.equal x "")) && (not (String.equal x "."))) in + clean_split (String.split_on_char '/' (String.trim path)) + + +let rec find_from_split path tree = + match (path, tree) with + | ([], _) -> Some tree + | (_, File _) -> failwith "cannot search file!" + | ([name], Directory (children, _)) -> + NameMap.find_opt name children + | (name :: rest, Directory (children, _)) -> + (match NameMap.find_opt name children with + | None -> None + | Some d -> find_from_split rest d) +let find_or_empty_dir name dir = + match dir with + | File _ -> failwith "cannot search file!" + | Directory (children, _) -> + (match NameMap.find_opt name children with + | None -> Directory (NameMap.empty, empty_dir_metadata) + | Some (Directory (x,y)) -> (Directory (x,y)) + | _ -> failwith "whoops, can't access child of file!") + +let add_to_dir name node dir = + match dir with + | Directory (children, md) -> + (* There is a specific case we may need to handle here - + Normally when a file a/b/c is found, we infer the existence + of a/ and a/b/, however if an entry for a/ is later found + we need to keep the children of a/, but need to merge the metadata + from the new entry. + There is also the more general case of the same path being + seen multiple times - the standard seems to say the last one wins. + *) + Directory (NameMap.add name node children, md) + | _ -> failwith "not a directory" + +let add_node path node tree = + let split_path = clean_path path in + let rec aux = function + | ([], dir) -> dir + | ([name], dir) -> + add_to_dir name node dir + | (dir_name :: rest, dir) -> + add_to_dir dir_name (aux (rest, find_or_empty_dir dir_name dir)) dir + (*| _ -> failwith "whatever"*) + in aux (split_path, tree) + +(* Assume we have a block, extract metadata from it. *) +let read_metadata offset (block : bytes) = + let name = List.hd (String.split_on_char (Char.chr 0) (Bytes.sub_string 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 + let size = Octal.to_int64 (Bytes.sub_string block 124 12) in + let time = Octal.to_int (Bytes.sub_string block 136 12) in + (* tODO: checksum, link *) + let type_flag = Bytes.get block 156 in + let _ = Bytes.sub_string block 157 100 in + if (String.equal "" name) && (size == 0L) && time == 0 then + ("", 0L, File (0L, default_file_metadata)) + else + 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 + let path = String.cat prefix name in + let md = { + default_file_metadata with + st_ino = (Int64.to_int offset) + 1; + st_kind = (match type_flag with + | '5' -> Unix.S_DIR + | _ -> Unix.S_REG); + st_perm = mode; + st_uid = uid; + st_gid = gid; + st_size = size; + st_mtime = float_of_int time; + } in + if (String.ends_with ~suffix:"/" path) || (ustar_used && type_flag == '5') then + (path, 0L, Directory ((NameMap.empty), md)) + else + (path, size, File (offset, md)) + +let buffer = Bytes.create 512 +let next_offset o = + Int64.add (Int64.mul 512L (Int64.div o 512L)) (if (Int64.rem o 512L) > 0L then 512L else 0L) +let read_file f ch off amount = + match f with + | File (file_offset, md) -> + (let () = In_channel.seek ch (Int64.add off (Int64.add 512L file_offset)) in + let n = Int64.to_int (max (Int64.of_int amount) (md.st_size)) in + let buf = Bytes.create n in + match In_channel.really_input ch buf 0 n with + | None -> failwith "can't read file!!!!" + | _ -> (buf, n)) + | _ -> failwith "can't read file" +let rec read_structure accum offset ch = + let () = In_channel.seek ch offset in + match In_channel.really_input ch buffer 0 512 with + | None -> Printf.printf "End of file\n"; accum + | _ -> + let (path, size, v) = read_metadata offset buffer in + let new_dir = add_node path v accum in + match (path, size) with + | ("", 0L) -> accum(*read_structure accum (next_offset (Int64.add 512L offset)) ch*) + | _ -> read_structure new_dir (next_offset (Int64.add 512L (Int64.add offset size))) ch + +and print_tree path = function + | File (offset, _) -> + Printf.printf "%s: %d\n" path (Int64.to_int offset) + | Directory (children, _) -> + NameMap.iter (fun s c -> print_tree (Printf.sprintf "%s/%s" path s) c) children + +let parse_tar fname = + let chan = In_channel.open_bin fname in + let root = Directory (NameMap.empty, empty_dir_metadata) in + let structure = read_structure root 0L chan in + (structure, chan) + diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..44bbbb0 --- /dev/null +++ b/dune-project @@ -0,0 +1,14 @@ +(lang dune 3.18) + +(name fusetar) + +(generate_opam_files true) + +(source + (github username/reponame)) + +(package + (name fusetar) + (synopsis "A fuse filesystem driver for tar") + (description "Mounts a tar file as a read-write file system on a directory") + (depends ocaml ocamlfuse)) diff --git a/fusetar.opam b/fusetar.opam new file mode 100644 index 0000000..a9836e3 --- /dev/null +++ b/fusetar.opam @@ -0,0 +1,28 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +synopsis: "A fuse filesystem driver for tar" +description: "Mounts a tar file as a read-write file system on a directory" +homepage: "https://github.com/username/reponame" +bug-reports: "https://github.com/username/reponame/issues" +depends: [ + "dune" {>= "3.18"} + "ocaml" + "ocamlfuse" + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/username/reponame.git" +x-maintenance-intent: ["(latest)"] diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..245bb7f --- /dev/null +++ b/shell.nix @@ -0,0 +1,14 @@ +{pkgs ? import {}} : + +pkgs.mkShell { + buildInputs = with pkgs; [ + ocaml + ocamlPackages.findlib + ocamlPackages.ocamlfuse + ocamlPackages.ocaml-lsp + ocamlPackages.ocamlformat + ocamlPackages.merlin + ocamlPackages.utop + dune_3 + ]; +}