xapi: CA-423064: Trigger group upgrades in addition to package upgrades (#6850)

In the event we add a package to one of the yum repository groups, that
has no packages requiring it, dnf5 will not install it by default (as it
has not implemented the `upgrade_group_objects_upgrade` configuration
option - see
https://dnf5.readthedocs.io/en/latest/dnf5.conf-todo.5.html).

We do not wish to be reliant on having to ensure all new packages are
required by an existing package, as such (at least until an
implementation of the above option is done in dnf5) trigger a `group
upgrade *` in addition to the `upgrade`.

Note that a `group upgrade *` alone is not sufficient, as this will not
cause any packages that are pulled in as dependencies to be upgraded,
only those explicitly listed in the group(s).

Author: robhoes

ocaml/tests/test_pkg_mgr.ml

@@ -159,6 +159,29 @@ let test_dnf_apply_upgrades =
     )
   ]
 
+let test_dnf_apply_group_upgrades =
+  [
+    ( "<null>"
+    , `Quick
+    , check
+        {
+          cmd= !Xapi_globs.dnf_cmd
+        ; params=
+            [
+              "-y"
+            ; "--disablerepo=*"
+            ; "--enablerepo=testrepo1,testrepo2"
+            ; "group"
+            ; "upgrade"
+            ; "*"
+            ]
+        }
+        (Pkg_mgr.Dnf_cmd.apply_group_upgrade
+           ~repositories:["testrepo1"; "testrepo2"]
+        )
+    )
+  ]
+
 let test_yum_repo_query_installed =
   [
     ( "<null>"
@@ -286,6 +309,29 @@ let test_yum_apply_upgrades =
     )
   ]
 
+let test_yum_apply_group_upgrades =
+  [
+    ( "<null>"
+    , `Quick
+    , check
+        {
+          cmd= !Xapi_globs.yum_cmd
+        ; params=
+            [
+              "-y"
+            ; "--disablerepo=*"
+            ; "--enablerepo=testrepo1,testrepo2"
+            ; "group"
+            ; "upgrade"
+            ; "*"
+            ]
+        }
+        (Pkg_mgr.Yum_cmd.apply_group_upgrade
+           ~repositories:["testrepo1"; "testrepo2"]
+        )
+    )
+  ]
+
 let test_yum_repo_query_updates =
   [
     ( "<null>"
@@ -320,13 +366,15 @@ let tests =
   ; ("test_dnf_cofig_repo", test_dnf_config_repo)
   ; ("test_dnf_sync_repo", test_dnf_sync_repo)
   ; ("test_dnf_apply_upgrades", test_dnf_apply_upgrades)
+  ; ("test_dnf_apply_group_upgrades", test_dnf_apply_group_upgrades)
   ; ("test_yum_repo_query_installed", test_yum_repo_query_installed)
   ; ("test_yum_clean_all_cache", test_yum_clean_all_cache)
   ; ("test_yum_clean_repo_cache", test_yum_clean_repo_cache)
   ; ("test_yum_get_pkgs_from_updateinfo", test_yum_get_pkgs_from_updateinfo)
   ; ("test_yum_cofig_repo", test_yum_config_repo)
   ; ("test_yum_sync_repo", test_yum_sync_repo)
   ; ("test_yum_apply_upgrades", test_yum_apply_upgrades)
+  ; ("test_yum_apply_group_upgrades", test_yum_apply_group_upgrades)
   ; ("test_yum_repo_query_updates", test_yum_repo_query_updates)
   ]
 

ocaml/xapi/pkg_mgr.ml

@@ -37,6 +37,9 @@ module type S = sig
 
   val get_updates_from_upgrade_dry_run : repositories:string list -> cmd_line
 
+  val get_updates_from_group_upgrade_dry_run :
+    repositories:string list -> cmd_line
+
   val is_obsoleted : pkg_name:string -> repositories:string list -> cmd_line
 
   val repoquery_updates : repositories:string list -> cmd_line
@@ -52,6 +55,8 @@ module type S = sig
   val sync_repo : repo_name:string -> cmd_line
 
   val apply_upgrade : repositories:string list -> cmd_line
+
+  val apply_group_upgrade : repositories:string list -> cmd_line
 end
 
 module type Args = sig
@@ -71,6 +76,8 @@ module type Args = sig
 
   val get_updates_from_upgrade_dry_run : string list -> string list
 
+  val get_updates_from_group_upgrade_dry_run : string list -> string list
+
   val is_obsoleted : string -> string list -> string list
 
   val repoquery_updates : string list -> string list
@@ -86,6 +93,8 @@ module type Args = sig
   val sync_repo : string -> string list
 
   val apply_upgrade : string list -> string list
+
+  val apply_group_upgrade : string list -> string list
 end
 
 let repoquery_sep = ":|"
@@ -125,6 +134,16 @@ module Common_args = struct
     ; "upgrade"
     ]
 
