search for: run_main_and_handle_errors

...| 9 ++++++++- 5 files changed, 41 insertions(+), 4 deletions(-) diff --git a/builder/builder.ml b/builder/builder.ml index c7cbcaedb..651db83f0 100644 --- a/builder/builder.ml +++ b/builder/builder.ml @@ -791,4 +791,11 @@ let main () = Option.may print_string stats -let () = run_main_and_handle_errors main +let () = + let main_wrap () = + try main () + with + | Curl.Curl_failed (code, url) -> + error (f_"curl error: failed to download ‘%s’, error code %d") url code + in + run_main_and_handle_errors main_wrap diff --git a/common/mltools/curl.ml b/common/mltools/curl....

In case a repository of virt-builder references files (e.g. the index) that cannot be downloaded (network issues, 404, etc) then virt-builder errors out on this situation. This is not a nice situation, from an user POV. This series does some refactoring to allow to better handle downloading failures, and handle the failures gracefully in virt-builder. RFC because I'm not yet too convinced

...et dryrun = !dryrun in let memsize = !memsize in let network = !network in @@ -239,10 +237,7 @@ read the man page virt-customize(1). message (f_"Finishing off"); g#shutdown (); - g#close (); - - if debug_gc then - Gc.compact () + g#close () (* Finished. *) let () = run_main_and_handle_errors main diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml index ca6d470..99d2098 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -759,3 +759,7 @@ let read_first_line_from_file filename = let line = input_line chan in close_in chan; line + +(** Install an exit hook t...

...+ List.iter ( + fun ov -> + let saved_filename = + sprintf "%s/%s-%s.qcow2" overlay_dir src_name ov.ov_sd in + rename ov.ov_overlay_file saved_filename; + printf (f_"Overlay saved as %s [--debug-overlays]\n") saved_filename + ) overlays + let () = run_main_and_handle_errors main -- 2.4.3

...| Some Source_QXL -> Some QXL > + | Some Source_Cirrus -> Some Cirrus > + | Some Source_other_video _ | None -> None in > + > + { > + rcaps_block_bus = block_type; > + rcaps_net_bus = net_type; > + rcaps_video = video; > + } > + > let () = run_main_and_handle_errors main It's a bit surprising, because I thought that you'd want to pass in the requested preferences on the command line? About the specific issue of ordering, although what you've written works, you could find a few surprises. eg: $ rlwrap ocaml OCaml version 4.02.3...

...it a/mllib/common_utils.ml b/mllib/common_utils.ml index f8fa8fd..f9c45cc 100644 --- a/mllib/common_utils.ml +++ b/mllib/common_utils.ml @@ -20,8 +20,6 @@ open Printf open Common_gettext.Gettext -module G = Guestfs - let (//) = Filename.concat let ( +^ ) = Int64.add @@ -357,7 +355,7 @@ let run_main_and_handle_errors main = error (f_"%s: %s: %s") fname (Unix.error_message code) param | Sys_error msg -> (* from a syscall *) error (f_"%s") msg - | G.Error msg -> (* from libguestfs *) + | Guestfs.Error msg -> (* from...

...| Some Source_Cirrus -> Some Cirrus > > + | Some Source_other_video _ | None -> None in > > + > > + { > > + rcaps_block_bus = block_type; > > + rcaps_net_bus = net_type; > > + rcaps_video = video; > > + } > > + > > let () = run_main_and_handle_errors main > > It's a bit surprising, because I thought that you'd want to pass in > the requested preferences on the command line? Passing that on the command line makes sense for the copying mode, because in that mode there's no other place where to affect the choices. In the in...

...9 + | None -> None in + + let video = + match source.s_video with + | Some Source_QXL -> Some QXL + | Some Source_Cirrus -> Some Cirrus + | None -> None in + + { + rcaps_block_bus = block_type; + rcaps_net_bus = net_type; + rcaps_video = video; + } + let () = run_main_and_handle_errors main -- 2.5.0

...+ + let video = + match source.s_video with + | Some Source_QXL -> Some QXL + | Some Source_Cirrus -> Some Cirrus + | Some Source_other_video _ | None -> None in + + { + rcaps_block_bus = block_type; + rcaps_net_bus = net_type; + rcaps_video = video; + } + let () = run_main_and_handle_errors main -- 2.5.0

...res cmdline.machine_readable + option tmp cmdline.zeroes | Mode_in_place -> - In_place.run indisk format ignores machine_readable zeroes + In_place.run cmdline.indisk cmdline.format cmdline.ignores + cmdline.machine_readable cmdline.zeroes ) let () = run_main_and_handle_errors main -- 2.5.0

