search for: open_out

These safe wrappers around Pervasives.open_in and Pervasives.open_out ensure that exceptions escaping cannot leave unclosed files. --- common/mlstdutils/std_utils.ml | 39 ++++++++++++++++++++-------------- common/mlstdutils/std_utils.mli | 12 +++++++++++ common/mltools/tools_utils.ml | 39 +++++++++++++++++----------------- dib/dib.ml | 9...

See patch #2 for more explanation. Pino Toscano (2): prepare: keep config_files available for longer prepare: create a really empty base.tar.gz with no config files src/mode_prepare.ml | 87 +++++++++++++++++++++++++++------------------ 1 file changed, 52 insertions(+), 35 deletions(-) -- 2.17.2

Enhance the output in machine parseable mode, by outputting all the messages of OCaml tools as JSON to the machine parseable stream. Related, although not strictly needed for this (and thus can be split if requested), is the addition of the fd format for the machine readable stream. Changes from v1: - use Obj.magic to convert int -> Unix.file_descr - add tests Pino Toscano (4):

...utput +let machine_readable_channel = ref None +let machine_readable () = + let chan = + if !machine_readable_channel = None then ( + let chan = + match !machine_readable_output with + | NoOutput -> None + | Channel chan -> Some chan + | File f -> Some (open_out f) in + machine_readable_channel := chan + ); + !machine_readable_channel + in + match chan with + | None -> None + | Some chan -> + let pr fs = + ksprintf (output_string chan) fs + in + Some { pr } + (* ANSI terminal colours. *) let istty chan = Unix.isatty...

...+ b/generator/utils.ml @@ -291,10 +291,22 @@ let pod2text_memo : (memo_key, memo_value) Hashtbl.t = v with _ -> Hashtbl.create 13 -let pod2text_memo_updated () = +let pod2text_memo_unsaved_count = ref 0 +let pod2text_memo_atexit = ref false +let pod2text_memo_save () = let chan = open_out pod2text_memo_filename in output_value chan pod2text_memo; close_out chan +let pod2text_memo_updated () = + if not (!pod2text_memo_atexit) then ( + at_exit pod2text_memo_save; + pod2text_memo_atexit := true; + ); + pod2text_memo_unsaved_count := !pod2text_memo_unsaved_count + 1; + i...

...t machine_readable_output = ref NoOutput let machine_readable_channel = ref None let machine_readable () = @@ -50,7 +51,10 @@ let machine_readable () = match !machine_readable_output with | NoOutput -> None | Channel chan -> Some chan - | File f -> Some (open_out f) in + | File f -> Some (open_out f) + | Fd fd -> + (* Note that Unix.file_descr is really just an int. *) + Some (Unix.out_channel_of_descr (Obj.magic fd)) in machine_readable_channel := chan ); !machine_readable_channel @@ -296,6 +300,11 @@...

...h> #include <guestfs.h> @@ -37,6 +40,7 @@ extern value guestfs_int_mllib_inspect_decrypt (value gv, value gpv, value keysv); extern value guestfs_int_mllib_set_echo_keys (value unitv); extern value guestfs_int_mllib_set_keys_from_stdin (value unitv); +extern value guestfs_int_mllib_open_out_channel_from_fd (value fdv); /* Interface with the guestfish inspection and decryption code. */ int echo_keys = 0; @@ -103,3 +107,16 @@ guestfs_int_mllib_set_keys_from_stdin (value unitv) keys_from_stdin = 1; return Val_unit; } + +value +guestfs_int_mllib_open_out_channel_from_fd (value...

...y_kernel, format, host_cpu, printf "supermin: there are %d config files\n" (List.length config_files); - let files_from = - (* Put the list of config files into a file, for tar to read. *) - let files_from = tmpdir // "files-from.txt" in - let chan = open_out files_from in - List.iter (fprintf chan ".%s\n") config_files; (* "./filename" *) - close_out chan; - - files_from in - - (* Write base.tar.gz. *) let base = outputdir // "base.tar.gz" in - if debug >= 1 then printf "supermin: writing %s\n%!"...

This is a "merge" of two previous series: https://www.redhat.com/archives/libguestfs/2018-December/msg00015.html https://www.redhat.com/archives/libguestfs/2018-December/msg00020.html The goal is to handle better situations like: - empty file in the appliance directory - no config files available in the packages to include in an appliance Compared to the two series, the changes are: -

Enhance the output in machine parseable mode, by outputting all the messages of OCaml tools as JSON to the machine parseable stream. Related, although not strictly needed for this (and thus can be split if requested), is the addition of the fd format for the machine readable stream. Pino Toscano (4): common/mltools: move the code for machine readable up common/mltools: make sure machine

...t;/images/<IMAGE_UUID>/ @@ -146,7 +144,7 @@ object vdsm_params.vm_uuid in (* Write it to the metadata file. *) - let file = ovf_dir // vdsm_params.vm_uuid ^ ".ovf" in + let file = vdsm_params.ovf_output // vdsm_params.vm_uuid ^ ".ovf" in let chan = open_out file in doc_to_chan chan ovf; close_out chan diff --git a/v2v/output_vdsm.mli b/v2v/output_vdsm.mli index 56ddf55..3f63191 100644 --- a/v2v/output_vdsm.mli +++ b/v2v/output_vdsm.mli @@ -22,6 +22,7 @@ type vdsm_params = { image_uuid : string; (* --vdsm-image-uuid *) vo...

