zerocheck: fix +2 GiB issue, add tests (#6721)

The issue was that the 61-bit ocaml value was being truncated to 32
bits.

Author: psafont

ocaml/idl/datamodel_lifecycle.ml

@@ -226,7 +226,9 @@ let prototyped_of_message = function
   | "VTPM", "create" ->
       Some "22.26.0"
   | "host", "update_firewalld_service_status" ->
-      Some "25.30.0-next"
+      Some "25.33.0-next"
+  | "host", "get_tracked_user_agents" ->
+      Some "25.33.0-next"
   | "host", "set_ssh_auto_mode" ->
       Some "25.27.0"
   | "host", "set_console_idle_timeout" ->

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

@@ -1,5 +1,13 @@
 (library
   (public_name xapi-stdext-zerocheck)
   (name xapi_stdext_zerocheck)
+  (modules :standard \ zerocheck_test)
   (foreign_stubs (language c) (names zerocheck_stub))
 )
+
+(test
+  (name zerocheck_test)
+  (package xapi-stdext-zerocheck)
+  (modules zerocheck_test)
+  (libraries alcotest xapi-stdext-zerocheck)
+)

ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.ml

@@ -11,4 +11,7 @@
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU Lesser General Public License for more details.
  *)
-external is_all_zeros : string -> int -> bool = "is_all_zeros"
+
+external is_all_zeros_in_length : string -> int -> bool = "is_all_zeros"
+
+let is_all_zeros str = is_all_zeros_in_length str (String.length str)

ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck.mli

@@ -12,5 +12,5 @@
  * GNU Lesser General Public License for more details.
  *)
 
-external is_all_zeros : string -> int -> bool = "is_all_zeros"
-(** [is_all_zeroes x len] returns true if the substring is all zeroes *)
+val is_all_zeros : string -> bool
+(** [is_all_zeroes x] returns whether [x] contains only zeroes *)

ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck_stub.c

@@ -23,9 +23,9 @@ value is_all_zeros(value string, value length)
 {
 	CAMLparam2(string, length);
 	const char *s = String_val(string);
-	unsigned int *p;
-	int len = Int_val(length);
-	int i;
+	unsigned const int *p;
+	long len = Long_val(length);
+	long i;
 
 	p = (unsigned int *) s;
 	for (i = len / 4; i > 0; i--)

ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck_test.ml

@@ -0,0 +1,43 @@
+(* Copyright (C) 2025 Vates
+
+   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 Zerocheck = Xapi_stdext_zerocheck.Zerocheck
+
+module Str = struct
+  let big_non_zero =
+    let spec = [("2 GiBs", 2_147_483_647); ("2 GiBs + 1", 2147483647 + 1)] in
+    let test size () =
+      let non_zeroes = Bytes.make size '\x00' in
+      Bytes.set non_zeroes (size - 1) '\x01' ;
+      let non_zeroes = Bytes.unsafe_to_string non_zeroes in
+      let expected = true in
+      let actual = not (Zerocheck.is_all_zeros non_zeroes) in
+      Alcotest.(check bool) "The last byte is not zero" expected actual
+    in
+    List.map (fun (name, size) -> (name, `Quick, test size)) spec
+
+  let big_zero =
+    let test () =
+      let size = 2147483647 + 1 in
+      let zeroes = String.make size '\x00' in
+      let expected = true in
+      let actual = Zerocheck.is_all_zeros zeroes in
+      Alcotest.(check bool) "All bytes are zero" expected actual
+    in
+    [("2 GiBs + 1", `Quick, test)]
+
+  let tests =
+    [("String: Not all zeroes", big_non_zero); ("String: all zeroes", big_zero)]
+end
+
+let () = Alcotest.run "Zerocheck" Str.tests

ocaml/libs/xapi-stdext/lib/xapi-stdext-zerocheck/zerocheck_test.mli

@@ -295,13 +295,9 @@ let send_all refresh_session ofd ~__context rpc session_id
                   in
                   Unixext.really_read ifd buffer 0 this_chunk ;
                   if
-                    (not
-                       (Zerocheck.is_all_zeros
-                          (Bytes.unsafe_to_string buffer)
-                          this_chunk
-                       )
-                    )
-                    || first_or_last
+                    first_or_last
+                    || not
+                         (Zerocheck.is_all_zeros (Bytes.unsafe_to_string buffer))
                   then (
                     last_transmission_time := now ;
                     write_block ~__context filename buffer ofd this_chunk