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

[Benjamin C. Pierce]

This looks good to me.  

    - B


On Feb 22, 2012, at 9:58 AM, Alan Schmitt wrote:

> 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
> _______________________________________________
> Unison-hackers mailing list
> Unison-hackers at lists.seas.upenn.edu
> http://lists.seas.upenn.edu/mailman/listinfo/unison-hackers