diff --git a/src/irmin-pack/unix/append_only_file_intf.ml b/src/irmin-pack/unix/append_only_file_intf.ml index c7aa00e034..4c5517980d 100644 --- a/src/irmin-pack/unix/append_only_file_intf.ml +++ b/src/irmin-pack/unix/append_only_file_intf.ml @@ -139,7 +139,7 @@ module type S = sig Attempting to read from the append buffer results in an [`Read_out_of_bounds] error. This feature could easily be implemented in - the future if ever needed. It was not needed with io_legacy. *) + the future if ever needed. *) val append_exn : t -> string -> unit (** [append_exn t ~off b] writes [b] to the end of [t]. Might trigger an auto diff --git a/src/irmin-pack/unix/atomic_write.ml b/src/irmin-pack/unix/atomic_write.ml index ec71b30822..b7a94c917a 100644 --- a/src/irmin-pack/unix/atomic_write.ml +++ b/src/irmin-pack/unix/atomic_write.ml @@ -1,18 +1,16 @@ open Import include Irmin_pack.Atomic_write -let current_version = `V1 - module Table (K : Irmin.Type.S) = Hashtbl.Make (struct type t = K.t [@@deriving irmin ~short_hash ~equal] let hash = short_hash ?seed:None end) -module Make_persistent (K : Irmin.Type.S) (V : Value.S) = struct +module Make_persistent (Io : Io.S) (K : Irmin.Type.S) (V : Value.S) = struct module Tbl = Table (K) module W = Irmin.Backend.Watch.Make (K) (V) - module Io_legacy = Io_legacy.Unix + module Io_errors = Io_errors.Make (Io) type key = K.t [@@deriving irmin ~pp ~to_bin_string ~of_bin_string] type value = V.t [@@deriving irmin ~equal ~decode_bin ~of_bin_string] @@ -21,39 +19,34 @@ module Make_persistent (K : Irmin.Type.S) (V : Value.S) = struct type t = { index : int63 Tbl.t; cache : V.t Tbl.t; - block : Io_legacy.t; + block : Io.t; + mutable block_size : int63; w : W.t; } + let dead_header_size = 16 let decode_bin = Irmin.Type.(unstage (decode_bin int32)) let read_length32 ~file_pos block = - let buf = Bytes.create 4 in - let n = Io_legacy.read block ~off:!file_pos buf in - assert (n = 4); - (file_pos := Int63.Syntax.(!file_pos + Int63.of_int 4)); + let len = 4 in + let buf = Bytes.create len in + Io.read_exn block ~off:!file_pos ~len buf; + (file_pos := Int63.Syntax.(!file_pos + Int63.of_int len)); let pos_ref = ref 0 in - (* Bytes.unsafe_to_string usage: We assume Io_legacy.read_block returns unique - ownership of buf back to this function (this assumption holds currently; subsequent - modifications of that code need to ensure this remains the case); then in call to - Bytes.unsafe_to_string we give up ownership of buf (we do not modify the buffer - afterwards) and get ownership of resulting string; so this use is safe. *) let v = decode_bin (Bytes.unsafe_to_string buf) pos_ref in - assert (!pos_ref = 4); + assert (!pos_ref = len); Int32.to_int v let entry = Irmin.Type.(pair (string_of `Int32) V.t) let entry_to_bin_string = Irmin.Type.(unstage (to_bin_string entry)) + let block_size block = Io_errors.raise_if_error (Io.read_size block) let set_entry t ?off k v = let k = key_to_bin_string k in let buf = entry_to_bin_string (k, v) in - let () = - match off with - | None -> Io_legacy.append t.block buf - | Some off -> Io_legacy.set t.block buf ~off - in - Io_legacy.flush t.block + let len = String.length buf in + let off = match off with None -> block_size t.block | Some off -> off in + Io.write_exn t.block ~off ~len buf let value_encoded_size = match Irmin.Type.Size.of_value V.t with @@ -73,8 +66,7 @@ module Make_persistent (K : Irmin.Type.S) (V : Value.S) = struct let buf_size = key_encoded_size + value_encoded_size in let buf = let buf = Bytes.create buf_size in - let n = Io_legacy.read t.block ~off:!file_pos buf in - assert (n = buf_size); + Io.read_exn t.block ~off:!file_pos ~len:buf_size buf; let open Int63.Syntax in file_pos := !file_pos + Int63.of_int buf_size; Bytes.unsafe_to_string buf @@ -97,13 +89,14 @@ module Make_persistent (K : Irmin.Type.S) (V : Value.S) = struct aux () let sync_offset t = - let former_offset = Io_legacy.offset t.block in - let offset = Io_legacy.force_offset t.block in - if offset > former_offset then refill t ~to_:offset ~from:former_offset + let former_offset = t.block_size in + t.block_size <- block_size t.block; + if t.block_size > former_offset then + refill t ~to_:t.block_size ~from:former_offset let unsafe_find t k = [%log.debug "[branches] find %a" pp_key k]; - if Io_legacy.readonly t.block then sync_offset t; + if Io.readonly t.block then sync_offset t; try Some (Tbl.find t.cache k) with Not_found -> None let find t k = Lwt.return (unsafe_find t k) @@ -129,14 +122,25 @@ module Make_persistent (K : Irmin.Type.S) (V : Value.S) = struct let watches = W.v () let v ?(fresh = false) ?(readonly = false) file = + Fmt.pr "%b - %b@." fresh readonly; let block = - Io_legacy.v ~fresh ~version:(Some current_version) ~readonly file + if + (not readonly) + && (fresh || Io.classify_path file = `No_such_file_or_directory) + then ( + let io = + Io_errors.raise_if_error (Io.create ~path:file ~overwrite:true) + in + Io.write_exn io ~off:Int63.zero ~len:dead_header_size + (String.make dead_header_size '\000'); + io) + else Io_errors.raise_if_error (Io.open_ ~path:file ~readonly) in let cache = Tbl.create 997 in let index = Tbl.create 997 in - let t = { cache; index; block; w = watches } in - let offset = Io_legacy.force_offset block in - refill t ~to_:offset ~from:Int63.zero; + let block_size = block_size block in + let t = { cache; index; block; block_size; w = watches } in + refill t ~to_:block_size ~from:(Int63.of_int dead_header_size); Lwt.return t let clear _ = Fmt.failwith "Unsupported operation" @@ -147,13 +151,13 @@ module Make_persistent (K : Irmin.Type.S) (V : Value.S) = struct Tbl.replace t.cache k v; set_entry t ~off k v with Not_found -> - let offset = Io_legacy.offset t.block in + let offset = block_size t.block in set_entry t k v; Tbl.add t.cache k v; Tbl.add t.index k offset let set t k v = - [%log.debug "[branches %s] set %a" (Io_legacy.name t.block) pp_key k]; + [%log.debug "[branches %s] set %a" (Io.path t.block) pp_key k]; unsafe_set t k v; W.notify t.w k (Some v) @@ -186,10 +190,9 @@ module Make_persistent (K : Irmin.Type.S) (V : Value.S) = struct let unsafe_close t = Tbl.reset t.index; Tbl.reset t.cache; - if not (Io_legacy.readonly t.block) then Io_legacy.flush t.block; - Io_legacy.close t.block; + Io_errors.raise_if_error (Io.close t.block); W.clear t.w let close t = unsafe_close t - let flush t = Io_legacy.flush t.block + let flush _t = () end diff --git a/src/irmin-pack/unix/atomic_write.mli b/src/irmin-pack/unix/atomic_write.mli index ddb81eebbe..8b7632959e 100644 --- a/src/irmin-pack/unix/atomic_write.mli +++ b/src/irmin-pack/unix/atomic_write.mli @@ -17,5 +17,5 @@ open! Import include module type of Irmin_pack.Atomic_write -module Make_persistent (K : Irmin.Type.S) (V : Value.S) : +module Make_persistent (Io : Io.S) (K : Irmin.Type.S) (V : Value.S) : Persistent with type key = K.t and type value = V.t diff --git a/src/irmin-pack/unix/io_legacy.ml b/src/irmin-pack/unix/io_legacy.ml deleted file mode 100644 index 2597edb220..0000000000 --- a/src/irmin-pack/unix/io_legacy.ml +++ /dev/null @@ -1,206 +0,0 @@ -(* - * Copyright (c) 2018-2022 Tarides - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -open! Import -include Io_legacy_intf - -module Unix : S = struct - module Raw = Index_unix.Private.Raw - - type t = { - file : string; - raw : Raw.t; - mutable offset : int63; - mutable flushed : int63; - readonly : bool; - mutable version : Version.t; - buf : Buffer.t; - } - - let name t = t.file - let header_size = (* offset + version *) Int63.of_int 16 - - let unsafe_flush t = - [%log.debug "IO flush %s" t.file]; - let buf = Buffer.contents t.buf in - if buf = "" then () - else - let offset = t.offset in - Buffer.clear t.buf; - Raw.unsafe_write t.raw ~off:t.flushed buf 0 (String.length buf); - Raw.Offset.set t.raw offset; - let open Int63.Syntax in - (* concurrent append might happen so here t.offset might differ - from offset *) - if - not (t.flushed + Int63.of_int (String.length buf) = header_size + offset) - then - Fmt.failwith "reload error: %s flushed=%a offset+header=%a\n%!" t.file - Int63.pp t.flushed Int63.pp (offset + header_size); - t.flushed <- offset + header_size - - let flush t = - if t.readonly then raise Irmin_pack.RO_not_allowed; - unsafe_flush t - - let auto_flush_limit = Int63.of_int 1_000_000 - - let append t buf = - Buffer.add_string t.buf buf; - let len = Int63.of_int (String.length buf) in - let open Int63.Syntax in - t.offset <- t.offset + len; - if t.offset - t.flushed > auto_flush_limit then flush t - - let set t ~off buf = - if t.readonly then raise Irmin_pack.RO_not_allowed; - unsafe_flush t; - let buf_len = String.length buf in - let open Int63.Syntax in - Raw.unsafe_write t.raw ~off:(header_size + off) buf 0 buf_len; - assert ( - let len = Int63.of_int buf_len in - let off = header_size + off + len in - off <= t.flushed) - - exception Invalid_read of string - - let raise_invalid_read fmt = Fmt.kstr (fun s -> raise (Invalid_read s)) fmt - - let read_buffer t ~off ~buf ~len = - let open Int63.Syntax in - let off = header_size + off in - if (not t.readonly) && off > t.flushed then - raise_invalid_read - "Requested read of %d bytes at offset %a, but only flushed to %a" len - Int63.pp off Int63.pp t.flushed; - Raw.unsafe_read t.raw ~off ~len buf - - let read t ~off buf = read_buffer t ~off ~buf ~len:(Bytes.length buf) - let offset t = t.offset - - let force_offset t = - t.offset <- Raw.Offset.get t.raw; - t.offset - - let version t = - [%log.debug - "[%s] version: %a" (Filename.basename t.file) Version.pp t.version]; - t.version - - let set_version t v = - [%log.debug - "[%s] set_version: %a -> %a" (Filename.basename t.file) Version.pp - t.version Version.pp v]; - Raw.Version.set t.raw (Version.to_bin v); - t.version <- v - - let readonly t = t.readonly - - let protect_unix_exn = function - | Unix.Unix_error _ as e -> failwith (Printexc.to_string e) - | e -> raise e - - let ignore_enoent = function - | Unix.Unix_error (Unix.ENOENT, _, _) -> () - | e -> raise e - - let protect f x = try f x with e -> protect_unix_exn e - let safe f x = try f x with e -> ignore_enoent e - - let mkdir dirname = - let rec aux dir k = - if Sys.file_exists dir && Sys.is_directory dir then k () - else ( - if Sys.file_exists dir then safe Unix.unlink dir; - (aux [@tailcall]) (Filename.dirname dir) (fun () -> - protect (Unix.mkdir dir) 0o755; - k ())) - in - aux dirname (fun () -> ()) - - let raw ~flags ~version ~offset file = - let x = Unix.openfile file flags 0o644 in - let raw = Raw.v x in - let header = - { Raw.Header_prefix.version = Version.to_bin version; offset } - in - Raw.Header_prefix.set raw header; - raw - - let v ~version ~fresh ~readonly file = - let get_version () = - match version with - | Some v -> v - | None -> - Fmt.invalid_arg - "Must supply an explicit version when creating a new store ({ file \ - = %s })" - file - in - let v ~offset ~version raw = - { - version; - file; - offset; - raw; - readonly; - buf = Buffer.create (4 * 1024); - flushed = Int63.Syntax.(header_size + offset); - } - in - let mode = Unix.(if readonly then O_RDONLY else O_RDWR) in - mkdir (Filename.dirname file); - match Sys.file_exists file with - | false -> - let version = get_version () in - let raw = - raw - ~flags:[ O_CREAT; mode; O_CLOEXEC ] - ~version ~offset:Int63.zero file - in - v ~offset:Int63.zero ~version raw - | true -> - let x = Unix.openfile file Unix.[ O_EXCL; mode; O_CLOEXEC ] 0o644 in - let raw = Raw.v x in - if fresh then ( - let version = get_version () in - let header = - { - Raw.Header_prefix.version = Version.to_bin version; - offset = Int63.zero; - } - in - Raw.Header_prefix.set raw header; - v ~offset:Int63.zero ~version raw) - else - let actual_version = - let v_string = Raw.Version.get raw in - match Version.of_bin v_string with - | Some v -> v - | None -> Version.invalid_arg v_string - in - (match version with - | Some v when Version.compare actual_version v > 0 -> - raise (Version.Invalid { expected = v; found = actual_version }) - | _ -> ()); - let offset = Raw.Offset.get raw in - v ~offset ~version:actual_version raw - - let close t = Raw.close t.raw - let exists file = Sys.file_exists file - let size { raw; _ } = (Raw.fstat raw).st_size -end diff --git a/src/irmin-pack/unix/io_legacy.mli b/src/irmin-pack/unix/io_legacy.mli deleted file mode 100644 index 13251fd978..0000000000 --- a/src/irmin-pack/unix/io_legacy.mli +++ /dev/null @@ -1,17 +0,0 @@ -(* - * Copyright (c) 2018-2022 Tarides - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -include Io_legacy_intf.Sigs diff --git a/src/irmin-pack/unix/io_legacy_intf.ml b/src/irmin-pack/unix/io_legacy_intf.ml deleted file mode 100644 index 098a13f614..0000000000 --- a/src/irmin-pack/unix/io_legacy_intf.ml +++ /dev/null @@ -1,48 +0,0 @@ -(* - * Copyright (c) 2018-2022 Tarides - * - * Permission to use, copy, modify, and distribute this software for any - * purpose with or without fee is hereby granted, provided that the above - * copyright notice and this permission notice appear in all copies. - * - * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES - * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR - * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES - * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN - * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF - * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. - *) - -open! Import - -module type S = sig - type t - type path := string - - val v : version:Version.t option -> fresh:bool -> readonly:bool -> path -> t - val name : t -> string - val append : t -> string -> unit - val set : t -> off:int63 -> string -> unit - val read : t -> off:int63 -> bytes -> int - val read_buffer : t -> off:int63 -> buf:bytes -> len:int -> int - val offset : t -> int63 - val force_offset : t -> int63 - val readonly : t -> bool - val flush : t -> unit - val close : t -> unit - val exists : string -> bool - val size : t -> int - val mkdir : string -> unit - - (* {2 Versioning} *) - - val version : t -> Version.t - val set_version : t -> Version.t -> unit -end - -module type Sigs = sig - module type S = S - - module Unix : S -end diff --git a/src/irmin-pack/unix/irmin_pack_unix.ml b/src/irmin-pack/unix/irmin_pack_unix.ml index 64ce22f394..9aa8edeef0 100644 --- a/src/irmin-pack/unix/irmin_pack_unix.ml +++ b/src/irmin-pack/unix/irmin_pack_unix.ml @@ -43,7 +43,6 @@ module Stats = Stats module Index = Pack_index module Inode = Inode module Pack_store = Pack_store -module Io_legacy = Io_legacy module Checks = Checks module Atomic_write = Atomic_write module Dict = Dict diff --git a/src/irmin-pack/unix/irmin_pack_unix.mli b/src/irmin-pack/unix/irmin_pack_unix.mli index 3ed6a3790a..206ff27ac9 100644 --- a/src/irmin-pack/unix/irmin_pack_unix.mli +++ b/src/irmin-pack/unix/irmin_pack_unix.mli @@ -49,7 +49,6 @@ module Stats = Stats module Index = Pack_index module Inode = Inode module Pack_store = Pack_store -module Io_legacy = Io_legacy module Atomic_write = Atomic_write module Dict = Dict module Dispatcher = Dispatcher diff --git a/src/irmin-pack/unix/store.ml b/src/irmin-pack/unix/store.ml index 8f271c764c..febf48cb85 100644 --- a/src/irmin-pack/unix/store.ml +++ b/src/irmin-pack/unix/store.ml @@ -117,7 +117,7 @@ module Maker (Config : Conf.S) = struct module Branch = struct module Key = B module Val = XKey - module AW = Atomic_write.Make_persistent (Key) (Val) + module AW = Atomic_write.Make_persistent (Io) (Key) (Val) include Atomic_write.Closeable (AW) let v ?fresh ?readonly path = diff --git a/test/irmin-pack/common.ml b/test/irmin-pack/common.ml index 7d601af7d8..fe871416c0 100644 --- a/test/irmin-pack/common.ml +++ b/test/irmin-pack/common.ml @@ -95,8 +95,7 @@ module Pack = (Errs) module Branch = - Irmin_pack_unix.Atomic_write.Make_persistent - (Irmin.Branch.String) + Irmin_pack_unix.Atomic_write.Make_persistent (Io) (Irmin.Branch.String) (Irmin_pack.Atomic_write.Value.Of_hash (Schema.Hash)) module Make_context (Config : sig @@ -112,7 +111,15 @@ struct [%logs.info "Constructing %s context object: %s" object_type name]; name - let mkdir_dash_p dirname = Irmin_pack_unix.Io_legacy.Unix.mkdir dirname + let mkdir_dash_p dirname = + let rec aux dir = + if Sys.file_exists dir && Sys.is_directory dir then () + else ( + if Sys.file_exists dir then Unix.unlink dir; + aux (Filename.dirname dir); + Unix.mkdir dir 0o755) + in + aux dirname type d = { name : string; fm : File_manager.t; dict : Dict.t } diff --git a/test/irmin-pack/test_pack.ml b/test/irmin-pack/test_pack.ml index 8f738acd73..3201e91fa1 100644 --- a/test/irmin-pack/test_pack.ml +++ b/test/irmin-pack/test_pack.ml @@ -418,6 +418,7 @@ end module Branch = struct module Branch = Irmin_pack_unix.Atomic_write.Make_persistent + (Irmin_pack_unix.Io.Unix) (Irmin.Branch.String) (Irmin_pack.Atomic_write.Value.Of_hash (Irmin.Hash.SHA1)) diff --git a/test/irmin-pack/test_pack_version_bump.ml b/test/irmin-pack/test_pack_version_bump.ml index 60e6d3a79c..dba67c5759 100644 --- a/test/irmin-pack/test_pack_version_bump.ml +++ b/test/irmin-pack/test_pack_version_bump.ml @@ -87,7 +87,7 @@ module Util = struct current directory %s and ancestors" v1_store_archive_dir (Sys.getcwd ()) - module Unix_ = Irmin_pack_unix.Io_legacy.Unix + module Unix_ = Irmin_pack_unix.Io.Unix (** Get the version of the underlying file; file is assumed to exist; file is assumed to be an Irmin_pack.IO.Unix file *)