libguestfs/0003-Update-common-submodule.patch

From c4ebeee5053a2f4ac87968121c29b64a596d42aa Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Sun, 11 May 2025 12:37:23 +0100
Subject: [PATCH] Update common submodule

Pull in these commits which require minor changes:

  Richard W.M. Jones (3):
      mlstdutils: Remove Std_utils.identity
      mlstdutils: Remove Std_utils.protect
      mlstdutils: Remove List.filter_map
---
 common                  | 2 +-
 daemon/btrfs.ml         | 4 ++--
 daemon/cryptsetup.ml    | 2 +-
 daemon/filearch.ml      | 2 +-
 daemon/inspect_utils.ml | 6 +++---
 daemon/sfdisk.ml        | 2 +-
 6 files changed, 9 insertions(+), 9 deletions(-)

Submodule common 4c7ae1581..3a05f1a7a:
diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index 159fc4a..39b5bc9 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -58,13 +58,6 @@ module List = struct
       | [x] -> x
       | _ :: xs -> last xs
 
-    let rec filter_map f = function
-      | [] -> []
-      | x :: xs ->
-          match f x with
-          | Some y -> y :: filter_map f xs
-          | None -> filter_map f xs
-
     let rec find_map f = function
       | [] -> raise Not_found
       | x :: xs ->
@@ -463,8 +456,6 @@ let ( /^ ) = Int64.div
 let ( &^ ) = Int64.logand
 let ( ~^ ) = Int64.lognot
 
-external identity : 'a -> 'a = "%identity"
-
 let roundup64 i a = let a = a -^ 1L in (i +^ a) &^ (~^ a)
 let div_roundup64 i a = (i +^ a -^ 1L) /^ a
 
@@ -628,13 +619,6 @@ let unique = let i = ref 0 in fun () -> incr i; !i
 
 type ('a, 'b) maybe = Either of 'a | Or of 'b
 
-let protect ~f ~finally =
-  let r =
-    try Either (f ())
-    with exn -> Or exn in
-  finally ();
-  match r with Either ret -> ret | Or exn -> raise exn
-
 type 'a return = { return: 'b. 'a -> 'b } [@@unboxed]
 let with_return (type a) f =
   let exception Return of a in
@@ -691,15 +675,15 @@ let wrap () = !wrap
 
 let with_open_in filename f =
   let chan = open_in filename in
-  protect ~f:(fun () -> f chan) ~finally:(fun () -> close_in chan)
+  Fun.protect (fun () -> f chan) ~finally:(fun () -> close_in chan)
 
 let with_open_out filename f =
   let chan = open_out filename in
-  protect ~f:(fun () -> f chan) ~finally:(fun () -> close_out chan)
+  Fun.protect (fun () -> f chan) ~finally:(fun () -> close_out chan)
 
 let with_openfile filename flags perms f =
   let fd = Unix.openfile filename flags perms in
-  protect ~f:(fun () -> f fd) ~finally:(fun () -> Unix.close fd)
+  Fun.protect (fun () -> f fd) ~finally:(fun () -> Unix.close fd)
 
 let read_whole_file path =
   let buf = Buffer.create 16384 in
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index 2526100..04c780a 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -31,6 +31,7 @@ module List : sig
     val map : ('a -> 'b) -> 'a list -> 'b list
     val mapi : (int -> 'a -> 'b) -> 'a list -> 'b list
     val rev_map : ('a -> 'b) -> 'a list -> 'b list
+    val filter_map : ('a -> 'b option) -> 'a list -> 'b list
     val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
     val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
     val iter2 : ('a -> 'b -> unit) -> 'a list -> 'b list -> unit
@@ -90,9 +91,6 @@ module List : sig
 
         @raise Invalid_argument if the list is empty *)
 
