supermin/0003-Add-and-use-an-helper-error-function.patch

From e434bb82253bd40961ad3ed49690360734e5e75f Mon Sep 17 00:00:00 2001
From: Pino Toscano <ptoscano@redhat.com>
Date: Thu, 18 Feb 2016 14:46:24 +0100
Subject: [PATCH 3/9] Add and use an helper error function

Simplier version of what is implemented in Common_utils in libguestfs,
only adding the application prefix and handling the exit.
---
 src/build.ml           | 20 +++++-----------
 src/dpkg.ml            |  4 +---
 src/kernel.ml          | 27 ++++++++++------------
 src/package_handler.ml |  7 +++---
 src/pacman.ml          |  6 ++---
 src/prepare.ml         | 12 ++++------
 src/rpm.ml             | 33 ++++++++-------------------
 src/supermin.ml        | 62 +++++++++++++++++++-------------------------------
 src/utils.ml           | 36 ++++++++++++++---------------
 src/utils.mli          |  3 +++
 10 files changed, 81 insertions(+), 129 deletions(-)

diff --git a/src/build.ml b/src/build.ml
index 4675454..e34ec5f 100644
--- a/src/build.ml
+++ b/src/build.ml
@@ -65,10 +65,8 @@ let rec build debug
   if debug >= 1 then
     printf "supermin: build: %s\n%!" (String.concat " " inputs);
 
-  if inputs = [] then (
-    eprintf "supermin: build: no input supermin appliance specified\n";
-    exit 1;
-  );
+  if inputs = [] then
+    error "build: no input supermin appliance specified";
 
   (* When base images are seen, they are unpacked into this temporary
    * directory.  But to speed things up, when we are building a chroot,
@@ -297,10 +295,8 @@ and update_appliance appliance lines = function
     let lines = List.map (
       fun path ->
         let n = String.length path in
-        if n < 1 || path.[0] <> '-' then (
-          eprintf "supermin: excludefiles line does not start with '-'\n";
-          exit 1
-        );
+        if n < 1 || path.[0] <> '-' then
+          error "excludefiles line does not start with '-'";
         String.sub path 1 (n-1)
     ) lines in
     { appliance with excludefiles = appliance.excludefiles @ lines }
@@ -335,16 +331,12 @@ and get_file_content file buf len =
     (* However we intend to support them in future for both input
      * and output.
      *)
-    eprintf "supermin: %s: cpio files are not supported in this version of supermin\n" file;
-    exit 1
+    error "%s: cpio files are not supported in this version of supermin" file;
   )
   else if len >= 2 && buf.[0] = '/' then Hostfiles
   else if len >= 2 && buf.[0] = '-' then Excludefiles
   else if len >= 1 && isalnum buf.[0] then Packages
-  else (
-    eprintf "supermin: %s: unknown file type in supermin directory\n" file;
-    exit 1
-  )
+  else error "%s: unknown file type in supermin directory" file
 
 and get_compressed_file_content zcat file =
   let cmd = sprintf "%s %s" zcat (quote file) in
diff --git a/src/dpkg.ml b/src/dpkg.ml
index ddfb03a..70acfa2 100644
--- a/src/dpkg.ml
+++ b/src/dpkg.ml
@@ -39,9 +39,7 @@ let dpkg_init s =
   let cmd = sprintf "%s --print-architecture" Config.dpkg in
   let lines = run_command_get_lines cmd in
   match lines with
