Repository: mirage/ocaml-tar
Pull request #109 (2023-02-07 17:35:18)

Prepare v2.3.0 release


Patch:
diff --git a/CHANGES.md b/CHANGES.md
index 8816fe7..5514ffd 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,7 @@
+## v2.3.0 (2023-02-09)
+
+- `tar-mirage`: implement mirage-kv.6.0.0 (@reynir, @hannesm)
+
 ## v2.2.2 (2022-12-12)
 
 - `tar-mirage`: fix writing of data when data+tar header is a multiple of `sector_size` greater than 1 (@reynir, review by @hannesm, #100)
diff --git a/dune-project b/dune-project
index 49071d8..6085eb1 100644
--- a/dune-project
+++ b/dune-project
@@ -72,7 +72,7 @@
   optint
   ptime
   (tar (= :version))
-  (mirage-block-unix (and :with-test (>= 2.5.0)))
+  (mirage-block-unix (and :with-test (>= 2.13.0)))
   (mirage-clock-unix :with-test)
   (ounit2 :with-test)
   (ounit2-lwt :with-test)
diff --git a/mirage/tar_mirage.ml b/mirage/tar_mirage.ml
index 75a270d..756d48c 100644
--- a/mirage/tar_mirage.ml
+++ b/mirage/tar_mirage.ml
@@ -496,20 +496,20 @@ module Make_KV_RW (CLOCK : Mirage_clock.PCLOCK) (BLOCK : Mirage_block.S) = struc
         | Ok (Value (hdr, start_block)) ->
           (* We can only easily remove if the key is the very last entry. *)
           let open Int64 in
-          let end_bytes =
+          let end_data_bytes =
             add (mul start_block 512L)
               (add hdr.file_size (of_int (Tar.Header.compute_zero_padding_length hdr)))
           in
-          if equal end_bytes (sub t.end_of_archive 1024L) then begin
+          if equal end_data_bytes (sub t.end_of_archive 1024L) then begin
             t.map <- update_remove t.map key;
             let start_bytes = mul (pred start_block) 512L in
             let sector_size = of_int t.info.sector_size in
             let start_sector, start_sector_offset =
               div start_bytes sector_size, rem start_bytes sector_size
             in
+            let end_bytes = add start_bytes 1024L in
             let end_sector, last_sector_offset =
-              let end_bytes = add start_bytes 1024L in
-              div (add end_bytes (pred sector_size)) sector_size, rem start_bytes sector_size
+              div (add end_bytes (pred sector_size)) sector_size, rem end_bytes sector_size
             in
             let buf = Cstruct.create (to_int (mul sector_size (sub end_sector start_sector))) in
             let first_sector = Cstruct.sub buf 0 t.info.sector_size in
@@ -525,13 +525,13 @@ module Make_KV_RW (CLOCK : Mirage_clock.PCLOCK) (BLOCK : Mirage_block.S) = struc
             (* To remove as robustly as possible we first zero the second
                sector (if applicable). *)
             begin if Cstruct.length buf > t.info.sector_size then
-                write t start_sector
+                write t (succ start_sector)
                   [Cstruct.sub buf t.info.sector_size t.info.sector_size] >>>= fun () ->
                 write t start_sector [Cstruct.sub buf 0 t.info.sector_size]
               else
                 write t start_sector [buf]
             end >>>= fun () ->
-            t.end_of_archive <- mul 512L (pred start_block);
+            t.end_of_archive <- end_bytes;
             Lwt_result.return ()
           end else
             Lwt.return (Error `Append_only))


Test patch:
diff --git a/lib_test/write_test.ml b/lib_test/write_test.ml
index a719232..c2bf35b 100644
--- a/lib_test/write_test.ml
+++ b/lib_test/write_test.ml
@@ -125,6 +125,18 @@ module Test(B : BLOCK) = struct
     KV_RW.remove t first >>=
     kv_rw_write_error
 
+  let set_after_remove test_ctxt =
+    let first = Mirage_kv.Key.v "first" and second = Mirage_kv.Key.v "second" in
+    connect_block test_ctxt >>= fun b ->
+    resize b 10240L >>= fun () ->
+    KV_RW.connect b >>= fun t ->
+    KV_RW.set t first "Some data\n" >>=
+    kv_rw_write_error >>= fun () ->
+    KV_RW.remove t first >>=
+    kv_rw_write_error >>= fun () ->
+    KV_RW.set t second "More data\n" >>=
+    kv_rw_write_error
+
   let allocate_doesn't_affect_beyond_end_of_archive data_size ctx =
     let first = Mirage_kv.Key.v "first" in
     connect_block ctx >>= fun b ->
@@ -183,6 +195,7 @@ module Test(B : BLOCK) = struct
       "write two files remove first" >:: write_two_files_remove_first;
       "write two files remove second" >:: write_two_files_remove_second;
       "remove odd sized file" >:: remove_odd_file;
+      "set after remove" >:: set_after_remove;
       "allocate doesn't affect tail after archive 0" >:: allocate_doesn't_affect_beyond_end_of_archive 0;
       "allocate doesn't affect tail after archive 1" >:: allocate_doesn't_affect_beyond_end_of_archive 1;
       "allocate doesn't affect tail after archive 1 sector" >:: allocate_doesn't_affect_beyond_end_of_archive (B.sector_size - 512);