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 ++++---- generator/bindtests.ml | 26 ++++++++++++----------- generator/utils.ml | 14 ++++--------- v2v/changeuid.ml | 7 +------ v2v/copy_to_local.ml | 4 +--- v2v/input_libvirt_vddk.ml | 9 ++++---- v2v/input_ova.ml | 46 +++++++++++++++++++++-------------------- v2v/output_local.ml | 4 +--- v2v/output_qemu.ml | 29 +++++++++++++------------- v2v/output_vdsm.ml | 8 ++----- 13 files changed, 127 insertions(+), 119 deletions(-) diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml index ba23f39ed..ee6bea5af 100644 --- a/common/mlstdutils/std_utils.ml +++ b/common/mlstdutils/std_utils.ml @@ -654,20 +654,29 @@ let verbose = ref false let set_verbose () = verbose := true let verbose () = !verbose +let with_open_in filename f = + let chan = open_in filename in + protect ~f:(fun () -> f chan) ~finally:(fun () -> close_in chan) + +let with_open_out filename f = + let chan = open_out filename in + protect ~f:(fun () -> f chan) ~finally:(fun () -> close_out chan) + let read_whole_file path = let buf = Buffer.create 16384 in - let chan = open_in path in - let maxlen = 16384 in - let b = Bytes.create maxlen in - let rec loop () = - let r = input chan b 0 maxlen in - if r > 0 then ( - Buffer.add_substring buf (Bytes.to_string b) 0 r; + with_open_in path ( + fun chan -> + let maxlen = 16384 in + let b = Bytes.create maxlen in + let rec loop () = + let r = input chan b 0 maxlen in + if r > 0 then ( + Buffer.add_substring buf (Bytes.to_string b) 0 r; + loop () + ) + in loop () - ) - in - loop (); - close_in chan; + ); Buffer.contents buf (* Compare two version strings intelligently. *) @@ -824,10 +833,10 @@ let last_part_of str sep = with Not_found -> None let read_first_line_from_file filename = - let chan = open_in filename in - let line = try input_line chan with End_of_file -> "" in - close_in chan; - line + with_open_in filename ( + fun chan -> + try input_line chan with End_of_file -> "" + ) let is_regular_file path = (* NB: follows symlinks. *) try (Unix.stat path).Unix.st_kind = Unix.S_REG diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli index 96c55a511..7af6c2111 100644 --- a/common/mlstdutils/std_utils.mli +++ b/common/mlstdutils/std_utils.mli @@ -387,6 +387,18 @@ val verbose : unit -> bool (** Stores the colours ([--colours]), quiet ([--quiet]), trace ([-x]) and verbose ([-v]) flags in global variables. *) +val with_open_in : string -> (in_channel -> 'a) -> 'a +(** [with_open_in filename f] calls function [f] with [filename] + open for input. The file is always closed either on normal + return or if the function [f] throws an exception, so this is + both safer and more concise than the regular function. *) + +val with_open_out : string -> (out_channel -> 'a) -> 'a +(** [with_open_out filename f] calls function [f] with [filename] + open for output. The file is always closed either on normal + return or if the function [f] throws an exception, so this is + both safer and more concise than the regular function. *) + val read_whole_file : string -> string (** Read in the whole file as a string. *) diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml index 8140ba84d..95658a75f 100644 --- a/common/mltools/tools_utils.ml +++ b/common/mltools/tools_utils.ml @@ -478,26 +478,25 @@ let debug_augeas_errors g = (* Detect type of a file. *) let detect_file_type filename = - let chan = open_in filename in - let get start size = - try - seek_in chan start; - let b = Bytes.create size in - really_input chan b 0 size; - Some (Bytes.to_string b) - with End_of_file | Invalid_argument _ -> None - in - let ret = - if get 0 6 = Some "\2537zXZ\000" then `XZ - else if get 0 4 = Some "PK\003\004" then `Zip - else if get 0 4 = Some "PK\005\006" then `Zip - else if get 0 4 = Some "PK\007\008" then `Zip - else if get 257 6 = Some "ustar\000" then `Tar - else if get 257 8 = Some "ustar\x20\x20\000" then `Tar - else if get 0 2 = Some "\x1f\x8b" then `GZip - else `Unknown in - close_in chan; - ret + with_open_in filename ( + fun chan -> + let get start size = + try + seek_in chan start; + let b = Bytes.create size in + really_input chan b 0 size; + Some (Bytes.to_string b) + with End_of_file | Invalid_argument _ -> None + in + if get 0 6 = Some "\2537zXZ\000" then `XZ + else if get 0 4 = Some "PK\003\004" then `Zip + else if get 0 4 = Some "PK\005\006" then `Zip + else if get 0 4 = Some "PK\007\008" then `Zip + else if get 257 6 = Some "ustar\000" then `Tar + else if get 257 8 = Some "ustar\x20\x20\000" then `Tar + else if get 0 2 = Some "\x1f\x8b" then `GZip + else `Unknown + ) let is_partition dev = try diff --git a/dib/dib.ml b/dib/dib.ml index 9a8d86bd9..94ad3003a 100644 --- a/dib/dib.ml +++ b/dib/dib.ml @@ -60,10 +60,11 @@ let read_dib_envvars () = String.concat "" vars let write_script fn text = - let oc = open_out fn in - output_string oc text; - flush oc; - close_out oc; + with_open_out fn ( + fun oc -> + output_string oc text; + flush oc + ); Unix.chmod fn 0o755 let envvars_string l = diff --git a/generator/bindtests.ml b/generator/bindtests.ml index 4bdff8092..79b020326 100644 --- a/generator/bindtests.ml +++ b/generator/bindtests.ml @@ -966,18 +966,20 @@ and generate_php_bindtests () = pr "--EXPECT--\n"; let dump filename = - let chan = open_in filename in - let rec loop () = - let line = input_line chan in - (match String.nsplit ":" line with - | ("obool"|"oint"|"oint64"|"ostring"|"ostringlist") as x :: _ -> - pr "%s: unset\n" x - | _ -> pr "%s\n" line - ); - loop () - in - (try loop () with End_of_file -> ()); - close_in chan in + with_open_in filename ( + fun chan -> + let rec loop () = + let line = input_line chan in + (match String.nsplit ":" line with + | ("obool"|"oint"|"oint64"|"ostring"|"ostringlist") as x :: _ -> + pr "%s: unset\n" x + | _ -> pr "%s\n" line + ); + loop () + in + (try loop () with End_of_file -> ()); + ) + in dump "bindtests" diff --git a/generator/utils.ml b/generator/utils.ml index b818a0b3c..e91fed577 100644 --- a/generator/utils.ml +++ b/generator/utils.ml @@ -179,19 +179,13 @@ type memo_value = string list (* list of lines of POD file *) let pod2text_memo_filename = "generator/.pod2text.data.version.2" let pod2text_memo : (memo_key, memo_value) Hashtbl.t = - try - let chan = open_in pod2text_memo_filename in - let v = input_value chan in - close_in chan; - v - with - _ -> Hashtbl.create 13 + try with_open_in pod2text_memo_filename input_value + with _ -> Hashtbl.create 13 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 + with_open_out pod2text_memo_filename + (fun chan -> output_value chan pod2text_memo) let pod2text_memo_updated () = if not (!pod2text_memo_atexit) then ( at_exit pod2text_memo_save; diff --git a/v2v/changeuid.ml b/v2v/changeuid.ml index 49290c298..f4c5c90d1 100644 --- a/v2v/changeuid.ml +++ b/v2v/changeuid.ml @@ -66,12 +66,7 @@ let rmdir t path = with_fork t (sprintf "rmdir: %s" path) (fun () -> rmdir path) let output t path f = - with_fork t path ( - fun () -> - let chan = open_out path in - f chan; - close_out chan - ) + with_fork t path (fun () -> with_open_out path f) let make_file t path content = output t path (fun chan -> output_string chan content) diff --git a/v2v/copy_to_local.ml b/v2v/copy_to_local.ml index f1a67fc14..3e41016c5 100644 --- a/v2v/copy_to_local.ml +++ b/v2v/copy_to_local.ml @@ -226,9 +226,7 @@ read the man page virt-v2v-copy-to-local(1). let guest_xml = guest_name ^ ".xml" in message (f_"Writing libvirt XML metadata to %s ...") guest_xml; - let chan = open_out guest_xml in - output_string chan xml; - close_out chan; + with_open_out guest_xml (fun chan -> output_string chan xml); (* Finished, so don't delete the disks on exit. *) message (f_"Finishing off"); diff --git a/v2v/input_libvirt_vddk.ml b/v2v/input_libvirt_vddk.ml index 63e76a5aa..e29fbc2b7 100644 --- a/v2v/input_libvirt_vddk.ml +++ b/v2v/input_libvirt_vddk.ml @@ -240,10 +240,11 @@ object "password=-" | Some password -> let password_file = tmpdir // "password" in - let chan = open_out password_file in - chmod password_file 0o600; - output_string chan password; - close_out chan; + with_open_out password_file ( + fun chan -> + chmod password_file 0o600; + output_string chan password + ); (* nbdkit reads the password from the file *) "password=+" ^ password_file in add_arg (sprintf "server=%s" server); diff --git a/v2v/input_ova.ml b/v2v/input_ova.ml index abb0654a5..ff00118b3 100644 --- a/v2v/input_ova.ml +++ b/v2v/input_ova.ml @@ -215,29 +215,31 @@ object debug "processing manifest %s" mf; let mf_folder = Filename.dirname mf in let mf_subfolder = subdirectory exploded mf_folder in - let chan = open_in mf in - let rec loop () = - let line = input_line chan in - if PCRE.matches rex line then ( - let mode = PCRE.sub 1 - and disk = PCRE.sub 2 - and expected = PCRE.sub 3 in - let csum = Checksums.of_string mode expected in - try - if partial then - Checksums.verify_checksum csum ~tar:ova (mf_subfolder // disk) + with_open_in mf ( + fun chan -> + let rec loop () = + let line = input_line chan in + if PCRE.matches rex line then ( + let mode = PCRE.sub 1 + and disk = PCRE.sub 2 + and expected = PCRE.sub 3 in + let csum = Checksums.of_string mode expected in + try + if partial then + Checksums.verify_checksum csum + ~tar:ova (mf_subfolder // disk) + else + Checksums.verify_checksum csum (mf_folder // disk) + with Checksums.Mismatched_checksum (_, actual) -> + error (f_"checksum of disk %s does not match manifest %s (actual %s(%s) = %s, expected %s(%s) = %s)") + disk mf mode disk actual mode disk expected; + ) else - Checksums.verify_checksum csum (mf_folder // disk) - with Checksums.Mismatched_checksum (_, actual) -> - error (f_"checksum of disk %s does not match manifest %s (actual %s(%s) = %s, expected %s(%s) = %s)") - disk mf mode disk actual mode disk expected; - ) - else - warning (f_"unable to parse line from manifest file: %S") line; - loop () - in - (try loop () with End_of_file -> ()); - close_in chan + warning (f_"unable to parse line from manifest file: %S") line; + loop () + in + (try loop () with End_of_file -> ()) + ) ) mf; let ovf_folder = Filename.dirname ovf in diff --git a/v2v/output_local.ml b/v2v/output_local.ml index 93d643f03..97ad8dddd 100644 --- a/v2v/output_local.ml +++ b/v2v/output_local.ml @@ -67,9 +67,7 @@ class output_local dir = object let name = source.s_name in let file = dir // name ^ ".xml" in - let chan = open_out file in - DOM.doc_to_chan chan doc; - close_out chan + with_open_out file (fun chan -> DOM.doc_to_chan chan doc) end let output_local = new output_local diff --git a/v2v/output_qemu.ml b/v2v/output_qemu.ml index 5304329ae..f61d698d6 100644 --- a/v2v/output_qemu.ml +++ b/v2v/output_qemu.ml @@ -229,23 +229,24 @@ object arg "-serial" "stdio"; (* Write the output file. *) - let chan = open_out file in - let fpf fs = fprintf chan fs in - fpf "#!/bin/sh -\n"; - fpf "\n"; + with_open_out file ( + fun chan -> + let fpf fs = fprintf chan fs in + fpf "#!/bin/sh -\n"; + fpf "\n"; - (match uefi_firmware with - | None -> () - | Some { Uefi.vars = vars_template } -> - fpf "# Make a copy of the UEFI variables template\n"; - fpf "uefi_vars=\"$(mktemp)\"\n"; - fpf "cp %s \"$uefi_vars\"\n" (quote vars_template); - fpf "\n" + (match uefi_firmware with + | None -> () + | Some { Uefi.vars = vars_template } -> + fpf "# Make a copy of the UEFI variables template\n"; + fpf "uefi_vars=\"$(mktemp)\"\n"; + fpf "cp %s \"$uefi_vars\"\n" (quote vars_template); + fpf "\n" + ); + + Qemuopts.to_chan cmd chan ); - Qemuopts.to_chan cmd chan; - close_out chan; - Unix.chmod file 0o755; (* If --qemu-boot option was specified then we should boot the guest. *) diff --git a/v2v/output_vdsm.ml b/v2v/output_vdsm.ml index 0aeee289d..d5911e80e 100644 --- a/v2v/output_vdsm.ml +++ b/v2v/output_vdsm.ml @@ -144,9 +144,7 @@ object List.iter ( fun ({ target_file }, meta) -> let meta_filename = target_file ^ ".meta" in - let chan = open_out meta_filename in - output_string chan meta; - close_out chan + with_open_out meta_filename (fun chan -> output_string chan meta) ) (List.combine targets metas); (* Return the list of targets. *) @@ -177,9 +175,7 @@ object (* Write it to the metadata file. *) let file = vdsm_params.ovf_output // vdsm_params.vm_uuid ^ ".ovf" in - let chan = open_out file in - DOM.doc_to_chan chan ovf; - close_out chan + with_open_out file (fun chan -> DOM.doc_to_chan chan ovf) end let output_vdsm = new output_vdsm -- 2.13.2