[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]

[Libguestfs] [PATCH 1/2] common/mlstdutils: Add with_open_in and with_open_out functions.



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


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]