-    val filter_map : ('a -> 'b option) -> 'a list -> 'b list
-    (** [filter_map f xs] applies [f] to each element of [xs].  If
-        [f x] returns [Some y] then [y] is added to the returned list. *)
     val find_map : ('a -> 'b option) -> 'a list -> 'b
     (** [find_map f xs] applies [f] to each element of [xs] until
         [f x] returns [Some y].  It returns [y].  If we exhaust the
@@ -331,8 +329,6 @@ val ( &^ ) : int64 -> int64 -> int64
 val ( ~^ ) : int64 -> int64
 (** Various int64 operators. *)
 
-external identity : 'a -> 'a = "%identity"
-
 val roundup64 : int64 -> int64 -> int64
 (** [roundup64 i a] returns [i] rounded up to the next multiple of [a]. *)
 val div_roundup64 : int64 -> int64 -> int64
@@ -371,18 +367,6 @@ val unique : unit -> int
 type ('a, 'b) maybe = Either of 'a | Or of 'b
 (** Like the Haskell [Either] type. *)
 
-val protect : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a
-(** Execute [~f] and afterwards execute [~finally].
-
-    If [~f] throws an exception then [~finally] is run and the
-    original exception from [~f] is re-raised.
-
-    If [~finally] throws an exception, then the original exception
-    is lost. (NB: Janestreet core {!Exn.protectx}, on which this
-    function is modelled, doesn't throw away the exception in this
-    case, but requires a lot more work by the caller.  Perhaps we
-    will change this in future.) *)
-
 type 'a return = { return: 'b. 'a -> 'b } [@@unboxed]
 val with_return : ('a return -> 'a) -> 'a
 (** {v
diff --git a/common/mlstdutils/std_utils_tests.ml b/common/mlstdutils/std_utils_tests.ml
index abe842b..10046bd 100644
--- a/common/mlstdutils/std_utils_tests.ml
+++ b/common/mlstdutils/std_utils_tests.ml
@@ -40,7 +40,7 @@ let assert_raises exn fn =
     )
 
 let assert_equal_string =
-  assert_equal ~printer:identity
+  assert_equal ~printer:Fun.id
 let assert_equal_int =
   assert_equal ~printer:(fun x -> string_of_int x)
 let assert_equal_int64 =
diff --git a/common/mlutils/c_utils_unit_tests.ml b/common/mlutils/c_utils_unit_tests.ml
index 961dac5..50c7e44 100644
--- a/common/mlutils/c_utils_unit_tests.ml
+++ b/common/mlutils/c_utils_unit_tests.ml
@@ -42,7 +42,7 @@ let assert_raises exn fn =
 
 (* Test drive_name function. *)
 let () =
-  let printer = identity in
+  let printer = Fun.id in
   assert_equal ~printer "a" (drive_name 0);
   assert_equal ~printer "z" (drive_name 25);
   assert_equal ~printer "aa" (drive_name 26);
@@ -74,7 +74,7 @@ let () =
 
 (* Test shell_unquote function. *)
 let () =
-  let printer = identity in
+  let printer = Fun.id in
   assert_equal ~printer "a" (shell_unquote "a");
   assert_equal ~printer "b" (shell_unquote "'b'");
   assert_equal ~printer "c" (shell_unquote "\"c\"");
diff --git a/daemon/btrfs.ml b/daemon/btrfs.ml
index 3f9d8308a..35e0b1765 100644
--- a/daemon/btrfs.ml
+++ b/daemon/btrfs.ml
@@ -48,7 +48,7 @@ let rec with_mounted mountable f =
       rmdir tmpdir
     in
 
-    protect ~finally ~f:(fun () -> mount_cmd tmpdir; f tmpdir)
+    Fun.protect ~finally (fun () -> mount_cmd tmpdir; f tmpdir)
   in
 
   match mountable.m_type with
@@ -124,4 +124,4 @@ let btrfs_subvolume_get_default mountable =
     with_mounted mountable (
       fun mp -> command "btrfs" ["subvolume"; "get-default"; mp]
     ) in
-  sscanf out "ID %Ld" identity
+  sscanf out "ID %Ld" Fun.id
diff --git a/daemon/cryptsetup.ml b/daemon/cryptsetup.ml
index ac2cf066e..9c0149b48 100644
--- a/daemon/cryptsetup.ml
+++ b/daemon/cryptsetup.ml
@@ -56,7 +56,7 @@ let cryptsetup_open ?(readonly = false) ?crypttype ?cipher device key mapname =
   Option.iter (fun s -> List.push_back_list args ["--cipher"; s]) cipher;
 
   (* Make sure we always remove the temporary file. *)
-  protect ~f:(fun () -> ignore (command "cryptsetup" !args))
+  Fun.protect (fun () -> ignore (command "cryptsetup" !args))
     ~finally:(fun () -> unlink keyfile);
 
   udev_settle ()
diff --git a/daemon/filearch.ml b/daemon/filearch.ml
index 6eed7d396..f45392b5f 100644
--- a/daemon/filearch.ml
+++ b/daemon/filearch.ml
@@ -116,7 +116,7 @@ and cpio_arch magic orig_path path =
   let tmpdir = Mkdtemp.temp_dir "filearch" in
   let finally () = ignore (Sys.command (sprintf "rm -rf %s" (quote tmpdir))) in
 
-  protect ~finally ~f:(
+  Fun.protect ~finally (
     fun () ->
       (* Construct a command to extract named binaries from the initrd file. *)
       let cmd =
diff --git a/daemon/inspect_utils.ml b/daemon/inspect_utils.ml
index 1aa762050..5ef8bfa25 100644
--- a/daemon/inspect_utils.ml
+++ b/daemon/inspect_utils.ml
@@ -57,8 +57,8 @@ let rec with_augeas ?name configfiles f =
     Augeas.create (Sysroot.sysroot ()) None
                   [Augeas.AugSaveNoop; Augeas.AugNoLoad] in
 
-  protect
-    ~f:(fun () ->
+  Fun.protect
+    (fun () ->
       (* Tell Augeas to only load configfiles and no other files.  This
        * prevents a rogue guest from performing a denial of service attack
        * by having large, over-complicated configuration files which are
@@ -179,4 +179,4 @@ let with_hive hive_filename f =
     | Some f -> f :: flags in
   let flags = if verbose () then Hivex.OPEN_VERBOSE :: flags else flags in
   let h = Hivex.open_file hive_filename flags in
-  protect ~f:(fun () -> f h (Hivex.root h)) ~finally:(fun () -> Hivex.close h)
+  Fun.protect (fun () -> f h (Hivex.root h)) ~finally:(fun () -> Hivex.close h)
diff --git a/daemon/sfdisk.ml b/daemon/sfdisk.ml
index c694c328c..3265d1e83 100644
--- a/daemon/sfdisk.ml
+++ b/daemon/sfdisk.ml
@@ -35,7 +35,7 @@ let part_get_mbr_id device partnum =
   udev_settle ();
 
   (* It's printed in hex, possibly with a leading space. *)
-  sscanf out " %x" identity
+  sscanf out " %x" Fun.id
 
 let part_get_gpt_type device partnum =
   if partnum <= 0 then
-- 
2.47.1