Support eio>=0.12

dune-project

@@ -91,7 +91,7 @@
  (tags ("org:xapi-project" "org:mirage"))
  (depends
   (ocaml (>= 4.08.0))
-  (eio (and (>= 0.10.0) (< 0.12)))
+  (eio (>= 0.12))
   (tar (= :version))
  )
 )

eio/dune

@@ -1,4 +1,11 @@
 (library
  (name tar_eio)
  (public_name tar-eio)
+ (modules tar_eio)
  (libraries tar eio))
+
+(library
+ (name tar_eio_gz)
+ (public_name tar-eio.gz)
+ (modules tar_eio_gz)
+ (libraries tar.gz tar_eio))

eio/tar_eio.ml

@@ -25,7 +25,7 @@ module Monad = struct
 end
 
 module Reader = struct
-  type in_channel = Flow.source
+  type in_channel = Flow.source_ty Resource.t
   type 'a t = 'a
   let really_read f b = Flow.read_exact f b
   let skip f (n: int) =
@@ -43,7 +43,7 @@ end
 let really_read = Reader.really_read
 
 module Writer = struct
-  type out_channel = Flow.sink
+  type out_channel = Flow.sink_ty Resource.t
   type 'a t = 'a
   let really_write f b = Flow.write f [ b ]
 end
@@ -66,7 +66,7 @@ module HR = Tar.HeaderReader(Monad)(Reader)
 module HW = Tar.HeaderWriter(Monad)(Writer)
 
 let get_next_header ?level ~global ic =