+  let get_updates_from_group_upgrade_dry_run repositories =
+    [
+      "--disablerepo=*"
+    ; Printf.sprintf "--enablerepo=%s" (String.concat "," repositories)
+    ; "--assumeno"
+    ; "group"
+    ; "upgrade"
+    ; "*"
+    ]
+
   let repoquery repositories =
     [
       "--disablerepo=*"
@@ -161,6 +180,16 @@ module Common_args = struct
     ; Printf.sprintf "--enablerepo=%s" (String.concat "," repositories)
     ; "upgrade"
     ]
+
+  let apply_group_upgrade repositories =
+    [
+      "-y"
+    ; "--disablerepo=*"
+    ; Printf.sprintf "--enablerepo=%s" (String.concat "," repositories)
+    ; "group"
+    ; "upgrade"
+    ; "*"
+    ]
 end
 
 module Yum_args : Args = struct
@@ -179,6 +208,10 @@ module Yum_args : Args = struct
   let get_updates_from_upgrade_dry_run repositories =
     ["--quiet"] @ Common_args.get_updates_from_upgrade_dry_run repositories
 
+  let get_updates_from_group_upgrade_dry_run repositories =
+    ["--quiet"]
+    @ Common_args.get_updates_from_group_upgrade_dry_run repositories
+
   let is_obsoleted pkg_name repositories =
     ["--all"] @ Common_args.is_obsoleted pkg_name repositories @ ["--plugins"]
 
@@ -283,6 +316,12 @@ module Cmd_line (M : Args) : S = struct
   let get_updates_from_upgrade_dry_run ~repositories =
     {cmd= M.pkg_cmd; params= M.get_updates_from_upgrade_dry_run repositories}
 
+  let get_updates_from_group_upgrade_dry_run ~repositories =
+    {
+      cmd= M.pkg_cmd
+    ; params= M.get_updates_from_group_upgrade_dry_run repositories
+    }
+
   let is_obsoleted ~pkg_name ~repositories =
     {cmd= M.repoquery_cmd; params= M.is_obsoleted pkg_name repositories}
 
@@ -305,6 +344,9 @@ module Cmd_line (M : Args) : S = struct
 
   let apply_upgrade ~repositories =
     {cmd= M.pkg_cmd; params= M.apply_upgrade repositories}
+
+  let apply_group_upgrade ~repositories =
+    {cmd= M.pkg_cmd; params= M.apply_group_upgrade repositories}
 end
 
 module Yum_cmd = Cmd_line (Yum_args)

ocaml/xapi/pkg_mgr.mli

@@ -41,6 +41,10 @@ module type S = sig
   val get_updates_from_upgrade_dry_run : repositories:string list -> cmd_line
   (** Command line and arguments to dry run an upgrade, with repositories enabled *)
 
+  val get_updates_from_group_upgrade_dry_run :
+    repositories:string list -> cmd_line
+  (** Command line and arguments to dry run a group upgrade, with repositories enabled *)
+
   val is_obsoleted : pkg_name:string -> repositories:string list -> cmd_line
   (** Command line and arguments to check whether a package is obsoleted by any other
    * package in given repositories *)
@@ -67,6 +71,9 @@ module type S = sig
 
   val apply_upgrade : repositories:string list -> cmd_line
   (** Command line and arguments to apply upgrades from repos *)
