Check index before using it removing an element from Imperative prior…

…ity queue

The queue uses an Array larger than the current size.
It's possible that code check the index much later returning error but also
setting the queue in an invalid state.
So to avoid structure corruption check the index as soon as possible.

Signed-off-by: Frediano Ziglio <[email protected]>

ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/dune

@@ -1,7 +1,7 @@
 (library
   (public_name xapi-stdext-threads)
   (name  xapi_stdext_threads)
-  (modules :standard \ ipq scheduler threadext_test)
+  (modules :standard \ ipq scheduler threadext_test ipq_test)
   (libraries
     threads.posix
     unix
@@ -16,9 +16,9 @@
   (libraries mtime mtime.clock threads.posix unix xapi-log xapi-stdext-threads)
 )
 
-(test
-  (name threadext_test)
+(tests
+  (names threadext_test ipq_test)
   (package xapi-stdext-threads)
-  (modules threadext_test)
-  (libraries xapi_stdext_threads alcotest mtime.clock.os mtime fmt threads.posix)
+  (modules threadext_test ipq_test)
+  (libraries xapi_stdext_threads alcotest mtime.clock.os mtime fmt threads.posix xapi_stdext_threads_scheduler)
 )

ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/ipq.ml

@@ -64,6 +64,8 @@ let maximum h =
 
 let remove h s =
   if h.size <= 0 then raise EmptyHeap ;
+  if s < 0 || s >= h.size then
+    invalid_arg (Printf.sprintf "%s: index %d out of bounds" __FUNCTION__ s) ;
   let n = h.size - 1 in
   h.size <- n ;
   let d = h.data in

ocaml/libs/xapi-stdext/lib/xapi-stdext-threads/ipq_test.ml

@@ -0,0 +1,40 @@
+(*
+ * Copyright (C) 2024 Cloud Software Group
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+module Ipq = Xapi_stdext_threads_scheduler.Ipq
+
+(* test we get "out of bound" exception calling Ipq.remove *)
+let test_out_of_index () =
+  let q = Ipq.create 10 in
+  Ipq.add q {Ipq.ev= 123; Ipq.time= Mtime_clock.now ()} ;
+  let is_oob = function
+    | Invalid_argument s when String.ends_with ~suffix:"  out of bounds" s ->
+        true
+    | _ ->
+        false
+  in
+  let oob_check n =
+    (Alcotest.match_raises "out of bound" is_oob @@ fun () -> Ipq.remove q n) ;
+    Alcotest.(check bool) "same value" false (Ipq.is_empty q)
+  in
+  oob_check 10 ;
+  oob_check (-1) ;
+  oob_check 9 ;
+  oob_check 1 ;
+  (* this should succeed *)
+  Ipq.remove q 0
+
+let tests = [("test_out_of_index", `Quick, test_out_of_index)]
+
+let () = Alcotest.run "Ipq" [("generic", tests)]