guestfs-tools/SOURCES/0005-customize-rebase-to-th...

379 lines
15 KiB
Diff
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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