[Unison-hackers] [unison-svn] r287 - trunk/src

[Benjamin C. Pierce]

Author: bcpierce
Date: 2008-06-21 12:06:27 -0400 (Sat, 21 Jun 2008)
New Revision: 287

Modified:
   trunk/src/RECENTNEWS
   trunk/src/copy.ml
   trunk/src/globals.ml
   trunk/src/globals.mli
   trunk/src/mkProjectInfo.ml
Log:
* Automatically supply "user@" in argument to external copy program.



Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS	2008-06-21 15:20:39 UTC (rev 286)
+++ trunk/src/RECENTNEWS	2008-06-21 16:06:27 UTC (rev 287)
@@ -1,3 +1,9 @@
+CHANGES FROM VERSION 2.29.2
+
+* Automatically supply "user@" in argument to external copy program.
+
+
+-------------------------------
 CHANGES FROM VERSION 2.29.1
 
 Follow maxthreads preference when transferring directories.

Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml	2008-06-21 15:20:39 UTC (rev 286)
+++ trunk/src/copy.ml	2008-06-21 16:06:27 UTC (rev 287)
@@ -479,8 +479,13 @@
 let copyprog =
   Prefs.createString "copyprog" "rsync --partial --inplace"
     "External program for copying large files"
-    ("A string giving the name (and command-line switches, if needed) of an "
-     ^ "external program that can be used to copy large files efficiently.")
+    ("A string giving the name of an "
+     ^ "external program that can be used to copy large files efficiently  "
+     ^ "(plus command-line switches "
+     ^ "telling it to copy files in-place and to resume"
+     ^ "interrupted transfers).  "
+     ^ "The default setting invokes {\\tt rsync} with appropriate "
+     ^ "options---most users should not need to change it.")
 
 let copythreshold =
   Prefs.createInt "copythreshold" (-1)
@@ -515,6 +520,25 @@
   Remote.registerRootCmdWithConnection
     "targetExistsWithCorrectSize" targetExistsWithCorrectSizeLocal
 
+let formatConnectionInfo root =
+  match root with
+    Common.Local, _ -> ""
+  | Common.Remote h, _ ->
+      (* Find the (unique) nonlocal root *)
+      match
+         Safelist.find (function Clroot.ConnectLocal _ -> false | _ -> true)
+           (Safelist.map Clroot.parseRoot (Globals.rawRoots()))
+      with
+        Clroot.ConnectByShell (_,h',uo,_,_) ->
+            (match uo with None -> "" | Some u -> u ^ "@")
+          ^ h ^ ":"
+          (* Note that we don't do anything with the port -- hopefully
+             this will not affect many people.  If we did want to include it,
+             we'd have to fiddle with the rsync parameters in a deeper way. *)
+      | Clroot.ConnectBySocket (h',_,_) ->
+          h ^ ":"
+      | Clroot.ConnectLocal _ -> assert false
+
 let transferFileUsingExternalCopyprog
              rootFrom pathFrom rootTo fspathTo pathTo realPathTo
              update desc fp ress id =
@@ -527,10 +551,10 @@
                  (Path.toString pathTo));
     Uutil.showProgress id Uutil.Filesize.zero "ext";
     let fromSpec =
-        (match fst rootFrom with Common.Local -> "" | Common.Remote h -> h ^ ":")
+        (formatConnectionInfo rootFrom)
       ^ (Fspath.concatToString (snd rootFrom) pathFrom) in
     let toSpec =
-        (match fst rootTo with Common.Local -> "" | Common.Remote h -> h ^ ":")
+        (formatConnectionInfo rootTo)
       ^ (Fspath.concatToString fspathTo pathTo) in
     let cmd = (Prefs.read copyprog) ^ " "
                ^ (Os.quotes fromSpec) ^ " "

Modified: trunk/src/globals.ml
===================================================================
--- trunk/src/globals.ml	2008-06-21 15:20:39 UTC (rev 286)
+++ trunk/src/globals.ml	2008-06-21 16:06:27 UTC (rev 287)
@@ -42,7 +42,7 @@
   let roots = rawRoots () in
   if Safelist.length roots <> 2 then
     raise (Util.Fatal (Printf.sprintf
-      "Wrong number of roots: 2 expected, but %d provided (%s)\n(Maybe you gave roots both on the command line and in the profile?)"
+      "Wrong number of roots: 2 expected, but %d provided (%s)\n(Maybe you specified roots both on the command line and in the profile?)"
       (Safelist.length roots)
       (String.concat ", " roots) ));
   Safelist.fold_right

Modified: trunk/src/globals.mli
===================================================================
--- trunk/src/globals.mli	2008-06-21 15:20:39 UTC (rev 286)
+++ trunk/src/globals.mli	2008-06-21 16:06:27 UTC (rev 287)
@@ -12,6 +12,7 @@
 (* Parse and canonize roots from their raw names                             *)
 val installRoots : (string -> string -> string) option -> unit Lwt.t
 
+(* An alternate method (under development?) *)
 val installRoots2 : unit -> unit
 
 (* The roots of the synchronization (with names canonized, but in the same   *)

Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml	2008-06-21 15:20:39 UTC (rev 286)
+++ trunk/src/mkProjectInfo.ml	2008-06-21 16:06:27 UTC (rev 287)
@@ -72,3 +72,4 @@
 
 
 
+