Pure dec enc with gz

bin/dune

@@ -2,4 +2,4 @@
  (name otar)
  (public_name otar)
  (package tar-unix)
- (libraries unix tar.gz))
+ (libraries unix tar.gz tar_unix))

bin/otar.ml

@@ -16,21 +16,6 @@
 
 let () = Printexc.record_backtrace true
 
-module Tar_gz = Tar_gz.Make
-  (struct type 'a t = 'a
-          let ( >>= ) x f = f x
-          let return x = x end)
-  (struct type out_channel = Stdlib.out_channel
-          type 'a io = 'a
-          let really_write oc str =
-            output_string oc str end)
-  (struct type in_channel = Stdlib.in_channel
-          type 'a io = 'a
-          let read ic buf =
-            input ic buf 0 (Bytes.length buf)
-        end)
-
-
 let ( / ) = Filename.concat
 
 let stream_of_fd fd =
@@ -44,6 +29,7 @@ let stream_of_fd fd =
 
 let always x = fun _ -> x
 
+(*
 let create_tarball directory oc =
   let files = Sys.readdir directory in
   let os = match Sys.os_type with
@@ -85,6 +71,7 @@ let make directory oc =
       let oc = open_out filename in
       oc, (fun () -> close_out oc), Filename.extension filename = ".gz" in
   create_tarball directory oc ; oc_close ()
+   *)
 
 let sizes = [| "B"; "KiB"; "MiB"; "GiB"; "TiB"; "PiB"; "EiB"; "ZiB"; "YiB" |]
 
@@ -97,35 +84,51 @@ let bytes_to_size ?(decimals = 2) ppf = function
       Format.fprintf ppf "%.*f %s" decimals r sizes.(int_of_float i)
 
 let list filename =
-  let ic = open_in filename in
-  let ic = Tar_gz.of_in_channel ~internal:(De.bigstring_create 0x1000) ic in
-  let rec go global () = match Tar_gz.HeaderReader.read ~global ic with
-    | Ok (hdr, global) ->
-      Format.printf "%s (%s, %a)\n%!"
-        hdr.Tar.Header.file_name
-        (Tar.Header.Link.to_string hdr.link_indicator)
-        (bytes_to_size ~decimals:2) hdr.Tar.Header.file_size ;
-      (* Alternatively:
-           let padding = Tar.Header.compute_zero_padding_length hdr in
-           let data = Int64.to_int hdr.Tar.Header.file_size in
-           let to_skip = data + padding in *)
-      let to_skip = Tar.Header.(Int64.to_int (to_sectors hdr) * length) in
-      Tar_gz.skip ic to_skip ;
-      go global ()
+  let go ?global:_ hdr () =
+    Format.printf "%s (%s, %a)\n%!"
+      hdr.Tar.Header.file_name
+      (Tar.Header.Link.to_string hdr.link_indicator)
+      (bytes_to_size ~decimals:2) hdr.Tar.Header.file_size ;
+    (*
+    (* Alternatively:
+         let padding = Tar.Header.compute_zero_padding_length hdr in
+         let data = Int64.to_int hdr.Tar.Header.file_size in
+         let to_skip = data + padding in *)
+    Tar_gz.skip ic to_skip ;
+    go global ()
     | Error `Eof -> ()
     | Error `Fatal e ->
       Format.eprintf "Error listing archive: %a\n%!" Tar.pp_error e;
       exit 2
+       *)
+    let open Tar in
+    let to_skip = Header.(Int64.to_int (to_sectors hdr) * length) in
+    let* _ = seek to_skip in
+    return (Ok ())
   in
-  go None ()
+  let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0 in
+  match Tar_unix.run (Tar_gz.gzipped (Tar.fold go ())) fd with
+  | Ok () -> ()
+  | Error (`Unix _) ->
+    Format.eprintf "Some UNIX error occurred.\n%!"
+  | Error (`Msg e) ->
+    Format.eprintf "Some error: %s.\n%!" e
+  | Error `Unexpected_end_of_file ->
+    Format.eprintf "Unexpected end of file.\n%!"
+  | Error `Eof | Error `Gz _ ->
+    Format.eprintf "Some fatal error occurred.\n%!"
+  | Error (`Fatal _) ->
+    Format.eprintf "Some fatal error occurred.\n%!"
 
 let () = match Sys.argv with
   | [| _; "list"; filename; |] when Sys.file_exists filename ->
     list filename
