[Unison-hackers] [unison-svn] r424 - in trunk: doc src
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Fri Mar 26 10:24:04 EDT 2010
Author: vouillon
Date: 2010-03-26 10:24:04 -0400 (Fri, 26 Mar 2010)
New Revision: 424
Modified:
trunk/doc/unison-manual.tex
trunk/src/RECENTNEWS
trunk/src/globals.ml
trunk/src/globals.mli
trunk/src/mkProjectInfo.ml
trunk/src/pred.ml
trunk/src/recon.ml
trunk/src/update.ml
Log:
* Added "BelowPath" patterns, that match a path as well as all paths below
(convenient to use with no{deletion,update,creation}partial preferences)
* Always check archive case sensivity mode before update detection,
even when the archive is already cached in memory, in case the
profile has been changed without restarting Unison.
Modified: trunk/doc/unison-manual.tex
===================================================================
--- trunk/doc/unison-manual.tex 2010-03-25 14:43:01 UTC (rev 423)
+++ trunk/doc/unison-manual.tex 2010-03-26 14:24:04 UTC (rev 424)
@@ -1838,15 +1838,19 @@
\begin{alltt}
Regex \ARG{regexp}
\end{alltt}
-For convenience, two other styles of pattern are also recognized:
+For convenience, three other styles of pattern are also recognized:
\begin{alltt}
Name \ARG{name}
\end{alltt}
-matches any path in which the last component matches \ARG{name}, while
+matches any path in which the last component matches \ARG{name},
\begin{alltt}
Path \ARG{path}
\end{alltt}
-matches exactly the path \ARG{path}.
+matches exactly the path \ARG{path}, and
+\begin{alltt}
+ BelowPath \ARG{path}
+\end{alltt}
+matches the path \ARG{path} and any path below.
%
The \ARG{name} and \ARG{path} arguments of the latter forms of
patterns are {\em not} regular expressions. Instead,
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2010-03-25 14:43:01 UTC (rev 423)
+++ trunk/src/RECENTNEWS 2010-03-26 14:24:04 UTC (rev 424)
@@ -1,3 +1,12 @@
+CHANGES FROM VERSION 2.40.15
+
+* Added "BelowPath" patterns, that match a path as well as all paths below
+ (convenient to use with no{deletion,update,creation}partial preferences)
+* Always check archive case sensivity mode before update detection,
+ even when the archive is already cached in memory, in case the
+ profile has been changed without restarting Unison.
+
+-------------------------------
CHANGES FROM VERSION 2.40.1
* Windows: more fixes for compilation with MSVC
Modified: trunk/src/globals.ml
===================================================================
--- trunk/src/globals.ml 2010-03-25 14:43:01 UTC (rev 423)
+++ trunk/src/globals.ml 2010-03-26 14:24:04 UTC (rev 424)
@@ -86,6 +86,8 @@
let rootsInCanonicalOrder() = Common.sortRoots (!theroots)
+let localRoot () = List.hd (rootsInCanonicalOrder ())
+
let reorderCanonicalListToUsersOrder l =
if rootsList() = rootsInCanonicalOrder() then l
else Safelist.rev l
Modified: trunk/src/globals.mli
===================================================================
--- trunk/src/globals.mli 2010-03-25 14:43:01 UTC (rev 423)
+++ trunk/src/globals.mli 2010-03-26 14:24:04 UTC (rev 424)
@@ -27,6 +27,9 @@
(* comes first *)
val rootsInCanonicalOrder : unit -> Common.root list
+(* a local root *)
+val localRoot : unit -> Common.root
+
(* Run a command on all roots *)
val allRootsIter :
(Common.root -> unit Lwt.t) -> unit Lwt.t
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2010-03-25 14:43:01 UTC (rev 423)
+++ trunk/src/mkProjectInfo.ml 2010-03-26 14:24:04 UTC (rev 424)
@@ -42,7 +42,7 @@
(* ---------------------------------------------------------------------- *)
(* You shouldn't need to edit below. *)
-let revisionString = "$Rev: 410$";;
+let revisionString = "$Rev: 424$";;
(* BCP (1/10): This bit was added to help with getting Unison via bazaar, but it
was never used much and I'm not confident it's working. I'll comment it out
@@ -102,3 +102,5 @@
+
+
Modified: trunk/src/pred.ml
===================================================================
--- trunk/src/pred.ml 2010-03-25 14:43:01 UTC (rev 423)
+++ trunk/src/pred.ml 2010-03-26 14:24:04 UTC (rev 424)
@@ -36,7 +36,7 @@
let error_msg s =
Printf.sprintf "bad pattern: %s\n\
A pattern must be introduced by one of the following keywords:\n\
- \032 Name, Path, or Regex." s
+ \032 Name, Path, BelowPath or Regex." s
(* [select str [(p1, f1), ..., (pN, fN)] fO]: (roughly) *)
(* match str with *)
@@ -80,6 +80,14 @@
^ "'Path' patterns may not begin with a slash; "
^ "only relative paths are allowed."));
Rx.globx str);
+ ("BelowPath ", fun str ->
+ if str<>"" && str.[0] = '/' then
+ raise (Prefs.IllegalValue
+ ("Malformed pattern: "
+ ^ "\"" ^ p ^ "\"\n"
+ ^ "'BelowPath' patterns may not begin with a slash; "
+ ^ "only relative paths are allowed."));
+ Rx.seq [Rx.globx str; Rx.rx "(/.*)?"]);
("Regex ", Rx.rx)]
(fun str -> raise (Prefs.IllegalValue (error_msg p)))
with
Modified: trunk/src/recon.ml
===================================================================
--- trunk/src/recon.ml 2010-03-25 14:43:01 UTC (rev 423)
+++ trunk/src/recon.ml 2010-03-26 14:24:04 UTC (rev 424)
@@ -187,7 +187,8 @@
\\texttt{nodeletionpartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file deletion in \\ARG{PATHSPEC} \
on root \\ARG{root} (see \\sectionref{pathspec}{Path Specification} \
- for more information).")
+ for more information). It is recommended to use {\\tt BelowPath} \
+ patterns when selecting a directory and all its contents.")
let noUpdatePartial =
Pred.create "noupdatepartial" ~advanced:true
@@ -195,7 +196,9 @@
\\texttt{noupdatepartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file update or deletion in \
\\ARG{PATHSPEC} on root \\ARG{root} (see \
- \\sectionref{pathspec}{Path Specification} for more information).")
+ \\sectionref{pathspec}{Path Specification} for more information). \
+ It is recommended to use {\\tt BelowPath} \
+ patterns when selecting a directory and all its contents.")
let noCreationPartial =
Pred.create "nocreationpartial" ~advanced:true
@@ -203,7 +206,9 @@
\\texttt{nocreationpartial = \\ARG{PATHSPEC} -> \\ARG{root}} prevents \
Unison from performing any file creation in \\ARG{PATHSPEC} \
on root \\ARG{root} (see \\sectionref{pathspec}{Path Specification} \
- for more information).")
+ for more information). \
+ It is recommended to use {\\tt BelowPath} \
+ patterns when selecting a directory and all its contents.")
let partialCancelPref actionKind =
match actionKind with
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2010-03-25 14:43:01 UTC (rev 423)
+++ trunk/src/update.ml 2010-03-26 14:24:04 UTC (rev 424)
@@ -273,77 +273,7 @@
Os.myCanonicalHostName,
System.file_exists (Os.fileInUnisonDir name)))
-let compatibleCaseMode magic =
- 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 (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 (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
- currently depends on the os type *)
- Globals.allRootsMap
- (fun r -> archiveNameOnRoot r MainArch) >>= fun names ->
- let l =
- List.map
- (fun (name, host, _) ->
- Format.sprintf " archive %s on host %s" name host)
- names
- in
- Lwt.fail
- (Util.Fatal
- (String.concat "\n"
- ("Warning: incompatible case sensitivity settings." ::
- Format.sprintf "Unison is currently in %s mode," curMode ::
- Format.sprintf
- "while the archives were created in %s mode." archMode ::
- "You should either change Unison's setup or delete" ::
- "the following archives from the .unison directories:" ::
- l @
- ["(or invoke Unison once with -ignorearchives flag).";
- "Then, try again."])))
- in
- match l with
- Some (_, magic) :: _ ->
- begin match compatibleCaseMode magic with
- `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 ()
-
(*****************************************************************************)
(* LOADING AND SAVING ARCHIVES *)
(*****************************************************************************)
@@ -603,6 +533,13 @@
(* ARCHIVE CASE CONVERSION *)
(*****************************************************************************)
+(* Stamp for marking unchange directories *)
+let dirStampKey : Props.dirChangedStamp Proplist.key =
+ Proplist.register "unchanged directory stamp"
+
+(* Property containing a description of the archive case sensitivity mode *)
+let caseKey : string Proplist.key = Proplist.register "case mode"
+
(* Turn a case sensitive archive into a case insensitive archive.
Directory children are resorted and duplicates are removed.
*)
@@ -613,8 +550,10 @@
let children =
NameMap.fold
(fun nm ch chs ->
- if NameMap.mem nm chs then dups := nm :: !dups;
- NameMap.add nm (makeCaseSensitiveRec ch) chs)
+ if Name.badEncoding nm then chs else begin
+ if NameMap.mem nm chs then dups := nm :: !dups;
+ NameMap.add nm (makeCaseSensitiveRec ch) chs
+ end)
children NameMap.empty
in
let children =
@@ -624,8 +563,81 @@
arch
let makeCaseSensitive thisRoot =
- setArchiveLocal thisRoot (makeCaseSensitiveRec (getArchive thisRoot))
+ setArchiveLocal thisRoot (makeCaseSensitiveRec (getArchive thisRoot));
+ (* We need to recheck all directories, so we mark them possibly changed *)
+ setArchivePropsLocal thisRoot
+ (Proplist.add dirStampKey (Props.freshDirStamp ())
+ (Proplist.add caseKey (Case.ops ())#modeDesc
+ (getArchiveProps thisRoot)))
+let makeCaseSensitiveOnRoot =
+ Remote.registerRootCmd "makeCaseSensitive"
+ (fun (fspath, ()) ->
+ makeCaseSensitive (thisRootsGlobalName fspath);
+ Lwt.return ())
+
+let canMakeCaseSensitive () =
+ Globals.allRootsMap (fun r -> Remote.commandAvailable r "makeCaseSensitive")
+ >>= fun l ->
+ Lwt.return (List.for_all (fun x -> x) l)
+
+(****)
+
+(* Get the archive case sensitivity mode from the archive magic. *)
+let archiveMode magic =
+ let currentMode = (Case.ops ())#modeDesc in
+ if magic = "" then currentMode (* Newly created archive *) else
+ try
+ String.sub magic 0 (String.index magic '\000')
+ with Not_found ->
+ (* Legacy format. Cannot be Unicode case insensitive. *)
+ if (Case.ops ())#mode = Case.UnicodeInsensitive then
+ "some non-Unicode"
+ else
+ currentMode
+
+let checkArchiveCaseSensitivity l =
+ let root = thisRootsGlobalName (snd (Globals.localRoot ())) in
+ let curMode = (Case.ops ())#modeDesc in
+ let archMode = Proplist.find caseKey (getArchiveProps root) in
+ if curMode = archMode then
+ Lwt.return ()
+ else begin
+ begin if archMode = Case.caseSensitiveModeDesc then
+ canMakeCaseSensitive ()
+ else
+ Lwt.return false
+ end >>= fun convert ->
+ if convert then
+ Globals.allRootsIter (fun r -> makeCaseSensitiveOnRoot r ())
+ else begin
+ (* We cannot compute the archive name locally as it
+ currently depends on the os type *)
+ Globals.allRootsMap
+ (fun r -> archiveNameOnRoot r MainArch) >>= fun names ->
+ let l =
+ List.map
+ (fun (name, host, _) ->
+ Format.sprintf " archive %s on host %s" name host)
+ names
+ in
+ Lwt.fail
+ (Util.Fatal
+ (String.concat "\n"
+ ("Warning: incompatible case sensitivity settings." ::
+ Format.sprintf "Unison is currently in %s mode," curMode ::
+ Format.sprintf
+ "while the archives were created in %s mode." archMode ::
+ "You should either change Unison's setup or delete" ::
+ "the following archives from the .unison directories:" ::
+ l @
+ ["(or invoke Unison once with -ignorearchives flag).";
+ "Then, try again."])))
+ end
+ end
+
+(****)
+
let rec populateCacheFromArchiveRec path arch =
match arch with
ArchiveDir (_, children) ->
@@ -658,21 +670,19 @@
^ "command-line use.")
let setArchiveData thisRoot fspath (arch, hash, magic, properties) info =
+ let archMode = archiveMode magic in
+ let curMode = (Case.ops ())#modeDesc in
+ let properties = Proplist.add caseKey archMode properties in
setArchiveLocal thisRoot arch;
setArchivePropsLocal thisRoot properties;
Hashtbl.replace archiveInfoCache thisRoot info;
- begin match compatibleCaseMode magic with
- `YES ->
- ()
- | `NO (conv, _, _) ->
- if conv then makeCaseSensitive thisRoot;
- populateCacheFromArchive fspath arch
- end;
+ if archMode <> curMode then populateCacheFromArchive fspath arch;
Lwt.return (Some (hash, magic))
let clearArchiveData thisRoot =
setArchiveLocal thisRoot NoArchive;
- setArchivePropsLocal thisRoot Proplist.empty;
+ setArchivePropsLocal thisRoot
+ (Proplist.add caseKey (Case.ops ())#modeDesc Proplist.empty);
Hashtbl.remove archiveInfoCache thisRoot;
Lwt.return (Some (0, ""))
@@ -1044,12 +1054,6 @@
Remote.registerRootCmd "translatePath"
(fun (fspath, path) -> Lwt.return (translatePathLocal fspath path))
-let isDir fspath path =
- let fullFspath = Fspath.concat fspath path in
- try
- (Fs.stat fullFspath).Unix.LargeFile.st_kind = Unix.S_DIR
- with Unix.Unix_error _ -> false
-
(***********************************************************************
MOUNT POINTS
************************************************************************)
@@ -1721,8 +1725,6 @@
let predKey : (string * string list) list Proplist.key =
Proplist.register "update predicates"
let rsrcKey : bool Proplist.key = Proplist.register "rsrc pref"
-let dirStampKey : Props.dirChangedStamp Proplist.key =
- Proplist.register "unchanged directory stamp"
let checkNoUpdatePredicateChange thisRoot =
let props = getArchiveProps thisRoot in
@@ -2304,7 +2306,7 @@
sizeOne children
let updateSize path ui =
- let rootLocal = List.hd (Globals.rootsInCanonicalOrder ()) in
+ let rootLocal = Globals.localRoot () in
let fspathLocal = snd rootLocal in
let root = thisRootsGlobalName fspathLocal in
let archive = getArchive root in
More information about the Unison-hackers
mailing list