-  match HR.read ?level ~global (ic :> Flow.source) with
+  match HR.read ?level ~global (ic :> Eio.Flow.source_ty Eio.Flow.source) with
   | Error `Eof -> None
   | Ok hdrs -> Some hdrs
 
@@ -95,8 +95,8 @@ let header_of_file ?level ?getpwuid ?getgrgid filepath : Tar.Header.t =
   Tar.Header.make ~file_mode ~user_id ~group_id ~mod_time ~link_indicator ~link_name
                   ?uname ?gname ~devmajor ~devminor (snd filepath) file_size
 
-let write_block ?level ?global (header: Tar.Header.t) (body: #Flow.sink -> unit) sink =
-  HW.write ?level ?global header (sink :> Flow.sink);
+let write_block ?level ?global (header: Tar.Header.t) body sink =
+  HW.write ?level ?global header (sink :> Eio.Flow.sink_ty Eio.Flow.sink);
   body sink;
   really_write sink (Tar.Header.zero_padding header)
 
@@ -111,7 +111,7 @@ module Archive = struct
       should leave the fd positioned immediately after the datablock. Finally the function
       skips past the zero padding to the next header *)
   let with_next_file src ~(global: Tar.Header.Extended.t option)
-      (f: Eio.Flow.source -> Tar.Header.Extended.t option -> Tar.Header.t -> 'a) =
+      (f: _ -> Tar.Header.Extended.t option -> Tar.Header.t -> 'a) =
     match get_next_header ~global src with
     | Some (hdr, global) ->
       let result = f src global hdr in
@@ -123,7 +123,7 @@ module Archive = struct
   (** List the contents of a tar *)
   let list ?level fd =
     let rec loop global acc =
-      match get_next_header ?level ~global (fd :> Flow.source) with
+      match get_next_header ?level ~global fd with
       | None -> List.rev acc
       | Some (hdr, global) ->
         Reader.skip fd (Int64.to_int hdr.Tar.Header.file_size);
@@ -145,7 +145,7 @@ module Archive = struct
     in
     loop None ()
 
-  let transform ?level f (ifd : #Flow.source) (ofd : #Flow.sink) =
+  let transform ?level f ifd ofd =
     let rec loop global () =
       match get_next_header ~global ifd with
       | None -> ()

eio/tar_eio.mli

@@ -20,7 +20,7 @@
     zero-filled blocks are discovered. Assumes stream is positioned at the
     possible start of a header block.
     @raise End_of_file if the stream unexpectedly fails. *)
-val get_next_header : ?level:Tar.Header.compatibility -> global:Tar.Header.Extended.t option -> Eio.Flow.source ->
+val get_next_header : ?level:Tar.Header.compatibility -> global:Tar.Header.Extended.t option -> 'a Eio.Flow.source ->
                       (Tar.Header.t * Tar.Header.Extended.t option) option
 
 (** Return the header needed for a particular file on disk. [getpwuid] and [getgrgid] are optional
@@ -30,7 +30,7 @@ val header_of_file :
     ?level:Tar.Header.compatibility ->
     ?getpwuid:(int64 -> string) ->
     ?getgrgid:(int64 -> string) ->
-    Eio.Fs.dir Eio.Path.t ->
+    Eio.Fs.dir_ty Eio.Path.t ->
     Tar.Header.t
 
 module Archive : sig
@@ -39,31 +39,31 @@ module Archive : sig
   (** Read the next header, apply the function 'f' to the source and the header. The function
       should leave the source positioned immediately after the datablock. Finally the function
       skips past the zero padding to the next header. *)
-  val with_next_file : Eio.Flow.source -> global:Tar.Header.Extended.t option ->
-                       (Eio.Flow.source -> Tar.Header.Extended.t option -> Tar.Header.t -> 'a) -> 'a option
+  val with_next_file : 'a Eio.Flow.source -> global:Tar.Header.Extended.t option ->
+                       ('a Eio.Flow.source -> Tar.Header.Extended.t option -> Tar.Header.t -> 'a) -> 'a option
 
   (** List the contents of a tar to stdout. *)
-  val list : ?level:Tar.Header.compatibility -> #Eio.Flow.source -> Tar.Header.t list
+  val list : ?level:Tar.Header.compatibility -> 'a Eio.Flow.source -> Tar.Header.t list
 
   (** [extract dest] extract the contents of a tar.
      Apply [dest] on each source filename to change the destination
      filename. It only supports extracting regular files from the
      top-level of the archive. *)
-  val extract : (string -> Eio.Fs.dir Eio.Path.t) -> Eio.Flow.source -> unit
+  val extract : (string -> [> Eio.Fs.dir_ty] Eio.Path.t) -> 'a Eio.Flow.source -> unit
 
   (** [transform f src sink] applies [f] to the header of each
      file in the tar inputted in [src], and writes the resulting
      headers to [sink] preserving the content and structure of the
      archive. *)
-  val transform : ?level:Tar.Header.compatibility -> (Tar.Header.t -> Tar.Header.t) -> #Eio.Flow.source -> #Eio.Flow.sink -> unit
+  val transform : ?level:Tar.Header.compatibility -> (Tar.Header.t -> Tar.Header.t) -> 'a Eio.Flow.source -> 'a Eio.Flow.sink -> unit
 
   (** Create a tar in the sink from a list of file paths. It only supports regular files.
 
       See {! header_of_file} for the meaning of [getpwuid] and [getgrgid]. *)
   val create :
     ?getpwuid:(int64 -> string) ->
     ?getgrgid:(int64 -> string) ->
-    Eio.Fs.dir Eio.Path.t list ->
-    #Eio.Flow.sink ->
+    [> Eio.Fs.dir_ty ] Eio.Path.t list ->
+    'a Eio.Flow.sink ->
     unit
 end

eio/tar_eio_gz.ml

@@ -0,0 +1,64 @@
+open Eio
+
+module Monad = struct
+  type 'a t = 'a
+
+  let ( >>= ) a f = f a
+  let return = Fun.id
+end
+
+module Reader = struct
+  type in_channel = Buf_read.t
+  type 'a t = 'a
+
+  let read f = Flow.single_read (Buf_read.as_flow f)
+  let really_read f b = Flow.read_exact (Buf_read.as_flow f) b
+  let skip = Buf_read.consume
+end
+
+module Writer = struct
+  type out_channel = Flow.sink_ty Resource.t
+  type 'a t = 'a
+
+  let really_write f b = Flow.write f [ b ]
+end
+
+include Tar_gz.Make (Monad) (Writer) (Reader)
+
+type source = in_channel
+type sink = out_channel
+
+let of_sink ?bits ?q ~level ~mtime os f =
+  of_out_channel ?bits ?q ~level ~mtime os (f :> Flow.sink_ty Resource.t)
+
+let of_source f =
+  of_in_channel ~internal:(Cstruct.create 65536)
+    (Buf_read.of_flow ~max_size:max_int f)
+
+type filter = [ `Skip | `Header | `Header_and_file ]
+
+let fold ?level ?(filter = fun _ -> `Header) f source init =
+  let rec aux global acc =
+    match get_next_header ?level ~global source with
+    | hdr, global ->
+        let size = Int64.to_int hdr.file_size in
+        let padding = Tar.Header.compute_zero_padding_length hdr in
+        let acc =
+          match (filter hdr : filter) with
+          | `Skip ->
+              skip source (size + padding);
+              acc
+          | `Header ->
+              skip source (size + padding);
+              f hdr (Eio.Flow.string_source "") acc
+          | `Header_and_file ->
+              let buf = Cstruct.create size in
+              let src = Eio.Flow.cstruct_source [ buf ] in
+              really_read source buf;
+              skip source padding;
+              f hdr src acc
+        in
+        aux global acc
+    | exception Tar.Header.End_of_stream -> acc
+  in
+  aux None init

eio/tar_eio_gz.mli

@@ -0,0 +1,74 @@
+(** Read tar.gz files with eio *)
+
+open Eio
+
+type source
+
+val of_source : 'a Flow.source -> source
+
+val get_next_header :
+  ?level:Tar.Header.compatibility ->
+  global:Tar.Header.Extended.t option ->
+  source ->
+  Tar.Header.t * Tar.Header.Extended.t option
+(** Returns the next header block or fails with {!Tar.Header.End_of_stream} if
+    two consecutive zero-filled blocks are discovered. Assumes stream is
+    positioned at the possible start of a header block.
+
+    @raise Stdlib.End_of_file if the stream unexpectedly fails. *)
+
+val really_read : source -> Cstruct.t -> unit
+(** [really_read fd buf] fills [buf] with data from [fd] or raises
+    {!Stdlib.End_of_file}. *)
+
+type filter = [ `Skip | `Header | `Header_and_file ]
+
+val fold :
+  ?level:Tar.Header.compatibility ->
+  ?filter:(Tar.Header.t -> filter) ->
+  (Tar.Header.t -> Flow.source_ty Resource.t -> 'a -> 'a) ->
+  source ->
+  'a ->
+  'a
+
+val skip : source -> int -> unit
+
+type sink
+
+val of_sink :
+  ?bits:int ->
+  ?q:int ->
+  level:int ->
+  mtime:int32 ->
+  Gz.os ->
+  'a Flow.sink ->
+  sink
+
+val write_block :
+  ?level:Tar.Header.compatibility ->
+  ?global:Tar.Header.Extended.t ->
+  Tar.Header.t ->
+  sink ->
+  (unit -> string option) ->
+  unit
+(** [write_block hdr oc stream] writes [hdr], then {i deflate} the given
+    [stream], then zero-pads so the stream is positionned for the next block.
+
+    A simple usage to write a file:
+    {[
+      let stream_of_fd fd =
+        let buf = Bytes.create 0x1000 in
+        fun () -> match Unix.read fd buf 0 (Bytes.length buf) with
+        | 0 -> None
+        | len -> Some (Bytes.sub_string buf 0 len)
+        | exception End_of_file -> None
+
+      let add_file oc filename =
+        let fd = Unix.openfile filename Unix.[ O_RDONLY ] 0o644 in
+        let hdr = Tar.Header.make ... in
+        write_block hdr oc (stream_of_fd fd) ;
+        Unix.close fd
+    ]} *)
+
+val write_end : sink -> unit
+(** [write_end oc] writes a stream terminator to [oc]. *)

tar-eio.opam

@@ -15,7 +15,7 @@ bug-reports: "https://github.com/mirage/ocaml-tar/issues"
 depends: [
   "dune" {>= "2.9"}
   "ocaml" {>= "4.08.0"}
-  "eio" {>= "0.10.0" & < "0.12"}
+  "eio" {>= "0.12"}
   "tar" {= version}
   "odoc" {with-doc}
 ]