+
+  val apply_group_upgrade : repositories:string list -> cmd_line
+  (** Command line and arguments to apply group upgrades from repos *)
 end
 
 (** Exposed only for unittest, do not use the modules directly

ocaml/xapi/repository.ml

@@ -565,6 +565,20 @@ let get_host_updates_in_json ~__context ~installed =
         let latest_updates' =
           get_updates_from_yum_upgrade_dry_run repositories
         in
+        let latest_updates_group' =
+          get_updates_from_yum_group_upgrade_dry_run repositories
+        in
+        let latest_updates_combined' =
+          match (latest_updates', latest_updates_group') with
+          | Some pkgs', Some group_pkgs' ->
+              Some (List.sort_uniq compare (pkgs' @ group_pkgs'))
+          | Some pkgs', None ->
+              Some pkgs'
+          | None, Some group_pkgs' ->
+              Some group_pkgs'
+          | None, None ->
+              None
+        in
         let latest_updates'' = get_updates_from_repoquery repositories in
         (* To ensure the updating function will not strand, use redundant
          * functions to get the update/installation list.
@@ -576,7 +590,7 @@ let get_host_updates_in_json ~__context ~installed =
         let fail_on_error = Xapi_fist.fail_on_error_in_yum_upgrade_dry_run () in
         let latest_updates =
           get_latest_updates_from_redundancy ~fail_on_error
-            ~pkgs:latest_updates' ~fallback_pkgs:latest_updates''
+            ~pkgs:latest_updates_combined' ~fallback_pkgs:latest_updates''
         in
         List.iter (fun r -> clean_yum_cache r) repositories ;
         let latest_updates_in_json =
@@ -686,8 +700,15 @@ let get_pool_updates_in_json ~__context ~hosts =
 let apply ~__context ~host =
   (* This function runs on member host *)
   with_local_repositories ~__context (fun repositories ->
-      let Pkg_mgr.{cmd; params} = Pkgs.apply_upgrade ~repositories in
-      try ignore (Helpers.call_script cmd params)
+      let upgrade () =
+        let Pkg_mgr.{cmd; params} = Pkgs.apply_upgrade ~repositories in
+        ignore (Helpers.call_script cmd params)
+      in
+      let group_upgrade () =
+        let Pkg_mgr.{cmd; params} = Pkgs.apply_group_upgrade ~repositories in
+        ignore (Helpers.call_script cmd params)
+      in
+      try upgrade () ; group_upgrade ()
       with e ->
         let host' = Ref.string_of host in
         error "Failed to apply updates on host ref='%s': %s" host'

ocaml/xapi/repository_helpers.ml

@@ -771,8 +771,10 @@ module YumUpgradeOutput = struct
     | false -> (
         take_till is_eol <* end_of_line >>= function
         | ( "Installing:"
+          | "Installing group/module packages:"
           | "Updating:"
           | "Upgrading:"
+          | "Upgrading groups:"
           | "Removing:"
           | "Reinstalling:"
           | "Downgrading:"
@@ -890,6 +892,7 @@ module YumUpgradeOutput = struct
         |> List.filter (fun (section, _) ->
             match section with
             | "Installing:"
+            | "Installing group/module packages:"
             | "Updating:"
             | "Upgrading:"
             | "Installing for dependencies:"
@@ -958,6 +961,31 @@ let get_updates_from_yum_upgrade_dry_run repositories =
       error "%s" (ExnHelper.string_of_exn e) ;
       None
 
+let get_updates_from_yum_group_upgrade_dry_run repositories =
+  let Pkg_mgr.{cmd; params} =
+    Pkgs.get_updates_from_group_upgrade_dry_run ~repositories
+  in
+  match Forkhelpers.execute_command_get_output cmd params with
+  | _, _ ->
+      Some []
+  | exception Forkhelpers.Spawn_internal_error (stderr, stdout, Unix.WEXITED 1)
+    -> (
+      (*Yum put the details to stderr while dnf to stdout*)
+      (match Pkgs.manager with Yum -> stderr | Dnf -> stdout)
+      |> YumUpgradeOutput.parse_output_of_dry_run
+      |> function
+      | Ok (pkgs, Some txn_file) ->
+          Unixext.unlink_safe txn_file ;
+          Some pkgs
+      | Ok (pkgs, None) ->
+          Some pkgs
+      | Error msg ->
+          error "%s" msg ; None
+    )
+  | exception e ->
+      error "%s" (ExnHelper.string_of_exn e) ;
+      None
+
 let get_latest_updates_from_redundancy ~fail_on_error ~pkgs ~fallback_pkgs =
   let err = "Failed to parse output of 'yum upgrade (dry run)' correctly" in
   let get_latest_updates_from_redundancy' ~fail_on_error ~pkgs ~fallback_pkgs =