[Unison-hackers] patch to specify client host name in profile

[Alan Schmitt]

Hello,

Here is a patch to specify the name of the client host in the profile. 
It relies on the fact that the server does not load preferences, so the 
default value of the preference is the one returned by 
UNISONLOCALHOSTNAME or by hostname:


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

(The rest of the patch simply deals with the signature change of 
MyCanonicalHostName.)

Thoughts?

Alan

The full patch:

Index: remote.ml
===================================================================
--- remote.ml	(revision 481)
+++ remote.ml	(working copy)
@@ -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
Index: os.ml
===================================================================
--- os.ml	(revision 481)
+++ os.ml	(working copy)
@@ -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
Index: update.ml
===================================================================
--- update.ml	(revision 481)
+++ update.ml	(working copy)
@@ -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)


Index: os.mli
===================================================================
--- os.mli	(revision 481)
+++ os.mli	(working copy)
@@ -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