[Unison-hackers] [unison-svn] r295 - trunk/src
Benjamin C. Pierce
bcpierce at seas.upenn.edu
Fri Jun 27 09:03:47 EDT 2008
Author: bcpierce
Date: 2008-06-27 09:03:38 -0400 (Fri, 27 Jun 2008)
New Revision: 295
Modified:
trunk/src/RECENTNEWS
trunk/src/copy.ml
trunk/src/files.ml
trunk/src/mkProjectInfo.ml
trunk/src/update.ml
trunk/src/update.mli
Log:
* A better fix for the "single file transfer failed in large directory" issue.
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2008-06-25 13:25:42 UTC (rev 294)
+++ trunk/src/RECENTNEWS 2008-06-27 13:03:38 UTC (rev 295)
@@ -1,3 +1,9 @@
+CHANGES FROM VERSION 2.30.0
+
+* A better fix for the "single file transfer failed in large directory" issue.
+
+
+-------------------------------
CHANGES FROM VERSION 2.29.9
* Trying a possible fix for the "assert failure in remote.ml" bug
Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml 2008-06-25 13:25:42 UTC (rev 294)
+++ trunk/src/copy.ml 2008-06-27 13:03:38 UTC (rev 295)
@@ -637,7 +637,7 @@
targetExistsOnRoot
rootTo rootFrom (`CheckSize desc, fspathTo, pathTo) >>= (fun b ->
if b then begin
- Util.msg "%s/%s already exists\n"
+ Util.msg "%s/%s has already been transferred\n"
(Fspath.toString fspathTo) (Path.toString pathTo);
Lwt.return ()
(* Check whether we should use an external program to copy the
Modified: trunk/src/files.ml
===================================================================
--- trunk/src/files.ml 2008-06-25 13:25:42 UTC (rev 294)
+++ trunk/src/files.ml 2008-06-27 13:03:38 UTC (rev 295)
@@ -75,13 +75,14 @@
(* FIX: maybe we should rename the destination before making any check ? *)
let delete rootFrom pathFrom rootTo pathTo ui =
Update.transaction (fun id ->
- Update.replaceArchive rootFrom pathFrom None Update.NoArchive id true
+ Update.replaceArchive rootFrom pathFrom None Update.NoArchive id true false
>>= (fun _ ->
(* Unison do the next line cause we want to keep a backup of the file.
FIX: We only need this when we are making backups *)
Update.updateArchive rootTo pathTo ui id >>= (fun _ ->
Update.replaceArchive
- rootTo pathTo None Update.NoArchive id true >>= (fun localPathTo ->
+ rootTo pathTo None Update.NoArchive id true false
+ >>= (fun localPathTo ->
(* Make sure the target is unchanged *)
(* (There is an unavoidable race condition here.) *)
Update.checkNoUpdates rootTo pathTo ui >>= (fun () ->
@@ -424,7 +425,8 @@
in
(* BCP (6/08): We used to have an unwindProtect here that would *always* do the
final performDelete. This was removed so that failed partial transfers can
- be restarted. *)
+ be restarted. We instead remove individual failing files (not
+ directories) inside replaceArchive. *)
Update.transaction (fun id ->
(* Update the archive on the source replica (but don't commit
the changes yet) and return the part of the new archive
@@ -437,17 +439,12 @@
in
copyRec localPathFrom tempPathTo realPathTo archFrom >>= (fun () ->
make_backup >>= (fun _ ->
- (* BCP: We put the unwindProtect here instead, so that we clean everything
- up if there is a failure during the paranoid checking phase. *)
- Remote.Thread.unwindProtect
- (fun () ->
- Update.replaceArchive
- rootTo pathTo (Some (workingDir, tempPathTo))
- archFrom id true >>= (fun _ ->
- rename rootTo pathTo localPathTo workingDir tempPathTo realPathTo uiTo))
- (fun _ ->
- debug (fun() -> Util.msg "Removing temp files\n");
- performDelete rootTo (Some workingDir, tempPathTo) ))))))
+ 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) )))))))
(* ------------------------------------------------------------ *)
@@ -899,10 +896,10 @@
(fun transid ->
Update.replaceArchive root1 path
(Some(workingDirForMerge, workingarch))
- new_archive_entry transid false >>= (fun _ ->
+ new_archive_entry transid false false >>= (fun _ ->
Update.replaceArchive root2 path
(Some(workingDirForMerge, workingarch))
- new_archive_entry transid false >>= (fun _ ->
+ new_archive_entry transid false false >>= (fun _ ->
Lwt.return ())))
end else
(Lwt.return ()) )))) )
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2008-06-25 13:25:42 UTC (rev 294)
+++ trunk/src/mkProjectInfo.ml 2008-06-27 13:03:38 UTC (rev 295)
@@ -5,8 +5,8 @@
let projectName = "unison"
let majorVersion = 2
-let minorVersion = 29
-let pointVersionOrigin = 284 (* Revision that corresponds to point version 0 *)
+let minorVersion = 30
+let pointVersionOrigin = 294 (* Revision that corresponds to point version 0 *)
(* Documentation:
This is a program to construct a version of the form Major.Minor.Point,
@@ -81,3 +81,4 @@
+
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2008-06-25 13:25:42 UTC (rev 294)
+++ trunk/src/update.ml 2008-06-27 13:03:38 UTC (rev 295)
@@ -1723,13 +1723,14 @@
Tree.map (fun n -> n) (fun (uc1,uc2) -> uc2) equals])
end
-let rec replaceArchiveRec fspath path arch paranoid =
+let rec replaceArchiveRec fspath path arch paranoid deleteBadTempFiles =
match arch with
ArchiveDir (desc, children) ->
ArchiveDir (desc,
NameMap.mapi
(fun nm a ->
- replaceArchiveRec fspath (Path.child path nm) a paranoid)
+ replaceArchiveRec
+ fspath (Path.child path nm) a paranoid deleteBadTempFiles)
children)
| ArchiveFile (desc, dig, stamp, ress) ->
if paranoid then begin
@@ -1738,11 +1739,13 @@
let info = Fileinfo.get false fspath path in
let dig' = Os.fingerprint fspath path info in
let ress' = Osx.stamp info.Fileinfo.osX in
- if dig' <> dig then
- raise (Util.Transient
- (Printf.sprintf
- "The file %s was incorrectly transferred \
- (fingerprint mismatch)" (Path.toString path)));
+ if dig' <> dig then begin
+ if deleteBadTempFiles then Os.delete fspath path;
+ raise (Util.Transient (Printf.sprintf
+ "The file %s was incorrectly transferred (fingerprint mismatch)%s"
+ (Path.toString path)
+ (if deleteBadTempFiles then " -- temp file removed" else "")));
+ end;
ArchiveFile (Props.override info.Fileinfo.desc desc,
dig, Fileinfo.stamp info, ress')
end else begin
@@ -1753,7 +1756,7 @@
| NoArchive ->
arch
-let replaceArchiveLocal fspath pathTo location arch id paranoid =
+let replaceArchiveLocal fspath pathTo location arch id paranoid deleteBadTempFiles =
debug (fun() -> Util.msg
"replaceArchiveLocal %s %s\n"
(Fspath.toString fspath)
@@ -1766,7 +1769,8 @@
None -> (fspath, localPath)
| Some loc -> loc
in
- let newArch = replaceArchiveRec workingDir tempPathTo arch paranoid in
+ let newArch =
+ replaceArchiveRec workingDir tempPathTo arch paranoid deleteBadTempFiles in
let commit () =
debug (fun() -> Util.msg "replaceArchiveLocal: committing\n");
let _ = Stasher.stashCurrentVersion fspath localPath (Some tempPathTo) in
@@ -1783,11 +1787,13 @@
let replaceArchiveOnRoot =
Remote.registerRootCmd
"replaceArchive"
- (fun (fspath, (pathTo, location, arch, id, paranoid)) ->
- Lwt.return (replaceArchiveLocal fspath pathTo location arch id paranoid))
+ (fun (fspath, (pathTo, location, arch, id, paranoid, deleteBadTempFiles)) ->
+ Lwt.return (replaceArchiveLocal fspath pathTo location arch
+ id paranoid deleteBadTempFiles))
-let replaceArchive root pathTo location archive id paranoid =
- replaceArchiveOnRoot root (pathTo, location, archive, id, paranoid)
+let replaceArchive root pathTo location archive id paranoid deleteBadTempFiles =
+ replaceArchiveOnRoot root
+ (pathTo, location, archive, id, paranoid, deleteBadTempFiles)
(* Update the archive to reflect
- the last observed state of the file on disk (ui)
Modified: trunk/src/update.mli
===================================================================
--- trunk/src/update.mli 2008-06-25 13:25:42 UTC (rev 294)
+++ trunk/src/update.mli 2008-06-27 13:03:38 UTC (rev 295)
@@ -42,7 +42,7 @@
(* Replace a part of an archive by another archive *)
val replaceArchive :
Common.root -> Path.t -> (Fspath.t * Path.local) option ->
- archive -> transaction -> bool -> Path.local Lwt.t
+ archive -> transaction -> bool -> bool -> Path.local Lwt.t
(* Update only some permissions *)
val updateProps :
Common.root -> Path.t -> Props.t option -> Common.updateItem ->
More information about the Unison-hackers
mailing list