[Unison-hackers] [unison-svn] r359 - trunk/src
vouillon@seas.upenn.edu
vouillon at seas.upenn.edu
Fri Jun 19 10:13:06 EDT 2009
Author: vouillon
Date: 2009-06-19 10:13:03 -0400 (Fri, 19 Jun 2009)
New Revision: 359
Modified:
trunk/src/Makefile.OCaml
trunk/src/RECENTNEWS
trunk/src/case.ml
trunk/src/copy.ml
trunk/src/globals.mli
trunk/src/mkProjectInfo.ml
trunk/src/path.mli
trunk/src/remote.ml
trunk/src/update.ml
Log:
* Various small changes
Modified: trunk/src/Makefile.OCaml
===================================================================
--- trunk/src/Makefile.OCaml 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/Makefile.OCaml 2009-06-19 14:13:03 UTC (rev 359)
@@ -416,7 +416,9 @@
-$(RM) -r *.o core gmon.out *~ .*~
-$(RM) -r *.obj *.lib *.exp
-$(RM) -r *.tmp *.bak?.tmp .*.bak?.tmp
- -$(RM) system/*.cm[iox] system/*.{o,obj}
+ -$(RM) system/*.cm[iox] system/*.{o,obj} system/win/*~
+ -$(RM) system/generic/*.cm[iox] system/generic/*.{o,obj} system/generic/*~
+ -$(RM) system/win/*.cm[iox] system/win/*.{o,obj} system/win/*~
.PHONY: paths
paths:
Modified: trunk/src/RECENTNEWS
===================================================================
--- trunk/src/RECENTNEWS 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/RECENTNEWS 2009-06-19 14:13:03 UTC (rev 359)
@@ -1,5 +1,10 @@
CHANGES FROM VERSION 2.35.-17
+* Various small changes
+
+-------------------------------
+CHANGES FROM VERSION 2.35.-17
+
* Use a better file name for keeping a copy of an incorrectly
transferred file. In particular, this is now a temp filename, and
Unison will not try to propagate it next time it is run.
Modified: trunk/src/case.ml
===================================================================
--- trunk/src/case.ml 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/case.ml 2009-06-19 14:13:03 UTC (rev 359)
@@ -133,7 +133,7 @@
let sensitiveOps = object
method mode = Sensitive
method modeDesc = "case sensitive"
- method compare s s' = compare s s'
+ method compare s s' = compare (s : string) s'
method hash s = Hashtbl.hash s
method normalizePattern s = s
method caseInsensitiveMatch = false
Modified: trunk/src/copy.ml
===================================================================
--- trunk/src/copy.ml 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/copy.ml 2009-06-19 14:13:03 UTC (rev 359)
@@ -88,7 +88,7 @@
Transfer aborted."
(Fspath.toPrintString (Fspath.concat fspathFrom pathFrom))))
-let checkContentsChangeOnHost =
+let checkContentsChangeOnRoot =
Remote.registerRootCmd
"checkContentsChange"
(fun (fspathFrom,
@@ -99,7 +99,7 @@
let checkContentsChange
root pathFrom archDesc archDig archStamp archRess paranoid =
- checkContentsChangeOnHost
+ checkContentsChangeOnRoot
root (pathFrom, archDesc, archDig, archStamp, archRess, paranoid)
(****)
@@ -211,11 +211,9 @@
let localFile
fspathFrom pathFrom fspathTo pathTo realPathTo update desc ressLength ido =
-(* let use_id f = match ido with Some id -> f id | None -> () in*)
Util.convertUnixErrorsToTransient
"copying locally"
(fun () ->
-(* use_id (fun id -> Uutil.showProgress id Uutil.Filesize.zero "l");*)
debug (fun () ->
Util.msg "Copy.localFile %s / %s to %s / %s\n"
(Fspath.toDebugString fspathFrom) (Path.toString pathFrom)
@@ -462,7 +460,6 @@
Lwt.catch
(fun () ->
decompressor := Remote.MsgIdMap.add file_id decompr !decompressor;
- Uutil.showProgress id Uutil.Filesize.zero "f";
compressRemotely connFrom
(bi, fspathFrom, pathFrom, fileKind, srcFileSize, id, file_id)
>>= fun () ->
@@ -720,7 +717,8 @@
rootFrom pathFrom rootTo fspathTo pathTo realPathTo
update desc fp ress id useExistingTarget
in
- (* When streaming, we only transfer one file at a time *)
+ (* When streaming, we only transfer one file at a time, so we don't
+ need to limit the number of concurrent transfers *)
if Prefs.read Remote.streamingActivated then
f ()
else
Modified: trunk/src/globals.mli
===================================================================
--- trunk/src/globals.mli 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/globals.mli 2009-06-19 14:13:03 UTC (rev 359)
@@ -22,8 +22,8 @@
(* same thing, as a list *)
val rootsList : unit -> Common.root list
-(* same thing, but in a standard order and ensuring that the Local root, if *)
-(* any, comes first *)
+(* same thing, but in a standard order and ensuring that a Local root *)
+(* comes first *)
val rootsInCanonicalOrder : unit -> Common.root list
(* Run a command on all roots *)
Modified: trunk/src/mkProjectInfo.ml
===================================================================
--- trunk/src/mkProjectInfo.ml 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/mkProjectInfo.ml 2009-06-19 14:13:03 UTC (rev 359)
@@ -164,3 +164,4 @@
+
Modified: trunk/src/path.mli
===================================================================
--- trunk/src/path.mli 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/path.mli 2009-06-19 14:13:03 UTC (rev 359)
@@ -19,7 +19,7 @@
val child : 'a path -> Name.t -> 'a path
val parent : local -> local
val finalName : t -> Name.t option
-val deconstruct : t -> (Name.t * t) option
+val deconstruct : 'a path -> (Name.t * 'a path) option
val deconstructRev : local -> (Name.t * local) option
val fromString : string -> 'a path
Modified: trunk/src/remote.ml
===================================================================
--- trunk/src/remote.ml 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/remote.ml 2009-06-19 14:13:03 UTC (rev 359)
@@ -960,8 +960,9 @@
checkHeader
conn (Bytearray.create 1) 0 (String.length connectionHeader) >>= (fun () ->
Lwt.ignore_result (receive conn);
- negociateFlowControl conn >>= (fun () ->
- Lwt.return conn))
+ (* Flow control negociation can be done asynchronously. *)
+ Lwt.ignore_result (negociateFlowControl conn);
+ Lwt.return conn)
let inetAddr host =
let targetHostEntry = Unix.gethostbyname host in
Modified: trunk/src/update.ml
===================================================================
--- trunk/src/update.ml 2009-06-18 09:29:40 UTC (rev 358)
+++ trunk/src/update.ml 2009-06-19 14:13:03 UTC (rev 359)
@@ -213,19 +213,26 @@
NoArchive appears only at root-level (indicated by [top]). Property: Two
archives of the same labeled-tree structure have the same hash-value.
NB: [h] is the hash accumulator *)
-let rec checkArchive (top: bool) (path: Path.t) (arch: archive) (h: int): int =
+(* Note that we build the current path as a list of names, as this is
+ much cheaper than using values of type [Path.t] *)
+let rec checkArchive
+ (top: bool) (path: Name.t list) (arch: archive) (h: int): int =
match arch with
ArchiveDir (desc, children) ->
begin match NameMap.validate children with
`Ok ->
()
| `Duplicate nm ->
+ let path =
+ List.fold_right (fun n p -> Path.child p n) path Path.empty in
raise
(Util.Fatal (Printf.sprintf
"Corrupted archive: \
the file %s occurs twice in path %s"
(Name.toString nm) (Path.toString path)));
| `Invalid (nm, nm') ->
+ let path =
+ List.fold_right (fun n p -> Path.child p n) path Path.empty in
raise
(Util.Fatal (Printf.sprintf
"Corrupted archive: the files %s and %s are not \
@@ -236,7 +243,7 @@
NameMap.fold
(fun n a h ->
Uutil.hash2 (Name.hash n)
- (checkArchive false (Path.child path n) a h))
+ (checkArchive false (n :: path) a h))
children (Props.hash desc h)
| ArchiveFile (desc, dig, _, ress) ->
Uutil.hash2 (Hashtbl.hash dig) (Props.hash desc h)
@@ -1653,7 +1660,7 @@
showArchive archive;
Format.print_flush();
**)
- let archiveHash = checkArchive true Path.empty archive 0 in
+ let archiveHash = checkArchive true [] archive 0 in
storeArchiveLocal
(Os.fileInUnisonDir newName) root archive archiveHash magic;
Lwt.return (Some archiveHash)
More information about the Unison-hackers
mailing list