From fb86980c9a08def05bf30b8a50262f5940917986 Mon Sep 17 00:00:00 2001 From: Paul Gossman Date: Tue, 24 Nov 2020 16:38:01 -0500 Subject: [PATCH 1/3] Move definition of Os.fileInUnisonDir to Util. This makes supplying a Util.fileInUnisonDir function via Util.supplyFileInUnisonDirFn unnecessary, which removes the code duplication where that is called. This also enables more flexible usage of a fileInUnisonDir function from ubase, where the Os module is not available. Os.fileInUnisonDir now references Util.fileInUnisonDir. --- src/main.ml | 6 ------ src/os.ml | 13 ++----------- src/ubase/util.ml | 20 ++++++++++++++------ src/ubase/util.mli | 5 +---- src/uimacbridge.ml | 5 ----- src/uimacbridgenew.ml | 5 ----- 6 files changed, 17 insertions(+), 37 deletions(-) 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..d0dc588a9 100644 --- a/src/os.ml +++ b/src/os.ml @@ -305,19 +305,10 @@ let fullfingerprintEqual (fp, rfp) (fp', rfp') = (* 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 +let unisonDir = Util.unisonDir (* build a fspath representing an archive child path whose name is given *) -let fileInUnisonDir str = System.fspathConcat unisonDir str +let fileInUnisonDir = Util.fileInUnisonDir (* Make sure archive directory exists *) let createUnisonDir() = diff --git a/src/ubase/util.ml b/src/ubase/util.ml index 3865d17be..d98be1c9e 100644 --- a/src/ubase/util.ml +++ b/src/ubase/util.ml @@ -496,11 +496,19 @@ let fileMaybeRelToHomeDir n = (* "Upcall" for building pathnames in the .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..8beda71a8 100644 --- a/src/ubase/util.mli +++ b/src/ubase/util.mli @@ -103,10 +103,7 @@ 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: *) +val unisonDir : System.fspath val fileInUnisonDir : string -> System.fspath (* Printing and formatting functions *) diff --git a/src/uimacbridge.ml b/src/uimacbridge.ml index d50dc7ce4..1a3960b4c 100644 --- a/src/uimacbridge.ml +++ b/src/uimacbridge.ml @@ -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..33637587d 100644 --- a/src/uimacbridgenew.ml +++ b/src/uimacbridgenew.ml @@ -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; From 6f3ef8782fe4d6afc7fa2fb582613ff8021cefd2 Mon Sep 17 00:00:00 2001 From: Paul Gossman Date: Tue, 24 Nov 2020 16:42:05 -0500 Subject: [PATCH 2/3] Make logfile default location .unison rather than $HOME. --- src/ubase/trace.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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." From 04c94926d9c5f6f2728cd0baccedb5b8f8e0b36f Mon Sep 17 00:00:00 2001 From: Paul Gossman Date: Thu, 26 Nov 2020 23:16:59 -0500 Subject: [PATCH 3/3] Remove Os.unisonDir and Os.fileInUnisonDir. After moving unisonDir and fileInUnisonDir from Os to Util, their definitions in Os were made references to the values in Util. This change removes them from Os, and replaces all usages of those Os values in the codebase with the Util values. --- src/fswatchold.ml | 2 +- src/os.ml | 13 +++---------- src/os.mli | 2 -- src/stasher.ml | 2 +- src/ubase/util.ml | 2 +- src/ubase/util.mli | 4 ++++ src/uicommon.ml | 2 +- src/uimacbridge.ml | 2 +- src/uimacbridgenew.ml | 2 +- src/uitext.ml | 2 +- src/update.ml | 38 +++++++++++++++++++------------------- 11 files changed, 33 insertions(+), 38 deletions(-) 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/os.ml b/src/os.ml index d0dc588a9..ad27e217e 100644 --- a/src/os.ml +++ b/src/os.ml @@ -303,22 +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 = Util.unisonDir - -(* build a fspath representing an archive child path whose name is given *) -let fileInUnisonDir = Util.fileInUnisonDir - (* 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/util.ml b/src/ubase/util.ml index d98be1c9e..c42113322 100644 --- a/src/ubase/util.ml +++ b/src/ubase/util.ml @@ -493,7 +493,7 @@ let fileMaybeRelToHomeDir n = else System.fspathFromString n (*****************************************************************************) -(* "Upcall" for building pathnames in the .unison dir *) +(* .unison dir *) (*****************************************************************************) external isMacOSXPred : unit -> bool = "isMacOSX" diff --git a/src/ubase/util.mli b/src/ubase/util.mli index 8beda71a8..9cc185ae1 100644 --- a/src/ubase/util.mli +++ b/src/ubase/util.mli @@ -103,7 +103,11 @@ val debug : string -> (unit->unit) -> unit val warnPrinter : (string -> unit) option ref val warn : string -> unit +(* 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 1a3960b4c..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;; diff --git a/src/uimacbridgenew.ml b/src/uimacbridgenew.ml index 33637587d..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;; 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