[Unison-hackers] [unison-svn] r345 - branches/2.32/src
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Fri May 29 08:54:28 EDT 2009
Author: vouillon
Date: 2009-05-29 08:54:25 -0400 (Fri, 29 May 2009)
New Revision: 345
Modified:
branches/2.32/src/RECENTNEWS
branches/2.32/src/case.ml
branches/2.32/src/case.mli
branches/2.32/src/mkProjectInfo.ml
branches/2.32/src/uitext.ml
branches/2.32/src/update.ml
branches/2.32/src/uutil.ml
branches/2.32/src/uutil.mli
Log:
* Case sensitivity information put in the archive (in a backward
compatible way) and checked when the archive is loaded
* Text UI: during update detection, display status by updating a
single line rather than generating a new line of output every so
often. That should be less confusing.
* Text UI: in repeat mode, don't save the archives when there is no
update. Indeed, in this mode, we should minimize the amount of work
performed and it is unlikely that the archives have changed much.
Modified: branches/2.32/src/RECENTNEWS
===================================================================
--- branches/2.32/src/RECENTNEWS 2009-05-29 12:05:25 UTC (rev 344)
+++ branches/2.32/src/RECENTNEWS 2009-05-29 12:54:25 UTC (rev 345)
@@ -1,3 +1,15 @@
+CHANGES FROM VERSION 2.32.30
+
+* Case sensitivity information put in the archive (in a backward
+ compatible way) and checked when the archive is loaded
+* Text UI: during update detection, display status by updating a
+ single line rather than generating a new line of output every so
+ often. That should be less confusing.
+* Text UI: in repeat mode, don't save the archives when there is no
+ update. Indeed, in this mode, we should minimize the amount of work
+ performed and it is unlikely that the archives have changed much.
+
+-------------------------------
CHANGES FROM VERSION 2.32.25
* Fixed quotation of paths and names when writing to a preference file
Modified: branches/2.32/src/case.ml
===================================================================
--- branches/2.32/src/case.ml 2009-05-29 12:05:25 UTC (rev 344)
+++ branches/2.32/src/case.ml 2009-05-29 12:54:25 UTC (rev 345)
@@ -43,6 +43,9 @@
(* Note: this function must be fast *)
let insensitive () = Prefs.read someHostIsInsensitive
+let modeDescription () =
+ if insensitive () then "Latin-1 case insensitive" else "case sensitive"
+
let needNormalization s =
let rec iter s pos len wasDot =
if pos = len then wasDot else
Modified: branches/2.32/src/case.mli
===================================================================
--- branches/2.32/src/case.mli 2009-05-29 12:05:25 UTC (rev 344)
+++ branches/2.32/src/case.mli 2009-05-29 12:54:25 UTC (rev 345)
@@ -2,6 +2,7 @@
(* Copyright 1999-2009, Benjamin C. Pierce (see COPYING for details) *)
val insensitive : unit -> bool
+val modeDescription : unit -> string
val normalize : string -> string
Modified: branches/2.32/src/mkProjectInfo.ml
===================================================================
--- branches/2.32/src/mkProjectInfo.ml 2009-05-29 12:05:25 UTC (rev 344)
+++ branches/2.32/src/mkProjectInfo.ml 2009-05-29 12:54:25 UTC (rev 345)
@@ -112,3 +112,5 @@
+
+
Modified: branches/2.32/src/uitext.ml
===================================================================
--- branches/2.32/src/uitext.ml 2009-05-29 12:05:25 UTC (rev 344)
+++ branches/2.32/src/uitext.ml 2009-05-29 12:54:25 UTC (rev 345)
@@ -534,7 +534,10 @@
no updates to propagate because some files (in fact, if we've
just switched to DST on windows, a LOT of files) might have new
modtimes in the archive. *)
- Update.commitUpdates ();
+ (* JV (5/09): Don't save the archive in repeat mode as it has some
+ costs and its unlikely there is much change to the archives in
+ this mode. *)
+ if Prefs.read Uicommon.repeat = "" then Update.commitUpdates ();
(skipped > 0, false, [])
end else if proceed=ProceedImmediately then begin
doit()
@@ -586,9 +589,31 @@
end
let synchronizeOnce() =
+ let showStatus path =
+ if path = "" then Util.set_infos "" else
+ let max_len = 70 in
+ let mid = (max_len - 3) / 2 in
+ let path =
+ let l = String.length path in
+ if l <= max_len then path else
+ String.sub path 0 (max_len - mid - 3) ^ "..." ^
+ String.sub path (l - mid) mid
+ in
+ let c = "-\\|/".[truncate (mod_float (4. *. Unix.gettimeofday ()) 4.)] in
+ Util.set_infos (Format.sprintf "%c %s" c path)
+ in
Trace.status "Looking for changes";
+ if not (Prefs.read Trace.terse) && (Prefs.read Trace.debugmods = []) then
+ Uutil.setUpdateStatusPrinter (Some showStatus);
+
+ let updates = Update.findUpdates() in
+
+ Uutil.setUpdateStatusPrinter None;
+ Util.set_infos "";
+
let (reconItemList, anyEqualUpdates, dangerousPaths) =
- Recon.reconcileAll (Update.findUpdates()) in
+ Recon.reconcileAll updates in
+
if reconItemList = [] then begin
(if anyEqualUpdates then
Trace.status ("Nothing to do: replicas have been changed only "
Modified: branches/2.32/src/update.ml
===================================================================
--- branches/2.32/src/update.ml 2009-05-29 12:05:25 UTC (rev 344)
+++ branches/2.32/src/update.ml 2009-05-29 12:54:25 UTC (rev 345)
@@ -247,6 +247,54 @@
h::r -> h <> None && Safelist.for_all (fun h' -> h = h') r
| _ -> true
+let (archiveNameOnRoot
+ : Common.root -> archiveVersion -> (string * string * bool) Lwt.t)
+ =
+ Remote.registerRootCmd
+ "archiveName"
+ (fun (fspath, v) ->
+ let (name,_) = archiveName fspath v in
+ Lwt.return
+ (name,
+ Os.myCanonicalHostName,
+ Sys.file_exists (Fspath.toString (Os.fileInUnisonDir name))))
+
+let checkArchiveCaseSensitivity l =
+ match l with
+ Some (_, magic) :: _ ->
+ begin try
+ let archMode = String.sub magic 0 (String.index magic '\000') in
+ let curMode = Case.modeDescription () in
+ if curMode <> archMode then 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 assume %s mode." archMode ::
+ "You should either change Unison's setup " ::
+ "or delete the following archives:" ::
+ l @
+ ["Then, try again."])))
+ end else
+ Lwt.return ()
+ with Not_found ->
+ Lwt.return ()
+ end
+ | _ ->
+ Lwt.return ()
+
(*****************************************************************************)
(* LOADING AND SAVING ARCHIVES *)
(*****************************************************************************)
@@ -319,8 +367,10 @@
output_string c "\n";
output_string c (verboseArchiveName thisRoot);
output_string c "\n";
- output_string c (Printf.sprintf "Written at %s\n"
- (Util.time2string (Util.time())));
+ (* This third line is purely informative *)
+ output_string c (Printf.sprintf "Written at %s - %s mode\n"
+ (Util.time2string (Util.time()))
+ (Case.modeDescription ()));
Marshal.to_channel c (archive, hash, magic) [Marshal.No_sharing];
close_out c)
@@ -554,6 +604,7 @@
^ " arXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n"
^ " where the X's are a hexidecimal number .\n"
^ " c) Run unison again to synchronize from scratch.\n"));
+ checkArchiveCaseSensitivity checksums >>= fun () ->
if Prefs.read dumpArchives then
Globals.allRootsMap (fun r -> dumpArchiveOnRoot r ())
>>= (fun _ -> Lwt.return identicals)
@@ -750,18 +801,6 @@
Sys.file_exists (Fspath.toString (Os.fileInUnisonDir newname)) in
Lwt.return (oldexists, newexists))
-let (archiveNameOnRoot
- : Common.root -> archiveVersion -> (string * string * bool) Lwt.t)
- =
- Remote.registerRootCmd
- "archiveName"
- (fun (fspath, v) ->
- let (name,_) = archiveName fspath v in
- Lwt.return
- (name,
- Os.myCanonicalHostName,
- Sys.file_exists (Fspath.toString (Os.fileInUnisonDir name))))
-
let forall = Safelist.for_all (fun x -> x)
let exists = Safelist.exists (fun x -> x)
@@ -1032,7 +1071,8 @@
fileLength := 0;
let t = Unix.gettimeofday () in
if t -. !t0 > 0.05 then begin
- Trace.statusDetail ("scanning... " ^ Path.toString path);
+ Uutil.showUpdateStatus (Path.toString path);
+(*Trace.statusDetail ("scanning... " ^ Path.toString path);*)
t0 := t
end
end
@@ -1422,7 +1462,7 @@
let rec buildUpdate archive fspath fullpath here path =
match Path.deconstruct path with
None ->
- showStatus path;
+ showStatus here;
let (arch, ui) =
buildUpdateRec archive fspath here (useFastChecking()) in
(begin match arch with
@@ -1554,8 +1594,9 @@
findOnRoot r pathList)
(fun (host, _) ->
begin match host with
- Remote(_) -> Trace.statusDetail "Waiting for changes from server"
- | _ -> ()
+ Remote _ -> Uutil.showUpdateStatus "";
+ Trace.statusDetail "Waiting for changes from server"
+ | _ -> ()
end)
>>= (fun updates ->
Trace.showTimer t;
@@ -1606,7 +1647,8 @@
Remote.Thread.unwindProtect
(fun () ->
let magic =
- Format.sprintf "%.f.%d" (Unix.gettimeofday ()) (Unix.getpid ())
+ Format.sprintf "%s\000%.f.%d"
+ (Case.modeDescription ()) (Unix.gettimeofday ()) (Unix.getpid ())
in
Globals.allRootsMap (fun r -> prepareCommitOnRoot r magic)
>>= (fun checksums ->
Modified: branches/2.32/src/uutil.ml
===================================================================
--- branches/2.32/src/uutil.ml 2009-05-29 12:05:25 UTC (rev 344)
+++ branches/2.32/src/uutil.ml 2009-05-29 12:54:25 UTC (rev 345)
@@ -94,6 +94,13 @@
let showProgress i bytes ch =
if i <> File.dummy then !progressPrinter i bytes ch
+let statusPrinter = ref None
+let setUpdateStatusPrinter p = statusPrinter := p
+let showUpdateStatus path =
+ match !statusPrinter with
+ Some f -> f path
+ | None -> Trace.statusDetail path
+
(*****************************************************************************)
(* Copy bytes from one file_desc to another *)
(*****************************************************************************)
Modified: branches/2.32/src/uutil.mli
===================================================================
--- branches/2.32/src/uutil.mli 2009-05-29 12:05:25 UTC (rev 344)
+++ branches/2.32/src/uutil.mli 2009-05-29 12:54:25 UTC (rev 345)
@@ -46,6 +46,8 @@
val setProgressPrinter :
(File.t -> Filesize.t -> string -> unit) -> unit
val showProgress : File.t -> Filesize.t -> string -> unit
+val setUpdateStatusPrinter : (string -> unit) option -> unit
+val showUpdateStatus : string -> unit
(* Utility function to transfer bytes from one file descriptor to another
until EOF *)
More information about the Unison-hackers
mailing list