diff --git a/bin/otar.ml b/bin/otar.ml index 59c3245..5c6b443 100644 --- a/bin/otar.ml +++ b/bin/otar.ml @@ -14,6 +14,8 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) +open Tar.Syntax + let () = Printexc.record_backtrace true let ( / ) = Filename.concat @@ -99,9 +101,8 @@ let list filename = hdr.Tar.Header.file_name (Tar.Header.Link.to_string hdr.link_indicator) (bytes_to_size ~decimals:2) hdr.Tar.Header.file_size ; - let open Tar in - let* _ = seek (Int64.to_int hdr.Tar.Header.file_size) in - return (Ok ()) + let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in + Tar.return (Ok ()) in let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0 in match Tar_unix.run (Tar_gz.in_gzipped (Tar.fold go ())) fd with diff --git a/eio/tar_eio.ml b/eio/tar_eio.ml index c97f448..ad6d4fa 100644 --- a/eio/tar_eio.ml +++ b/eio/tar_eio.ml @@ -122,7 +122,7 @@ let copy dst len = let rec read_write dst len = if len = 0 then value (Ok ()) else - let ( let* ) = Tar.( let* ) in + let open Tar.Syntax in let slen = min blen len in let* str = Tar.really_read slen in let* _written = Result.ok (Eio.Flow.copy_string str dst) |> value in @@ -132,7 +132,7 @@ let copy dst len = let extract ?(filter = fun _ -> true) src dst = let f ?global:_ hdr () = - let ( let* ) = Tar.( let* ) in + let open Tar.Syntax in let path = dst / hdr.Tar.Header.file_name in match (filter hdr, hdr.Tar.Header.link_indicator) with | true, Tar.Header.Link.Normal -> diff --git a/lib/tar.ml b/lib/tar.ml index f7546e2..2f9de6c 100644 --- a/lib/tar.ml +++ b/lib/tar.ml @@ -832,13 +832,19 @@ type ('a, 'err, 't) t = | High : (('a, 'err) result, 't) io -> ('a, 'err, 't) t | Write : string -> (unit, 'err, 't) t -let ( let* ) x f = Bind (x, f) +let bind x f = Bind (x, f) let return x = Return x let really_read n = Really_read n let read n = Read n let seek n = Seek n let write str = Write str +module Syntax = struct + let ( let* ) = bind +end + +open Syntax + type ('a, 'err, 't) fold = (?global:Header.Extended.t -> Header.t -> 'a -> ('a, 'err, 't) t) -> 'a -> ('a, 'err, 't) t let fold f init = diff --git a/lib/tar.mli b/lib/tar.mli index 4a8af7e..0da9091 100644 --- a/lib/tar.mli +++ b/lib/tar.mli @@ -201,10 +201,14 @@ type ('a, 'err, 't) t = val really_read : int -> (string, _, _) t val read : int -> (string, _, _) t val seek : int -> (unit, _, _) t -val ( let* ) : ('a, 'err, 't) t -> ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t +val bind : ('a, 'err, 't) t -> ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t val return : ('a, 'err) result -> ('a, 'err, _) t val write : string -> (unit, _, _) t +module Syntax : sig + val ( let* ) : ('a, 'err, 't) t -> ('a -> ('b, 'err, 't) t) -> ('b, 'err, 't) t +end + type ('a, 'err, 't) fold = (?global:Header.Extended.t -> Header.t -> 'a -> ('a, 'err, 't) t) -> 'a -> ('a, 'err, 't) t val fold : ('a, [> `Fatal of error ], 't) fold diff --git a/lib/tar_gz.ml b/lib/tar_gz.ml index 4d852c0..4ac1a33 100644 --- a/lib/tar_gz.ml +++ b/lib/tar_gz.ml @@ -14,6 +14,8 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) +open Tar.Syntax + external ba_get_int32_ne : De.bigstring -> int -> int32 = "%caml_bigstring_get32" external ba_set_int32_ne : De.bigstring -> int -> int32 -> unit = "%caml_bigstring_set32" @@ -56,7 +58,6 @@ type decoder = let read_through_gz : decoder -> bytes -> (int, 'err, _) Tar.t = fun ({ ic_buffer; oc_buffer; tp_length; _ } as state) res -> - let open Tar in let rec until_full_or_end gz (res, res_off, res_len) = match Gz.Inf.decode gz with | `Flush gz -> @@ -66,7 +67,7 @@ let read_through_gz if len < max then ( state.pos <- len ; state.gz <- gz - ; return (Ok (res_off + len)) ) + ; Tar.return (Ok (res_off + len)) ) else until_full_or_end (Gz.Inf.flush gz) (res, res_off + len, res_len - len) | `End gz -> let max = De.bigstring_length oc_buffer - Gz.Inf.dst_rem gz in @@ -74,24 +75,23 @@ let read_through_gz bigstring_blit_bytes oc_buffer ~src_off:0 res ~dst_off:res_off ~len; state.pos <- len; state.gz <- gz; - return (Ok (res_off + len)) + Tar.return (Ok (res_off + len)) | `Await gz -> let* tp_buffer = Tar.read tp_length in let len = String.length tp_buffer in bigstring_blit_string tp_buffer ~src_off:0 ic_buffer ~dst_off:0 ~len; let gz = Gz.Inf.src gz ic_buffer 0 len in until_full_or_end gz (res, res_off, res_len) - | `Malformed err -> return (Error (`Gz err)) in + | `Malformed err -> Tar.return (Error (`Gz err)) in let max = (De.bigstring_length oc_buffer - Gz.Inf.dst_rem state.gz) - state.pos in let len = min (Bytes.length res) max in bigstring_blit_bytes oc_buffer ~src_off:state.pos res ~dst_off:0 ~len; if len < max then ( state.pos <- state.pos + len - ; return (Ok len) ) + ; Tar.return (Ok len) ) else until_full_or_end (Gz.Inf.flush state.gz) (res, len, Bytes.length res - len) let really_read_through_gz decoder len = - let open Tar in let res = Bytes.create len in let* len = read_through_gz decoder res in if Bytes.length res = len @@ -99,7 +99,6 @@ let really_read_through_gz decoder len = else Tar.return (Error `Eof) let read_through_gz decoder len = - let open Tar in let res = Bytes.create len in let* len = read_through_gz decoder res in let str = Bytes.sub_string res 0 len in @@ -110,7 +109,6 @@ type error = [ `Fatal of Tar.error | `Eof | `Gz of string ] let seek_through_gz : decoder -> int -> (unit, [> error ], _) Tar.t = fun state len -> - let open Tar in let* _buf = really_read_through_gz state len in Tar.return (Ok ()) @@ -211,13 +209,13 @@ let out_gzipped ~level ~mtime os t = let gz = Gz.Def.dst gz oc_buffer 0 (De.bigstring_length oc_buffer) in let* state = until_await 0 oc_buffer (Gz.Def.encode gz) in let encoder = - { state + { state ; ic_buffer ; oc_buffer } in let* result = go encoder t in let `Await gz = encoder.state in let* () = Gz.Def.src gz ic_buffer 0 0 - |> Gz.Def.encode + |> Gz.Def.encode |> until_end 0 oc_buffer in Tar.return (Ok result) diff --git a/lib_test/global_extended_headers_test.ml b/lib_test/global_extended_headers_test.ml index a4ef1ab..cf2da0a 100644 --- a/lib_test/global_extended_headers_test.ml +++ b/lib_test/global_extended_headers_test.ml @@ -47,7 +47,7 @@ let use_global_extended_headers _test_ctxt = Alcotest.testable (fun ppf hdr -> Fmt.pf ppf "%a" Fmt.(option pp) hdr) ( = ) in let f ?global hdr idx = - let ( let* ) = Tar.( let* ) in + let open Tar.Syntax in let* _pos = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in match idx with | 0 -> diff --git a/lib_test/parse_test.ml b/lib_test/parse_test.ml index 30f303b..a71aaaa 100644 --- a/lib_test/parse_test.ml +++ b/lib_test/parse_test.ml @@ -13,6 +13,7 @@ *) open Lwt.Infix +open Tar.Syntax let convert_path os path = let ch = Unix.open_process_in (Printf.sprintf "cygpath -%c -- %s" (match os with `Mixed -> 'm' | `Unix -> 'u' | `Windows -> 'w') path) in @@ -34,8 +35,7 @@ end let list filename = let f ?global:_ hdr acc = print_endline hdr.Tar.Header.file_name; - let ( let* ) = Tar.( let* ) in - let* _pos = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in + let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in Tar.return (Ok (hdr :: acc)) in match Tar_unix.fold f filename [] with @@ -169,8 +169,7 @@ let can_list_pax_implicit_dir () = let f ?global:_ hdr () = Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.Tar.Header.link_indicator; Alcotest.(check string) "filename is patched" "clearly/a/directory/" hdr.file_name; - let ( let* ) = Tar.( let* ) in - let* _pos = Tar.seek (Int64.to_int hdr.file_size) in + let* () = Tar.seek (Int64.to_int hdr.file_size) in Tar.return (Ok ()) in match Tar_unix.fold f "lib_test/pax-shenanigans.tar" () with @@ -192,8 +191,7 @@ let can_list_longlink_implicit_dir () = let f ?global:_ hdr () = Alcotest.(check link) "is directory" Tar.Header.Link.Directory hdr.Tar.Header.link_indicator; Alcotest.(check string) "filename is patched" "some/long/name/for/a/directory/" hdr.file_name; - let ( let* ) = Tar.( let* ) in - let* _pos = Tar.seek (Int64.to_int hdr.file_size) in + let* () = Tar.seek (Int64.to_int hdr.file_size) in Tar.return (Ok ()) in match Tar_unix.fold f "lib_test/long-implicit-dir.tar" () with @@ -216,8 +214,7 @@ let can_transform_tar () = let fd_out = Unix.openfile tar_out [ O_WRONLY; O_CREAT; O_CLOEXEC ] 0o644 in with_tmpdir @@ fun temp_dir -> let f ?global:_ hdr _ = - let ( let* ) = Tar.( let* ) in - let* _pos = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in + let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in let hdr = { hdr with Tar.Header.file_name = Filename.concat temp_dir hdr.file_name; @@ -236,8 +233,7 @@ let can_transform_tar () = | Ok () -> Unix.close fd_out; let f ?global:_ hdr _ = - let ( let* ) = Tar.( let* ) in - let* _pos = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in + let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in Alcotest.(check string) "Filename was transformed" temp_dir (String.sub hdr.file_name 0 (min (String.length hdr.file_name) (String.length temp_dir))); Tar.return (Ok ()) diff --git a/unix/tar_lwt_unix.ml b/unix/tar_lwt_unix.ml index 7c2eb4a..1ef6d15 100644 --- a/unix/tar_lwt_unix.ml +++ b/unix/tar_lwt_unix.ml @@ -15,6 +15,8 @@ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *) +open Tar.Syntax + type decode_error = [ | `Fatal of Tar.error | `Unix of Unix.error * string * string @@ -122,7 +124,6 @@ let copy ~dst_fd len = let rec read_write ~dst_fd len = if len = 0 then value (Lwt.return (Ok ())) else - let ( let* ) = Tar.( let* ) in let slen = min blen len in let* str = Tar.really_read slen in let* _written = Lwt_result.map_error unix_err_to_msg @@ -139,7 +140,6 @@ let extract ?(filter = fun _ -> true) ~src dst = (fun _ -> Lwt.return_unit) >|= Result.ok in let f ?global:_ hdr () = - let ( let* ) = Tar.( let* ) in match filter hdr, hdr.Tar.Header.link_indicator with | true, Tar.Header.Link.Normal -> let* dst = Lwt_result.map_error diff --git a/unix/tar_unix.ml b/unix/tar_unix.ml index 761f3b9..6c1165e 100644 --- a/unix/tar_unix.ml +++ b/unix/tar_unix.ml @@ -127,7 +127,7 @@ let unix_err_to_msg = function let copy ~dst_fd len = let blen = 65536 in let rec read_write ~dst_fd len = - let ( let* ) = Tar.( let* ) in + let open Tar.Syntax in if len = 0 then Tar.return (Ok ()) else let slen = min blen len in @@ -156,11 +156,11 @@ let extract ?(filter = fun _ -> true) ~src dst = (* TODO set owner / mode / mtime etc. *) | _ -> (* TODO handle directories, links, etc. *) - let ( let* ) = Tar.( let* ) in + let open Tar.Syntax in let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in Tar.return (Ok ()) else - let ( let* ) = Tar.( let* ) in + let open Tar.Syntax in let* () = Tar.seek (Int64.to_int hdr.Tar.Header.file_size) in Tar.return (Ok ()) in