-  | [] ->
-    eprintf "supermin: dpkg: expecting %s to return some output\n" cmd;
-    exit 1
+  | [] -> error "dpkg: expecting %s to return some output" cmd
   | arch :: _ -> dpkg_primary_arch := arch
 
 type dpkg_t = {
diff --git a/src/kernel.ml b/src/kernel.ml
index 046cde9..356ac4b 100644
--- a/src/kernel.ml
+++ b/src/kernel.ml
@@ -128,16 +128,15 @@ and kernel_filter patterns is_arm all_files =
   List.filter (fun filename -> has_modpath filename) files
 
 and no_kernels host_cpu =
-  eprintf "\
-supermin: failed to find a suitable kernel (host_cpu=%s).
+  error "\
+failed to find a suitable kernel (host_cpu=%s).
 
 I looked for kernels in /boot and modules in /lib/modules.
 
 If this is a Xen guest, and you only have Xen domU kernels
 installed, try installing a fullvirt kernel (only for
-supermin use, you shouldn't boot the Xen guest with it).\n"
-    host_cpu;
-  exit 1
+supermin use, you shouldn't boot the Xen guest with it)."
+    host_cpu
 
 and find_dtb debug copy_kernel kernel_name wildcard dtb =
   let dtb_file =
@@ -180,27 +179,25 @@ and find_dtb debug copy_kernel kernel_name wildcard dtb =
   copy_or_symlink_file copy_kernel dtb_file dtb
 
 and no_dtb_dir kernel_name =
-  eprintf "\
-supermin: failed to find a dtb (device tree) directory.
+  error "\
+failed to find a dtb (device tree) directory.
 
 I expected to take '%s' and to
 replace vmlinuz- with dtb- to form a directory.
 
 You can set SUPERMIN_KERNEL, SUPERMIN_MODULES and SUPERMIN_DTB
-to override automatic selection.  See supermin(1).\n"
-    kernel_name;
-  exit 1
+to override automatic selection.  See supermin(1)."
+    kernel_name
 
 and no_dtb dtb_dir wildcard =
-  eprintf "\
-supermin: failed to find a matching device tree.
+  error "\
+failed to find a matching device tree.
 
 I looked for a file matching '%s' in directory '%s'.
 
 You can set SUPERMIN_KERNEL, SUPERMIN_MODULES and SUPERMIN_DTB
-to override automatic selection.  See supermin(1).\n"
-    wildcard dtb_dir;
-  exit 1
+to override automatic selection.  See supermin(1)."
+    wildcard dtb_dir
 
 and find_modpath debug kernel_version =
   try
diff --git a/src/package_handler.ml b/src/package_handler.ml
index 64b8f66..0409438 100644
--- a/src/package_handler.ml
+++ b/src/package_handler.ml
@@ -116,8 +116,8 @@ let check_system settings =
     handler := Some h;
     ph.ph_init settings
   with Not_found ->
-    eprintf "\
-supermin: could not detect package manager used by this system or distro.
+    error "\
+could not detect package manager used by this system or distro.
 
 If this is a new Linux distro, or not Linux, or a Linux distro that uses
 an unusual packaging format then you may need to port supermin.  If
@@ -128,8 +128,7 @@ To list which package handlers are compiled into this version of
 supermin, do:
 
   supermin --list-drivers
-";
-    exit 1
+"
 
 let rec get_package_handler () =
   match !handler with
diff --git a/src/pacman.ml b/src/pacman.ml
index 45fb393..3340fa6 100644
--- a/src/pacman.ml
+++ b/src/pacman.ml
@@ -66,10 +66,8 @@ let pacman_package_of_string str =
     ) lines;
 
     let name = !name and evr = !evr and arch = !arch in
-    if name = "" || evr = "" || arch = "" then (
-      eprintf "supermin: pacman: Name/Version/Architecture field missing in output of %s\n" cmd;
-      exit 1
-    );
+    if name = "" || evr = "" || arch = "" then
+      error "pacman: Name/Version/Architecture field missing in output of %s" cmd;
 
     (* Parse epoch:version-release field. *)
     let epoch, version, release =
diff --git a/src/prepare.ml b/src/prepare.ml
index 8193f36..830b620 100644
--- a/src/prepare.ml
+++ b/src/prepare.ml
@@ -28,10 +28,8 @@ let prepare debug (copy_kernel, dtb_wildcard, format, host_cpu,
   if debug >= 1 then
     printf "supermin: prepare: %s\n%!" (String.concat " " inputs);
 
-  if inputs = [] then (
-    eprintf "supermin: prepare: no input packages specified\n";
-    exit 1;
-  );
+  if inputs = [] then
+    error "prepare: no input packages specified";
 
   let ph = get_package_handler () in
 
@@ -40,10 +38,8 @@ let prepare debug (copy_kernel, dtb_wildcard, format, host_cpu,
    * filter_map will return only packages which are installed.
    *)
   let packages = filter_map ph.ph_package_of_string inputs in
-  if packages = [] then (
-    eprintf "supermin: prepare: none of the packages listed on the command line seem to be installed\n";
-    exit 1;
-  );
+  if packages = [] then
+    error "prepare: none of the packages listed on the command line seem to be installed";
 
   if debug >= 1 then (
     printf "supermin: packages specified on the command line:\n";
diff --git a/src/rpm.ml b/src/rpm.ml
index cf6341c..a5dc67a 100644
--- a/src/rpm.ml
+++ b/src/rpm.ml
@@ -61,9 +61,7 @@ let t = ref None
 
 let get_rpm () =
   match !t with
-  | None ->
-    eprintf "supermin: rpm: get_rpm called too early";
-    exit 1
+  | None -> error "rpm: get_rpm called too early"
   | Some t -> t
 
 let rec rpm_init s =
@@ -75,17 +73,12 @@ let rec rpm_init s =
   let version = rpm_version () in
   let major, minor =
     match string_split "." version with
-    | [] ->
-      eprintf "supermin: unable to parse empty rpm version string\n";
-      exit 1
-    | [x] ->
-      eprintf "supermin: unable to parse rpm version string: %s\n" x;
-      exit 1
+    | [] -> error "unable to parse empty rpm version string"
+    | [x] -> error "unable to parse rpm version string: %s" x
     | major :: minor :: _ ->
       try int_of_string major, int_of_string minor
       with Failure "int_of_string" ->
-        eprintf "supermin: unable to parse rpm version string: non-numeric, %s\n" version;
-        exit 1 in
+        error "unable to parse rpm version string: non-numeric, %s" version in
   rpm_major := major;
   rpm_minor := minor;
   if !settings.debug >= 1 then
@@ -103,28 +96,20 @@ and opensuse_init s =
   let lines = run_command_get_lines cmd in
   let major, minor, patch =
     match lines with
-    | [] ->
-      eprintf "supermin: zypper --version command had no output\n";
-      exit 1
+    | [] -> error "zypper --version command had no output"
     | line :: _ ->
       let line = string_split "." line in
       match line with
-      | [] ->
-        eprintf "supermin: unable to parse empty output of zypper --version\n";
-        exit 1
-      | [x] ->
-        eprintf "supermin: unable to parse output of zypper --version: %s\n" x;
-        exit 1
+      | [] -> error "unable to parse empty output of zypper --version"
+      | [x] -> error "unable to parse output of zypper --version: %s" x
       | major :: minor :: [] ->
         (try int_of_string major, int_of_string minor, 0
         with Failure "int_of_string" ->
-          eprintf "supermin: unable to parse output of zypper --version: non-numeric\n";
-          exit 1)
+          error "unable to parse output of zypper --version: non-numeric")
       | major :: minor :: patch :: _ ->
         (try int_of_string major, int_of_string minor, int_of_string patch
         with Failure "int_of_string" ->
-          eprintf "supermin: unable to parse output of zypper --version: non-numeric\n";
-          exit 1) in
+          error "unable to parse output of zypper --version: non-numeric") in
   zypper_major := major;
   zypper_minor := minor;
   zypper_patch := patch;
diff --git a/src/supermin.ml b/src/supermin.ml
index bbb1dba..b0532e5 100644
--- a/src/supermin.ml
+++ b/src/supermin.ml
@@ -54,10 +54,8 @@ let main () =
    * This is untested and will break in some way or another later, so
    * better to die now with a meaningful error message.
    *)
