From 16d69055e24c32c5585545407deb588e6e0ff235 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Sun, 4 Feb 2024 00:15:49 +0100 Subject: [PATCH] remove offset nonsense --- unix/tar_unix.ml | 129 +++++++++++++++++++++------------------------- unix/tar_unix.mli | 22 ++++---- 2 files changed, 69 insertions(+), 82 deletions(-) diff --git a/unix/tar_unix.ml b/unix/tar_unix.ml index d9c858e..340462e 100644 --- a/unix/tar_unix.ml +++ b/unix/tar_unix.ml @@ -17,20 +17,20 @@ let ( let* ) = Result.bind -let rec safe ~off f a = +let rec safe f a = try Ok (f a) with - | Unix.Unix_error (Unix.EINTR, _, _) -> safe ~off f a - | Unix.Unix_error (e, f, s) -> Error (`Unix (off, e, f, s)) + | Unix.Unix_error (Unix.EINTR, _, _) -> safe f a + | Unix.Unix_error (e, f, s) -> Error (`Unix (e, f, s)) let safe_close fd = try Unix.close fd with _ -> () -let read_complete ~off fd buf len = +let read_complete fd buf len = let rec loop offset = if offset < len then - let* n = safe ~off (Unix.read fd buf offset) (len - offset) in + let* n = safe (Unix.read fd buf offset) (len - offset) in if n = 0 then - Error (`Unexpected_end_of_file off) + Error `Unexpected_end_of_file else loop (offset + n) else @@ -38,69 +38,64 @@ let read_complete ~off fd buf len = in loop 0 -let seek ~off fd n = - safe ~off (Unix.lseek fd n) Unix.SEEK_CUR +let seek fd n = + safe (Unix.lseek fd n) Unix.SEEK_CUR type decode_error = [ - | `Fatal of int * [ `Checksum_mismatch | `Corrupt_pax_header | `Unmarshal of string ] - | `Unix of int * Unix.error * string * string - | `Unexpected_end_of_file of int - | `Msg of int * string + | `Fatal of [ `Checksum_mismatch | `Corrupt_pax_header | `Unmarshal of string ] + | `Unix of Unix.error * string * string + | `Unexpected_end_of_file + | `Msg of string ] let pp_decode_error ppf = function - | `Fatal (off, err) -> - Format.fprintf ppf "Offset %u, %a" off Tar.pp_error err - | `Unix (off, err, fname, arg) -> - Format.fprintf ppf "Offset %u, Unix error %s (function %s, arg %s)" off + | `Fatal err -> Tar.pp_error ppf err + | `Unix (err, fname, arg) -> + Format.fprintf ppf "Unix error %s (function %s, arg %s)" (Unix.error_message err) fname arg - | `Unexpected_end_of_file off -> - Format.fprintf ppf "Offset %u unexpected end of file" off - | `Msg (off, msg) -> - Format.fprintf ppf "Offset %u error %s" off msg + | `Unexpected_end_of_file -> + Format.fprintf ppf "Unexpected end of file" + | `Msg msg -> + Format.fprintf ppf "Error %s" msg let fold f filename init = - let* fd = safe ~off:0 Unix.(openfile filename [ O_RDONLY ]) 0 in - let rec go ~off t fd ?global ?data acc = + let* fd = safe Unix.(openfile filename [ O_RDONLY ]) 0 in + let rec go t fd ?global ?data acc = let* data = match data with | None -> let buf = Bytes.make Tar.Header.length '\000' in - let* () = read_complete ~off fd buf Tar.Header.length in + let* () = read_complete fd buf Tar.Header.length in Ok (Bytes.unsafe_to_string buf) | Some data -> Ok data in match Tar.decode t data with | Ok (t, Some `Header hdr, g) -> let global = Option.fold ~none:global ~some:(fun g -> Some g) g in - let* acc' = - Result.map_error - (fun (`Msg s) -> `Msg (off, s)) - (f fd ?global hdr acc) - in - let* off = seek ~off fd (Tar.Header.compute_zero_padding_length hdr) in - go ~off t fd ?global acc' + let* acc' = f fd ?global hdr acc in + let* _off = seek fd (Tar.Header.compute_zero_padding_length hdr) in + go t fd ?global acc' | Ok (t, Some `Skip n, g) -> let global = Option.fold ~none:global ~some:(fun g -> Some g) g in - let* off = seek ~off fd n in - go ~off t fd ?global acc + let* _off = seek fd n in + go t fd ?global acc | Ok (t, Some `Read n, g) -> let global = Option.fold ~none:global ~some:(fun g -> Some g) g in let buf = Bytes.make n '\000' in - let* () = read_complete ~off fd buf n in + let* () = read_complete fd buf n in let data = Bytes.unsafe_to_string buf in - go ~off:(off + n) t fd ?global ~data acc + go t fd ?global ~data acc | Ok (t, None, g) -> let global = Option.fold ~none:global ~some:(fun g -> Some g) g in - go ~off t fd ?global acc + go t fd ?global acc | Error `Eof -> Ok acc - | Error `Fatal e -> Error (`Fatal (off, e)) + | Error `Fatal _ as e -> e in Fun.protect ~finally:(fun () -> safe_close fd) - (fun () -> go ~off:0 (Tar.decode_state ()) fd init) + (fun () -> go (Tar.decode_state ()) fd init) -let map_to_msg = function - | `Unix (_off, e, f, s) -> +let unix_err_to_msg = function + | `Unix (e, f, s) -> `Msg (Format.sprintf "error %s in function %s %s" (Unix.error_message e) f s) @@ -115,14 +110,14 @@ let copy ~src_fd ~dst_fd len = let* () = Result.map_error (function - | `Unix _ as e -> map_to_msg e - | `Unexpected_end_of_file _off -> - `Msg ("Unexpected end of file")) - (read_complete ~off:0 src_fd buffer l) + | `Unix _ as e -> unix_err_to_msg e + | `Unexpected_end_of_file -> + `Msg "Unexpected end of file") + (read_complete src_fd buffer l) in let* _written = - Result.map_error map_to_msg - (safe ~off:0 (Unix.write dst_fd buffer 0) l) + Result.map_error unix_err_to_msg + (safe (Unix.write dst_fd buffer 0) l) in read_write ~src_fd ~dst_fd (len - l) in @@ -134,30 +129,27 @@ let extract ?(filter = fun _ -> true) ~src dst = match hdr.Tar.Header.link_indicator with | Tar.Header.Link.Normal -> let* dst = - Result.map_error map_to_msg - (safe ~off:0 Unix.(openfile (Filename.concat dst hdr.Tar.Header.file_name) - [ O_WRONLY ; O_CREAT ]) hdr.Tar.Header.file_mode) + Result.map_error unix_err_to_msg + (safe Unix.(openfile (Filename.concat dst hdr.Tar.Header.file_name) + [ O_WRONLY ; O_CREAT ]) hdr.Tar.Header.file_mode) in Fun.protect ~finally:(fun () -> safe_close dst) (fun () -> copy ~src_fd:fd ~dst_fd:dst (Int64.to_int hdr.Tar.Header.file_size)) - (* TODO set owner / mode / mtime etc. *) + (* TODO set owner / mode / mtime etc. *) | _ -> Error (`Msg "not yet handled") else let* _off = - Result.map_error (fun (`Unix (_off, e, f, s)) -> - `Msg (Format.sprintf "error %s in function %s %s" - (Unix.error_message e) f s)) - (seek ~off:0 fd (Int64.to_int hdr.Tar.Header.file_size)) + Result.map_error unix_err_to_msg + (seek fd (Int64.to_int hdr.Tar.Header.file_size)) in Ok () in fold f src () - (** Return the header needed for a particular file on disk *) let header_of_file ?level file = let level = Tar.Header.compatibility level in - let* stat = safe ~off:0 Unix.LargeFile.lstat file in + let* stat = safe Unix.LargeFile.lstat file in let file_mode = stat.Unix.LargeFile.st_perm in let user_id = stat.Unix.LargeFile.st_uid in let group_id = stat.Unix.LargeFile.st_gid in @@ -181,15 +173,13 @@ let append_file ?level ?header filename fd = let* _off = List.fold_left (fun acc d -> let* _off = acc in - Result.map_error map_to_msg - (safe ~off:0 (Unix.write_substring fd d 0) (String.length d))) + Result.map_error unix_err_to_msg + (safe (Unix.write_substring fd d 0) (String.length d))) (Ok 0) header_strings in let* src = - Result.map_error (fun (`Unix (_off, e, f, s)) -> - `Msg (Format.sprintf "error %s in function %s %s" - (Unix.error_message e) f s)) - (safe ~off:0 Unix.(openfile filename [ O_RDONLY ]) 0) + Result.map_error unix_err_to_msg + (safe Unix.(openfile filename [ O_RDONLY ]) 0) in (* TOCTOU [also, header may not be valid for file] *) Fun.protect ~finally:(fun () -> safe_close src) @@ -201,16 +191,16 @@ let write_global_extended_header ?level header fd = let* _off = List.fold_left (fun acc d -> let* _off = acc in - Result.map_error map_to_msg - (safe ~off:0 (Unix.write_substring fd d 0) (String.length d))) + Result.map_error unix_err_to_msg + (safe (Unix.write_substring fd d 0) (String.length d))) (Ok 0) header_strings in Ok () let write_end fd = let* _written = - Result.map_error map_to_msg - (safe ~off:0 + Result.map_error unix_err_to_msg + (safe (Unix.write_substring fd (Tar.Header.zero_block ^ Tar.Header.zero_block) 0) (Tar.Header.length + Tar.Header.length)) in @@ -218,9 +208,8 @@ let write_end fd = let create ?level ?global ?(filter = fun _ -> true) ~src dst = let* dst_fd = - Result.map_error map_to_msg - (safe ~off:0 Unix.(openfile dst [ O_WRONLY ; O_CREAT ]) - 0o644) + Result.map_error unix_err_to_msg + (safe Unix.(openfile dst [ O_WRONLY ; O_CREAT ]) 0o644) in Fun.protect ~finally:(fun () -> safe_close dst_fd) (fun () -> @@ -230,12 +219,12 @@ let create ?level ?global ?(filter = fun _ -> true) ~src dst = write_global_extended_header ?level hdr dst_fd in let rec copy_files directory = - let* dir = safe ~off:0 Unix.opendir directory in + let* dir = safe Unix.opendir directory in Fun.protect ~finally:(fun () -> try Unix.closedir dir with _ -> ()) (fun () -> let rec next () = try - let* name = safe ~off:0 Unix.readdir dir in + let* name = safe Unix.readdir dir in let filename = Filename.concat directory name in let* header = header_of_file ?level filename in if filter header then diff --git a/unix/tar_unix.mli b/unix/tar_unix.mli index 996cfc2..357efd3 100644 --- a/unix/tar_unix.mli +++ b/unix/tar_unix.mli @@ -16,13 +16,11 @@ (** Unix I/O for tar-formatted data. *) -(* TODO provide a type error and a pretty-printer *) - type decode_error = [ - | `Fatal of int * [ `Checksum_mismatch | `Corrupt_pax_header | `Unmarshal of string ] - | `Unix of int * Unix.error * string * string - | `Unexpected_end_of_file of int - | `Msg of int * string + | `Fatal of [ `Checksum_mismatch | `Corrupt_pax_header | `Unmarshal of string ] + | `Unix of Unix.error * string * string + | `Unexpected_end_of_file + | `Msg of string ] val pp_decode_error : Format.formatter -> decode_error -> unit @@ -31,8 +29,8 @@ val pp_decode_error : Format.formatter -> decode_error -> unit for each [hdr : Tar.Header.t]. It should forward the position in the file descriptor by [hdr.Tar.Header.file_size]. *) val fold : - (Unix.file_descr -> ?global:Tar.Header.Extended.t -> Tar.Header.t -> - 'a -> ('a, [ `Msg of string ]) result) -> + (Unix.file_descr -> ?global:Tar.Header.Extended.t -> Tar.Header.t -> 'a -> + ('a, decode_error) result) -> string -> 'a -> ('a, decode_error) result (** [extract ~filter ~src dst] extracts the tar archive [src] into the @@ -52,24 +50,24 @@ val create : ?level:Tar.Header.compatibility -> ?global:Tar.Header.Extended.t -> ?filter:(Tar.Header.t -> bool) -> src:string -> string -> - (unit, [ `Msg of string | `Unix of (int * Unix.error * string * string) ]) result + (unit, [ `Msg of string | `Unix of (Unix.error * string * string) ]) result (** [header_of_file ~level filename] returns the tar header of [filename]. *) val header_of_file : ?level:Tar.Header.compatibility -> string -> - (Tar.Header.t, [ `Unix of (int * Unix.error * string * string) ]) result + (Tar.Header.t, [ `Unix of (Unix.error * string * string) ]) result (** [append_file ~level ~header filename fd] appends the contents of [filename] to the tar archive [fd]. If [header] is not provided, {header_of_file} is used for constructing a header. *) val append_file : ?level:Tar.Header.compatibility -> ?header:Tar.Header.t -> string -> Unix.file_descr -> - (unit, [ `Msg of string | `Unix of (int * Unix.error * string * string) ]) result + (unit, [ `Msg of string | `Unix of (Unix.error * string * string) ]) result (** [write_global_extended_header ~level hdr fd] writes the extended header [hdr] to [fd]. *) val write_global_extended_header : ?level:Tar.Header.compatibility -> Tar.Header.Extended.t -> Unix.file_descr -> - (unit, [ `Msg of string | `Unix of (int * Unix.error * string * string) ]) result + (unit, [ `Msg of string | `Unix of (Unix.error * string * string) ]) result (** [write_end fd] writes the tar end marker to [fd]. *) val write_end : Unix.file_descr -> (unit, [ `Msg of string ]) result