irmin-pack: fix v2 lower migration

CHANGES.md

@@ -1,3 +1,10 @@
+## Unreleased
+
+### Fixed
+
+- **irmin-pack**
+  - Fix issue when migrating v2 stores to use lower layer (@metanivek, #2241)
+
 ## 3.7.0 (2023-04-26)
 
 ### Added

src/irmin-pack/unix/file_manager.ml

@@ -568,10 +568,35 @@ struct
       let data = Layout.prefix ~root ~generation in
       Sparse.Ao.create ~mapping ~data >>= Sparse.Ao.close
     in
-    (* Step 4. Update the upper control file. *)
+    (* Step 4. Remove dead header from dict (if needed) *)
+    let* dict_end_poff, after_payload_write =
+      if dead_header_size > 0 then (
+        let dict_path = Layout.dict ~root in
+        let tmp_dict_path = Filename.temp_file ~temp_dir:root "store" "dict" in
+        let* dict_file = Io.open_ ~path:dict_path ~readonly:false in
+        let* len = Io.read_size dict_file in
+        let* tmp_dict_file = Io.open_ ~path:tmp_dict_path ~readonly:false in
+        let contents_len = Int63.to_int len - dead_header_size in
+        let* contents =
+          Io.read_to_string dict_file
+            ~off:(Int63.of_int dead_header_size)
+            ~len:contents_len
+        in
+        Io.write_exn tmp_dict_file ~off:Int63.zero ~len:contents_len contents;
+        let* _ = Io.close dict_file in
+        let* _ = Io.close tmp_dict_file in
+        (* Delay moving the temp file until after the payload is written so
+           that we do not try to remove the dead header twice after a failure. *)
+        Ok
+          ( Int63.of_int contents_len,
+            fun () -> Io.move_file ~src:tmp_dict_path ~dst:dict_path ))
+      else Ok (payload.dict_end_poff, Fun.const (Ok ()))
+    in
+    (* Step 5. Update the upper control file. *)
     let payload =
       {
         payload with
+        dict_end_poff;
         chunk_start_idx;
         appendable_chunk_poff = Int63.zero;
         volume_num = 1;
@@ -587,6 +612,7 @@ struct
       }
     in
     let* () = Control.set_payload control payload in
+    let* () = after_payload_write () in
     Ok payload
 
   let load_payload ~config ~root ~lower_root ~control =

test/irmin-pack/test_lower.ml

@@ -210,6 +210,28 @@ module Store_tc = struct
     | Gced { generation; _ } -> generation
     | _ -> Alcotest.fail "expected gced status"
 
+  (* Reads all objects from the repo by iterating its index and folding its commit trees. *)
+  let read_everything repo =
+    let fm = Store.Internal.file_manager repo in
+    let index = Store.Internal.File_manager.index fm in
+    let commits = ref [] in
+    let () =
+      Store.Internal.Index.iter
+        (fun hash (_offset, _len, kind) ->
+          match kind with
+          | Irmin_pack.Pack_value.Kind.Commit_v2 -> commits := hash :: !commits
+          | _ -> ())
+        index
+    in
+    Lwt_list.map_s
+      (fun hash ->
+        [%log.debug "read %a" Irmin.Type.(pp Store.Hash.t) hash];
+        let* commit = Store.Commit.of_hash repo hash in
+        match commit with
+        | None -> Alcotest.fail "failed to read commit"
+        | Some commit -> Store.Tree.fold (Store.Commit.tree commit) ())
+      !commits
+
   let test_create () =
     let* repo = init () in
     (* A newly created store with a lower should have an empty volume. *)
@@ -307,6 +329,44 @@ module Store_tc = struct
     let previous_tree = Store.Commit.tree @@ Option.get parent in
     let* a_opt = Store.Tree.find previous_tree [ "a" ] in
     Alcotest.(check (option string)) "upper to lower" (Some "a") a_opt;
+    let* _ = read_everything repo in
+    Store.Repo.close repo
+
+  (* Tests that dead header is handled appropriately *)
+  let test_migrate_v2 () =
+    let ( / ) = Filename.concat in
+    let root_archive =
+      "test" / "irmin-pack" / "data" / "version_2_to_3_always"
+    in
+    let root = "_build" / "test_lower_migrate_v2" in
+    setup_test_env ~root_archive ~root_local_build:root;
+    let lower_root = root / "lower" in
+    (* Open store and trigger migration. This should succeed. *)
+    let* repo = Store.Repo.v (config ~fresh:false ~lower_root root) in
+    let* _ = read_everything repo in
+    Store.Repo.close repo
+
+  let test_migrate_v3 () =
+    (* minimal indexing *)
+    let ( / ) = Filename.concat in
+    let root_archive = "test" / "irmin-pack" / "data" / "version_3_minimal" in
+    let root = "_build" / "test_lower_migrate_v3_minimal" in
+    setup_test_env ~root_archive ~root_local_build:root;
+    let lower_root = root / "lower" in
+    (* Open store and trigger migration. This should succeed. *)
+    let* repo = Store.Repo.v (config ~fresh:false ~lower_root root) in
+    let* _ = read_everything repo in
+    let* _ = Store.Repo.close repo in
+
+    (* always indexing *)
+    let ( / ) = Filename.concat in
+    let root_archive = "test" / "irmin-pack" / "data" / "version_3_always" in
+    let root = "_build" / "test_lower_migrate_v3_always" in
+    setup_test_env ~root_archive ~root_local_build:root;
+    let lower_root = root / "lower" in
+    (* Open store and trigger migration. This should succeed. *)
+    let* repo = Store.Repo.v (config ~fresh:false ~lower_root root) in
+    let* _ = read_everything repo in
     Store.Repo.close repo
 
   let test_migrate_then_gc () =
@@ -330,6 +390,7 @@ module Store_tc = struct
     (* GC at [b] requires reading [a] data from the lower volume *)
     let* _ = Store.Gc.start_exn repo (Store.Commit.key b_commit) in
     let* _ = Store.Gc.finalise_exn ~wait:true repo in
+    let* _ = read_everything repo in
     Store.Repo.close repo
 
   let test_volume_data_locality () =
@@ -444,6 +505,8 @@ module Store = struct
         quick_tc "control file updated after add" test_add_volume_reopen;
         quick_tc "add volume and reopen" test_add_volume_reopen;
         quick_tc "create without lower then migrate" test_migrate;
+        quick_tc "migrate v2" test_migrate_v2;
+        quick_tc "migrate v3" test_migrate_v3;
         quick_tc "migrate then gc" test_migrate_then_gc;
         quick_tc "test data locality" test_volume_data_locality;
         quick_tc "test cleanup" test_cleanup;