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

[schmitta at seas.upenn.edu]

Author: schmitta
Date: 2012-02-26 07:56:45 -0500 (Sun, 26 Feb 2012)
New Revision: 482

Modified:
   trunk/src/RECENTNEWS
   trunk/src/mkProjectInfo.ml
   trunk/src/os.ml
   trunk/src/os.mli
   trunk/src/remote.ml
   trunk/src/update.ml
Log:
* Added option clientHostName. If specified, it will be used to as the client
  host name, overriding UNISONLOCALHOSTNAME and the actual host name.


Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS	2012-01-21 19:13:41 UTC (rev 481)
+++ trunk/src/RECENTNEWS	2012-02-26 12:56:45 UTC (rev 482)
@@ -1,3 +1,9 @@
+CHANGES FROM VERSION 2.44.10
+
+* Added option clientHostName. If specified, it will be used to as the client
+  host name, overriding UNISONLOCALHOSTNAME and the actual host name.
+
+-------------------------------
 CHANGES FROM VERSION 2.44.9
 
 - OS X GUI: fix crash under Lion, because of problems with the toolbar, using

Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml	2012-01-21 19:13:41 UTC (rev 481)
+++ trunk/src/mkProjectInfo.ml	2012-02-26 12:56:45 UTC (rev 482)
@@ -62,3 +62,4 @@
 
 
 
+

Modified: trunk/src/os.ml
===================================================================
--- trunk/src/os.ml	2012-01-21 19:13:41 UTC (rev 481)
+++ trunk/src/os.ml	2012-02-26 12:56:45 UTC (rev 482)
@@ -21,10 +21,21 @@
 
 let debug = Util.debug "os"
 
-let myCanonicalHostName =
-  try System.getenv "UNISONLOCALHOSTNAME"
-  with Not_found -> Unix.gethostname()
+(* Assumption: Prefs are not loaded on server, so clientHostName is always *)
+(* set to myCanonicalHostName. *)
+    
+let clientHostName : string Prefs.t =
+  let myCanonicalHostName =
+    try System.getenv "UNISONLOCALHOSTNAME"
+    with Not_found -> Unix.gethostname()
+  in
+  Prefs.createString "clientHostName" myCanonicalHostName
+    "!set host name of client"
+    ("When specified, the host name of the client will not be guessed" ^
+     "and the provided host name will be used to find the archive.")
 
+let myCanonicalHostName () = Prefs.read clientHostName
+
 let tempFilePrefix = ".unison."
 let tempFileSuffixFixed = ".unison.tmp"
 let tempFileSuffix = ref tempFileSuffixFixed

Modified: trunk/src/os.mli
===================================================================
--- trunk/src/os.mli	2012-01-21 19:13:41 UTC (rev 481)
+++ trunk/src/os.mli	2012-02-26 12:56:45 UTC (rev 482)
@@ -1,7 +1,7 @@
 (* Unison file synchronizer: src/os.mli *)
 (* Copyright 1999-2010, Benjamin C. Pierce (see COPYING for details) *)
 
-val myCanonicalHostName : string
+val myCanonicalHostName : unit -> string
 
 val tempPath : ?fresh:bool -> Fspath.t -> Path.local -> Path.local
 val tempFilePrefix : string

Modified: trunk/src/remote.ml
===================================================================
--- trunk/src/remote.ml	2012-01-21 19:13:41 UTC (rev 481)
+++ trunk/src/remote.ml	2012-02-26 12:56:45 UTC (rev 482)
@@ -1168,7 +1168,7 @@
 let canonizeOnServer =
   registerServerCmd "canonizeOnServer"
     (fun _ (s, unicode) ->
-       Lwt.return (Os.myCanonicalHostName, canonizeLocally s unicode))
+       Lwt.return (Os.myCanonicalHostName (), canonizeLocally s unicode))
 
 let canonize clroot = (* connection for clroot must have been set up already *)
   match clroot with

Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml	2012-01-21 19:13:41 UTC (rev 481)
+++ trunk/src/update.ml	2012-02-26 12:56:45 UTC (rev 482)
@@ -150,7 +150,7 @@
             (Safelist.map
                (function
                    (Common.Local,f) ->
-                     (Common.Remote Os.myCanonicalHostName,f)
+                     (Common.Remote (Os.myCanonicalHostName ()),f)
                 | r ->
                    r)
                (Globals.rootsInCanonicalOrder())))) in
@@ -166,7 +166,7 @@
   | `Unix -> 32
 
 let thisRootsGlobalName (fspath: Fspath.t): string =
-  root2stringOrAlias (Common.Remote Os.myCanonicalHostName, fspath)
+  root2stringOrAlias (Common.Remote (Os.myCanonicalHostName ()), fspath)
 
 (* ----- *)
 
@@ -278,7 +278,7 @@
        let (name,_) = archiveName fspath v in
        Lwt.return
          (name,
-          Os.myCanonicalHostName,
+          Os.myCanonicalHostName (),
           System.file_exists (Os.fileInUnisonDir name)))
 
 
@@ -784,7 +784,7 @@
     None
   else
     Some (Printf.sprintf "The file %s on host %s should be deleted"
-            (System.fspathToPrintString lockFile) Os.myCanonicalHostName)
+            (System.fspathToPrintString lockFile) (Os.myCanonicalHostName ()))
 
 let lockArchiveOnRoot: Common.root -> unit -> string option Lwt.t =
   Remote.registerRootCmd
@@ -1070,7 +1070,8 @@
        if not (Os.exists fspath path) then
          raise (Util.Fatal
            (Printf.sprintf "Path %s / %s is designated as a mountpoint, but points to nothing on host %s\n"
-             (Fspath.toPrintString fspath) (Path.toString path) Os.myCanonicalHostName)))
+             (Fspath.toPrintString fspath) (Path.toString path)
+	     (Os.myCanonicalHostName ()))))
     (Prefs.read mountpoints)