diff --git a/src/irmin-pack/unix/dispatcher.ml b/src/irmin-pack/unix/dispatcher.ml index 7107cbd42e..81028e99fe 100644 --- a/src/irmin-pack/unix/dispatcher.ml +++ b/src/irmin-pack/unix/dispatcher.ml @@ -28,7 +28,7 @@ module Make (Fm : File_manager.S with module Io = Io.Unix) : module Errs = Fm.Errs module Control = Fm.Control - type t = { fm : Fm.t; root : string } + type t = { fm : Fm.t } type location = Prefix | Suffix [@@deriving irmin] type accessor = { poff : int63; len : int; location : location } @@ -40,8 +40,8 @@ module Make (Fm : File_manager.S with module Io = Io.Unix) : [location] is a file identifier. *) - let v ~root fm = - let t = { fm; root } in + let v fm = + let t = { fm } in Ok t let get_prefix t = @@ -250,4 +250,72 @@ module Make (Fm : File_manager.S with module Io = Io.Unix) : let shrink_accessor_exn a ~new_len = if new_len > a.len then failwith "shrink_accessor_exn to larger accessor"; { a with len = new_len } + + let create_sequential_accessor_exn location rem_len ~poff ~len = + if len > rem_len then raise (Errors.Pack_error `Read_out_of_bounds) + else { poff; len; location } + + let create_sequential_accessor_from_range_exn location rem_len ~poff ~min_len + ~max_len = + let len = + if rem_len < min_len then raise (Errors.Pack_error `Read_out_of_bounds) + else if rem_len > max_len then max_len + else rem_len + in + { poff; len; location } + + let create_sequential_accessor_seq t ~min_header_len ~max_header_len ~read_len + = + let preffix_chunks = + match Fm.mapping t.fm with + | Some mapping -> + let preffix_chunks = ref [] in + Mapping_file.iter mapping (fun ~off ~len -> + preffix_chunks := (off, len) :: !preffix_chunks) + |> Errs.raise_if_error; + List.rev !preffix_chunks + | None -> [] + in + let suffix_end_offset = Fm.Suffix.end_offset (Fm.suffix t.fm) in + let entry_offset_suffix_start = entry_offset_suffix_start t in + let get_entry_accessor rem_len location poff = + let accessor = + create_sequential_accessor_from_range_exn location rem_len ~poff + ~min_len:min_header_len ~max_len:max_header_len + in + let buf = Bytes.create max_header_len in + read_exn t accessor buf; + let entry_len = read_len buf in + ( entry_len, + create_sequential_accessor_exn location rem_len ~poff ~len:entry_len ) + in + let rec suffix_accessors poff () = + let open Seq in + let open Int63.Syntax in + if poff >= suffix_end_offset then Nil + else + let rem_len = Int63.to_int (suffix_end_offset - poff) in + let entry_len, accessor = get_entry_accessor rem_len Suffix poff in + let r = (entry_offset_suffix_start + poff, accessor) in + let poff = poff + Int63.of_int entry_len in + let f = suffix_accessors poff in + Cons (r, f) + in + let rec prefix_accessors poff acc () = + let open Seq in + match acc with + | [] -> suffix_accessors Int63.zero () + | (off, rem_len) :: acc -> + if rem_len <= 0 then prefix_accessors poff acc () + else + let entry_len, accessor = get_entry_accessor rem_len Suffix poff in + let r = (off, accessor) in + let rem_len = rem_len - entry_len in + let open Int63.Syntax in + let poff = poff + Int63.of_int entry_len in + let off = off + Int63.of_int entry_len in + let f = prefix_accessors poff ((off, rem_len) :: acc) in + Cons (r, f) + in + prefix_accessors Int63.zero preffix_chunks end diff --git a/src/irmin-pack/unix/dispatcher_intf.ml b/src/irmin-pack/unix/dispatcher_intf.ml index da8ff9cd07..d04241db18 100644 --- a/src/irmin-pack/unix/dispatcher_intf.ml +++ b/src/irmin-pack/unix/dispatcher_intf.ml @@ -31,7 +31,7 @@ module type S = sig finalisation, an accessor could no longer point to a valid area because the GC changes the domain of valid readable areas) *) - val v : root:string -> Fm.t -> (t, [> Fm.Errs.t ]) result + val v : Fm.t -> (t, [> Fm.Errs.t ]) result val create_accessor_exn : t -> off:int63 -> len:int -> accessor (** [create_accessor_exn] returns an accessor if [off] and [len] designate a @@ -50,6 +50,20 @@ module type S = sig (** [shrink_accessor_exn a ~new_len] is [a] where the length is smaller than in [a].*) + val create_sequential_accessor_seq : + t -> + min_header_len:int -> + max_header_len:int -> + read_len:(bytes -> int) -> + (int63 * accessor) Seq.t + (** [create_sequential_accessor_seq ~min_header_len ~max_header_len ~read_len] + returns a sequence of accessors, which simulates iterating sequentially + trough the entries of a pack file. [min_header_len] & [max_header_len] + represents the minimum & maximum lengths required to read the header of an + entry. [read_len] will then be called with a buffer containing the header + of the entry and should return the total length of the entry (the length + of he header plus the length of the payload)*) + val read_exn : t -> accessor -> bytes -> unit (** [read_exn] either reads in the prefix or the suffix file, depending on [accessor]. *) diff --git a/src/irmin-pack/unix/ext.ml b/src/irmin-pack/unix/ext.ml index 8f52c1dd0e..5284e962eb 100644 --- a/src/irmin-pack/unix/ext.ml +++ b/src/irmin-pack/unix/ext.ml @@ -187,7 +187,7 @@ module Maker (Config : Conf.S) = struct | (`File | `Other), _ -> Errs.raise_error (`Not_a_directory root) in let dict = Dict.v fm |> Errs.raise_if_error in - let dispatcher = Dispatcher.v ~root fm |> Errs.raise_if_error in + let dispatcher = Dispatcher.v fm |> Errs.raise_if_error in let contents = Contents.CA.v ~config ~fm ~dict ~dispatcher in let node = Node.CA.v ~config ~fm ~dict ~dispatcher in let commit = Commit.CA.v ~config ~fm ~dict ~dispatcher in diff --git a/src/irmin-pack/unix/gc.ml b/src/irmin-pack/unix/gc.ml index d92f20c108..006b789e90 100644 --- a/src/irmin-pack/unix/gc.ml +++ b/src/irmin-pack/unix/gc.ml @@ -163,7 +163,7 @@ module Worker = struct Fm.close fm |> Errs.log_if_error "GC: Close File_manager") @@ fun () -> let dict = Dict.v fm |> Errs.raise_if_error in - let dispatcher = Dispatcher.v ~root fm |> Errs.raise_if_error in + let dispatcher = Dispatcher.v fm |> Errs.raise_if_error in let node_store = Node_store.v ~config ~fm ~dict ~dispatcher in let commit_store = Commit_store.v ~config ~fm ~dict ~dispatcher in diff --git a/src/irmin-pack/unix/snapshot.ml b/src/irmin-pack/unix/snapshot.ml index 14aec2a9fc..b322591109 100644 --- a/src/irmin-pack/unix/snapshot.ml +++ b/src/irmin-pack/unix/snapshot.ml @@ -60,10 +60,7 @@ module Make (Args : Args) = struct files: suffix and control. We just open the file manager for simplicity. *) let fm = Fm.open_ro config |> Fm.Errs.raise_if_error in - let dispatcher = - let root = Conf.root config in - Dispatcher.v ~root fm |> Fm.Errs.raise_if_error - in + let dispatcher = Dispatcher.v fm |> Fm.Errs.raise_if_error in let log_size = Conf.index_log_size config in { fm; dispatcher; log_size; inode_pack; contents_pack } diff --git a/test/irmin-pack/common.ml b/test/irmin-pack/common.ml index cfcb2b927f..34518368a1 100644 --- a/test/irmin-pack/common.ml +++ b/test/irmin-pack/common.ml @@ -153,7 +153,7 @@ struct let f = ref (fun () -> ()) in let config = config ~readonly ~fresh name in let fm = get_fm config in - let dispatcher = Dispatcher.v ~root:name fm |> Errs.raise_if_error in + let dispatcher = Dispatcher.v fm |> Errs.raise_if_error in (* open the index created by the fm. *) let index = File_manager.index fm in let dict = Dict.v fm |> Errs.raise_if_error in diff --git a/test/irmin-pack/test_inode.ml b/test/irmin-pack/test_inode.ml index 444b3a50e7..271c0a0c67 100644 --- a/test/irmin-pack/test_inode.ml +++ b/test/irmin-pack/test_inode.ml @@ -120,7 +120,7 @@ struct let config = config ~indexing_strategy ~readonly:false ~fresh:true root in let fm = get_fm config in let dict = Dict.v fm |> Errs.raise_if_error in - let dispatcher = Dispatcher.v ~root fm |> Errs.raise_if_error in + let dispatcher = Dispatcher.v fm |> Errs.raise_if_error in let store = Inode.v ~config ~fm ~dict ~dispatcher in let store_contents = Contents_store.v ~config ~fm ~dict ~dispatcher in let+ foo, bar =