[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]

[Libguestfs] [PATCH 14/14] mllib: Add a common 'warning' utility function.



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


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]