[Pkg-libvirt-commits] [libguestfs] 20/63: OCaml virt-* tools: Handle pretty printing of exceptions through a common library function.
Hilko Bengen
bengen at moszumanska.debian.org
Fri Oct 3 14:43:25 UTC 2014
This is an automated email from the git hooks/post-receive script.
bengen pushed a commit to annotated tag debian/1%1.27.39-1
in repository libguestfs.
commit bb362f687840cd9fcf68bea08fd34fe8e4ddc64c
Author: Richard W.M. Jones <rjones at redhat.com>
Date: Wed Sep 3 12:13:42 2014 +0100
OCaml virt-* tools: Handle pretty printing of exceptions through a common library function.
---
builder/builder.ml | 28 +---------------------------
customize/customize_main.ml | 23 +----------------------
mllib/common_utils.ml | 26 ++++++++++++++++++++++++++
mllib/common_utils.mli | 3 +++
resize/resize.ml | 29 +----------------------------
sparsify/sparsify.ml | 29 +----------------------------
sysprep/main.ml | 33 +--------------------------------
v2v/v2v.ml | 32 +-------------------------------
8 files changed, 35 insertions(+), 168 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 213e93e..a407924 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -736,30 +736,4 @@ let main () =
| None -> ()
| Some stats -> print_string stats
-let () =
- try main ()
- with
- | Unix_error (code, fname, "") -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s\n") prog fname (error_message code);
- exit 1
- | Unix_error (code, fname, param) -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s: %s\n") prog fname (error_message code) param;
- exit 1
- | G.Error msg -> (* from libguestfs *)
- eprintf (f_"%s: libguestfs error: %s\n") prog msg;
- exit 1
- | Failure msg -> (* from failwith/failwithf *)
- eprintf (f_"%s: failure: %s\n") prog msg;
- exit 1
- | Invalid_argument msg -> (* probably should never happen *)
- eprintf (f_"%s: internal error: invalid argument: %s\n") prog msg;
- exit 1
- | Assert_failure (file, line, char) -> (* should never happen *)
- eprintf (f_"%s: internal error: assertion failed at %s, line %d, char %d\n") prog file line char;
- exit 1
- | Not_found -> (* should never happen *)
- eprintf (f_"%s: internal error: Not_found exception was thrown\n") prog;
- exit 1
- | exn -> (* something not matched above *)
- eprintf (f_"%s: exception: %s\n") prog (Printexc.to_string exn);
- exit 1
+let () = run_main_and_handle_errors ~prog main
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index 7229943..485e60b 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -242,25 +242,4 @@ read the man page virt-customize(1).
Gc.compact ()
(* Finished. *)
-let () =
- (try main ()
- with
- | Failure msg -> (* from failwith/failwithf *)
- eprintf (f_"%s: %s\n") prog msg;
- exit 1
- | Invalid_argument msg -> (* probably should never happen *)
- eprintf (f_"%s: internal error: invalid argument: %s\n") prog msg;
- exit 1
- | Assert_failure (file, line, char) -> (* should never happen *)
- eprintf (f_"%s: internal error: assertion failed at %s, line %d, char %d\n")
- prog file line char;
- exit 1
- | Not_found -> (* should never happen *)
- eprintf (f_"%s: internal error: Not_found exception was thrown\n") prog;
- exit 1
- | exn ->
- eprintf (f_"%s: exception: %s\n") prog (Printexc.to_string exn);
- exit 1
- );
-
- exit 0
+let () = run_main_and_handle_errors ~prog main
diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index 6c7ac34..871390a 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -231,6 +231,32 @@ let warning ~prog fs =
in
ksprintf display fs
+(* All the OCaml virt-* programs use this wrapper to catch exceptions
+ * and print them nicely.
+ *)
+let run_main_and_handle_errors ~prog main =
+ try main ()
+ with
+ | Unix.Unix_error (code, fname, "") -> (* from a syscall *)
+ error ~prog (f_"%s: %s") fname (Unix.error_message code)
+ | Unix.Unix_error (code, fname, param) -> (* from a syscall *)
+ error ~prog (f_"%s: %s: %s") fname (Unix.error_message code) param
+ | Sys_error msg -> (* from a syscall *)
+ error ~prog (f_"%s") msg
+ | G.Error msg -> (* from libguestfs *)
+ error ~prog (f_"libguestfs error: %s") msg
+ | Failure msg -> (* from failwith/failwithf *)
+ error ~prog (f_"failure: %s") msg
+ | Invalid_argument msg -> (* probably should never happen *)
+ error ~prog (f_"internal error: invalid argument: %s") msg
+ | Assert_failure (file, line, char) -> (* should never happen *)
+ error ~prog (f_"internal error: assertion failed at %s, line %d, char %d")
+ file line char
+ | Not_found -> (* should never happen *)
+ error ~prog (f_"internal error: Not_found exception was thrown")
+ | exn -> (* something not matched above *)
+ error ~prog (f_"exception: %s") (Printexc.to_string exn)
+
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 20dfc31..e77fcd2 100644
--- a/mllib/common_utils.mli
+++ b/mllib/common_utils.mli
@@ -62,6 +62,9 @@ val error : prog:string -> ?exit_code:int -> ('a, unit, string, 'b) format4 -> '
val warning : prog:string -> ('a, unit, string, unit) format4 -> 'a
(** Standard warning function. *)
+val run_main_and_handle_errors : prog:string -> (unit -> unit) -> unit
+(** Common function for handling pretty-printing exceptions. *)
+
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 0521474..b877106 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -1302,31 +1302,4 @@ read the man page virt-resize(1).
if debug_gc then
Gc.compact ()
-let () =
- try main ()
- with
- | Unix.Unix_error (code, fname, "") -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s\n") prog fname (Unix.error_message code);
- exit 1
- | Unix.Unix_error (code, fname, param) -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s: %s\n") prog fname (Unix.error_message code)
- param;
- exit 1
- | G.Error msg -> (* from libguestfs *)
- eprintf (f_"%s: libguestfs error: %s\n") prog msg;
- exit 1
- | Failure msg -> (* from failwith/failwithf *)
- eprintf (f_"%s: failure: %s\n") prog msg;
- exit 1
- | Invalid_argument msg -> (* probably should never happen *)
- eprintf (f_"%s: internal error: invalid argument: %s\n") prog msg;
- exit 1
- | Assert_failure (file, line, char) -> (* should never happen *)
- eprintf (f_"%s: internal error: assertion failed at %s, line %d, char %d\n") prog file line char;
- exit 1
- | Not_found -> (* should never happen *)
- eprintf (f_"%s: internal error: Not_found exception was thrown\n") prog;
- exit 1
- | exn -> (* something not matched above *)
- eprintf (f_"%s: exception: %s\n") prog (Printexc.to_string exn);
- exit 1
+let () = run_main_and_handle_errors ~prog main
diff --git a/sparsify/sparsify.ml b/sparsify/sparsify.ml
index 529a054..18ab77c 100644
--- a/sparsify/sparsify.ml
+++ b/sparsify/sparsify.ml
@@ -45,31 +45,4 @@ let rec main () =
if debug_gc then
Gc.compact ()
-let () =
- try main ()
- with
- | Unix.Unix_error (code, fname, "") -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s\n") prog fname (Unix.error_message code);
- exit 1
- | Unix.Unix_error (code, fname, param) -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s: %s\n") prog fname (Unix.error_message code)
- param;
- exit 1
- | G.Error msg -> (* from libguestfs *)
- eprintf (f_"%s: libguestfs error: %s\n") prog msg;
- exit 1
- | Failure msg -> (* from failwith/failwithf *)
- eprintf (f_"%s: failure: %s\n") prog msg;
- exit 1
- | Invalid_argument msg -> (* probably should never happen *)
- eprintf (f_"%s: internal error: invalid argument: %s\n") prog msg;
- exit 1
- | Assert_failure (file, line, char) -> (* should never happen *)
- eprintf (f_"%s: internal error: assertion failed at %s, line %d, char %d\n") prog file line char;
- exit 1
- | Not_found -> (* should never happen *)
- eprintf (f_"%s: internal error: Not_found exception was thrown\n") prog;
- exit 1
- | exn -> (* something not matched above *)
- eprintf (f_"%s: exception: %s\n") prog (Printexc.to_string exn);
- exit 1
+let () = run_main_and_handle_errors ~prog main
diff --git a/sysprep/main.ml b/sysprep/main.ml
index a3900a5..5d64538 100644
--- a/sysprep/main.ml
+++ b/sysprep/main.ml
@@ -284,38 +284,7 @@ let do_sysprep () =
(* Finished. *)
let () =
- (try do_sysprep ()
- with
- | Unix.Unix_error (code, fname, "") -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s\n") prog fname (Unix.error_message code);
- exit 1
- | Unix.Unix_error (code, fname, param) -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s: %s\n") prog fname (Unix.error_message code)
- param;
- exit 1
- | Sys_error msg -> (* from a syscall *)
- eprintf (f_"%s: error: %s\n") prog msg;
- exit 1
- | G.Error msg -> (* from libguestfs *)
- eprintf (f_"%s: libguestfs error: %s\n") prog msg;
- exit 1
- | Failure msg -> (* from failwith/failwithf *)
- eprintf (f_"%s: failure: %s\n") prog msg;
- exit 1
- | Invalid_argument msg -> (* probably should never happen *)
- eprintf (f_"%s: internal error: invalid argument: %s\n") prog msg;
- exit 1
- | Assert_failure (file, line, char) -> (* should never happen *)
- eprintf (f_"%s: internal error: assertion failed at %s, line %d, char %d\n")
- prog file line char;
- exit 1
- | Not_found -> (* should never happen *)
- eprintf (f_"%s: internal error: Not_found exception was thrown\n") prog;
- exit 1
- | exn ->
- eprintf (f_"%s: exception: %s\n") prog (Printexc.to_string exn);
- exit 1
- );
+ run_main_and_handle_errors ~prog do_sysprep;
g#shutdown ();
g#close ();
diff --git a/v2v/v2v.ml b/v2v/v2v.ml
index 38994f3..dbe653f 100644
--- a/v2v/v2v.ml
+++ b/v2v/v2v.ml
@@ -381,34 +381,4 @@ and inspect_source g root_choice =
i_apps = apps;
i_apps_map = apps_map; }
-let () =
- try main ()
- with
- | Unix.Unix_error (code, fname, "") -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s\n") prog fname (Unix.error_message code);
- exit 1
- | Unix.Unix_error (code, fname, param) -> (* from a syscall *)
- eprintf (f_"%s: error: %s: %s: %s\n") prog fname (Unix.error_message code)
- param;
- exit 1
- | Sys_error msg -> (* from a syscall *)
- eprintf (f_"%s: error: %s\n") prog msg;
- exit 1
- | G.Error msg -> (* from libguestfs *)
- eprintf (f_"%s: libguestfs error: %s\n") prog msg;
- exit 1
- | Failure msg -> (* from failwith/failwithf *)
- eprintf (f_"%s: failure: %s\n") prog msg;
- exit 1
- | Invalid_argument msg -> (* probably should never happen *)
- eprintf (f_"%s: internal error: invalid argument: %s\n") prog msg;
- exit 1
- | Assert_failure (file, line, char) -> (* should never happen *)
- eprintf (f_"%s: internal error: assertion failed at %s, line %d, char %d\n") prog file line char;
- exit 1
- | Not_found -> (* should never happen *)
- eprintf (f_"%s: internal error: Not_found exception was thrown\n") prog;
- exit 1
- | exn -> (* something not matched above *)
- eprintf (f_"%s: exception: %s\n") prog (Printexc.to_string exn);
- exit 1
+let () = run_main_and_handle_errors ~prog main
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-libvirt/libguestfs.git
More information about the Pkg-libvirt-commits
mailing list