Skip to content

Commit

Permalink
WIP tar_lwt_unix gzip functions
Browse files Browse the repository at this point in the history
  • Loading branch information
reynir committed Sep 11, 2024
1 parent 41c955a commit e6751c8
Show file tree
Hide file tree
Showing 3 changed files with 43 additions and 11 deletions.
2 changes: 1 addition & 1 deletion unix/dune
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
(library
(name tar_unix)
(public_name tar-unix)
(libraries tar lwt lwt.unix)
(libraries tar tar_gz lwt lwt.unix)
(wrapped false))
30 changes: 20 additions & 10 deletions unix/tar_lwt_unix.ml
Original file line number Diff line number Diff line change
Expand Up @@ -105,12 +105,16 @@ let run t fd =
run x >>= fun value -> run (f value) in
run t

let fold f filename init =
let with_in filename f =
let open Lwt_result.Infix in
safe Lwt_unix.(openfile filename [ O_RDONLY ]) 0 >>= fun fd ->
Lwt.finalize
(fun () -> run (Tar.fold f init) fd)
(fun () -> safe_close fd)
Lwt.finalize (fun () -> f fd) (fun () -> safe_close fd)

let fold f filename init =
with_in filename (fun fd -> run (Tar.fold f init) fd)

let fold_gz f filename init =
with_in filename (fun fd -> run (Tar_gz.in_gzipped (Tar.fold f init)) fd)

let unix_err_to_msg = function
| `Unix (e, f, s) ->
Expand All @@ -131,13 +135,10 @@ let copy ~dst_fd len =
in
read_write ~dst_fd len

let extract ?(filter = fun _ -> true) ~src dst =
let extract ~filter dst =
let safe_close fd =
let open Lwt.Infix in
Lwt.catch
(fun () -> Lwt_unix.close fd)
(fun _ -> Lwt.return_unit)
>|= Result.ok in
safe_close fd >|= Result.ok in
let f ?global:_ hdr () =
let ( let* ) = Tar.( let* ) in
match filter hdr, hdr.Tar.Header.link_indicator with
Expand All @@ -158,7 +159,12 @@ let extract ?(filter = fun _ -> true) ~src dst =
let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in
Tar.return (Ok ())
in
fold f src ()
Tar.fold f ()

let extract ?(filter = fun _ -> true) ~src dst =
with_in src (fun fd -> run (extract ~filter dst) fd)
and extract_gz ?(filter = fun _ -> true) ~src dst =
with_in src (fun fd -> run (Tar_gz.in_gzipped (extract ~filter dst)) fd)
(** Return the header needed for a particular file on disk *)
let header_of_file ?level file =
Expand Down Expand Up @@ -296,3 +302,7 @@ let create ?level ?global ?(filter = fun _ -> true) ~src dst =
copy_files src >>= fun () ->
write_end dst_fd)
(fun () -> safe_close dst_fd)
let create_gz ?level:_ ?global:_ ?filter:_ ~src:_ _dst =
(* TODO *)
assert false
22 changes: 22 additions & 0 deletions unix/tar_lwt_unix.mli
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,13 @@ val fold :
('a, [> decode_error ] as 'err, t) Tar.t) ->
string -> 'a -> ('a, 'err) result Lwt.t

(** [fold_gz f filename acc] is like [fold f filename acc] working on a gzip
compressed tar archive. *)
val fold_gz :
(?global:Tar.Header.Extended.t -> Tar.Header.t -> 'a ->
('a, [> decode_error | Tar_gz.error ] as 'err, t) Tar.t) ->
string -> 'a -> ('a, 'err) result Lwt.t

(** [extract ~filter ~src dst] extracts the tar archive [src] into the
directory [dst]. If [dst] does not exist, it is created. If [filter] is
provided (defaults to [fun _ -> true]), any file where [filter hdr] returns
Expand All @@ -48,6 +55,13 @@ val extract :
src:string -> string ->
(unit, [> `Exn of exn | decode_error ]) result Lwt.t

(** [extract_gz ~filter ~src dst] is like [extract ~filter ~src dst] extracting
a gzip compressed archive. *)
val extract_gz :
?filter:(Tar.Header.t -> bool) ->
src:string -> string ->
(unit, [> `Exn of exn | decode_error | Tar_gz.error ]) result Lwt.t

(** [create ~level ~filter ~src dst] creates a tar archive at [dst]. It uses
[src], a directory name, as input. If [filter] is provided
(defaults to [fun _ -> true]), any file where [filter hdr] returns [false]
Expand All @@ -58,6 +72,14 @@ val create : ?level:Tar.Header.compatibility ->
src:string -> string ->
(unit, [ `Msg of string | `Unix of (Unix.error * string * string) ]) result Lwt.t

(** [create_gz ~level ~filter ~src dst] is like [create ~level ~filter ~src
dst] creating a gzip compressed archive. *)
val create_gz : ?level:Tar.Header.compatibility ->
?global:Tar.Header.Extended.t ->
?filter:(Tar.Header.t -> bool) ->
src:string -> string ->
(unit, [ `Msg of string | `Unix of (Unix.error * string * string) | Tar_gz.error ]) result Lwt.t

(** [header_of_file ~level filename] returns the tar header of [filename]. *)
val header_of_file : ?level:Tar.Header.compatibility -> string ->
(Tar.Header.t, [ `Msg of string | `Unix of (Unix.error * string * string) ]) result Lwt.t
Expand Down

0 comments on commit e6751c8

Please sign in to comment.