From f4b2060823055e35848337c625c39f93c60d39ce Mon Sep 17 00:00:00 2001 From: metanivek Date: Mon, 23 Jan 2023 11:18:46 -0500 Subject: [PATCH 1/4] irmin-pack: add lower_root config for lower layer --- src/irmin-pack/conf.ml | 10 +++++++++- src/irmin-pack/conf.mli | 5 +++++ src/irmin-pack/irmin_pack_intf.ml | 1 + 3 files changed, 15 insertions(+), 1 deletion(-) diff --git a/src/irmin-pack/conf.ml b/src/irmin-pack/conf.ml index cd887d9c8f..206d438878 100644 --- a/src/irmin-pack/conf.ml +++ b/src/irmin-pack/conf.ml @@ -38,6 +38,7 @@ module Default = struct let dict_auto_flush_threshold = 1_000_000 let suffix_auto_flush_threshold = 1_000_000 let no_migrate = false + let lower_root = None end open Irmin.Backend.Conf @@ -70,6 +71,11 @@ module Key = struct let root = root spec + let lower_root = + key ~spec ~doc:"Optional path for lower layer directory." "lower-root" + Irmin.Type.(option string) + Default.lower_root + let indexing_strategy = let serialisable_t = [%typ: [ `Always | `Minimal ]] in key ~spec ~doc:"Strategy to use for adding objects to the index" @@ -115,6 +121,7 @@ let root config = the store" | Some root -> root +let lower_root config = get config Key.lower_root let indexing_strategy config = get config Key.indexing_strategy let use_fsync config = get config Key.use_fsync let dict_auto_flush_threshold config = get config Key.dict_auto_flush_threshold @@ -131,9 +138,10 @@ let init ?(fresh = Default.fresh) ?(readonly = Default.readonly) ?(use_fsync = Default.use_fsync) ?(dict_auto_flush_threshold = Default.dict_auto_flush_threshold) ?(suffix_auto_flush_threshold = Default.suffix_auto_flush_threshold) - ?(no_migrate = Default.no_migrate) root = + ?(no_migrate = Default.no_migrate) ?(lower_root = Default.lower_root) root = let config = empty spec in let config = add config Key.root root in + let config = add config Key.lower_root lower_root in let config = add config Key.fresh fresh in let config = add config Key.lru_size lru_size in let config = add config Key.index_log_size index_log_size in diff --git a/src/irmin-pack/conf.mli b/src/irmin-pack/conf.mli index 7ccbef02c7..974ac4fdbf 100644 --- a/src/irmin-pack/conf.mli +++ b/src/irmin-pack/conf.mli @@ -74,6 +74,7 @@ module Key : sig val index_log_size : int Irmin.Backend.Conf.key val readonly : bool Irmin.Backend.Conf.key val root : string Irmin.Backend.Conf.key + val lower_root : string option Irmin.Backend.Conf.key val merge_throttle : merge_throttle Irmin.Backend.Conf.key val indexing_strategy : Indexing_strategy.t Irmin.Backend.Conf.key val use_fsync : bool Irmin.Backend.Conf.key @@ -105,6 +106,9 @@ val root : Irmin.Backend.Conf.t -> string Note: The path before the root directory must exist. Only the final directory in the path will be created if it is missing. *) +val lower_root : Irmin.Backend.Conf.t -> string option +(** Optional path for lower layer directory. Default [None]. *) + val indexing_strategy : Irmin.Backend.Conf.t -> Indexing_strategy.t (** Strategy for choosing which objects to index. See {!Indexing_strategy.t} for more discussion. Default {!Indexing_strategy.default} *) @@ -135,6 +139,7 @@ val init : ?dict_auto_flush_threshold:int -> ?suffix_auto_flush_threshold:int -> ?no_migrate:bool -> + ?lower_root:string option -> string -> Irmin.config (** [init root] creates a backend configuration for storing data with default diff --git a/src/irmin-pack/irmin_pack_intf.ml b/src/irmin-pack/irmin_pack_intf.ml index 6ac29ed0c1..cb58765aea 100644 --- a/src/irmin-pack/irmin_pack_intf.ml +++ b/src/irmin-pack/irmin_pack_intf.ml @@ -80,6 +80,7 @@ module type Sigs = sig ?dict_auto_flush_threshold:int -> ?suffix_auto_flush_threshold:int -> ?no_migrate:bool -> + ?lower_root:string option -> string -> Irmin.config (** Configuration options for stores. See {!Irmin_pack.Conf} for more details. *) From 7197e8c8f6f73d6ca0b9f6d69f63119731b52645 Mon Sep 17 00:00:00 2001 From: metanivek Date: Mon, 23 Jan 2023 11:35:40 -0500 Subject: [PATCH 2/4] irmin-pack: validate lower_root --- src/irmin-pack/unix/store.ml | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/irmin-pack/unix/store.ml b/src/irmin-pack/unix/store.ml index a90ca6401a..1c138d2e32 100644 --- a/src/irmin-pack/unix/store.ml +++ b/src/irmin-pack/unix/store.ml @@ -170,6 +170,21 @@ module Maker (Config : Conf.S) = struct let v config = let root = Irmin_pack.Conf.root config in + let _lower_path = + (* Validate lower layer root directory. + + TODO: The value is a placeholder which will be used + in subsequent chagnes. *) + let lower_root = Irmin_pack.Conf.lower_root config in + match lower_root with + | None -> None + | Some path -> ( + match Io.classify_path path with + | `Directory -> Some path + | `No_such_file_or_directory -> + Errs.raise_error `No_such_file_or_directory + | `File | `Other -> Errs.raise_error (`Not_a_directory path)) + in let fm = let readonly = Irmin_pack.Conf.readonly config in if readonly then File_manager.open_ro config |> Errs.raise_if_error From eaf725d836563fb056df56c57b8d60110673d0a3 Mon Sep 17 00:00:00 2001 From: metanivek Date: Mon, 23 Jan 2023 16:13:39 -0500 Subject: [PATCH 3/4] irmin-pack: add path to No_such_file_or_directory To give context in logs when this error is triggered. --- src/irmin-pack/unix/control_file_intf.ml | 2 +- src/irmin-pack/unix/errors.ml | 2 +- src/irmin-pack/unix/file_manager.ml | 12 ++++++------ src/irmin-pack/unix/file_manager_intf.ml | 6 +++--- src/irmin-pack/unix/io.ml | 10 ++++++---- src/irmin-pack/unix/io_errors.ml | 2 +- src/irmin-pack/unix/io_intf.ml | 10 +++++++--- src/irmin-pack/unix/mapping_file.ml | 2 +- src/irmin-pack/unix/mapping_file_intf.ml | 2 +- src/irmin-pack/unix/store.ml | 2 +- test/irmin-pack/common.ml | 24 +++++++++++++++++++++--- test/irmin-pack/common.mli | 7 +++++++ test/irmin-pack/test_gc.ml | 7 +++---- test/irmin-pack/test_upgrade.ml | 5 ++++- 14 files changed, 63 insertions(+), 30 deletions(-) diff --git a/src/irmin-pack/unix/control_file_intf.ml b/src/irmin-pack/unix/control_file_intf.ml index b512979e4f..f282bbde4b 100644 --- a/src/irmin-pack/unix/control_file_intf.ml +++ b/src/irmin-pack/unix/control_file_intf.ml @@ -210,7 +210,7 @@ module type S = sig type open_error := [ `Corrupted_control_file | `Io_misc of Io.misc_error - | `No_such_file_or_directory + | `No_such_file_or_directory of string | `Not_a_file | `Closed | `Unknown_major_pack_version of string ] diff --git a/src/irmin-pack/unix/errors.ml b/src/irmin-pack/unix/errors.ml index f2ebbdcf84..d54c09d79b 100644 --- a/src/irmin-pack/unix/errors.ml +++ b/src/irmin-pack/unix/errors.ml @@ -38,7 +38,7 @@ type base_error = [ `Double_close | `File_exists of string | `Invalid_parent_directory - | `No_such_file_or_directory + | `No_such_file_or_directory of string | `Not_a_file | `Read_out_of_bounds | `Invalid_argument diff --git a/src/irmin-pack/unix/file_manager.ml b/src/irmin-pack/unix/file_manager.ml index aa43324dac..10a2a32dfe 100644 --- a/src/irmin-pack/unix/file_manager.ml +++ b/src/irmin-pack/unix/file_manager.ml @@ -598,7 +598,7 @@ struct let no_migrate = Irmin_pack.Conf.no_migrate config in match Io.classify_path root with | `File | `Other -> Error (`Not_a_directory root) - | `No_such_file_or_directory -> Error `No_such_file_or_directory + | `No_such_file_or_directory -> Error (`No_such_file_or_directory root) | `Directory -> ( let path = Irmin_pack.Layout.V4.control ~root in match Io.classify_path path with @@ -621,11 +621,11 @@ struct Control.open_ ~readonly:true ~path (* If no control file, then check whether the store is in v1 or v2. *) |> Result.map_error (function - | `No_such_file_or_directory -> ( + | `No_such_file_or_directory _ -> ( let pack = Irmin_pack.Layout.V1_and_v2.pack ~root in match Io.classify_path pack with | `File -> `Migration_needed - | `No_such_file_or_directory -> `No_such_file_or_directory + | `No_such_file_or_directory -> `No_such_file_or_directory pack | `Directory | `Other -> `Invalid_layout) | error -> error) in @@ -693,20 +693,20 @@ struct | Ok v -> Ok v | Error `Double_close | Error `Invalid_argument | Error `Closed -> assert false - | Error `No_such_file_or_directory -> Error `Invalid_layout + | Error (`No_such_file_or_directory _) -> Error `Invalid_layout | Error `Not_a_file -> Error `Invalid_layout | Error `Corrupted_legacy_file | Error `Read_out_of_bounds -> Error `Corrupted_legacy_file | Error (`Io_misc _) as e -> e in match Io.classify_path root with - | `No_such_file_or_directory -> Error `No_such_file_or_directory + | `No_such_file_or_directory -> Error (`No_such_file_or_directory root) | `File | `Other -> Error (`Not_a_directory root) | `Directory -> ( let path = Irmin_pack.Layout.V4.control ~root in match Control.open_ ~path ~readonly:true with | Ok _ -> Ok `V3 - | Error `No_such_file_or_directory -> v2_or_v1 () + | Error (`No_such_file_or_directory _) -> v2_or_v1 () | Error `Not_a_file -> Error `Invalid_layout | Error `Closed -> assert false | Error diff --git a/src/irmin-pack/unix/file_manager_intf.ml b/src/irmin-pack/unix/file_manager_intf.ml index 215a44fe4e..24064e673d 100644 --- a/src/irmin-pack/unix/file_manager_intf.ml +++ b/src/irmin-pack/unix/file_manager_intf.ml @@ -110,7 +110,7 @@ module type S = sig | `Invalid_layout | `Io_misc of Control.Io.misc_error | `Migration_needed - | `No_such_file_or_directory + | `No_such_file_or_directory of string | `Not_a_directory of string | `Not_a_file | `Read_out_of_bounds @@ -148,7 +148,7 @@ module type S = sig | `Corrupted_mapping_file of string | `Io_misc of Io.misc_error | `Migration_needed - | `No_such_file_or_directory + | `No_such_file_or_directory of string | `Not_a_file | `Closed | `V3_store_from_the_future @@ -227,7 +227,7 @@ module type S = sig | `Corrupted_legacy_file | `Invalid_layout | `Io_misc of Io.misc_error - | `No_such_file_or_directory + | `No_such_file_or_directory of string | `Not_a_directory of string | `Unknown_major_pack_version of string ] diff --git a/src/irmin-pack/unix/io.ml b/src/irmin-pack/unix/io.ml index 2c4d44f9fe..8da1597179 100644 --- a/src/irmin-pack/unix/io.ml +++ b/src/irmin-pack/unix/io.ml @@ -61,7 +61,9 @@ module Unix = struct type create_error = [ `Io_misc of misc_error | `File_exists of string ] type open_error = - [ `Io_misc of misc_error | `No_such_file_or_directory | `Not_a_file ] + [ `Io_misc of misc_error + | `No_such_file_or_directory of string + | `Not_a_file ] type read_error = [ `Io_misc of misc_error @@ -75,7 +77,7 @@ module Unix = struct type mkdir_error = [ `Io_misc of misc_error | `File_exists of string - | `No_such_file_or_directory + | `No_such_file_or_directory of string | `Invalid_parent_directory ] let raise_misc_error (x, y, z) = raise (Unix.Unix_error (x, y, z)) @@ -135,7 +137,7 @@ module Unix = struct let open_ ~path ~readonly = match classify_path path with | `Directory | `Other -> Error `Not_a_file - | `No_such_file_or_directory -> Error `No_such_file_or_directory + | `No_such_file_or_directory -> Error (`No_such_file_or_directory path) | `File -> ( let mode = Unix.(if readonly then O_RDONLY else O_RDWR) in try @@ -282,7 +284,7 @@ module Unix = struct with Unix.Unix_error (e, s1, s2) -> Error (`Io_misc (e, s1, s2))) | `Directory, (`File | `Directory | `Other) -> Error (`File_exists path) | `No_such_file_or_directory, `No_such_file_or_directory -> - Error `No_such_file_or_directory + Error (`No_such_file_or_directory path) | _ -> Error `Invalid_parent_directory let unlink path = diff --git a/src/irmin-pack/unix/io_errors.ml b/src/irmin-pack/unix/io_errors.ml index 651586dc4d..be08ba8397 100644 --- a/src/irmin-pack/unix/io_errors.ml +++ b/src/irmin-pack/unix/io_errors.ml @@ -39,7 +39,7 @@ module Make (Io : Io.S) : S with module Io = Io = struct [ `Double_close | `File_exists of string | `Invalid_parent_directory - | `No_such_file_or_directory + | `No_such_file_or_directory of string | `Not_a_file | `Read_out_of_bounds | `Invalid_argument diff --git a/src/irmin-pack/unix/io_intf.ml b/src/irmin-pack/unix/io_intf.ml index 23e4ac77f5..933f493452 100644 --- a/src/irmin-pack/unix/io_intf.ml +++ b/src/irmin-pack/unix/io_intf.ml @@ -38,7 +38,9 @@ module type S = sig type create_error = [ `Io_misc of misc_error | `File_exists of string ] type open_error = - [ `Io_misc of misc_error | `No_such_file_or_directory | `Not_a_file ] + [ `Io_misc of misc_error + | `No_such_file_or_directory of string + | `Not_a_file ] type read_error = [ `Io_misc of misc_error @@ -52,7 +54,7 @@ module type S = sig type mkdir_error = [ `Io_misc of misc_error | `File_exists of string - | `No_such_file_or_directory + | `No_such_file_or_directory of string | `Invalid_parent_directory ] (** {1 Safe Functions} @@ -105,7 +107,9 @@ module type S = sig val size_of_path : string -> ( int63, - [> `Io_misc of misc_error | `No_such_file_or_directory | `Not_a_file ] ) + [> `Io_misc of misc_error + | `No_such_file_or_directory of string + | `Not_a_file ] ) result val classify_path : diff --git a/src/irmin-pack/unix/mapping_file.ml b/src/irmin-pack/unix/mapping_file.ml index 26c1be1c64..2955b446d8 100644 --- a/src/irmin-pack/unix/mapping_file.ml +++ b/src/irmin-pack/unix/mapping_file.ml @@ -160,7 +160,7 @@ module Make (Io : Io.S) = struct (`Corrupted_mapping_file (__FILE__ ^ ": mapping mmap size did not meet size requirements")) ) - | _ -> Error `No_such_file_or_directory + | _ -> Error (`No_such_file_or_directory path) let create ?report_mapping_size ~root ~generation ~register_entries () = assert (generation > 0); diff --git a/src/irmin-pack/unix/mapping_file_intf.ml b/src/irmin-pack/unix/mapping_file_intf.ml index 23ec900a04..c3d19980cc 100644 --- a/src/irmin-pack/unix/mapping_file_intf.ml +++ b/src/irmin-pack/unix/mapping_file_intf.ml @@ -31,7 +31,7 @@ module type S = sig module Errs : Io_errors.S with module Io = Io type open_error := - [ `Corrupted_mapping_file of string | `No_such_file_or_directory ] + [ `Corrupted_mapping_file of string | `No_such_file_or_directory of string ] val create : ?report_mapping_size:(int63 -> unit) -> diff --git a/src/irmin-pack/unix/store.ml b/src/irmin-pack/unix/store.ml index 1c138d2e32..5f2abb2a42 100644 --- a/src/irmin-pack/unix/store.ml +++ b/src/irmin-pack/unix/store.ml @@ -182,7 +182,7 @@ module Maker (Config : Conf.S) = struct match Io.classify_path path with | `Directory -> Some path | `No_such_file_or_directory -> - Errs.raise_error `No_such_file_or_directory + Errs.raise_error (`No_such_file_or_directory path) | `File | `Other -> Errs.raise_error (`Not_a_directory path)) in let fm = diff --git a/test/irmin-pack/common.ml b/test/irmin-pack/common.ml index f4fbe6d8ac..f3a007a1fa 100644 --- a/test/irmin-pack/common.ml +++ b/test/irmin-pack/common.ml @@ -179,11 +179,29 @@ module Alcotest = struct let int63 = testable Int63.pp Int63.equal + let check_raises_pack_error msg pass f = + Lwt.try_bind f + (fun _ -> + Alcotest.failf + "Fail %s: expected function to raise, but it returned instead." msg) + (function + | Irmin_pack_unix.Errors.Pack_error e as exn -> ( + match pass e with + | true -> Lwt.return_unit + | false -> + Alcotest.failf + "Fail %s: function raised unexpected exception %s" msg + (Printexc.to_string exn)) + | exn -> + Alcotest.failf + "Fail %s: expected function to raise Pack_error, but it raised \ + %s instead" + msg (Printexc.to_string exn)) + (** TODO: upstream this to Alcotest *) let check_raises_lwt msg exn (type a) (f : unit -> a Lwt.t) = - Lwt.catch - (fun x -> - let* (_ : a) = f x in + Lwt.try_bind f + (fun _ -> Alcotest.failf "Fail %s: expected function to raise %s, but it returned instead." msg (Printexc.to_string exn)) diff --git a/test/irmin-pack/common.mli b/test/irmin-pack/common.mli index be4aec4d48..658e7c46d4 100644 --- a/test/irmin-pack/common.mli +++ b/test/irmin-pack/common.mli @@ -53,6 +53,13 @@ module Alcotest : sig val int63 : Int63.t testable val kind : Irmin_pack.Pack_value.Kind.t testable val hash : Schema.Hash.t testable + + val check_raises_pack_error : + string -> + (Irmin_pack_unix.Errors.base_error -> bool) -> + (unit -> _ Lwt.t) -> + unit Lwt.t + val check_raises_lwt : string -> exn -> (unit -> _ Lwt.t) -> unit Lwt.t val check_repr : diff --git a/test/irmin-pack/test_gc.ml b/test/irmin-pack/test_gc.ml index 16a971ed06..84ee49fbc9 100644 --- a/test/irmin-pack/test_gc.ml +++ b/test/irmin-pack/test_gc.ml @@ -874,10 +874,9 @@ module Concurrent_gc = struct let killed = kill_gc t in let* () = if killed then - Alcotest.check_raises_lwt "Gc process killed" - (Irmin_pack_unix.Errors.Pack_error - (`Gc_process_died_without_result_file - "cancelled \"No_such_file_or_directory\"")) + Alcotest.check_raises_pack_error "Gc process killed" + (function + | `Gc_process_died_without_result_file _ -> true | _ -> false) (fun () -> finalise_gc t) else Lwt.return_unit in diff --git a/test/irmin-pack/test_upgrade.ml b/test/irmin-pack/test_upgrade.ml index 1391b47b5d..0fe12da749 100644 --- a/test/irmin-pack/test_upgrade.ml +++ b/test/irmin-pack/test_upgrade.ml @@ -589,7 +589,10 @@ let open_ro t current_phase = let+ repo = match (t.setup.start_mode, current_phase) with | From_scratch, S1_before_start -> - fail_and_skip `No_such_file_or_directory + let missing_path = + Irmin_pack.Layout.V1_and_v2.pack ~root:root_local_build + in + fail_and_skip (`No_such_file_or_directory missing_path) | From_v2, S1_before_start -> fail_and_skip `Migration_needed | (From_v2 | From_v3 | From_v3_c0_gced | From_scratch), _ -> Store.v t.setup ~readonly:true ~fresh:false root_local_build From 7d39a58f21d58291c7056f0edd62ad1c130c1722 Mon Sep 17 00:00:00 2001 From: metanivek Date: Fri, 27 Jan 2023 11:43:24 -0500 Subject: [PATCH 4/4] Add changes entry for lower_root --- CHANGES.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index f7f90c635f..363fad412d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,11 @@ ## Unreleased +### Added + +- **irmin-pack** + - Add configuration option, `lower_root`, to specify a path for archiving data + during a GC. (#2177, @metanivek) + ### Changed - **irmin-pack**