[Unison-hackers] [unison-svn] r351 - in branches/2.32/src: . lwt uimacnew/uimacnew.xcodeproj
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Tue Jun 9 11:46:44 EDT 2009
Author: vouillon
Date: 2009-06-09 11:46:38 -0400 (Tue, 09 Jun 2009)
New Revision: 351
Modified:
branches/2.32/src/RECENTNEWS
branches/2.32/src/copy.ml
branches/2.32/src/files.ml
branches/2.32/src/lwt/lwt_unix.ml
branches/2.32/src/mkProjectInfo.ml
branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj
Log:
* Fix to the Mac GUI: the bigarray library is now required
* Improvement to the code for resuming directory transfers:
- make sure file information (permissions, ...) has been properly set
when using a previously transferred temp file
- make sure previously transferred directories are writable
(other changes made in the developer version of Unison require a
protocol change)
* Fixed bug in Lwt_unix.run which could make it fail with a Not_found
exception (see [Not_found raised in tryCopyMovedFile] errors)
Modified: branches/2.32/src/RECENTNEWS
===================================================================
--- branches/2.32/src/RECENTNEWS 2009-06-09 15:41:29 UTC (rev 350)
+++ branches/2.32/src/RECENTNEWS 2009-06-09 15:46:38 UTC (rev 351)
@@ -1,3 +1,16 @@
+CHANGES FROM VERSION 2.32.33
+
+* Fix to the Mac GUI: the bigarray library is now required
+* Improvement to the code for resuming directory transfers:
+ - make sure file information (permissions, ...) has been properly set
+ when using a previously transferred temp file
+ - make sure previously transferred directories are writable
+ (other changes made in the developer version of Unison require a
+ protocol change)
+* Fixed bug in Lwt_unix.run which could make it fail with a Not_found
+ exception (see [Not_found raised in tryCopyMovedFile] errors)
+
+-------------------------------
CHANGES FROM VERSION 2.32.32
* Got rid of the 16MiB marshalling limit by marshalling to a bigarray
Modified: branches/2.32/src/copy.ml
===================================================================
--- branches/2.32/src/copy.ml 2009-06-09 15:41:29 UTC (rev 350)
+++ branches/2.32/src/copy.ml 2009-06-09 15:46:38 UTC (rev 351)
@@ -74,6 +74,11 @@
(****)
+let setFileinfo fspathTo pathTo realPathTo update desc =
+ match update with
+ `Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc
+ | `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc
+
let localFile
fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido =
let use_id f = match ido with Some id -> f id | None -> () in
@@ -114,11 +119,7 @@
(fun () -> close_out_noerr outFd))
(fun () -> close_in_noerr inFd);
end;
- match update with
- `Update _ ->
- Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc
- | `Copy ->
- Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc)
+ setFileinfo fspathTo pathTo realPathTo update desc)
(****)
@@ -396,10 +397,7 @@
Lwt.fail e))
end else
Lwt.return ()) >>= (fun () ->
- begin match update with
- `Update _ -> Fileinfo.set fspathTo pathTo (`Copy realPathTo) desc
- | `Copy -> Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc
- end;
+ setFileinfo fspathTo pathTo realPathTo update desc;
Lwt.return ()))
(****)
@@ -557,7 +555,10 @@
Remote.registerRootCmdWithConnection "tryCopyMovedFile" tryCopyMovedFileLocal
let setFileinfoLocal connFrom (fspathTo, pathTo, desc) =
- Lwt.return (Fileinfo.set fspathTo pathTo (`Set Props.fileDefault) desc)
+ setFileinfo fspathTo pathTo
+ pathTo `Copy (*FIX: should be realPathTo and update *)
+ desc;
+ Lwt.return ()
let setFileinfoOnRoot =
Remote.registerRootCmdWithConnection "setFileinfo" setFileinfoLocal
@@ -678,7 +679,8 @@
Trace.log (Printf.sprintf
"%s/%s has already been transferred\n"
(Fspath.toString fspathTo) (Path.toString pathTo));
- Lwt.return ()
+ (* Make sure the file information is right *)
+ setFileinfoOnRoot rootTo rootFrom (fspathTo, pathTo, desc)
(* Check whether we should use an external program to copy the
file *)
end else if
Modified: branches/2.32/src/files.ml
===================================================================
--- branches/2.32/src/files.ml 2009-06-09 15:41:29 UTC (rev 350)
+++ branches/2.32/src/files.ml 2009-06-09 15:46:38 UTC (rev 351)
@@ -139,23 +139,28 @@
setPropRemote2 toRoot (toLocalPath, `Update oldDesc, newDesc))))
(* ------------------------------------------------------------ *)
-
+
let mkdirRemote =
Remote.registerRootCmd
"mkdir"
(fun (fspath,(workingDir,path)) ->
- let createIt() = Os.createDir workingDir path Props.dirDefault in
- if Os.exists workingDir path then
- if (Fileinfo.get false workingDir path).Fileinfo.typ <> `DIRECTORY then begin
+ let info = Fileinfo.get false workingDir path in
+ if info.Fileinfo.typ = `DIRECTORY then begin
+ begin try
+ (* Make sure the directory is writable *)
+ Unix.chmod (Fspath.concatToString workingDir path)
+ (Props.perms info.Fileinfo.desc lor 0o700)
+ with Unix.Unix_error _ -> () end;
+ Lwt.return info.Fileinfo.desc
+ end else begin
+ if info.Fileinfo.typ <> `ABSENT then
Os.delete workingDir path;
- createIt()
- end else ()
- else
- createIt();
- Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc)
-
+ Os.createDir workingDir path Props.dirDefault;
+ Lwt.return (Fileinfo.get false workingDir path).Fileinfo.desc
+ end)
+
let mkdir onRoot workingDir path = mkdirRemote onRoot (workingDir,path)
-
+
(* ------------------------------------------------------------ *)
let renameLocal (root, (localTargetPath, fspath, pathFrom, pathTo)) =
@@ -457,9 +462,7 @@
Update.replaceArchive
rootTo pathTo (Some (workingDir, tempPathTo))
archFrom id true true >>= (fun _ ->
- rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo >>= (fun() ->
- debug (fun() -> Util.msg "Removing temp files\n");
- performDelete rootTo (Some workingDir, tempPathTo) )))))))
+ rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo))))))
(* ------------------------------------------------------------ *)
Modified: branches/2.32/src/lwt/lwt_unix.ml
===================================================================
--- branches/2.32/src/lwt/lwt_unix.ml 2009-06-09 15:41:29 UTC (rev 350)
+++ branches/2.32/src/lwt/lwt_unix.ml 2009-06-09 15:46:38 UTC (rev 351)
@@ -141,33 +141,39 @@
restart_threads !event_counter now;
List.iter
(fun fd ->
- match List.assoc fd !inputs with
- `Read (buf, pos, len, res) ->
- wrap_syscall inputs fd res
- (fun () -> Unix.read fd buf pos len)
- | `Accept res ->
- wrap_syscall inputs fd res
- (fun () ->
- let (s, _) as v = Unix.accept fd in
- if not windows_hack then Unix.set_nonblock s;
- v)
- | `Wait res ->
- wrap_syscall inputs fd res (fun () -> ()))
+ try
+ match List.assoc fd !inputs with
+ `Read (buf, pos, len, res) ->
+ wrap_syscall inputs fd res
+ (fun () -> Unix.read fd buf pos len)
+ | `Accept res ->
+ wrap_syscall inputs fd res
+ (fun () ->
+ let (s, _) as v = Unix.accept fd in
+ if not windows_hack then Unix.set_nonblock s;
+ v)
+ | `Wait res ->
+ wrap_syscall inputs fd res (fun () -> ())
+ with Not_found ->
+ ())
readers;
List.iter
(fun fd ->
- match List.assoc fd !outputs with
- `Write (buf, pos, len, res) ->
- wrap_syscall outputs fd res
- (fun () -> Unix.write fd buf pos len)
- | `CheckSocket res ->
- wrap_syscall outputs fd res
- (fun () ->
- try ignore (Unix.getpeername fd) with
- Unix.Unix_error (Unix.ENOTCONN, _, _) ->
- ignore (Unix.read fd " " 0 1))
- | `Wait res ->
- wrap_syscall inputs fd res (fun () -> ()))
+ try
+ match List.assoc fd !outputs with
+ `Write (buf, pos, len, res) ->
+ wrap_syscall outputs fd res
+ (fun () -> Unix.write fd buf pos len)
+ | `CheckSocket res ->
+ wrap_syscall outputs fd res
+ (fun () ->
+ try ignore (Unix.getpeername fd) with
+ Unix.Unix_error (Unix.ENOTCONN, _, _) ->
+ ignore (Unix.read fd " " 0 1))
+ | `Wait res ->
+ wrap_syscall inputs fd res (fun () -> ())
+ with Not_found ->
+ ())
writers;
if !child_exited then begin
child_exited := false;
Modified: branches/2.32/src/mkProjectInfo.ml
===================================================================
--- branches/2.32/src/mkProjectInfo.ml 2009-06-09 15:41:29 UTC (rev 350)
+++ branches/2.32/src/mkProjectInfo.ml 2009-06-09 15:46:38 UTC (rev 351)
@@ -116,3 +116,4 @@
+
Modified: branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj
===================================================================
--- branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-06-09 15:41:29 UTC (rev 350)
+++ branches/2.32/src/uimacnew/uimacnew.xcodeproj/project.pbxproj 2009-06-09 15:46:38 UTC (rev 351)
@@ -581,6 +581,7 @@
"-lunix",
"-lthreadsnat",
"-lstr",
+ "-lbigarray",
"-lasmrun",
);
PREBINDING = NO;
@@ -617,6 +618,7 @@
"-lunix",
"-lthreadsnat",
"-lstr",
+ "-lbigarray",
"-lasmrun",
);
PREBINDING = NO;
@@ -650,6 +652,7 @@
"-lunix",
"-lthreadsnat",
"-lstr",
+ "-lbigarray",
"-lasmrun",
);
PREBINDING = NO;
More information about the Unison-hackers
mailing list