Initial working commit

.envrc

@@ -0,0 +1 @@
+use nix

.gitignore

@@ -0,0 +1,4 @@
+asd.tar
+mnt/
+*~
+_build/

bin/dune

@@ -0,0 +1,5 @@
+(executable
+ (public_name main)
+ (name main)
+ (modules main tar octal)
+ (libraries ocamlfuse))

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;
+    }

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)

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)
+

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))

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)"]

shell.nix

@@ -0,0 +1,14 @@
+{pkgs ? import <nixpkgs> {}} :
+
+pkgs.mkShell {
+  buildInputs = with pkgs; [
+    ocaml
+    ocamlPackages.findlib
+    ocamlPackages.ocamlfuse
+    ocamlPackages.ocaml-lsp
+    ocamlPackages.ocamlformat
+    ocamlPackages.merlin
+    ocamlPackages.utop
+    dune_3
+  ];
+}