+      (*
   | [| _; directory |] when Sys.is_directory directory ->
     make directory None
   | [| _; directory; output |] when Sys.is_directory directory ->
     make directory (Some output)
+         *)
   | _ ->
     let cmd = Filename.basename Sys.argv.(0) in
     Format.eprintf "%s <directory> [<filename.tar.gz>]\n%s list <filename.tar.gz>\n" cmd cmd

eio/tar_eio.ml

@@ -18,42 +18,63 @@
 
 open Eio
 
-module Monad = struct
-  type 'a t = 'a
-  let (>>=) a f = f a
-  let return = Fun.id
-end
+module High : sig
+  type t
+  type 'a s = 'a
 
-module Io = struct
-  type in_channel = Flow.source
-  type 'a io = 'a
-  let really_read f b =
-    let len = Bytes.length b in
-    let cs = Cstruct.create len in
-    Flow.read_exact f cs;
-    Cstruct.blit_to_bytes cs 0 b 0 len
-  let skip f (n: int) =
-    let buffer_size = 32768 in
-    let buffer = Cstruct.create buffer_size in
-    let rec loop (n: int) =
-      if n <= 0 then ()
-      else
-        let amount = min n buffer_size in
-        let block = Cstruct.sub buffer 0 amount in
-        Flow.read_exact f block;
-        loop (n - amount) in
-    loop n
+  external inj : 'a s -> ('a, t) Tar.io = "%identity"
+  external prj : ('a, t) Tar.io -> 'a s = "%identity"
+end = struct
+  type t
+  type 'a s = 'a
 
-  type out_channel = Flow.sink
-  let really_write f str = Flow.write f [ Cstruct.of_string str ]
+  external inj : 'a -> 'b = "%identity"
+  external prj : 'b -> 'a = "%identity"
 end
 
-let really_read = Flow.read_exact
-let skip = Io.skip
-let really_write f b = Flow.write f [ b ]
+type t = High.t
+
+let value v = Tar.High (High.inj v)
 
-module HeaderReader = Tar.HeaderReader(Monad)(Io)
-module HeaderWriter = Tar.HeaderWriter(Monad)(Io)
+let run t f =
+  let rec run : type a. (a, 'err, t) Tar.t -> (a, 'err) result = function
+    | Tar.Read len ->
+      let b = Cstruct.create len in
+      (match Flow.single_read f b with
+       | len ->
+         Ok (Cstruct.to_string ~len b)
+       | exception End_of_file ->
+         (* XXX: should we catch other exceptions?! *)
+         Error `Unexpected_end_of_file)
+    | Tar.Really_read len ->
+      let b = Cstruct.create len in
+      (try
+         Flow.read_exact f b;
+         Ok (Cstruct.to_string b)
+       with End_of_file -> Error `Unexpected_end_of_file)
+    | Tar.Seek n ->
+      let buffer_size = 32768 in
+      let buffer = Cstruct.create buffer_size in
+      let rec loop (n: int) =
+        if n <= 0 then Ok ()
+        else
+          let amount = min n buffer_size in
+          let block = Cstruct.sub buffer 0 amount in
+          Flow.read_exact f block;
+          loop (n - amount) in
+      loop n
+    | Tar.Return value -> value
+    | Tar.High value -> High.prj value
+    | Tar.Bind (x, f) ->
+      match run x with
+      | Ok value -> run (f value)
+      | Error _ as err -> err in
+  run t
+
+let fold f filename init =
+  (* XXX(reynir): ??? *)
+  Eio.Path.with_open_in filename
+    (run (Tar.fold f init))
 
 (* Eio needs a non-file-opening stat. *)
 let stat path =
@@ -79,3 +100,28 @@ let header_of_file ?level ?getpwuid ?getgrgid filepath : Tar.Header.t =
   let devminor    = if level = Ustar then stat.rdev |> Int64.to_int else 0 in
   Tar.Header.make ~file_mode ~user_id ~group_id ~mod_time ~link_indicator ~link_name
                   ?uname ?gname ~devmajor ~devminor (snd filepath) file_size
+let extract ?filter:(_ = fun _ -> true) ~src:_ _dst =
+  (* TODO *)
+  failwith "TODO"
+
+let create ?level:_ ?global:_ ?filter:(_ = fun _ -> true) ~src:_ _dst =
+  (* TODO *)
+  failwith "TODO"
+
+let append_file ?level:_ ?header:_ _filename _dst =
+  (* TODO *)
+  failwith "TODO"
+
+let write_header ?level:_ _hdr _fl =
+  (* TODO *)
+  failwith "TODO"
+
+let write_global_extended_header ?level:_ _global _fl =
+  (* TODO *)
+  failwith "TODO"
+
+let write_end fl =
+  let zero_block = Cstruct.of_string Tar.Header.zero_block in
+  (* TODO: catch exceptions?! *)
+  Eio.Flow.write fl [ zero_block; zero_block ];
+  Ok ()

eio/tar_eio.mli

@@ -16,17 +16,20 @@
 
 (** I/O for tar-formatted data *)
 
-val really_read: Eio.Flow.source -> Cstruct.t -> unit
-(** [really_read fd buf] fills [buf] with data from [fd] or fails
-    with {!Stdlib.End_of_file}. *)
+type t
 
-val really_write: Eio.Flow.sink -> Cstruct.t -> unit
-(** [really_write fd buf] writes the full contents of [buf] to
-    [fd] or fails with {!Stdlib.End_of_file}. *)
+val value : ('a, 'err) result -> ('a, 'err, t) Tar.t
 
-val skip : Eio.Flow.source -> int -> unit
-(** [skip fd n] reads [n] bytes from [fd] and discards them. If possible, you
-    should use [Lwt_unix.lseek fd n Lwt_unix.SEEK_CUR] instead. *)
+val run : ('a, [> `Unexpected_end_of_file] as 'b, t) Tar.t -> Eio.Flow.source -> ('a, 'b) result
+
+val fold :
+  (?global:Tar.Header.Extended.t ->
+   Tar.Header.t ->
+   'a ->
+   ('a, [> `Fatal of Tar.error | `Unexpected_end_of_file ] as 'b, t) Tar.t) ->
+  Eio.Fs.dir Eio.Path.t ->
+  'a ->
+  ('a, 'b) result
 
 (** Return the header needed for a particular file on disk. [getpwuid] and [getgrgid] are optional
     functions that should take the uid and gid respectively and return the passwd and group entry
@@ -38,5 +41,30 @@ val header_of_file :
     Eio.Fs.dir Eio.Path.t ->
     Tar.Header.t
 
-module HeaderReader : Tar.HEADERREADER with type in_channel = Eio.Flow.source and type 'a io = 'a
-module HeaderWriter : Tar.HEADERWRITER with type out_channel = Eio.Flow.sink and type 'a io = 'a
+val extract : ?filter:(Tar.Header.t -> bool) ->
+  src:Eio.Fs.dir Eio.Path.t ->
+  Eio.Fs.dir Eio.Path.t ->
+  (unit, _) result
+
+val create : ?level:Tar.Header.compatibility ->
+  ?global:Tar.Header.Extended.t ->
+  ?filter:(Tar.Header.t -> bool) ->
+  src:Eio.Fs.dir Eio.Path.t ->
+  Eio.Fs.dir Eio.Path.t ->
+  (unit, _) result
+
+val append_file : ?level:Tar.Header.compatibility ->
+  ?header:Tar.Header.t ->
+  Eio.Fs.dir Eio.Path.t ->
+  Eio.Flow.sink ->
+  (unit, _) result
+
+val write_header : ?level:Tar.Header.compatibility ->
+  Tar.Header.t -> Eio.Flow.sink ->
+  (unit, _) result
+
+val write_global_extended_header : ?level:Tar.Header.compatibility ->
+  Tar.Header.Extended.t -> Eio.Flow.sink ->
+  (unit, _) result
+
+val write_end : Eio.Flow.sink -> (unit, _) result