From 2014844107fc356e945fb637ef9179bc29656864 Mon Sep 17 00:00:00 2001

From: Laszlo Ersek <lersek@redhat.com>

Date: Mon, 6 Jun 2022 16:20:42 +0200

Subject: [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@redhat.com>

Message-Id: <20220606142042.16680-1-lersek@redhat.com>

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

(cherry picked from commit 7eb1ecf467e86374d72b23994d435139e302bca5)

---

 common                     |   2 +-

 customize/customize_run.ml | 106 ++++---------------------------------

 2 files changed, 10 insertions(+), 98 deletions(-)

Submodule common f8de5508f..9e990f3e4:

diff --git a/common/mlcustomize/Makefile.am b/common/mlcustomize/Makefile.am

index cd7d897..4e26064 100644

--- a/common/mlcustomize/Makefile.am

+++ b/common/mlcustomize/Makefile.am

@@ -38,10 +38,12 @@ generator_built = \

 SOURCES_MLI = \

 	firstboot.mli \

+	guest_packages.mli \

 	SELinux_relabel.mli

 SOURCES_ML = \

 	firstboot.ml \

+	guest_packages.ml \

 	SELinux_relabel.ml

 if HAVE_OCAML

diff --git a/common/mlcustomize/guest_packages.ml b/common/mlcustomize/guest_packages.ml

new file mode 100644

index 0000000..4c3c34e

--- /dev/null

+++ b/common/mlcustomize/guest_packages.ml

@@ -0,0 +1,132 @@

+(* virt-customize

+ * Copyright (C) 2012-2021 Red Hat Inc.

+ *

+ * This program is free software; you can redistribute it and/or modify

+ * it under the terms of the GNU General Public License as published by

+ * the Free Software Foundation; either version 2 of the License, or

+ * (at your option) any later version.

+ *

+ * 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 General Public License for more details.

+ *

+ * You should have received a copy of the GNU General Public License along

+ * with this program; if not, write to the Free Software Foundation, Inc.,

+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

+ *)

+

+open Printf

+

+open Common_gettext.Gettext

+open Std_utils

+

+exception Unknown_package_manager of string

+exception Unimplemented_package_manager of string

+

+(* Windows has package_management == "unknown". *)

+let error_unknown_package_manager flag =

+  let msg = sprintf (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 virt-customize(1) manual).") flag in

+  raise (Unknown_package_manager msg)

+

+let error_unimplemented_package_manager flag pm =

+  let msg = sprintf (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 virt-customize(1) manual).")

+                    flag pm in

+  raise (Unimplemented_package_manager msg)

+

+(* http://distrowatch.com/dwres.php?resource=package-management *)

+let install_command packages package_management =

+  let quoted_args = String.concat " " (List.map quote packages) in

+  match package_management 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

+

+let update_command package_management =

+  match package_management 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

+

+let uninstall_command packages package_management =

+  let quoted_args = String.concat " " (List.map quote packages) in

+  match package_management 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

diff --git a/common/mlcustomize/guest_packages.mli b/common/mlcustomize/guest_packages.mli

new file mode 100644

index 0000000..7504a6a

--- /dev/null

+++ b/common/mlcustomize/guest_packages.mli

@@ -0,0 +1,44 @@

+(* virt-customize

+ * Copyright (C) 2012-2021 Red Hat Inc.

+ *

+ * This program is free software; you can redistribute it and/or modify

+ * it under the terms of the GNU General Public License as published by

+ * the Free Software Foundation; either version 2 of the License, or

+ * (at your option) any later version.

+ *

+ * 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 General Public License for more details.

+ *

+ * You should have received a copy of the GNU General Public License along

+ * with this program; if not, write to the Free Software Foundation, Inc.,

+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

+ *)

+

+exception Unknown_package_manager of string

+exception Unimplemented_package_manager of string

+(** For all three functions below, [package_management] determines the package

+    management system in use by the guest; commonly it should be filled in from

+    [Guestfs.inspect_get_package_management], or the equivalent guestfs object

+    method.

+

+    If [package_management] is unknown or unimplemented, the functions raise

+    [Unknown_package_manager "error message"] or [Unimplemented_package_manager

+    "error message"], correspondingly. *)

+

+val install_command : string list -> string -> string

+(** [install_command packages package_management] produces a properly quoted

+    shell command string suitable for execution in the guest (directly or via a

+    Firstboot script) for installing the OS packages listed in [packages]. *)

+

+val update_command : string -> string

+(** [update_command package_management] produces a properly quoted shell command

+    string suitable for execution in the guest (directly or via a Firstboot

+    script) for updating the OS packages that are currently installed in the

+    guest. *)

+

+val uninstall_command : string list -> string -> string

+(** [uninstall_command packages package_management] produces a properly quoted

+    shell command string suitable for execution in the guest (directly or via a

+    Firstboot script) for uninstalling the OS packages listed in [packages]. *)

diff --git a/customize/customize_run.ml b/customize/customize_run.ml

index 99b5fe14d..bb2ba2a03 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) ->

-- 

2.31.1