OCaml virt-* tools: Handle pretty printing of exceptions through a common library function.

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

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

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

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. *)
 

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

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

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 ();
 

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