...s = - let args = Array.to_list args in - let rec quote_args = function - | [] -> "" - | x :: xs -> " " ^ (quote x) ^ quote_args xs - in - match args with - | [] -> "" - | app :: xs -> app ^ quote_args xs - let write_script fn text = let oc = open_out fn in output_string oc text; @@ -507,7 +497,7 @@ let main () = printf " (none)\n"; printf "\n"; ); - let dib_args = make_dib_args Sys.argv in + let dib_args = stringify_args Sys.argv in let dib_vars = read_dib_envvars () in if debug >= 1 then (...

...); + if debug >= 1 then + printf "supermin: there are %d config files\n" + (List.length config_files); + let files_from = (* Put the list of config files into a file, for tar to read. *) let files_from = tmpdir // "files-from.txt" in let chan = open_out files_from in -- 2.17.2

...ockf lock_fd Unix.F_LOCK 1 + with + | exn -> + perror "lock: HACKING" exn; + exit 1); let close = output_to "src/guestfs_protocol.x" in generate_xdr (); @@ -10339,4 +10360,7 @@ Run it from the top source directory using the command *) let chan = open_out "src/stamp-generator" in fprintf chan "1\n"; - close_out chan + close_out chan; + + (* Release lock. *) + Unix.close lock_fd -- 1.6.5.2

...ect_fs_windows.ml | 7 +++---- 4 files changed, 15 insertions(+), 7 deletions(-) diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml index ee6bea5af..5d451fae8 100644 --- a/common/mlstdutils/std_utils.ml +++ b/common/mlstdutils/std_utils.ml @@ -662,6 +662,10 @@ let with_open_out filename f = let chan = open_out filename in protect ~f:(fun () -> f chan) ~finally:(fun () -> close_out chan) +let with_openfile filename flags perms f = + let fd = Unix.openfile filename flags perms in + protect ~f:(fun () -> f fd) ~finally:(fun () -> Unix.close fd) + let r...

...>/<ESD_UUID>/images/ @@ -164,7 +162,7 @@ object vdsm_params.vm_uuid in (* Write it to the metadata file. *) - let file = ovf_dir // vdsm_params.vm_uuid ^ ".ovf" in + let file = vdsm_params.ovf_output // vdsm_params.vm_uuid ^ ".ovf" in let chan = open_out file in doc_to_chan chan ovf; close_out chan diff --git a/v2v/output_vdsm.mli b/v2v/output_vdsm.mli index 3ee5425..26ac15d 100644 --- a/v2v/output_vdsm.mli +++ b/v2v/output_vdsm.mli @@ -22,6 +22,7 @@ type vdsm_params = { image_uuids : string list; (* --vdsm-image-uuid (multipl...

...s.ml | 18 ++++++++---------- 4 files changed, 20 insertions(+), 13 deletions(-) diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml index ee6bea5af..32944ed27 100644 --- a/common/mlstdutils/std_utils.ml +++ b/common/mlstdutils/std_utils.ml @@ -662,6 +662,10 @@ let with_open_out filename f = let chan = open_out filename in protect ~f:(fun () -> f chan) ~finally:(fun () -> close_out chan) +let with_openfile filename flags perms = + let fd = Unix.openfile filename flags perms in + protect ~f:(fun () -> f fd) ~finally:(fun () -> close fd) + let read_who...

...t;/images/<IMAGE_UUID>/ @@ -146,7 +144,7 @@ object vdsm_params.vm_uuid in (* Write it to the metadata file. *) - let file = ovf_dir // vdsm_params.vm_uuid ^ ".ovf" in + let file = vdsm_params.ovf_output // vdsm_params.vm_uuid ^ ".ovf" in let chan = open_out file in doc_to_chan chan ovf; close_out chan diff --git a/v2v/output_vdsm.mli b/v2v/output_vdsm.mli index 56ddf55..3f63191 100644 --- a/v2v/output_vdsm.mli +++ b/v2v/output_vdsm.mli @@ -22,6 +22,7 @@ type vdsm_params = { image_uuid : string; (* --vdsm-image-uuid *) vo...

...>/<ESD_UUID>/images/ @@ -164,7 +162,7 @@ object vdsm_params.vm_uuid in (* Write it to the metadata file. *) - let file = ovf_dir // vdsm_params.vm_uuid ^ ".ovf" in + let file = vdsm_params.ovf_output // vdsm_params.vm_uuid ^ ".ovf" in let chan = open_out file in doc_to_chan chan ovf; close_out chan diff --git a/v2v/output_vdsm.mli b/v2v/output_vdsm.mli index 3ee5425..26ac15d 100644 --- a/v2v/output_vdsm.mli +++ b/v2v/output_vdsm.mli @@ -22,6 +22,7 @@ type vdsm_params = { image_uuids : string list; (* --vdsm-image-uuid (multipl...

...t;/images/<IMAGE_UUID>/ @@ -146,7 +144,7 @@ object vdsm_params.vm_uuid in (* Write it to the metadata file. *) - let file = ovf_dir // vdsm_params.vm_uuid ^ ".ovf" in + let file = vdsm_params.ovf_output // vdsm_params.vm_uuid ^ ".ovf" in let chan = open_out file in doc_to_chan chan ovf; close_out chan diff --git a/v2v/output_vdsm.mli b/v2v/output_vdsm.mli index 56ddf55..3f63191 100644 --- a/v2v/output_vdsm.mli +++ b/v2v/output_vdsm.mli @@ -22,6 +22,7 @@ type vdsm_params = { image_uuid : string; (* --vdsm-image-uuid *) vo...