-  if try Filename.is_relative (getenv "TMPDIR") with Not_found -> false then (
-    eprintf "supermin: error: environment variable $TMPDIR must be an absolute path\n";
-    exit 1
-  );
+  if try Filename.is_relative (getenv "TMPDIR") with Not_found -> false then
+    error "error: environment variable $TMPDIR must be an absolute path";
 
   (* Create a temporary directory for scratch storage. *)
   let tmpdir =
@@ -102,9 +100,7 @@ let main () =
     let set_format = function
       | "chroot" | "fs" | "filesystem" -> format := Some Chroot
       | "ext2" -> format := Some Ext2
-      | s ->
-        eprintf "supermin: unknown --format option (%s)\n" s;
-        exit 1
+      | s -> error "unknown --format option (%s)\n" s
     in
 
     let rec set_prepare_mode () =
@@ -116,20 +112,19 @@ let main () =
         bad_mode ();
       mode := Some Build
     and bad_mode () =
-      eprintf "supermin: you must use --prepare or --build to select the mode\n";
-      exit 1
+      error "you must use --prepare or --build to select the mode"
     in
 
     let set_size arg = size := Some (parse_size arg) in
 
     let error_supermin_5 () =
-      eprintf "supermin: *** error: This is supermin version 5.\n";
-      eprintf "supermin: *** It looks like you are looking for supermin version 4.\n";
-      eprintf "\n";
-      eprintf "This version of supermin will not work.  You need to find the old version\n";
-      eprintf "or upgrade to libguestfs >= 1.26.\n";
-      eprintf "\n";
-      exit 1
+      error "\
+*** error: This is supermin version 5.
+supermin: *** It looks like you are looking for supermin version 4.
+
+This version of supermin will not work.  You need to find the old version
+or upgrade to libguestfs >= 1.26.
+"
     in
 
     let ditto = " -\"-" in
