$OpenBSD: patch-copy_ml,v 1.1 2005/05/30 19:27:45 sturm Exp $
Post-release developer patch.
o Fix the file open in text mode instead of binary.
  See http://groups.yahoo.com/group/unison-users/message/3184
  and http://lists.seas.upenn.edu/pipermail/unison-hackers/2005-May/000089.html
o Fix the Windows client hang problem.
  See http://groups.yahoo.com/group/unison-users/message/2885
--- copy.ml.orig	Mon Sep  6 15:15:47 2004
+++ copy.ml	Mon May 23 16:26:18 2005
@@ -10,14 +10,16 @@ let debug = Trace.debug "copy"
 
 let openFileIn fspath path kind =
   match kind with
-    `DATA   -> Unix.openfile (Fspath.concatToString fspath path)
-                 [Unix.O_RDONLY] 0o444
+    `DATA   -> Unix.descr_of_in_channel
+                 (open_in_gen [Open_rdonly; Open_binary]  0o444
+                    (Fspath.concatToString fspath path))
   | `RESS _ -> Osx.openRessIn fspath path
 
 let openFileOut fspath path kind =
   match kind with
-    `DATA     -> Unix.openfile (Fspath.concatToString fspath path)
-                   [Unix.O_WRONLY;Unix.O_CREAT;Unix.O_EXCL] 0o600
+    `DATA     -> Unix.descr_of_out_channel
+                   (open_out_gen [Open_wronly; Open_creat; Open_excl; Open_binary]
+                       0o600 (Fspath.concatToString fspath path))
   | `RESS len -> Osx.openRessOut fspath path len
 
 let protect f g =
@@ -260,10 +262,9 @@ let reallyTransmitFile
     fspathTo pathTo realPathTo `DATA update srcFileSize id file_id
     >>= (fun (outfd, infd, bi) ->
   Lwt.catch (fun () ->
-    Lwt_util.run_in_region transmitFileReg (bufferSize srcFileSize) (fun () ->
-      Uutil.showProgress id Uutil.Filesize.zero "f";
-      compressRemotely connFrom
-        (bi, fspathFrom, pathFrom, `DATA, srcFileSize, id, file_id))
+    Uutil.showProgress id Uutil.Filesize.zero "f";
+    compressRemotely connFrom
+      (bi, fspathFrom, pathFrom, `DATA, srcFileSize, id, file_id)
             >>= (fun () ->
     decompressor :=
       Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
@@ -281,16 +282,15 @@ let reallyTransmitFile
       (`RESS ressLength) update ressLength id file_id
         >>= (fun (outfd, infd, bi) ->
     Lwt.catch (fun () ->
-      Lwt_util.run_in_region transmitFileReg (bufferSize ressLength) (fun () ->
-        Uutil.showProgress id Uutil.Filesize.zero "f";
-        compressRemotely connFrom
-          (bi, fspathFrom, pathFrom,
-           `RESS ressLength, ressLength, id, file_id))
-              >>= (fun () ->
-        decompressor :=
-          Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
-        close_all infd outfd;
-        Lwt.return ()))
+      Uutil.showProgress id Uutil.Filesize.zero "f";
+      compressRemotely connFrom
+        (bi, fspathFrom, pathFrom,
+         `RESS ressLength, ressLength, id, file_id)
+            >>= (fun () ->
+      decompressor :=
+        Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
+      close_all infd outfd;
+      Lwt.return ()))
     (fun e ->
        decompressor :=
          Remote.MsgIdMap.remove file_id !decompressor; (* For GC *)
@@ -367,9 +367,13 @@ let transmitFileOnRoot =
 let transmitFile
     rootFrom pathFrom rootTo fspathTo pathTo realPathTo
     update desc fp ress id =
-  transmitFileOnRoot rootTo rootFrom
-    (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo,
-     update, desc, fp, ress, id)
+  let bufSz = bufferSize (max (Props.length desc) (Osx.ressLength ress)) in
+  (* This must be on the client: any lock on the server side may result
+     in a deadlock under windows *)
+  Lwt_util.run_in_region transmitFileReg bufSz (fun () ->
+    transmitFileOnRoot rootTo rootFrom
+      (snd rootFrom, pathFrom, fspathTo, pathTo, realPathTo,
+       update, desc, fp, ress, id))
 
 (****)
 
