[Libguestfs] [PATCH 3/3] Add and use an helper error function
Pino Toscano
ptoscano at redhat.com
Thu Feb 18 14:18:58 UTC 2016
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
More information about the Libguestfs
mailing list