From: Stefano Zacchiroli <zack@upsilon.cc>
Date: Thu, 20 May 2004 17:17:24 +0000 (+0000)
Subject: added file locking while writing configuration to file (save_to)
X-Git-Tag: V_0_0_9~15
X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=3b1f83736ed6e8d73782bee68b903cb196056ff7;p=helm.git

added file locking while writing configuration to file (save_to)
---

diff --git a/helm/ocaml/registry/helm_registry.ml b/helm/ocaml/registry/helm_registry.ml
index a5e1d6e1a..ffe3b3a20 100644
--- a/helm/ocaml/registry/helm_registry.ml
+++ b/helm/ocaml/registry/helm_registry.ml
@@ -250,7 +250,8 @@ let save_to =
   in
   fun fname ->
     let xml_root =
-      create_element_node ~valcheck:false PxpHelmConf.pxp_spec dtd "helm_registry" []
+      create_element_node ~valcheck:false PxpHelmConf.pxp_spec dtd
+      "helm_registry" []
     in
     Hashtbl.iter
       (fun key value ->
@@ -264,17 +265,27 @@ let save_to =
         in
         add_key_node xml_root sections key value)
       registry;
-      let outchan = (* let's write xml output to fname *)
-        if Unix.system "xmllint --version &> /dev/null" = Unix.WEXITED 0 then
-          (* xmllint available, use it! *)
-          Unix.open_process_out (sprintf
-            "xmllint --format --encode utf8 -o '%s' -" fname)
-        else
-          (* xmllint not available, write pxp ugly output directly to fname *)
-          open_out fname
-      in
-      xml_root#write (`Out_channel outchan) `Enc_utf8;
-      close_out outchan
+      let outfile = open_out fname in
+      Unix.lockf (Unix.descr_of_out_channel outfile) Unix.F_LOCK 0; (* blocks *)
+      if
+        Unix.system "xmllint --version &> /dev/null" = Unix.WEXITED 0
+      then begin
+        let (xmllint_in, xmllint_out) =
+          Unix.open_process "xmllint --format --encode utf8 -"
+        in
+        xml_root#write (`Out_channel xmllint_out) `Enc_utf8;
+        close_out xmllint_out;
+        try
+          while true do
+            output_string outfile (input_line xmllint_in ^ "\n")
+          done
+        with End_of_file ->
+          close_in xmllint_in;
+          ignore (Unix.close_process (xmllint_in, xmllint_out))
+      end else
+        xml_root#write (`Out_channel outfile) `Enc_utf8;
+      Unix.lockf (Unix.descr_of_out_channel outfile) Unix.F_ULOCK 0;
+      close_out outfile
 
 let load_from_absolute =
   let config = PxpHelmConf.pxp_config in