Libguestfs - Jun 2022 - [guestfs-tools PATCH] customize: rebase to the common/mlcustomize/Guest_packages interface

Replace the "guest_install_command", "guest_update_command"
and
"guest_uninstall_command" helper functions with the corresponding
functions from libguestfs-common, interface mlcustomize/Guest_packages.

Add a wrapper function for (a) dealing with the exceptions uniformly
(keeping the original behavior of virt-customize), (b) centralizing the
[g#inspect_get_package_management root] call. Regarding (b), the wrapper
function fills in the last argument [package_management] of the
Guest_packages functions; thus, pass partially applied functions to the
wrapper at the original call sites.

Bugzilla: https://bugzilla.redhat.com/show_bug.cgi?id=2028764
Signed-off-by: Laszlo Ersek <lersek at redhat.com>
---

Notes:
    Regression-tested with:
    
    virt-builder fedora-35
    virt-customize -a fedora-35.img -v -x --no-logfile --install
qemu-guest-agent
    virt-customize -a fedora-35.img -v -x --no-logfile --uninstall
qemu-guest-agent
    virt-customize -a fedora-35.img -v -x --no-logfile --update

 customize/customize_run.ml | 106 ++------------------
 common                     |   2 +-
 2 files changed, 10 insertions(+), 98 deletions(-)

diff --git a/customize/customize_run.ml b/customize/customize_run.ml
index 99b5fe14d849..bb2ba2a03221 100644
--- a/customize/customize_run.ml
+++ b/customize/customize_run.ml
@@ -67,99 +67,11 @@ let run (g : G.guestfs) root (ops : ops)          error
(f_"%s: command exited with an error") display
   in
 
-  (* http://distrowatch.com/dwres.php?resource=package-management *)
-  let rec guest_install_command packages -    let quoted_args = String.concat
" " (List.map quote packages) in
-    match g#inspect_get_package_management root with
-    | "apk" ->
-       sprintf "
-         apk update
-         apk add %s
-       " quoted_args
-    | "apt" ->
-      (* http://unix.stackexchange.com/questions/22820 *)
-      sprintf "
-        export DEBIAN_FRONTEND=noninteractive
-        apt_opts='-q -y -o Dpkg::Options::=--force-confnew'
-        apt-get $apt_opts update
-        apt-get $apt_opts install %s
-      " quoted_args
-    | "dnf" ->
-       sprintf "dnf%s -y install %s"
-               (if verbose () then " --verbose" else "")
-               quoted_args
-    | "pisi" ->   sprintf "pisi it %s" quoted_args
-    | "pacman" -> sprintf "pacman -S --noconfirm %s"
quoted_args
-    | "urpmi" ->  sprintf "urpmi %s" quoted_args
-    | "xbps" ->   sprintf "xbps-install -Sy %s"
quoted_args
-    | "yum" ->    sprintf "yum -y install %s"
quoted_args
-    | "zypper" -> sprintf "zypper -n in -l %s"
quoted_args
-
-    | "unknown" ->
-      error_unknown_package_manager (s_"--install")
-    | pm ->
-      error_unimplemented_package_manager (s_"--install") pm
-
-  and guest_update_command () -    match g#inspect_get_package_management root
with
-    | "apk" ->
-       "
-         apk update
-         apk upgrade
-       "
-    | "apt" ->
-      (* http://unix.stackexchange.com/questions/22820 *)
-      "
-        export DEBIAN_FRONTEND=noninteractive
-        apt_opts='-q -y -o Dpkg::Options::=--force-confnew'
-        apt-get $apt_opts update
-        apt-get $apt_opts upgrade
-      "
-    | "dnf" ->
-       sprintf "dnf%s -y --best upgrade"
-               (if verbose () then " --verbose" else "")
-    | "pisi" ->   "pisi upgrade"
-    | "pacman" -> "pacman -Su"
-    | "urpmi" ->  "urpmi --auto-select"
-    | "xbps" ->   "xbps-install -Suy"
-    | "yum" ->    "yum -y update"
-    | "zypper" -> "zypper -n update -l"
-
-    | "unknown" ->
-      error_unknown_package_manager (s_"--update")
-    | pm ->
-      error_unimplemented_package_manager (s_"--update") pm
-
-  and guest_uninstall_command packages -    let quoted_args = String.concat
" " (List.map quote packages) in
-    match g#inspect_get_package_management root with
-    | "apk" -> sprintf "apk del %s" quoted_args
-    | "apt" ->
-      (* http://unix.stackexchange.com/questions/22820 *)
-      sprintf "
-        export DEBIAN_FRONTEND=noninteractive
-        apt_opts='-q -y -o Dpkg::Options::=--force-confnew'
-        apt-get $apt_opts remove %s
-      " quoted_args
-    | "dnf" ->    sprintf "dnf -y remove %s" quoted_args
-    | "pisi" ->   sprintf "pisi rm %s" quoted_args
-    | "pacman" -> sprintf "pacman -R %s" quoted_args
-    | "urpmi" ->  sprintf "urpme %s" quoted_args
-    | "xbps" ->   sprintf "xbps-remove -Sy %s"
quoted_args
-    | "yum" ->    sprintf "yum -y remove %s" quoted_args
-    | "zypper" -> sprintf "zypper -n rm %s" quoted_args
-
-    | "unknown" ->
-      error_unknown_package_manager (s_"--uninstall")
-    | pm ->
-      error_unimplemented_package_manager (s_"--uninstall") pm
-
-  (* Windows has package_management == "unknown". *)
-  and error_unknown_package_manager flag -    error (f_"cannot use ?%s?
because no package manager has been detected for this guest OS.\n\nIf this guest
OS is a common one with ordinary package management then this may have been
caused by a failure of libguestfs inspection.\n\nFor OSes such as Windows that
lack package management, this is not possible.  Try using one of the
?--firstboot*? flags instead (described in the manual).") flag
-
-  and error_unimplemented_package_manager flag pm -      error (f_"sorry,
?%s? with the ?%s? package manager has not been implemented yet.\n\nYou can work
around this by using one of the ?--run*? or ?--firstboot*? options instead
(described in the manual).") flag pm
+  let guest_pkgs_command f +    try f (g#inspect_get_package_management root)
with
+    | Guest_packages.Unknown_package_manager msg
+    | Guest_packages.Unimplemented_package_manager msg ->
+      error "%s" msg
   in
 
   (* Set the random seed. *)
@@ -255,7 +167,7 @@ let run (g : G.guestfs) root (ops : ops)      |
`FirstbootPackages pkgs ->
       message (f_"Installing firstboot packages: %s")
         (String.concat " " pkgs);
-      let cmd = guest_install_command pkgs in
+      let cmd = guest_pkgs_command (Guest_packages.install_command pkgs) in
       let name = String.concat " " ("install" :: pkgs) in
       Firstboot.add_firstboot_script g root name cmd
 
@@ -271,7 +183,7 @@ let run (g : G.guestfs) root (ops : ops)  
     | `InstallPackages pkgs ->
       message (f_"Installing packages: %s") (String.concat "
" pkgs);
-      let cmd = guest_install_command pkgs in
+      let cmd = guest_pkgs_command (Guest_packages.install_command pkgs) in
       do_run ~display:cmd ~warn_failed_no_network:true cmd
 
     | `Link (target, links) ->
@@ -365,12 +277,12 @@ let run (g : G.guestfs) root (ops : ops)  
     | `UninstallPackages pkgs ->
       message (f_"Uninstalling packages: %s") (String.concat "
" pkgs);
-      let cmd = guest_uninstall_command pkgs in
+      let cmd = guest_pkgs_command (Guest_packages.uninstall_command pkgs) in
       do_run ~display:cmd cmd
 
     | `Update ->
       message (f_"Updating packages");
-      let cmd = guest_update_command () in
+      let cmd = guest_pkgs_command Guest_packages.update_command in
       do_run ~display:cmd ~warn_failed_no_network:true cmd
 
     | `Upload (path, dest) ->
diff --git a/common b/common
index f8de5508fe75..79828d1a92a4 160000
--- a/common
+++ b/common
@@ -1 +1 @@
-Subproject commit f8de5508fe755acca99c9ab40c501d6c3e2bcb1e
+Subproject commit 79828d1a92a407edd8f946db5cc1bf07d260bf2f
-- 
2.19.1.3.g30247aa5d201

This patch and the companion patch to libguestfs-common:

Reviewed-by: Richard W.M. Jones <rjones at redhat.com>

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
libguestfs lets you edit virtual machines.  Supports shell scripting,
bindings from many languages.  http://libguestfs.org