.. and a lot of refactoring. https://bugzilla.redhat.com/show_bug.cgi?id=1167623 Rich.

https://bugzilla.redhat.com/show_bug.cgi?id=1167623

...| CDROM -> s_"CD-ROM" + | Floppy -> s_"floppy disk") + desired_slot_nr + ) source.s_removables; + + { target_virtio_blk_bus = !virtio_blk_bus; + target_ide_bus = !ide_bus; + target_scsi_bus = !scsi_bus } + let () = run_main_and_handle_errors main -- 2.3.1

...ommon_utils.mli | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/mllib/common_utils.mli b/mllib/common_utils.mli index 79032bc..24f8f83 100644 --- a/mllib/common_utils.mli +++ b/mllib/common_utils.mli @@ -90,10 +90,6 @@ val info : ('a, unit, string, unit) format4 -> 'a val run_main_and_handle_errors : (unit -> unit) -> unit (** Common function for handling pretty-printing exceptions. *) -val print_version_and_exit : unit -> unit -(** Print the version number and exit. Implements [--version] flag in - the OCaml tools. *) - val generated_by : string (** The string "generat...

Just refactoring. Rich.

The 'may' function is a higher-order function (HOF) that replaces: match x with | None -> () | Some x -> f x with: may f x The idea comes from lablgtk (OCaml Gtk bindings) where it is widely used. If this change is clearer than previous code, then this could be used in many more places. However I previously steered clear from using HOFs like this because they can be

The decision on which device type to use for disks, network and video cards on output used to be taken deep inside the converting functions. This is not always desirable. In particular, there are scenarios when this decision is made before the convertion takes place. E.g. in in-place mode, the decisions are taken and the output VM configuration is created outside of v2v tool. This patchset

....smp; g#set_network cmdline.network; (* The output disk is being created, so use cache=unsafe here. *) @@ -781,6 +781,6 @@ let main () = Pervasives.flush Pervasives.stdout; Pervasives.flush Pervasives.stderr; - may print_string stats + Option.may print_string stats let () = run_main_and_handle_errors main diff --git a/builder/index.ml b/builder/index.ml index b895e3f52..84f66c265 100644 --- a/builder/index.ml +++ b/builder/index.ml @@ -53,34 +53,29 @@ let print_entry chan (name, { printable_name; file_uri; arch; osinfo; notes; aliases; hidden }) = let fp fs = f...

...cmdline.format cmdline.ignores option tmp cmdline.zeroes | Mode_in_place -> - In_place.run cmdline.indisk cmdline.format cmdline.ignores - cmdline.machine_readable cmdline.zeroes + In_place.run cmdline.indisk cmdline.format cmdline.ignores cmdline.zeroes ) let () = run_main_and_handle_errors main diff --git a/v2v/cmdline.ml b/v2v/cmdline.ml index 5b2df3555..10cbb90e6 100644 --- a/v2v/cmdline.ml +++ b/v2v/cmdline.ml @@ -48,7 +48,6 @@ let parse_cmdline () = let compressed = ref false in let debug_overlays = ref false in let do_copy = ref true in - let machine_readable = ref fal...

...mmand cmd <> 0 then + error (f_"Failed to move %s in repository") (tmprepo // filename) + ) (Array.to_list (Sys.readdir tmprepo)); + + (* Remove the processed image files *) + List.iter ( + fun filename -> Sys.remove (cmdline.repo // filename) + ) images + +let () = run_main_and_handle_errors main diff --git a/builder/virt-builder-repository.pod b/builder/virt-builder-repository.pod new file mode 100644 index 000000000..29d86b4ac --- /dev/null +++ b/builder/virt-builder-repository.pod @@ -0,0 +1,144 @@ +=begin html + +<img src="virt-builder.svg" width="250" + sty...