mirror of
https://github.com/libguestfs/libguestfs.git
synced 2026-03-22 07:03:38 +00:00
sparsify: Capture any exceptions and display nicer error messages.
This is just code motion, there is no functional change.
This commit is contained in:
Richard W.M. Jones
@@ -31,68 +31,69 @@ external statvfs_free_space : string -> int64 =
|
||||
|
||||
let () = Random.self_init ()
|
||||
|
||||
(* Command line argument parsing. *)
|
||||
let prog = Filename.basename Sys.executable_name
|
||||
let error fs = error ~prog fs
|
||||
|
||||
let indisk, outdisk, check_tmpdir, compress, convert, debug_gc,
|
||||
format, ignores, machine_readable,
|
||||
option, quiet, verbose, trace, zeroes =
|
||||
let display_version () =
|
||||
printf "virt-sparsify %s\n" Config.package_version;
|
||||
exit 0
|
||||
in
|
||||
let main () =
|
||||
(* Command line argument parsing. *)
|
||||
let indisk, outdisk, check_tmpdir, compress, convert, debug_gc,
|
||||
format, ignores, machine_readable,
|
||||
option, quiet, verbose, trace, zeroes =
|
||||
let display_version () =
|
||||
printf "virt-sparsify %s\n" Config.package_version;
|
||||
exit 0
|
||||
in
|
||||
|
||||
let add xs s = xs := s :: !xs in
|
||||
let add xs s = xs := s :: !xs in
|
||||
|
||||
let check_tmpdir = ref `Warn in
|
||||
let set_check_tmpdir = function
|
||||
| "ignore" | "i" -> check_tmpdir := `Ignore
|
||||
| "continue" | "cont" | "c" -> check_tmpdir := `Continue
|
||||
| "warn" | "warning" | "w" -> check_tmpdir := `Warn
|
||||
| "fail" | "f" | "error" -> check_tmpdir := `Fail
|
||||
| str ->
|
||||
eprintf (f_"--check-tmpdir: unknown argument `%s'\n") str;
|
||||
exit 1
|
||||
in
|
||||
let check_tmpdir = ref `Warn in
|
||||
let set_check_tmpdir = function
|
||||
| "ignore" | "i" -> check_tmpdir := `Ignore
|
||||
| "continue" | "cont" | "c" -> check_tmpdir := `Continue
|
||||
| "warn" | "warning" | "w" -> check_tmpdir := `Warn
|
||||
| "fail" | "f" | "error" -> check_tmpdir := `Fail
|
||||
| str ->
|
||||
eprintf (f_"--check-tmpdir: unknown argument `%s'\n") str;
|
||||
exit 1
|
||||
in
|
||||
|
||||
let compress = ref false in
|
||||
let convert = ref "" in
|
||||
let debug_gc = ref false in
|
||||
let format = ref "" in
|
||||
let ignores = ref [] in
|
||||
let machine_readable = ref false in
|
||||
let option = ref "" in
|
||||
let quiet = ref false in
|
||||
let verbose = ref false in
|
||||
let trace = ref false in
|
||||
let zeroes = ref [] in
|
||||
let compress = ref false in
|
||||
let convert = ref "" in
|
||||
let debug_gc = ref false in
|
||||
let format = ref "" in
|
||||
let ignores = ref [] in
|
||||
let machine_readable = ref false in
|
||||
let option = ref "" in
|
||||
let quiet = ref false in
|
||||
let verbose = ref false in
|
||||
let trace = ref false in
|
||||
let zeroes = ref [] in
|
||||
|
||||
let ditto = " -\"-" in
|
||||
let argspec = Arg.align [
|
||||
"--check-tmpdir", Arg.String set_check_tmpdir, "ignore|..." ^ " " ^ s_"Check there is enough space in $TMPDIR";
|
||||
"--compress", Arg.Set compress, " " ^ s_"Compressed output format";
|
||||
"--convert", Arg.Set_string convert, s_"format" ^ " " ^ s_"Format of output disk (default: same as input)";
|
||||
"--debug-gc", Arg.Set debug_gc, " " ^ s_"Debug GC and memory allocations";
|
||||
"--format", Arg.Set_string format, s_"format" ^ " " ^ s_"Format of input disk";
|
||||
"--ignore", Arg.String (add ignores), s_"fs" ^ " " ^ s_"Ignore filesystem";
|
||||
"--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
|
||||
"--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
|
||||
"-o", Arg.Set_string option, s_"option" ^ " " ^ s_"Add qemu-img options";
|
||||
"-q", Arg.Set quiet, " " ^ s_"Quiet output";
|
||||
"--quiet", Arg.Set quiet, ditto;
|
||||
"-v", Arg.Set verbose, " " ^ s_"Enable debugging messages";
|
||||
"--verbose", Arg.Set verbose, ditto;
|
||||
"-V", Arg.Unit display_version, " " ^ s_"Display version and exit";
|
||||
"--version", Arg.Unit display_version, ditto;
|
||||
"-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
|
||||
"--zero", Arg.String (add zeroes), s_"fs" ^ " " ^ s_"Zero filesystem";
|
||||
] in
|
||||
long_options := argspec;
|
||||
let disks = ref [] in
|
||||
let anon_fun s = disks := s :: !disks in
|
||||
let usage_msg =
|
||||
sprintf (f_"\
|
||||
let ditto = " -\"-" in
|
||||
let argspec = Arg.align [
|
||||
"--check-tmpdir", Arg.String set_check_tmpdir, "ignore|..." ^ " " ^ s_"Check there is enough space in $TMPDIR";
|
||||
"--compress", Arg.Set compress, " " ^ s_"Compressed output format";
|
||||
"--convert", Arg.Set_string convert, s_"format" ^ " " ^ s_"Format of output disk (default: same as input)";
|
||||
"--debug-gc", Arg.Set debug_gc, " " ^ s_"Debug GC and memory allocations";
|
||||
"--format", Arg.Set_string format, s_"format" ^ " " ^ s_"Format of input disk";
|
||||
"--ignore", Arg.String (add ignores), s_"fs" ^ " " ^ s_"Ignore filesystem";
|
||||
"--long-options", Arg.Unit display_long_options, " " ^ s_"List long options";
|
||||
"--machine-readable", Arg.Set machine_readable, " " ^ s_"Make output machine readable";
|
||||
"-o", Arg.Set_string option, s_"option" ^ " " ^ s_"Add qemu-img options";
|
||||
"-q", Arg.Set quiet, " " ^ s_"Quiet output";
|
||||
"--quiet", Arg.Set quiet, ditto;
|
||||
"-v", Arg.Set verbose, " " ^ s_"Enable debugging messages";
|
||||
"--verbose", Arg.Set verbose, ditto;
|
||||
"-V", Arg.Unit display_version, " " ^ s_"Display version and exit";
|
||||
"--version", Arg.Unit display_version, ditto;
|
||||
"-x", Arg.Set trace, " " ^ s_"Enable tracing of libguestfs calls";
|
||||
"--zero", Arg.String (add zeroes), s_"fs" ^ " " ^ s_"Zero filesystem";
|
||||
] in
|
||||
long_options := argspec;
|
||||
let disks = ref [] in
|
||||
let anon_fun s = disks := s :: !disks in
|
||||
let usage_msg =
|
||||
sprintf (f_"\
|
||||
%s: sparsify a virtual machine disk
|
||||
|
||||
virt-sparsify [--options] indisk outdisk
|
||||
@@ -100,118 +101,114 @@ let indisk, outdisk, check_tmpdir, compress, convert, debug_gc,
|
||||
A short summary of the options is given below. For detailed help please
|
||||
read the man page virt-sparsify(1).
|
||||
")
|
||||
prog in
|
||||
Arg.parse argspec anon_fun usage_msg;
|
||||
prog in
|
||||
Arg.parse argspec anon_fun usage_msg;
|
||||
|
||||
(* Dereference the rest of the args. *)
|
||||
let check_tmpdir = !check_tmpdir in
|
||||
let compress = !compress in
|
||||
let convert = match !convert with "" -> None | str -> Some str in
|
||||
let debug_gc = !debug_gc in
|
||||
let format = match !format with "" -> None | str -> Some str in
|
||||
let ignores = List.rev !ignores in
|
||||
let machine_readable = !machine_readable in
|
||||
let option = match !option with "" -> None | str -> Some str in
|
||||
let quiet = !quiet in
|
||||
let verbose = !verbose in
|
||||
let trace = !trace in
|
||||
let zeroes = List.rev !zeroes in
|
||||
(* Dereference the rest of the args. *)
|
||||
let check_tmpdir = !check_tmpdir in
|
||||
let compress = !compress in
|
||||
let convert = match !convert with "" -> None | str -> Some str in
|
||||
let debug_gc = !debug_gc in
|
||||
let format = match !format with "" -> None | str -> Some str in
|
||||
let ignores = List.rev !ignores in
|
||||
let machine_readable = !machine_readable in
|
||||
let option = match !option with "" -> None | str -> Some str in
|
||||
let quiet = !quiet in
|
||||
let verbose = !verbose in
|
||||
let trace = !trace in
|
||||
let zeroes = List.rev !zeroes in
|
||||
|
||||
(* No arguments and machine-readable mode? Print out some facts
|
||||
* about what this binary supports.
|
||||
*)
|
||||
if !disks = [] && machine_readable then (
|
||||
printf "virt-sparsify\n";
|
||||
printf "linux-swap\n";
|
||||
printf "zero\n";
|
||||
printf "check-tmpdir\n";
|
||||
let g = new G.guestfs () in
|
||||
g#add_drive "/dev/null";
|
||||
g#launch ();
|
||||
if g#feature_available [| "ntfsprogs"; "ntfs3g" |] then
|
||||
printf "ntfs\n";
|
||||
if g#feature_available [| "btrfs" |] then
|
||||
printf "btrfs\n";
|
||||
exit 0
|
||||
);
|
||||
(* No arguments and machine-readable mode? Print out some facts
|
||||
* about what this binary supports.
|
||||
*)
|
||||
if !disks = [] && machine_readable then (
|
||||
printf "virt-sparsify\n";
|
||||
printf "linux-swap\n";
|
||||
printf "zero\n";
|
||||
printf "check-tmpdir\n";
|
||||
let g = new G.guestfs () in
|
||||
g#add_drive "/dev/null";
|
||||
g#launch ();
|
||||
if g#feature_available [| "ntfsprogs"; "ntfs3g" |] then
|
||||
printf "ntfs\n";
|
||||
if g#feature_available [| "btrfs" |] then
|
||||
printf "btrfs\n";
|
||||
exit 0
|
||||
);
|
||||
|
||||
(* Verify we got exactly 2 disks. *)
|
||||
let indisk, outdisk =
|
||||
match List.rev !disks with
|
||||
| [indisk; outdisk] -> indisk, outdisk
|
||||
| _ ->
|
||||
(* Verify we got exactly 2 disks. *)
|
||||
let indisk, outdisk =
|
||||
match List.rev !disks with
|
||||
| [indisk; outdisk] -> indisk, outdisk
|
||||
| _ ->
|
||||
error "usage is: %s [--options] indisk outdisk" prog in
|
||||
|
||||
(* Simple-minded check that the user isn't trying to use the
|
||||
* same disk for input and output.
|
||||
(* Simple-minded check that the user isn't trying to use the
|
||||
* same disk for input and output.
|
||||
*)
|
||||
if indisk = outdisk then
|
||||
error (f_"you cannot use the same disk image for input and output");
|
||||
|
||||
(* The input disk must be an absolute path, so we can store the name
|
||||
* in the overlay disk.
|
||||
*)
|
||||
let indisk =
|
||||
if not (Filename.is_relative indisk) then
|
||||
indisk
|
||||
else
|
||||
Sys.getcwd () // indisk in
|
||||
|
||||
(* Check the output is not a block or char special (RHBZ#1056290). *)
|
||||
if is_block_device outdisk then
|
||||
error (f_"output '%s' cannot be a block device, it must be a regular file")
|
||||
outdisk;
|
||||
|
||||
if is_char_device outdisk then
|
||||
error (f_"output '%s' cannot be a character device, it must be a regular file")
|
||||
outdisk;
|
||||
|
||||
indisk, outdisk, check_tmpdir, compress, convert,
|
||||
debug_gc, format, ignores, machine_readable,
|
||||
option, quiet, verbose, trace, zeroes in
|
||||
|
||||
(* Once we have got past argument parsing and start to create
|
||||
* temporary files (including the potentially massive overlay file), we
|
||||
* need to catch SIGINT (^C) and exit cleanly so the temporary file
|
||||
* goes away. Note that we don't delete temporaries in the signal
|
||||
* handler.
|
||||
*)
|
||||
if indisk = outdisk then
|
||||
error (f_"you cannot use the same disk image for input and output");
|
||||
|
||||
(* The input disk must be an absolute path, so we can store the name
|
||||
* in the overlay disk.
|
||||
*)
|
||||
let indisk =
|
||||
if not (Filename.is_relative indisk) then
|
||||
indisk
|
||||
else
|
||||
Sys.getcwd () // indisk in
|
||||
|
||||
(* Check the output is not a block or char special (RHBZ#1056290). *)
|
||||
if is_block_device outdisk then
|
||||
error (f_"output '%s' cannot be a block device, it must be a regular file")
|
||||
outdisk;
|
||||
|
||||
if is_char_device outdisk then
|
||||
error (f_"output '%s' cannot be a character device, it must be a regular file")
|
||||
outdisk;
|
||||
|
||||
indisk, outdisk, check_tmpdir, compress, convert,
|
||||
debug_gc, format, ignores, machine_readable,
|
||||
option, quiet, verbose, trace, zeroes
|
||||
|
||||
(* Once we have got past argument parsing and start to create
|
||||
* temporary files (including the potentially massive overlay file), we
|
||||
* need to catch SIGINT (^C) and exit cleanly so the temporary file
|
||||
* goes away. Note that we don't delete temporaries in the signal
|
||||
* handler.
|
||||
*)
|
||||
let () =
|
||||
let do_sigint _ = exit 1 in
|
||||
Sys.set_signal Sys.sigint (Sys.Signal_handle do_sigint)
|
||||
Sys.set_signal Sys.sigint (Sys.Signal_handle do_sigint);
|
||||
|
||||
(* What should the output format be? If the user specified an
|
||||
* input format, use that, else detect it from the source image.
|
||||
*)
|
||||
let output_format =
|
||||
match convert with
|
||||
| Some fmt -> fmt (* user specified output conversion *)
|
||||
| None ->
|
||||
match format with
|
||||
| Some fmt -> fmt (* user specified input format, use that *)
|
||||
(* What should the output format be? If the user specified an
|
||||
* input format, use that, else detect it from the source image.
|
||||
*)
|
||||
let output_format =
|
||||
match convert with
|
||||
| Some fmt -> fmt (* user specified output conversion *)
|
||||
| None ->
|
||||
(* Don't know, so we must autodetect. *)
|
||||
match (new G.guestfs ())#disk_format indisk with
|
||||
| "unknown" ->
|
||||
error (f_"cannot detect input disk format; use the --format parameter")
|
||||
| fmt -> fmt
|
||||
match format with
|
||||
| Some fmt -> fmt (* user specified input format, use that *)
|
||||
| None ->
|
||||
(* Don't know, so we must autodetect. *)
|
||||
match (new G.guestfs ())#disk_format indisk with
|
||||
| "unknown" ->
|
||||
error (f_"cannot detect input disk format; use the --format parameter")
|
||||
| fmt -> fmt in
|
||||
|
||||
(* Compression is not supported by raw output (RHBZ#852194). *)
|
||||
let () =
|
||||
(* Compression is not supported by raw output (RHBZ#852194). *)
|
||||
if output_format = "raw" && compress then
|
||||
error (f_"--compress cannot be used for raw output. Remove this option or use --convert qcow2.")
|
||||
error (f_"--compress cannot be used for raw output. Remove this option or use --convert qcow2.");
|
||||
|
||||
(* Get virtual size of the input disk. *)
|
||||
let virtual_size = (new G.guestfs ())#disk_virtual_size indisk
|
||||
let () =
|
||||
(* Get virtual size of the input disk. *)
|
||||
let virtual_size = (new G.guestfs ())#disk_virtual_size indisk in
|
||||
if not quiet then
|
||||
printf (f_"Input disk virtual size = %Ld bytes (%s)\n%!")
|
||||
virtual_size (human_size virtual_size)
|
||||
virtual_size (human_size virtual_size);
|
||||
|
||||
(* Check there is enough space in $TMPDIR. *)
|
||||
let tmpdir = Filename.temp_dir_name
|
||||
(* Check there is enough space in $TMPDIR. *)
|
||||
let tmpdir = Filename.temp_dir_name in
|
||||
|
||||
let () =
|
||||
let print_warning () =
|
||||
let free_space = statvfs_free_space tmpdir in
|
||||
let extra_needed = virtual_size -^ free_space in
|
||||
@@ -236,7 +233,7 @@ You can ignore this warning or change it to a hard failure using the
|
||||
) else false
|
||||
in
|
||||
|
||||
match check_tmpdir with
|
||||
(match check_tmpdir with
|
||||
| `Ignore -> ()
|
||||
| `Continue -> ignore (print_warning ())
|
||||
| `Warn ->
|
||||
@@ -249,57 +246,54 @@ You can ignore this warning or change it to a hard failure using the
|
||||
eprintf "Exiting because --check-tmpdir=fail was set.\n%!";
|
||||
exit 2
|
||||
)
|
||||
);
|
||||
|
||||
let () =
|
||||
if not quiet then
|
||||
printf (f_"Create overlay file in %s to protect source disk ...\n%!") tmpdir
|
||||
printf (f_"Create overlay file in %s to protect source disk ...\n%!") tmpdir;
|
||||
|
||||
(* Create the temporary overlay file. *)
|
||||
let overlaydisk =
|
||||
let tmp = Filename.temp_file "sparsify" ".qcow2" in
|
||||
unlink_on_exit tmp;
|
||||
(* Create the temporary overlay file. *)
|
||||
let overlaydisk =
|
||||
let tmp = Filename.temp_file "sparsify" ".qcow2" in
|
||||
unlink_on_exit tmp;
|
||||
|
||||
(* Create it with the indisk as the backing file. *)
|
||||
(* XXX Old code used to:
|
||||
* - detect if compat=1.1 was supported
|
||||
* - add lazy_refcounts option
|
||||
*)
|
||||
(new G.guestfs ())#disk_create
|
||||
~backingfile:indisk ?backingformat:format ~compat:"1.1"
|
||||
tmp "qcow2" Int64.minus_one;
|
||||
(* Create it with the indisk as the backing file. *)
|
||||
(* XXX Old code used to:
|
||||
* - detect if compat=1.1 was supported
|
||||
* - add lazy_refcounts option
|
||||
*)
|
||||
(new G.guestfs ())#disk_create
|
||||
~backingfile:indisk ?backingformat:format ~compat:"1.1"
|
||||
tmp "qcow2" Int64.minus_one;
|
||||
|
||||
tmp
|
||||
tmp in
|
||||
|
||||
let () =
|
||||
if not quiet then
|
||||
printf (f_"Examine source disk ...\n%!")
|
||||
printf (f_"Examine source disk ...\n%!");
|
||||
|
||||
(* Connect to libguestfs. *)
|
||||
let g =
|
||||
let g = new G.guestfs () in
|
||||
if trace then g#set_trace true;
|
||||
if verbose then g#set_verbose true;
|
||||
(* Connect to libguestfs. *)
|
||||
let g =
|
||||
let g = new G.guestfs () in
|
||||
if trace then g#set_trace true;
|
||||
if verbose then g#set_verbose true;
|
||||
|
||||
(* Note that the temporary overlay disk is always qcow2 format. *)
|
||||
g#add_drive ~format:"qcow2" ~readonly:false ~cachemode:"unsafe" overlaydisk;
|
||||
(* Note that the temporary overlay disk is always qcow2 format. *)
|
||||
g#add_drive ~format:"qcow2" ~readonly:false ~cachemode:"unsafe" overlaydisk;
|
||||
|
||||
if not quiet then Progress.set_up_progress_bar ~machine_readable g;
|
||||
g#launch ();
|
||||
if not quiet then Progress.set_up_progress_bar ~machine_readable g;
|
||||
g#launch ();
|
||||
|
||||
g
|
||||
g in
|
||||
|
||||
(* Modify SIGINT handler (set first above) to cancel the handle. *)
|
||||
let () =
|
||||
(* Modify SIGINT handler (set first above) to cancel the handle. *)
|
||||
let do_sigint _ =
|
||||
g#user_cancel ();
|
||||
exit 1
|
||||
in
|
||||
Sys.set_signal Sys.sigint (Sys.Signal_handle do_sigint)
|
||||
Sys.set_signal Sys.sigint (Sys.Signal_handle do_sigint);
|
||||
|
||||
(* Write zeroes for non-ignored filesystems that we are able to mount,
|
||||
* and selected swap partitions.
|
||||
*)
|
||||
let () =
|
||||
(* Write zeroes for non-ignored filesystems that we are able to mount,
|
||||
* and selected swap partitions.
|
||||
*)
|
||||
let filesystems = g#list_filesystems () in
|
||||
let filesystems = List.map fst filesystems in
|
||||
let filesystems = List.sort compare filesystems in
|
||||
@@ -356,10 +350,9 @@ let () =
|
||||
|
||||
g#umount_all ()
|
||||
)
|
||||
) filesystems
|
||||
) filesystems;
|
||||
|
||||
(* Fill unused space in volume groups. *)
|
||||
let () =
|
||||
(* Fill unused space in volume groups. *)
|
||||
let vgs = g#vgs () in
|
||||
let vgs = Array.to_list vgs in
|
||||
let vgs = List.sort compare vgs in
|
||||
@@ -382,22 +375,19 @@ let () =
|
||||
g#lvremove lvdev
|
||||
)
|
||||
)
|
||||
) vgs
|
||||
) vgs;
|
||||
|
||||
(* Don't need libguestfs now. *)
|
||||
let () =
|
||||
(* Don't need libguestfs now. *)
|
||||
g#shutdown ();
|
||||
g#close ()
|
||||
g#close ();
|
||||
|
||||
(* Modify SIGINT handler (set first above) to just exit. *)
|
||||
let () =
|
||||
(* Modify SIGINT handler (set first above) to just exit. *)
|
||||
let do_sigint _ = exit 1 in
|
||||
Sys.set_signal Sys.sigint (Sys.Signal_handle do_sigint)
|
||||
Sys.set_signal Sys.sigint (Sys.Signal_handle do_sigint);
|
||||
|
||||
(* Now run qemu-img convert which copies the overlay to the
|
||||
* destination and automatically does sparsification.
|
||||
*)
|
||||
let () =
|
||||
(* Now run qemu-img convert which copies the overlay to the
|
||||
* destination and automatically does sparsification.
|
||||
*)
|
||||
if not quiet then
|
||||
printf (f_"Copy to destination and make sparse ...\n%!");
|
||||
|
||||
@@ -412,16 +402,42 @@ let () =
|
||||
if verbose then
|
||||
printf "%s\n%!" cmd;
|
||||
if Sys.command cmd <> 0 then
|
||||
error (f_"external command failed: %s") cmd
|
||||
error (f_"external command failed: %s") cmd;
|
||||
|
||||
(* Finished. *)
|
||||
let () =
|
||||
(* Finished. *)
|
||||
if not quiet then (
|
||||
print_newline ();
|
||||
wrap (s_"Sparsify operation completed with no errors. Before deleting the old disk, carefully check that the target disk boots and works correctly.\n");
|
||||
);
|
||||
|
||||
if debug_gc then
|
||||
Gc.compact ();
|
||||
Gc.compact ()
|
||||
|
||||
exit 0
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user