88 lines
3.7 KiB
Plaintext
88 lines
3.7 KiB
Plaintext
$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))
|
|
|
|
(****)
|
|
|