[Libguestfs] [PATCH 14/14] mllib: Add a common 'warning' utility function.
Richard W.M. Jones
rjones at redhat.com
Mon Jun 23 11:32:30 UTC 2014
This commit changes many places in OCaml utilities that print
warnings to use the warning function instead.
---
builder/builder.ml | 7 +++----
customize/customize_run.ml | 11 ++++-------
customize/password.ml | 11 ++++-------
mllib/common_utils.ml | 7 +++++++
mllib/common_utils.mli | 3 +++
resize/resize.ml | 2 +-
sysprep/sysprep_operation_fs_uuids.ml | 6 +++++-
v2v/convert_linux_enterprise.ml | 20 ++++++++++----------
v2v/convert_linux_grub.ml | 5 +++--
v2v/source_libvirt.ml | 7 +++----
10 files changed, 43 insertions(+), 36 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 5c2f6bb..70c9430 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -126,7 +126,7 @@ let main () =
exit 1
)
else if debug then
- eprintf (f_"%s: warning: gpg program is not available\n") prog
+ warning ~prog (f_"gpg program is not available")
);
(* Check that curl works. *)
@@ -150,9 +150,8 @@ let main () =
| Some dir ->
try Some (Cache.create ~debug ~directory:dir)
with exn ->
- eprintf (f_"%s: warning: cache %s: %s\n") prog dir
- (Printexc.to_string exn);
- eprintf (f_"%s: disabling the cache\n%!") prog;
+ warning ~prog (f_"cache %s: %s") dir (Printexc.to_string exn);
+ warning ~prog (f_"disabling the cache");
None
in
diff --git a/customize/customize_run.ml b/customize/customize_run.ml
index 4d83e90..57b888f 100644
--- a/customize/customize_run.ml
+++ b/customize/customize_run.ml
@@ -149,7 +149,7 @@ exec >>%s 2>&1
(* Set the random seed. *)
msg (f_"Setting a random seed");
if not (Random_seed.set_random_seed g root) then
- eprintf (f_"%s: warning: random seed could not be set for this type of guest\n%!") prog;
+ warning ~prog (f_"random seed could not be set for this type of guest");
(* Used for numbering firstboot commands. *)
let i = ref 0 in
@@ -216,8 +216,7 @@ exec >>%s 2>&1
| `Hostname hostname ->
msg (f_"Setting the hostname: %s") hostname;
if not (Hostname.set_hostname g root hostname) then
- eprintf (f_"%s: warning: hostname could not be set for this type of guest\n%!")
- prog
+ warning ~prog (f_"hostname could not be set for this type of guest")
| `InstallPackages pkgs ->
msg (f_"Installing packages: %s") (String.concat " " pkgs);
@@ -253,8 +252,7 @@ exec >>%s 2>&1
| `Timezone tz ->
msg (f_"Setting the timezone: %s") tz;
if not (Timezone.set_timezone ~prog g root tz) then
- eprintf (f_"%s: warning: timezone could not be set for this type of guest\n%!")
- prog
+ warning ~prog (f_"timezone could not be set for this type of guest")
| `Update ->
msg (f_"Updating core packages");
@@ -294,8 +292,7 @@ exec >>%s 2>&1
set_linux_passwords ~prog ?password_crypto g root passwords
| _ ->
- eprintf (f_"%s: warning: passwords could not be set for this type of guest\n%!")
- prog
+ warning ~prog (f_"passwords could not be set for this type of guest")
);
if ops.flags.selinux_relabel then (
diff --git a/customize/password.ml b/customize/password.ml
index 6527138..d76ebea 100644
--- a/customize/password.ml
+++ b/customize/password.ml
@@ -84,7 +84,7 @@ let chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789./"
let rec set_linux_passwords ~prog ?password_crypto g root passwords =
let crypto =
match password_crypto with
- | None -> default_crypto g root
+ | None -> default_crypto ~prog g root
| Some c -> c in
(* XXX Would like to use Augeas here, but Augeas doesn't support
@@ -145,7 +145,7 @@ and encrypt password crypto =
* precede this date only support md5, whereas all guests after this
* date can support sha512.
*)
-and default_crypto g root =
+and default_crypto ~prog g root =
let distro = g#inspect_get_distro root in
let major = g#inspect_get_major_version root in
match distro, major with
@@ -167,9 +167,6 @@ and default_crypto g root =
| "ubuntu", _ -> `MD5
| _, _ ->
- eprintf (f_"\
-virt-sysprep: password: warning: using insecure md5 password encryption for
-guest of type %s version %d.
-If this is incorrect, use --password-crypto option and file a bug.\n%!")
- distro major;
+ warning ~prog (f_"password: using insecure md5 password encryption for
+guest of type %s version %d.\nIf this is incorrect, use --password-crypto option and file a bug.") distro major;
`MD5
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index d4a97a7..1ce2abe 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -208,6 +208,13 @@ let error ~prog ?(exit_code = 1) fs =
in
ksprintf display fs
+let warning ~prog fs =
+ let display str =
+ wrap ~chan:stderr (sprintf (f_"%s: warning: %s") prog str);
+ prerr_newline ();
+ in
+ ksprintf display fs
+
let read_whole_file path =
let buf = Buffer.create 16384 in
let chan = open_in path in
diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli
index 4368e57..16b9dee 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -56,6 +56,9 @@ val make_message_function : quiet:bool -> ('a, unit, string, unit) format4 -> 'a
val error : prog:string -> ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a
(** Standard error function. *)
+val warning : prog:string -> ('a, unit, string, unit) format4 -> 'a
+(** Standard warning function. *)
+
val read_whole_file : string -> string
(** Read in the whole file as a string. *)
diff --git a/resize/resize.ml b/resize/resize.ml
index c6b6c9e..dec23b1 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -1160,7 +1160,7 @@ read the man page virt-resize(1).
(* Sanity check: it contains the NTFS magic. *)
let magic = g#pread_device target 8 3L in
if magic <> "NTFS " then
- eprintf (f_"warning: first partition is NTFS but does not contain NTFS boot loader magic\n%!")
+ warning ~prog (f_"first partition is NTFS but does not contain NTFS boot loader magic")
else (
if not quiet then
printf (f_"Fixing first NTFS partition boot record ...\n%!");
diff --git a/sysprep/sysprep_operation_fs_uuids.ml b/sysprep/sysprep_operation_fs_uuids.ml
index 32ee67d..57ccd68 100644
--- a/sysprep/sysprep_operation_fs_uuids.ml
+++ b/sysprep/sysprep_operation_fs_uuids.ml
@@ -19,10 +19,14 @@
open Printf
open Sysprep_operation
+
open Common_gettext.Gettext
+open Common_utils
module G = Guestfs
+let prog = "virt-sysprep"
+
let rec fs_uuids_perform ~debug ~quiet g root side_effects =
let fses = g#list_filesystems () in
List.iter (function
@@ -35,7 +39,7 @@ let rec fs_uuids_perform ~debug ~quiet g root side_effects =
g#set_uuid dev new_uuid
with
G.Error msg ->
- eprintf (f_"warning: cannot set random UUID on filesystem %s type %s: %s\n")
+ warning ~prog (f_"cannot set random UUID on filesystem %s type %s: %s")
dev typ msg
) fses
diff --git a/v2v/convert_linux_enterprise.ml b/v2v/convert_linux_enterprise.ml
index 8bf8f33..e3cfab8 100644
--- a/v2v/convert_linux_enterprise.ml
+++ b/v2v/convert_linux_enterprise.ml
@@ -212,8 +212,8 @@ Grub1/grub-legacy error was: %s")
Convert_linux_common.augeas_reload verbose g
with
G.Error msg ->
- eprintf (f_"%s: warning: VirtualBox Guest Additions were detected, but uninstallation failed. The error message was: %s (ignored)\n%!")
- prog msg
+ warning ~prog (f_"VirtualBox Guest Additions were detected, but uninstallation failed. The error message was: %s (ignored)")
+ msg
)
and unconfigure_vmware () =
@@ -297,8 +297,8 @@ Grub1/grub-legacy error was: %s")
Convert_linux_common.augeas_reload verbose g
with
G.Error msg ->
- eprintf (f_"%s: warning: VMware tools was detected, but uninstallation failed. The error message was: %s (ignored)\n%!")
- prog msg
+ warning ~prog (f_"VMware tools was detected, but uninstallation failed. The error message was: %s (ignored)")
+ msg
)
and unconfigure_citrix () =
@@ -389,8 +389,8 @@ Grub1/grub-legacy error was: %s")
check_kernel_package (0_l, "2.6.25.5", "1.1")
| _ ->
- eprintf (f_"%s: warning: don't know how to install virtio drivers for %s %d\n%!")
- prog distro major_version;
+ warning ~prog (f_"don't know how to install virtio drivers for %s %d\n%!")
+ distro major_version;
false
and check_kernel_package minversion =
@@ -401,8 +401,8 @@ Grub1/grub-legacy error was: %s")
) names in
if not found then (
let _, minversion, minrelease = minversion in
- eprintf (f_"%s: warning: cannot enable virtio in this guest.\nTo enable virtio you need to install a kernel >= %s-%s and run %s again.\n%!")
- prog minversion minrelease prog
+ warning ~prog (f_"cannot enable virtio in this guest.\nTo enable virtio you need to install a kernel >= %s-%s and run %s again.")
+ minversion minrelease prog
);
found
@@ -421,8 +421,8 @@ Grub1/grub-legacy error was: %s")
| _ ->
if warn then (
let _, minversion, minrelease = minversion in
- eprintf (f_"%s: warning: cannot enable virtio in this guest.\nTo enable virtio you need to upgrade %s >= %s-%s and run %s again.\n%!")
- prog name minversion minrelease prog
+ warning ~prog (f_"cannot enable virtio in this guest.\nTo enable virtio you need to upgrade %s >= %s-%s and run %s again.")
+ name minversion minrelease prog
);
false
diff --git a/v2v/convert_linux_grub.ml b/v2v/convert_linux_grub.ml
index 1f4d1ae..1b02141 100644
--- a/v2v/convert_linux_grub.ml
+++ b/v2v/convert_linux_grub.ml
@@ -21,6 +21,7 @@ module G = Guestfs
open Printf
open Common_gettext.Gettext
+open Common_utils
open Utils
open Types
@@ -272,8 +273,8 @@ object (self)
ignore (g#command [| "grub2-mkconfig"; "-o"; config_file |])
with
G.Error msg ->
- eprintf (f_"%s: warning: could not update grub2 console: %s (ignored)\n%!")
- prog msg
+ warning ~prog (f_"could not update grub2 console: %s (ignored)")
+ msg
)
method configure_console () = self#update_console ~remove:false
diff --git a/v2v/source_libvirt.ml b/v2v/source_libvirt.ml
index 4a3c9f1..d9c7b5e 100644
--- a/v2v/source_libvirt.ml
+++ b/v2v/source_libvirt.ml
@@ -128,12 +128,11 @@ let create_xml ?dir xml =
)
| "" -> ()
| protocol ->
- eprintf (f_"%s: warning: network <disk> with <source protocol='%s'> was ignored\n%!")
- prog protocol
+ warning ~prog (f_"network <disk> with <source protocol='%s'> was ignored")
+ protocol
)
| disk_type ->
- eprintf (f_"%s: warning: <disk type='%s'> was ignored\n%!")
- prog disk_type
+ warning ~prog (f_"<disk type='%s'> was ignored") disk_type
done;
List.rev !disks in
--
1.9.0
More information about the Libguestfs
mailing list