@@ -178,18 +173,14 @@ let main () =
     let format =
       match mode, !format with
       | Prepare, Some _ ->
-        eprintf "supermin: cannot use --prepare and --format options together\n";
-        exit 1
+        error "cannot use --prepare and --format options together"
       | Prepare, None -> Chroot (* doesn't matter, prepare doesn't use this *)
       | Build, None ->
-        eprintf "supermin: when using --build, you must specify an output --format\n";
-        exit 1
+        error "when using --build, you must specify an output --format"
       | Build, Some f -> f in
 
-    if outputdir = "" then (
-      eprintf "supermin: output directory (-o option) must be supplied\n";
-      exit 1
-    );
+    if outputdir = "" then
+      error "supermin: output directory (-o option) must be supplied";
     (* Chop final '/' in output directory (RHBZ#1146753). *)
     let outputdir =
       let len = String.length outputdir in
@@ -293,24 +284,17 @@ let () =
   try main ()
   with
   | Unix.Unix_error (code, fname, "") -> (* from a syscall *)
-    eprintf "supermin: error: %s: %s\n" fname (Unix.error_message code);
-    exit 1
+    error "error: %s: %s" fname (Unix.error_message code)
   | Unix.Unix_error (code, fname, param) -> (* from a syscall *)
-    eprintf "supermin: error: %s: %s: %s\n" fname (Unix.error_message code)
-      param;
-    exit 1
+    error "error: %s: %s: %s" fname (Unix.error_message code) param
   | Failure msg ->                      (* from failwith/failwithf *)
-    eprintf "supermin: failure: %s\n" msg;
-    exit 1
+    error "failure: %s" msg
   | Invalid_argument msg ->             (* probably should never happen *)
-    eprintf "supermin: internal error: invalid argument: %s\n" msg;
-    exit 1
+    error "internal error: invalid argument: %s" msg
   | Assert_failure (file, line, char) -> (* should never happen *)
-    eprintf "supermin: internal error: assertion failed at %s, line %d, char %d\n" file line char;
-    exit 1
+    error "internal error: assertion failed at %s, line %d, char %d"
+      file line char
   | Not_found ->                        (* should never happen *)
-    eprintf "supermin: internal error: Not_found exception was thrown\n";
-    exit 1
+    error "internal error: Not_found exception was thrown"
   | exn ->                              (* something not matched above *)
-    eprintf "supermin: exception: %s\n" (Printexc.to_string exn);
-    exit 1
+    error "exception: %s" (Printexc.to_string exn)
diff --git a/src/utils.ml b/src/utils.ml
index 87c9cf7..4223be4 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -28,6 +28,13 @@ let (//) = Filename.concat
 let quote = Filename.quote
 let quoted_list names = String.concat " " (List.map quote names)
 
+let error ?(exit_code = 1) fs =
+  let display str =
+    prerr_endline (sprintf "supermin: %s" str);
+    exit exit_code
+  in
+  ksprintf display fs
+
 let dir_exists name =
   try (stat name).st_kind = S_DIR
   with Unix_error _ -> false
@@ -59,31 +66,25 @@ let run_command_get_lines cmd =
   (match stat with
    | WEXITED 0 -> ()
    | WEXITED i ->
-       eprintf "supermin: command '%s' failed (returned %d), see earlier error messages\n" cmd i;
-       exit i
+       error ~exit_code:i "command '%s' failed (returned %d), see earlier error messages"
+         cmd i
    | WSIGNALED i ->
-       eprintf "supermin: command '%s' killed by signal %d" cmd i;
-       exit 1
+       error "command '%s' killed by signal %d" cmd i
    | WSTOPPED i ->
-       eprintf "supermin: command '%s' stopped by signal %d" cmd i;
-       exit 1
+       error "command '%s' stopped by signal %d" cmd i
   );
   lines
 
 let run_command cmd =
-  if Sys.command cmd <> 0 then (
-    eprintf "supermin: %s: command failed, see earlier errors\n" cmd;
-    exit 1
-  )
+  if Sys.command cmd <> 0 then
+    error "%s: command failed, see earlier errors" cmd
 
 let run_shell code args =
   let cmd = sprintf "sh -c %s arg0 %s"
     (Filename.quote code)
     (String.concat " " (List.map Filename.quote args)) in
-  if Sys.command cmd <> 0 then (
-    eprintf "supermin: external shell program failed, see earlier error messages\n";
-    exit 1
-  )
+  if Sys.command cmd <> 0 then
+    error "external shell program failed, see earlier error messages"
 
 let rec find s sub =
   let len = String.length s in
@@ -191,8 +192,8 @@ let compare_architecture a1 a2 =
     | "s390x" -> 64
     | "alpha" -> 64
     | a ->
-      eprintf "supermin: missing support for architecture '%s'\nIt may need to be added to supermin.\n" a;
-      exit 1
+      error "missing support for architecture '%s'\nIt may need to be added to supermin."
+        a
   in
   compare (index_of_architecture a1) (index_of_architecture a2)
 
@@ -213,6 +214,5 @@ let parse_size =
     if matches const_re then (
       size_scaled (float_of_string (sub 1)) (sub 2)
     ) else (
-      eprintf "supermin: cannot parse size field '%s'\n" field;
-      exit 1
+      error "cannot parse size field '%s'" field
     )
diff --git a/src/utils.mli b/src/utils.mli
index 1a7687a..c5e931b 100644
--- a/src/utils.mli
+++ b/src/utils.mli
@@ -24,6 +24,9 @@ val ( *^ ) : int64 -> int64 -> int64
 val (/^) : int64 -> int64 -> int64
   (** Int64 operators. *)
 
+val error : ?exit_code:int -> ('a, unit, string, 'b) format4 -> 'a
+(** Standard error function. *)
+
 val dir_exists : string -> bool
   (** Return [true] iff dir exists. *)
 
-- 
2.5.0