diff --git a/src/fswatchold.ml b/src/fswatchold.ml index b69fd16a6..008fddca9 100644 --- a/src/fswatchold.ml +++ b/src/fswatchold.ml @@ -25,7 +25,7 @@ let debug = Util.debug "fswatch" let watchinterval = 5 -let watcherTemp archHash n = Os.fileInUnisonDir (n ^ archHash) +let watcherTemp archHash n = Util.fileInUnisonDir (n ^ archHash) let watchercmd archHash root = let fsmonfile = diff --git a/src/main.ml b/src/main.ml index d1a64eef6..411bd2eb1 100644 --- a/src/main.ml +++ b/src/main.ml @@ -191,12 +191,6 @@ let init () = begin exit 0 with Not_found -> () end; - (* Install an appropriate function for finding preference files. (We put - this here just because the Prefs module lives below the Os module in the - dependency hierarchy, so Prefs can't call Os directly.) *) - Util.supplyFileInUnisonDirFn - (fun n -> Os.fileInUnisonDir(n)); - (* Start a server if requested *) if Util.StringMap.mem serverPrefName argv then begin catch_all (fun () -> diff --git a/src/os.ml b/src/os.ml index 22ed9c0f2..ad27e217e 100644 --- a/src/os.ml +++ b/src/os.ml @@ -303,31 +303,15 @@ let fullfingerprintEqual (fp, rfp) (fp', rfp') = (* UNISON DIRECTORY *) (*****************************************************************************) -(* Gives the fspath of the archive directory on the machine, depending on *) -(* which OS we use *) -let unisonDir = - try - System.fspathFromString (System.getenv "UNISON") - with Not_found -> - let genericName = - Util.fileInHomeDir (Printf.sprintf ".%s" Uutil.myName) in - if Osx.isMacOSX && not (System.file_exists genericName) then - Util.fileInHomeDir "Library/Application Support/Unison" - else - genericName - -(* build a fspath representing an archive child path whose name is given *) -let fileInUnisonDir str = System.fspathConcat unisonDir str - (* Make sure archive directory exists *) let createUnisonDir() = - try ignore (System.stat unisonDir) + try ignore (System.stat Util.unisonDir) with Unix.Unix_error(_) -> Util.convertUnixErrorsToFatal (Printf.sprintf "creating unison directory %s" - (System.fspathToPrintString unisonDir)) + (System.fspathToPrintString Util.unisonDir)) (fun () -> - ignore (System.mkdir unisonDir 0o700)) + ignore (System.mkdir Util.unisonDir 0o700)) (*****************************************************************************) (* TEMPORARY FILES *) diff --git a/src/os.mli b/src/os.mli index 8af058eff..8c08804f4 100644 --- a/src/os.mli +++ b/src/os.mli @@ -11,8 +11,6 @@ val includeInTempNames : string -> unit val exists : Fspath.t -> Path.local -> bool val createUnisonDir : unit -> unit -val fileInUnisonDir : string -> System.fspath -val unisonDir : System.fspath val childrenOf : Fspath.t -> Path.local -> Name.t list val readLink : Fspath.t -> Path.local -> string diff --git a/src/stasher.ml b/src/stasher.ml index 5f01c9675..5c0974981 100644 --- a/src/stasher.ml +++ b/src/stasher.ml @@ -139,7 +139,7 @@ let backupDirectory () = if Prefs.read backupdir <> "" then Fspath.canonize (Some (Prefs.read backupdir)) else Fspath.canonize - (Some (System.fspathToString (Os.fileInUnisonDir "backup")))) + (Some (System.fspathToString (Util.fileInUnisonDir "backup")))) let backupcurrent = Pred.create "backupcurr" ~advanced:true diff --git a/src/ubase/trace.ml b/src/ubase/trace.ml index e88107fdf..73b85c31c 100644 --- a/src/ubase/trace.ml +++ b/src/ubase/trace.ml @@ -113,10 +113,10 @@ let logging = let logfile = Prefs.createFspath "logfile" - (Util.fileInHomeDir "unison.log") + (Util.fileInUnisonDir "unison.log") "!logfile name" "By default, logging messages will be appended to the file - \\verb|unison.log| in your HOME directory. Set this preference if + \\verb|unison.log| in your .unison directory. Set this preference if you prefer another file. It can be a path relative to your HOME directory. Sending SIGUSR1 will close the logfile; the logfile will be re-opened (and created, if needed) automatically, to allow for log rotation." diff --git a/src/ubase/util.ml b/src/ubase/util.ml index 3865d17be..c42113322 100644 --- a/src/ubase/util.ml +++ b/src/ubase/util.ml @@ -493,14 +493,22 @@ let fileMaybeRelToHomeDir n = else System.fspathFromString n (*****************************************************************************) -(* "Upcall" for building pathnames in the .unison dir *) +(* .unison dir *) (*****************************************************************************) -let fileInUnisonDirFn = ref None +external isMacOSXPred : unit -> bool = "isMacOSX" -let supplyFileInUnisonDirFn f = fileInUnisonDirFn := Some(f) +let isMacOSX = isMacOSXPred () -let fileInUnisonDir n = - match !fileInUnisonDirFn with - None -> assert false - | Some(f) -> f n +let unisonDir = + try + System.fspathFromString (System.getenv "UNISON") + with Not_found -> + let genericName = + fileInHomeDir (Printf.sprintf ".%s" ProjectInfo.myName) in + if isMacOSX && not (System.file_exists genericName) then + fileInHomeDir "Library/Application Support/Unison" + else + genericName + +let fileInUnisonDir str = System.fspathConcat unisonDir str diff --git a/src/ubase/util.mli b/src/ubase/util.mli index 621825f3f..9cc185ae1 100644 --- a/src/ubase/util.mli +++ b/src/ubase/util.mli @@ -103,10 +103,11 @@ val debug : string -> (unit->unit) -> unit val warnPrinter : (string -> unit) option ref val warn : string -> unit -(* Someone should supply a function here that will convert a simple filename - to a filename in the unison directory *) -val supplyFileInUnisonDirFn : (string -> System.fspath) -> unit -(* Use it like this: *) +(* Gives the fspath of the archive directory on the machine, depending on *) +(* which OS we use *) +val unisonDir : System.fspath + +(* build a fspath representing an archive child path whose name is given *) val fileInUnisonDir : string -> System.fspath (* Printing and formatting functions *) diff --git a/src/uicommon.ml b/src/uicommon.ml index 7acfe5ee2..7eb1c42ca 100644 --- a/src/uicommon.ml +++ b/src/uicommon.ml @@ -546,7 +546,7 @@ let scanProfiles () = (f, info)) (Safelist.filter (fun name -> not ( Util.startswith name ".#" || Util.startswith name Os.tempFilePrefix)) - (Files.ls Os.unisonDir "*.prf"))) + (Files.ls Util.unisonDir "*.prf"))) (* ---- *) diff --git a/src/uimacbridge.ml b/src/uimacbridge.ml index d50dc7ce4..eb0e4c5d7 100644 --- a/src/uimacbridge.ml +++ b/src/uimacbridge.ml @@ -19,7 +19,7 @@ type stateItem = { mutable ri : reconItem; let theState = ref [| |];; let unsynchronizedPaths = ref None;; -let unisonDirectory() = System.fspathToPrintString Os.unisonDir +let unisonDirectory() = System.fspathToPrintString Util.unisonDir ;; Callback.register "unisonDirectory" unisonDirectory;; @@ -58,11 +58,6 @@ Callback.register "unisonGetVersion" unisonGetVersion;; (* Returns a string option: command line profile, if any *) let unisonInit0() = ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150}); - (* Install an appropriate function for finding preference files. (We put - this in Util just because the Prefs module lives below the Os module in the - dependency hierarchy, so Prefs can't call Os directly.) *) - Util.supplyFileInUnisonDirFn - (fun n -> Os.fileInUnisonDir(n)); (* Display status in GUI instead of on stderr *) let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in Trace.messageDisplayer := displayStatus; diff --git a/src/uimacbridgenew.ml b/src/uimacbridgenew.ml index bf9932f82..9bd48484b 100644 --- a/src/uimacbridgenew.ml +++ b/src/uimacbridgenew.ml @@ -20,7 +20,7 @@ type stateItem = { mutable ri : reconItem; let theState = ref [| |];; let unsynchronizedPaths = ref None;; -let unisonDirectory() = System.fspathToString Os.unisonDir +let unisonDirectory() = System.fspathToString Util.unisonDir ;; Callback.register "unisonDirectory" unisonDirectory;; @@ -142,11 +142,6 @@ Callback.register "unisonGetVersion" unisonGetVersion;; (* Returns a string option: command line profile, if any *) let unisonInit0() = ignore (Gc.set {(Gc.get ()) with Gc.max_overhead = 150}); - (* Install an appropriate function for finding preference files. (We put - this in Util just because the Prefs module lives below the Os module in the - dependency hierarchy, so Prefs can't call Os directly.) *) - Util.supplyFileInUnisonDirFn - (fun n -> Os.fileInUnisonDir(n)); (* Display status in GUI instead of on stderr *) let formatStatus major minor = (Util.padto 30 (major ^ " ")) ^ minor in Trace.messageDisplayer := displayStatus; diff --git a/src/uitext.ml b/src/uitext.ml index b14bb047e..9ccdb49b9 100644 --- a/src/uitext.ml +++ b/src/uitext.ml @@ -1225,7 +1225,7 @@ let getProfile default = Trace.log (Format.sprintf "You have too many profiles in %s \ for interactive selection. Please specify profile \ or roots on command line.\n" - (System.fspathToPrintString Os.unisonDir)); + (System.fspathToPrintString Util.unisonDir)); Trace.log "The profile names are:\n"; Safelist.iter (fun (p, _) -> Trace.log (Format.sprintf " %s\n" p)) !Uicommon.profilesAndRoots; diff --git a/src/update.ml b/src/update.ml index c4307f33c..c299ea298 100644 --- a/src/update.ml +++ b/src/update.ml @@ -279,7 +279,7 @@ let (archiveNameOnRoot Lwt.return (name, Os.myCanonicalHostName (), - System.file_exists (Os.fileInUnisonDir name))) + System.file_exists (Util.fileInUnisonDir name))) (*****************************************************************************) @@ -378,7 +378,7 @@ let storeArchiveLocal fspath thisRoot archive hash magic properties = let removeArchiveLocal ((fspath: Fspath.t), (v: archiveVersion)): unit Lwt.t = Lwt.return (let (name,_) = archiveName fspath v in - let fspath = Os.fileInUnisonDir name in + let fspath = Util.fileInUnisonDir name in debug (fun() -> Util.msg "Removing archive %s\n" (System.fspathToDebugString fspath)); Util.convertUnixErrorsToFatal "removing archive" (fun () -> @@ -397,8 +397,8 @@ let commitArchiveLocal ((fspath: Fspath.t), ()) Lwt.return (let (fromname,_) = archiveName fspath ScratchArch in let (toname,_) = archiveName fspath NewArch in - let ffrom = Os.fileInUnisonDir fromname in - let fto = Os.fileInUnisonDir toname in + let ffrom = Util.fileInUnisonDir fromname in + let fto = Util.fileInUnisonDir toname in Util.convertUnixErrorsToFatal "committing" (fun () -> System.rename ffrom fto)) @@ -416,8 +416,8 @@ let postCommitArchiveLocal (fspath,()) Lwt.return (let (fromname,_) = archiveName fspath NewArch in let (toname, thisRoot) = archiveName fspath MainArch in - let ffrom = Os.fileInUnisonDir fromname in - let fto = Os.fileInUnisonDir toname in + let ffrom = Util.fileInUnisonDir fromname in + let fto = Util.fileInUnisonDir toname in debug (fun() -> Util.msg "Copying archive %s to %s\n" (System.fspathToDebugString ffrom) @@ -438,7 +438,7 @@ let postCommitArchiveLocal (fspath,()) close_in inFd; close_out outFd end; - let arcFspath = Os.fileInUnisonDir toname in + let arcFspath = Util.fileInUnisonDir toname in let info = Fileinfo.get' arcFspath in Hashtbl.replace archiveInfoCache thisRoot info)) @@ -660,7 +660,7 @@ let rec populateCacheFromArchiveRec path arch = let populateCacheFromArchive fspath arch = let (cacheFilename, _) = archiveName fspath FPCache in - let cacheFile = Os.fileInUnisonDir cacheFilename in + let cacheFile = Util.fileInUnisonDir cacheFilename in Fpcache.init true (Prefs.read ignoreArchives) cacheFile; populateCacheFromArchiveRec Path.empty arch; Fpcache.finish () @@ -692,7 +692,7 @@ let loadArchiveOnRoot: Common.root -> bool -> (int * string) option Lwt.t = "loadArchive" (fun (fspath, optimistic) -> let (arcName,thisRoot) = archiveName fspath MainArch in - let arcFspath = Os.fileInUnisonDir arcName in + let arcFspath = Util.fileInUnisonDir arcName in if Prefs.read ignoreArchives then begin foundArchives := false; @@ -703,16 +703,16 @@ let loadArchiveOnRoot: Common.root -> bool -> (int * string) option Lwt.t = (* If the archive is not in a stable state, we need to perform archive recovery. So, the optimistic loading fails. *) - System.file_exists (Os.fileInUnisonDir newArcName) + System.file_exists (Util.fileInUnisonDir newArcName) || let (lockFilename, _) = archiveName fspath Lock in - let lockFile = Os.fileInUnisonDir lockFilename in + let lockFile = Util.fileInUnisonDir lockFilename in Lock.is_locked lockFile then Lwt.return None else let (arcName,thisRoot) = archiveName fspath MainArch in - let arcFspath = Os.fileInUnisonDir arcName in + let arcFspath = Util.fileInUnisonDir arcName in let info = Fileinfo.get' arcFspath in if archiveUnchanged fspath info then (* The archive is unchanged. So, we don't need to do @@ -767,7 +767,7 @@ let loadArchives (optimistic: bool) = ^ " (in case they may be useful for debugging).\n" ^ " The archive files on this machine are in the directory\n" ^ (Printf.sprintf " %s\n" - (System.fspathToPrintString Os.unisonDir)) + (System.fspathToPrintString Util.unisonDir)) ^ " and have names of the form\n" ^ " arXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n" ^ " where the X's are hexadecimal numbers.\n" @@ -781,7 +781,7 @@ let loadArchives (optimistic: bool) = let lockArchiveLocal fspath = let (lockFilename, _) = archiveName fspath Lock in - let lockFile = Os.fileInUnisonDir lockFilename in + let lockFile = Util.fileInUnisonDir lockFilename in if Lock.acquire lockFile then None else @@ -794,7 +794,7 @@ let lockArchiveOnRoot: Common.root -> unit -> string option Lwt.t = let unlockArchiveLocal fspath = Lock.release - (Os.fileInUnisonDir (fst (archiveName fspath Lock))) + (Util.fileInUnisonDir (fst (archiveName fspath Lock))) let unlockArchiveOnRoot: Common.root -> unit -> unit Lwt.t = Remote.registerRootCmd @@ -886,10 +886,10 @@ let archivesExistOnRoot: Common.root -> unit -> (bool * bool) Lwt.t = (fun (fspath,rootsName) -> let (oldname,_) = archiveName fspath MainArch in let oldexists = - System.file_exists (Os.fileInUnisonDir oldname) in + System.file_exists (Util.fileInUnisonDir oldname) in let (newname,_) = archiveName fspath NewArch in let newexists = - System.file_exists (Os.fileInUnisonDir newname) in + System.file_exists (Util.fileInUnisonDir newname) in Lwt.return (oldexists, newexists)) let forall = Safelist.for_all (fun x -> x) @@ -1971,7 +1971,7 @@ let t1 = Unix.gettimeofday () in showStatus = not !Trace.runningasserver } in let (cacheFilename, _) = archiveName fspath FPCache in - let cacheFile = Os.fileInUnisonDir cacheFilename in + let cacheFile = Util.fileInUnisonDir cacheFilename in Fpcache.init scanInfo.fastCheck (Prefs.read ignoreArchives) cacheFile; let unchangedOptions = try @@ -2123,7 +2123,7 @@ let prepareCommitLocal (fspath, magic) = let archiveHash = checkArchive true [] archive 0 in let props = getArchiveProps root in storeArchiveLocal - (Os.fileInUnisonDir newName) root archive archiveHash magic props; + (Util.fileInUnisonDir newName) root archive archiveHash magic props; Lwt.return (Some archiveHash) let prepareCommitOnRoot