[Unison-hackers] [unison-svn] r421 - in trunk/src: . ubase
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Wed Mar 17 18:34:37 EDT 2010
Author: vouillon
Date: 2010-03-17 18:34:35 -0400 (Wed, 17 Mar 2010)
New Revision: 421
Modified:
trunk/src/RECENTNEWS
trunk/src/case.ml
trunk/src/case.mli
trunk/src/fileinfo.mli
trunk/src/globals.ml
trunk/src/globals.mli
trunk/src/mkProjectInfo.ml
trunk/src/props.ml
trunk/src/props.mli
trunk/src/recon.ml
trunk/src/ubase/prefs.ml
trunk/src/ubase/prefs.mli
trunk/src/uicommon.ml
trunk/src/uigtk2.ml
trunk/src/update.ml
Log:
* Added a "fat" preference that makes Unison use the right options
when one of the replica is on a FAT filesystem.
* Allow "prefer/force=newer" even when not synchronizing modification
times. (The reconciler will not be aware of the modification time
of unchanged files, so the synchronization choices of Unison can be
different from when "times=true", but the behavior remains sane:
changed files with the most recent modification time will be
propagated.)
* Automatic archive conversion to case sensitive mode (useful when
Unison default is case sensitive and the user switches after the
fact to case insensitive, for instance by setting the "fat"
preference).
* Make Unicode the default on all architectures (it was only the
default when a Mac OS X or Windows machine was involved).
* GTK UI: added "Change Profile" toolbar button.
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/RECENTNEWS 2010-03-17 22:34:35 UTC (rev 421)
@@ -1,5 +1,24 @@
CHANGES FROM VERSION 2.40.1
+* Added a "fat" preference that makes Unison use the right options
+ when one of the replica is on a FAT filesystem.
+* Allow "prefer/force=newer" even when not synchronizing modification
+ times. (The reconciler will not be aware of the modification time
+ of unchanged files, so the synchronization choices of Unison can be
+ different from when "times=true", but the behavior remains sane:
+ changed files with the most recent modification time will be
+ propagated.)
+* Automatic archive conversion to case sensitive mode (useful when
+ Unison default is case sensitive and the user switches after the
+ fact to case insensitive, for instance by setting the "fat"
+ preference).
+* Make Unicode the default on all architectures (it was only the
+ default when a Mac OS X or Windows machine was involved).
+* GTK UI: added "Change Profile" toolbar button.
+
+-------------------------------
+CHANGES FROM VERSION 2.40.1
+
* Silence compiler warnings on cltool.c (in OSX build)
Modified: trunk/src/case.ml
===================================================================
--- trunk/src/case.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/case.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -44,21 +44,20 @@
Prefs.createBoolWithDefault "unicode"
"!assume Unicode encoding in case insensitive mode"
"When set to {\\tt true}, this flag causes Unison to perform \
- case insensitive file comparisons assuming Unicode encoding"
+ case insensitive file comparisons assuming Unicode encoding. \
+ This is the default. When the flag is set to {\\tt false}, \
+ a Latin 1 encoding is assumed. This flag has no effect when \
+ Unison runs in case sensitive mode."
let unicodeEncoding =
Prefs.createBool "unicodeEnc" false
"*Pseudo-preference for internal use only" ""
-(* Whether we default to Unicode encoding on OSX and Windows *)
-let defaultToUnicode = true
-
-let useUnicode b =
+let useUnicode () =
let pref = Prefs.read unicode in
- pref = `True ||
- (defaultToUnicode && pref = `Default && b)
+ pref = `True || pref = `Default
-let useUnicodeAPI () = useUnicode true
+let useUnicodeAPI = useUnicode
(* During startup the client determines the case sensitivity of each root. *)
(* If any root is case insensitive, all roots must know it; we ensure this *)
@@ -68,7 +67,7 @@
Prefs.set someHostIsInsensitive
(Prefs.read caseInsensitiveMode = `True ||
(Prefs.read caseInsensitiveMode = `Default && b));
- Prefs.set unicodeEncoding (useUnicode b)
+ Prefs.set unicodeEncoding (useUnicode ())
(****)
@@ -174,3 +173,5 @@
insensitiveOps
end else
sensitiveOps
+
+let caseSensitiveModeDesc = sensitiveOps#modeDesc
Modified: trunk/src/case.mli
===================================================================
--- trunk/src/case.mli 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/case.mli 2010-03-17 22:34:35 UTC (rev 421)
@@ -1,6 +1,7 @@
(* Unison file synchronizer: src/case.mli *)
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
+val caseInsensitiveMode : [`True|`False|`Default] Prefs.t
val unicodeEncoding : bool Prefs.t
val useUnicodeAPI : unit -> bool
@@ -25,3 +26,5 @@
the correct encoding *)
val init : bool -> unit
+
+val caseSensitiveModeDesc : string
Modified: trunk/src/fileinfo.mli
===================================================================
--- trunk/src/fileinfo.mli 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/fileinfo.mli 2010-03-17 22:34:35 UTC (rev 421)
@@ -27,3 +27,5 @@
(****)
val init : bool -> unit
+val allowSymlinks : [`True|`False|`Default] Prefs.t
+val ignoreInodeNumbers : bool Prefs.t
Modified: trunk/src/globals.ml
===================================================================
--- trunk/src/globals.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/globals.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -287,3 +287,17 @@
let allHostsAreRunningWindows =
Prefs.createBool "allHostsAreRunningWindows" false "*" ""
+
+let fatFilesystem =
+ Prefs.createBool "fat" ~local:true false
+ "use appropriate options for FAT filesystems"
+ ("When this is set to {\\tt true}, Unison will use appropriate options \
+ to synchronize efficiently and without error a replica located on a \
+ FAT filesystem on a non-Windows machine: \
+ only synchronize the write permission bit ({\\tt perms = 0o200}); \
+ treat filenames as case insensitive ({\\tt ignorecase = true}); \
+ do not attempt to synchronize symbolic links ({\\tt links = false}); \
+ ignore inode number changes when detecting updates \
+ ({\\tt ignoreinodenumbers = true}). \
+ Any of these change can be overridden by explicitely setting \
+ the corresponding preference in the profile.")
Modified: trunk/src/globals.mli
===================================================================
--- trunk/src/globals.mli 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/globals.mli 2010-03-17 22:34:35 UTC (rev 421)
@@ -87,3 +87,4 @@
(* Internal prefs, needed to know whether to do filenames checks *)
val someHostIsRunningWindows : bool Prefs.t
val allHostsAreRunningWindows : bool Prefs.t
+val fatFilesystem : bool Prefs.t
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/mkProjectInfo.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -99,3 +99,4 @@
+
Modified: trunk/src/props.ml
===================================================================
--- trunk/src/props.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/props.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -46,6 +46,7 @@
val extract : t -> int
val check : Fspath.t -> Path.local -> Unix.LargeFile.stats -> t -> unit
val validatePrefs : unit -> unit
+ val permMask : int Prefs.t
end = struct
(* We introduce a type, Perm.t, that holds a file's permissions along with *)
@@ -227,7 +228,9 @@
"Failed to set permissions of file %s to %s: \
the permissions was set to %s instead. \
The filesystem probably does not support all permission bits. \
- You should probably set the \"perms\" option to 0o%o \
+ If this is a FAT filesystem, you should set the \"fat\" option \
+ to true. \
+ Otherwise, you should probably set the \"perms\" option to 0o%o \
(or to 0 if you don't need to synchronize permissions)."
(Fspath.toPrintString (Fspath.concat fspath path))
(syncedPartsToString (fp, mask))
@@ -762,6 +765,7 @@
let perms p = Perm.extract p.perm
let syncModtimes = Time.sync
+let permMask = Perm.permMask
let validatePrefs = Perm.validatePrefs
Modified: trunk/src/props.mli
===================================================================
--- trunk/src/props.mli 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/props.mli 2010-03-17 22:34:35 UTC (rev 421)
@@ -29,6 +29,7 @@
val dirDefault : t
val syncModtimes : bool Prefs.t
+val permMask : int Prefs.t
(* We are reusing the directory length to store a flag indicating that
the directory is unchanged *)
@@ -39,4 +40,4 @@
val dirMarkedUnchanged : t -> dirChangedStamp -> int -> bool
val validatePrefs: unit -> unit
-
+
Modified: trunk/src/recon.ml
===================================================================
--- trunk/src/recon.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/recon.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -276,8 +276,8 @@
(* errors *)
let checkThatPreferredRootIsValid () =
let test_root predname = function
- | "" -> ()
- | ("newer" | "older") as r ->
+ | "" | "newer" -> ()
+ | "older" as r ->
if not (Prefs.read Props.syncModtimes) then
raise (Util.Transient (Printf.sprintf
"The '%s=%s' preference can only be used with 'times=true'"
Modified: trunk/src/ubase/prefs.ml
===================================================================
--- trunk/src/ubase/prefs.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/ubase/prefs.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -3,16 +3,24 @@
let debug = Util.debug "prefs"
-type 'a t = ('a * string list) ref
+type 'a t =
+ { mutable value : 'a; defaultValue : 'a; mutable names : string list;
+ mutable setInProfile : bool }
-let read p = fst !p
+let read p = p.value
-let set p v = p:=(v, snd !p)
+let set p v = p.setInProfile <- true; p.value <- v
-let name p = snd !p
+let overrideDefault p v = if not p.setInProfile then p.value <- v
-let rawPref default = ref default
+let name p = p.names
+let readDefault p = p.defaultValue
+
+let rawPref default name =
+ { value = default; defaultValue = default; names = [name];
+ setInProfile = false }
+
(* ------------------------------------------------------------------------- *)
let profileName = ref None
@@ -161,7 +169,7 @@
let (_,pspec,_) = Util.StringMap.find (Safelist.hd (name pref)) !prefs in
prefs := Util.StringMap.add newname ("*", pspec, "") !prefs;
aliasMap := Util.StringMap.add newname (Safelist.hd (name pref)) !aliasMap;
- pref := (fst !pref, newname::(snd !pref))
+ pref.names <- newname :: pref.names
let registerPref name typ pspec doc fulldoc =
if Util.StringMap.mem name !prefs then
@@ -172,17 +180,23 @@
prefType := Util.StringMap.add name typ !prefType
let createPrefInternal name typ local default doc fulldoc printer parsefn =
- let newCell = rawPref (default, [name]) in
+ let newCell = rawPref default name in
registerPref name typ (parsefn newCell) doc fulldoc;
- adddumper name local (fun () -> Marshal.to_string !newCell []);
- addprinter name (fun () -> printer (fst !newCell));
- addresetter (fun () -> newCell := (default, [name]));
- addloader name (fun s -> newCell := Marshal.from_string s 0);
+ adddumper name local
+ (fun () -> Marshal.to_string (newCell.value, newCell.names) []);
+ addprinter name (fun () -> printer newCell.value);
+ addresetter
+ (fun () ->
+ newCell.setInProfile <- false; newCell.value <- newCell.defaultValue);
+ addloader name
+ (fun s ->
+ let (value, names) = Marshal.from_string s 0 in
+ newCell.value <- value);
newCell
let create name ?(local=false) default doc fulldoc intern printer =
createPrefInternal name `CUSTOM local default doc fulldoc printer
- (fun cell -> Uarg.String (fun s -> set cell (intern (fst !cell) s)))
+ (fun cell -> Uarg.String (fun s -> set cell (intern (read cell) s)))
let createBool name ?(local=false) default doc fulldoc =
let doc = if default then doc ^ " (default true)" else doc in
@@ -208,7 +222,7 @@
let createStringList name ?(local=false) doc fulldoc =
createPrefInternal name `STRING_LIST local [] doc fulldoc
(fun v -> v)
- (fun cell -> Uarg.String (fun s -> set cell (s::(fst !cell))))
+ (fun cell -> Uarg.String (fun s -> set cell (s:: read cell)))
let createBoolWithDefault name ?(local=false) doc fulldoc =
createPrefInternal name `BOOLDEF local `Default doc fulldoc
Modified: trunk/src/ubase/prefs.mli
===================================================================
--- trunk/src/ubase/prefs.mli 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/ubase/prefs.mli 2010-03-17 22:34:35 UTC (rev 421)
@@ -6,6 +6,8 @@
val read : 'a t -> 'a
val set : 'a t -> 'a -> unit
val name : 'a t -> string list
+val overrideDefault : 'a t -> 'a -> unit
+val readDefault : 'a t -> 'a
(* Convenient functions for registering simple kinds of preferences. Note *)
(* that createStringPref creates a preference that can only be set once, *)
Modified: trunk/src/uicommon.ml
===================================================================
--- trunk/src/uicommon.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/uicommon.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -457,6 +457,12 @@
Safelist.exists (fun (_, isOSX, _) -> isOSX) archs in
let someHostIsCaseInsensitive =
someHostIsRunningWindows || someHostRunningOsX in
+ if Prefs.read Globals.fatFilesystem then begin
+ Prefs.overrideDefault Props.permMask 0o200;
+ Prefs.overrideDefault Case.caseInsensitiveMode `True;
+ Prefs.overrideDefault Fileinfo.allowSymlinks `False;
+ Prefs.overrideDefault Fileinfo.ignoreInodeNumbers true
+ end;
Case.init someHostIsCaseInsensitive;
Props.init someHostIsRunningWindows;
Osx.init someHostRunningOsX;
Modified: trunk/src/uigtk2.ml
===================================================================
--- trunk/src/uigtk2.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/uigtk2.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -1570,13 +1570,7 @@
if React.state unicode then
Printf.fprintf ch "unicode = true\n";
*)
- if React.state fat then begin
- Printf.fprintf ch "ignorecase = true\n";
- Printf.fprintf ch "unicode = true\n";
- Printf.fprintf ch "ignoreinodenumbers = true\n";
- Printf.fprintf ch "links = false\n";
- Printf.fprintf ch "perms = 0o200\n"
- end;
+ if React.state fat then Printf.fprintf ch "fat = true\n";
close_out ch;
profileName := Some (React.state name)
with Sys_error _ as e ->
@@ -3915,13 +3909,6 @@
~tooltip:"Compare the two files at each replica"
~callback:diffCmd ());
-(* actionBar#insert_space ();*)
-(*
- grAdd grDiff (actionBar#insert_button ~text:"Merge"
- ~icon:((GMisc.image ~stock:`DIALOG_QUESTION ())#coerce)
- ~tooltip:"Merge the two items at each replica"
- ~callback:mergeCmd ());
- *)
(*********************************************************************
Detail button
*********************************************************************)
@@ -3933,6 +3920,20 @@
~callback:showDetCommand ());
(*********************************************************************
+ Profile change button
+ *********************************************************************)
+ actionBar#insert_space ();
+ let profileChange _ =
+ match getProfile false with
+ None -> ()
+ | Some p -> clearMainWindow (); loadProfile p false; detectCmd ()
+ in
+ grAdd grRescan (actionBar#insert_button ~text:"Change Profile"
+ ~icon:((GMisc.image ~stock:`OPEN ())#coerce)
+ ~tooltip:"Select a different profile"
+ ~callback:profileChange ());
+
+ (*********************************************************************
Keyboard commands
*********************************************************************)
ignore
@@ -3983,13 +3984,6 @@
left#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._greater;
left#add_accelerator ~group:accel_group GdkKeysyms._period;
- let merge =
- actionMenu#add_image_item ~key:GdkKeysyms._m ~callback:mergeAction
- ~image:((GMisc.image ~stock:`ADD ~icon_size:`MENU ())#coerce)
- "_Merge the Files" in
- grAdd grAction merge;
- (* merge#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._m; *)
-
let def_descl = "Right to Left" in
let descl =
if init || loc1 = loc2 then def_descr else
@@ -4008,6 +4002,13 @@
~image:((GMisc.image ~stock:`NO ~icon_size:`MENU ())#coerce)
"Do _Not Propagate Changes");
+ let merge =
+ actionMenu#add_image_item ~key:GdkKeysyms._m ~callback:mergeAction
+ ~image:((GMisc.image ~stock:`ADD ~icon_size:`MENU ())#coerce)
+ "_Merge the Files" in
+ grAdd grAction merge;
+ (* merge#add_accelerator ~group:accel_group ~modi:[`SHIFT] GdkKeysyms._m; *)
+
(* Override actions *)
ignore (actionMenu#add_separator ());
grAdd grAction
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2010-03-13 19:13:41 UTC (rev 420)
+++ trunk/src/update.ml 2010-03-17 22:34:35 UTC (rev 421)
@@ -274,21 +274,34 @@
System.file_exists (Os.fileInUnisonDir name)))
let compatibleCaseMode magic =
- if magic = "" then `YES else
+ if magic = "" then `YES (* Newly created archive *) else
try
let archMode = String.sub magic 0 (String.index magic '\000') in
let curMode = (Case.ops ())#modeDesc in
if curMode <> archMode then
- `NO (curMode, archMode)
+ `NO (archMode = Case.caseSensitiveModeDesc, curMode, archMode)
else
`YES
with Not_found ->
+ (* Legacy format. Cannot be Unicode case insensitive. *)
if (Case.ops ())#mode = Case.UnicodeInsensitive then
let curMode = (Case.ops ())#modeDesc in
- `NO (curMode, "some non-Unicode")
+ `NO (false, curMode, "some non-Unicode")
else
`YES
+(* HACK: we use this as just a flag. Should delete this when Unison minor
+ version is bumped. *)
+
+let rootCanMakeCaseSensitive
+ = Remote.registerRootCmd "canMakeCaseSensitive" (fun _ -> Lwt.return ())
+
+let didMakeCaseSensitive () =
+ Globals.allRootsMap
+ (fun r -> Remote.commandAvailable r "canMakeCaseSensitive") >>= fun l ->
+ Lwt.return (List.for_all (fun x -> x) l)
+
+
let checkArchiveCaseSensitivity l =
let error curMode archMode =
(* We cannot compute the archive name locally as it
@@ -317,8 +330,16 @@
match l with
Some (_, magic) :: _ ->
begin match compatibleCaseMode magic with
- `NO (curMode, archMode) -> error curMode archMode
- | `YES -> Lwt.return ()
+ `NO (conv, curMode, archMode) ->
+ begin if conv then
+ didMakeCaseSensitive ()
+ else
+ Lwt.return false
+ end >>= fun converted ->
+ if converted then Lwt.return () else
+ error curMode archMode
+ | `YES ->
+ Lwt.return ()
end
| _ ->
Lwt.return ()
@@ -578,6 +599,51 @@
let dumpArchiveOnRoot : Common.root -> unit -> unit Lwt.t =
Remote.registerRootCmd "dumpArchive" dumpArchiveLocal
+(*****************************************************************************)
+(* ARCHIVE CASE CONVERSION *)
+(*****************************************************************************)
+
+(* Turn a case sensitive archive into a case insensitive archive.
+ Directory children are resorted and duplicates are removed.
+*)
+let rec makeCaseSensitiveRec arch =
+ match arch with
+ ArchiveDir (desc, children) ->
+ let dups = ref [] in
+ let children =
+ NameMap.fold
+ (fun nm ch chs ->
+ if NameMap.mem nm chs then dups := nm :: !dups;
+ NameMap.add nm (makeCaseSensitiveRec ch) chs)
+ children NameMap.empty
+ in
+ let children =
+ List.fold_left (fun chs nm -> NameMap.remove nm chs) children !dups in
+ ArchiveDir (desc, children)
+ | ArchiveFile _ | ArchiveSymlink _ | NoArchive ->
+ arch
+
+let makeCaseSensitive thisRoot =
+ setArchiveLocal thisRoot (makeCaseSensitiveRec (getArchive thisRoot))
+
+let rec populateCacheFromArchiveRec path arch =
+ match arch with
+ ArchiveDir (_, children) ->
+ NameMap.iter
+ (fun nm ch -> populateCacheFromArchiveRec (Path.child path nm) ch)
+ children
+ | ArchiveFile (desc, dig, stamp, ress) ->
+ Fpcache.save path (desc, dig, stamp, ress)
+ | ArchiveSymlink _ | NoArchive ->
+ ()
+
+let populateCacheFromArchive fspath arch =
+ let (cacheFilename, _) = archiveName fspath FPCache in
+ let cacheFile = Os.fileInUnisonDir cacheFilename in
+ Fpcache.init true cacheFile;
+ populateCacheFromArchiveRec Path.empty arch;
+ Fpcache.finish ()
+
(*************************************************************************)
(* Loading archives *)
(*************************************************************************)
@@ -591,27 +657,16 @@
^ "not a good idea to set this option in a profile: it is intended for "
^ "command-line use.")
-let rec populateCacheFromArchive path arch =
- match arch with
- ArchiveDir (_, children) ->
- NameMap.iter
- (fun nm ch -> populateCacheFromArchive (Path.child path nm) ch)
- children
- | ArchiveFile (desc, dig, stamp, ress) ->
- Fpcache.save path (desc, dig, stamp, ress)
- | ArchiveSymlink _ | NoArchive ->
- ()
-
let setArchiveData thisRoot fspath (arch, hash, magic, properties) info =
setArchiveLocal thisRoot arch;
setArchivePropsLocal thisRoot properties;
Hashtbl.replace archiveInfoCache thisRoot info;
- if compatibleCaseMode magic <> `YES then begin
- let (cacheFilename, _) = archiveName fspath FPCache in
- let cacheFile = Os.fileInUnisonDir cacheFilename in
- Fpcache.init true cacheFile;
- populateCacheFromArchive Path.empty arch;
- Fpcache.finish ()
+ begin match compatibleCaseMode magic with
+ `YES ->
+ ()
+ | `NO (conv, _, _) ->
+ if conv then makeCaseSensitive thisRoot;
+ populateCacheFromArchive fspath arch
end;
Lwt.return (Some (hash, magic))
@@ -629,9 +684,10 @@
let (arcName,thisRoot) = archiveName fspath MainArch in
let arcFspath = Os.fileInUnisonDir arcName in
- if Prefs.read ignoreArchives then
+ if Prefs.read ignoreArchives then begin
+ foundArchives := false;
clearArchiveData thisRoot
- else if optimistic then begin
+ end else if optimistic then begin
let (newArcName, _) = archiveName fspath NewArch in
if
(* If the archive is not in a stable state, we need to
More information about the Unison-hackers
mailing list