[Unison-hackers] [unison-svn] r296 - trunk/src
ALAN SCHMITT
schmitta at seas.upenn.edu
Fri Jun 27 12:21:28 EDT 2008
Author: schmitta
Date: 2008-06-27 12:21:22 -0400 (Fri, 27 Jun 2008)
New Revision: 296
Modified:
trunk/src/RECENTNEWS
trunk/src/copy.ml
trunk/src/mkProjectInfo.ml
trunk/src/os.ml
trunk/src/os.mli
trunk/src/update.ml
Log:
- Fixed handling of paths containing spaces when using rsync
- Better error report for fingerprint mismatch
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2008-06-27 13:03:38 UTC (rev 295)
+++ trunk/src/RECENTNEWS 2008-06-27 16:21:22 UTC (rev 296)
@@ -1,3 +1,8 @@
+CHANGES FROM VERSION 2.30.1
+
+- Fixed handling of paths containing spaces when using rsync
+- Better error report for fingerprint mismatch
+-------------------------------
CHANGES FROM VERSION 2.30.0
* A better fix for the "single file transfer failed in large directory" issue.
Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml 2008-06-27 13:03:38 UTC (rev 295)
+++ trunk/src/copy.ml 2008-06-27 16:21:22 UTC (rev 296)
@@ -522,6 +522,17 @@
^ "See \\sectionref{speeding}{Making Unison Faster on Large Files} "
^ "for more information.")
+let copyquoterem =
+ Prefs.createString "copyquoterem" "default"
+ "!add quotes to remote file name for copyprog (true/false/default)"
+ ("When set to {\\tt true}, this flag causes Unison to add an extra layer "
+ ^ "of quotes to the remote path passed to the external copy program. "
+ ^ "This is needed by rsync, for example, which internal uses an ssh "
+ ^ "connection requiring an extra level of quoting for paths containing "
+ ^ "spaces. When this flag is set to {\\tt default}, extra quotes are "
+ ^ "added if the value of {\tt copyprog} contains the string "
+ ^ "{\tt rsync}.")
+
let tryCopyMovedFileLocal connFrom
(fspathTo, pathTo, realPathTo, update, desc, fp, ress, id) =
Lwt.return (tryCopyMovedFile fspathTo pathTo realPathTo update desc fp ress id)
@@ -586,22 +597,29 @@
if b then Lwt.return ()
else begin
Uutil.showProgress id Uutil.Filesize.zero "ext";
- let fromSpec =
- (formatConnectionInfo rootFrom)
- ^ (Fspath.concatToString (snd rootFrom) pathFrom) in
- let toSpec =
- (formatConnectionInfo rootTo)
- ^ (Fspath.concatToString fspathTo pathTo) in
targetExistsOnRoot
rootTo rootFrom (`CheckNonemptyAndMakeWriteable, fspathTo, pathTo) >>= (fun b ->
let prog =
if b
then Prefs.read copyprogrest
else Prefs.read copyprog in
+ let extraquotes = Prefs.read copyquoterem = "true"
+ || ( Prefs.read copyquoterem = "default"
+ && Util.findsubstring "rsync" prog <> None) in
+ let addquotes root s =
+ match root with
+ | Common.Local, _ -> s
+ | Common.Remote _, _ -> if extraquotes then Os.quotes s else s in
+ let fromSpec =
+ (formatConnectionInfo rootFrom)
+ ^ (addquotes rootFrom (Fspath.concatToString (snd rootFrom) pathFrom)) in
+ let toSpec =
+ (formatConnectionInfo rootTo)
+ ^ (addquotes rootTo (Fspath.concatToString fspathTo pathTo)) in
let cmd = prog ^ " "
^ (Os.quotes fromSpec) ^ " "
^ (Os.quotes toSpec) in
- loggit (Printf.sprintf "%s\n" cmd);
+ Trace.log (Printf.sprintf "%s\n" cmd);
let _,log = Os.runExternalProgram cmd in
debug (fun() -> Util.msg
"transferFileUsingExternalCopyprog: returned\n------\n%s\n-----\n"
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2008-06-27 13:03:38 UTC (rev 295)
+++ trunk/src/mkProjectInfo.ml 2008-06-27 16:21:22 UTC (rev 296)
@@ -82,3 +82,4 @@
+
Modified: trunk/src/os.ml
===================================================================
--- trunk/src/os.ml 2008-06-27 13:03:38 UTC (rev 295)
+++ trunk/src/os.ml 2008-06-27 16:21:22 UTC (rev 296)
@@ -124,15 +124,15 @@
if Util.endswith file !tempFileSuffix then begin
let p = Path.child path filename in
let i = Fileinfo.get false fspath p in
- let secondsinaweek = 604800.0 in
- if Props.time i.Fileinfo.desc +. secondsinaweek < Util.time()
+ let secondsinthirtydays = 2592000.0 in
+ if Props.time i.Fileinfo.desc +. secondsinthirtydays < Util.time()
then begin
debug (fun()-> Util.msg "deleting old temp file %s\n"
(Fspath.concatToString fspath p));
delete fspath p
end else
debug (fun()-> Util.msg
- "keeping temp file %s since it is less than a week old\n"
+ "keeping temp file %s since it is less than 30 days old\n"
(Fspath.concatToString fspath p));
end;
false
@@ -267,6 +267,11 @@
let fullfingerprint_to_string (fp,rfp) =
Printf.sprintf "(%s,%s)" (Fingerprint.toString fp) (Fingerprint.toString rfp)
+let reasonForFingerprintMismatch (digdata,digress) (digdata',digress') =
+ if digdata = digdata' then "resource fork"
+ else if digress = digress' then "file contents"
+ else "both file contents and resource fork"
+
let fullfingerprint_dummy = (Fingerprint.dummy,Fingerprint.dummy)
(*****************************************************************************)
Modified: trunk/src/os.mli
===================================================================
--- trunk/src/os.mli 2008-06-27 13:03:38 UTC (rev 295)
+++ trunk/src/os.mli 2008-06-27 16:21:22 UTC (rev 296)
@@ -29,6 +29,7 @@
if any. *)
type fullfingerprint
val fullfingerprint_to_string : fullfingerprint -> string
+val reasonForFingerprintMismatch : fullfingerprint -> fullfingerprint -> string
val fullfingerprint_dummy : fullfingerprint
(* Use this function if the file may change during fingerprinting *)
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2008-06-27 13:03:38 UTC (rev 295)
+++ trunk/src/update.ml 2008-06-27 16:21:22 UTC (rev 296)
@@ -1742,8 +1742,9 @@
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"
+ "The file %s was incorrectly transferred (fingerprint mismatch in %s)%s"
(Path.toString path)
+ (Os.reasonForFingerprintMismatch dig dig')
(if deleteBadTempFiles then " -- temp file removed" else "")));
end;
ArchiveFile (Props.override info.Fileinfo.desc desc,
More information about the Unison-hackers
mailing list